X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?p=honey;a=blobdiff_plain;f=src%2Fmain%2Fparse.lisp;h=74745bc750e392efe53821b680855b58081d5ebe;hp=b64cb22a09bf54be4ab300056499a656ac452b3a;hb=00c7e5b;hpb=16e1c2e03364b20f402be75788b68410efb5b95d

diff --git a/src/main/parse.lisp b/src/main/parse.lisp
index b64cb22..74745bc 100644
--- a/src/main/parse.lisp
+++ b/src/main/parse.lisp
@@ -30,12 +30,28 @@ DESCRIPTION:
   (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
@@ -45,42 +61,55 @@ DESCRIPTION:
 
 (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)
@@ -90,6 +119,12 @@ DESCRIPTION:
  (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
@@ -106,8 +141,29 @@ DESCRIPTION:
 (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)