(list prev)
(let*
((line (car lines))
- (parser (getf (cadr (find-if #1'(funcall (getf $1 :checker) line) (reverse *line-parsers*) :key #'cadr)) :parser)))
+ (parser
+ (getf
+ (cadr (find-if (lambda (parser) (funcall (getf parser :checker) line)) (reverse *line-parsers*) :key #'cadr))
+ :parser)))
(when (not parser) (error "Weird! Couldn't find a match for ~A" line))
- (multiple-value-bind (parsed-line squash-prev) (funcall (funcall parser line) prev)
- (if squash-prev
- (parse-lines (cdr lines) parsed-line)
- (cons prev (parse-lines (cdr lines) parsed-line)))))))
+ (multiple-value-bind (parsed-line squash-prev suspension) (funcall (funcall parser line) prev)
+ (cond
+ (squash-prev (parse-lines (cdr lines) parsed-line))
+ (suspension
+ (let*
+ ((regex-to-find (car suspension))
+ (function-to-call (cadr suspension))
+ (pos
+ (position-if
+ (lambda (line) (cl-ppcre:scan regex-to-find line))
+ (cdr lines))))
+ (append
+ (list
+ prev
+ (funcall function-to-call (subseq (cdr lines) 0 (or pos (length lines)))))
+ (parse-lines (nthcdr (1+ pos) (cdr lines))))))
+ (t (cons prev (parse-lines (cdr lines) parsed-line))))))))
(defun parse-texts (line)
(cond
(defun parse-inline (str)
(let
- ((parser (getf (cadr (find-if #1'(funcall (getf $1 :checker) str) (reverse *inline-parsers*) :key #'cadr)) :parser)))
+ ((parser
+ (getf
+ (cadr (find-if (lambda (parser) (funcall (getf parser :checker) str)) (reverse *inline-parsers*) :key #'cadr))
+ :parser)))
(if parser (funcall parser str) str)))
(defmacro defline-parser (regex handler)
(let
((regex (format nil "^~A$" regex)))
`(progn
- (when (not (utils:strassoc ,regex *line-parsers*)) (push (list ,regex nil) *line-parsers*))
- (setf (utils:strassoc ,regex *line-parsers*)
- (list
- :checker (lambda (str) (cl-ppcre:scan ,regex str))
- :parser (lambda (str)
- (apply
- (function ,handler)
- (mapcar
- #'as-text
- (coerce (second (multiple-value-list (cl-ppcre:scan-to-strings ,regex str))) 'list)))))))))
+ (when (not (find ,regex *line-parsers* :key #'car :test #'string=)) (push (list ,regex nil) *line-parsers*))
+ (let
+ ((parser (find ,regex *line-parsers* :key #'car :test #'string=)))
+ (setf
+ (cadr parser)
+ (list
+ :checker (lambda (str) (cl-ppcre:scan ,regex str))
+ :parser (lambda (str)
+ (apply
+ (function ,handler)
+ (mapcar
+ #'as-text
+ (coerce (second (multiple-value-list (cl-ppcre:scan-to-strings ,regex str))) 'list))))))))))
(defmacro definline-parser (regex handler)
(let
((regex (format nil "^~A$" regex)))
`(progn
- (when (not (utils:strassoc ,regex *inline-parsers*)) (push (list ,regex nil) *inline-parsers*))
- (setf (utils:strassoc ,regex *inline-parsers*)
- (list
- :checker (lambda (str) (cl-ppcre:scan ,regex str))
- :parser (lambda (str)
- (apply (function ,handler)
- (mapcar
- #'parse-inline
- (coerce (second (multiple-value-list (cl-ppcre:scan-to-strings ,regex str))) 'list)))))))))
-
-; each parser function needs to return a function that takes the previous line and returns either
+ (when (not (find ,regex *inline-parsers* :key #'car :test #'string=)) (push (list ,regex nil) *inline-parsers*))
+ (let
+ ((parser (find ,regex *inline-parsers* :key #'car :test #'string=)))
+ (setf
+ (cadr parser)
+ (list
+ :checker (lambda (str) (cl-ppcre:scan ,regex str))
+ :parser (lambda (str)
+ (apply (function ,handler)
+ (mapcar
+ #'parse-inline
+ (coerce (second (multiple-value-list (cl-ppcre:scan-to-strings ,regex str))) 'list))))))))))
+
+; each parser function needs to return a function that takes the previous line and returns
;
-; a single element being the new element, and optionally a second values option about whether
-; the previous line should be consumed
+; the values:
+; the new element
+; whether the previous line should be consumed (optional)
+; an optional list with two items, which suspends parsing until regex is found
+; - the regex to end the suspension
+; - the function to call with the list of lines
(defun prev-h2 ()
(lambda (prev)
(lambda (prev)
(if (textp prev) (values (h1 prev) t) (hr))))
+(defun inline-h1 (text) (lambda (prev) (h1 text)))
+(defun inline-h2 (text) (lambda (prev) (h2 text)))
+(defun inline-h3 (text) (lambda (prev) (h3 text)))
+(defun inline-h4 (text) (lambda (prev) (h4 text)))
+(defun inline-h5 (text) (lambda (prev) (h5 text)))
+
(defun list-item (text)
(lambda (prev)
(let
(defun default (text)
(lambda (prev) (declare (ignore prev)) text))
+(defun codefence (codetype)
+ (lambda (prev)
+ (declare (ignore prev))
+ (values
+ nil
+ nil
+ (list
+ "^```$"
+ (lambda (lines)
+ (pre
+ (code
+ (format nil "~{~A~%~}" lines))))))))
+
(defline-parser "-+" prev-h2)
(defline-parser "=+" prev-h1)
+
+; These need to be in reverse order so they match correctly
+(defline-parser "##### *(.*)" inline-h5)
+(defline-parser "#### *(.*)" inline-h4)
+(defline-parser "### *(.*)" inline-h3)
+(defline-parser "## *(.*)" inline-h2)
+(defline-parser "# *(.*)" inline-h1)
+(defline-parser "```(.*)" codefence)
(defline-parser " *\\* *(.*)" list-item)
(defline-parser " *" emptiness)
(defline-parser "(.*)" default)