Add codefence, underscore emphasis

[honey] / src / main / parse.lisp

diff --git a/src/main/parse.lisp b/src/main/parse.lisp
index af3fca9a4e73795c0de31d17a13707024633f4a4..61f37e8e32cd3d5b50501862926890f131b0a50d 100644 (file)
--- a/src/main/parse.lisp
+++ b/src/main/parse.lisp
@@ -30,10 +30,13 @@ 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 suspension) (funcall (funcall parser line) prev)
-    (cond 
+    (cond
      (squash-prev (parse-lines (cdr lines) parsed-line))
      (suspension
       (let*
@@ -46,8 +49,8 @@ DESCRIPTION:
        (append
         (list
          prev
-         (funcall function-to-call (subseq (cdr lines) 0 (or pos (length lines)))))
-        (parse-lines (nthcdr (1+ pos) (cdr lines))))))
+         (funcall function-to-call (subseq (cdr lines) 0 (or pos (1- (length lines))))))
+        (parse-lines (nthcdr (if pos (1+ pos) (length lines)) (cdr lines))))))
      (t (cons prev (parse-lines (cdr lines) parsed-line))))))))
 
 (defun parse-texts (line)
@@ -58,37 +61,46 @@ 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)))))))))
+    (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
 ;
@@ -151,7 +163,17 @@ DESCRIPTION:
 (defline-parser "### *(.*)" inline-h3)
 (defline-parser "## *(.*)" inline-h2)
 (defline-parser "# *(.*)" inline-h1)
+
+; Ignore codefence
+(defline-parser "(```.*```.*)" default)
+
 (defline-parser "```(.*)" codefence)
+
+; If we start with a space after the asterisk, we really do want a list
+(defline-parser " *\\* (.*)" list-item)
+; Ignore list-tiem
+(defline-parser "(\\*\\*.*\\*\\*.*)" default)
+(defline-parser "(\\*.*\\*.*)" default)
 (defline-parser " *\\* *(.*)" list-item)
 (defline-parser " *" emptiness)
 (defline-parser "(.*)" default)
@@ -165,6 +187,11 @@ DESCRIPTION:
 (defun md-link (before text md-link after)
  (list before (a :href md-link (parse-texts text)) after))
 
+(defun inline-code (before during after)
+ (list before (code during) after))
+
 (definline-parser "(.*)\\[([^\\]]*)\\]\\(([^)]*)\\)(.*)" md-link)
 (definline-parser "(.*)\\*\\*(.*)\\*\\*(.*)" strength)
 (definline-parser "(.*)\\*(.*)\\*(.*)" emphasis)
+(definline-parser "(.*)_(.*)_(.*)" emphasis)
+(definline-parser "(.*)```(.*)```(.*)" inline-code)