math: support output to markdown

3bmd-ext-math.asd

@@ -1,9 +1,19 @@
-(in-package #:asdf-user)
-
-(defsystem 3bmd-ext-math
+(asdf:defsystem "3bmd-ext-math"
   :description "An extension for 3bmd for handling math markup"
-  :depends-on (3bmd esrap)
+  :depends-on ("3bmd" "esrap")
   :serial t
   :license "MIT"
   :author "Lukasz Janyst <lukasz@jany.st>"
-  :components ((:file "math")))
+  :components ((:file "math"))
+  :in-order-to ((test-op (test-op 3bmd-ext-math/tests))))
+
+(asdf:defsystem "3bmd-ext-math/tests"
+  :depends-on ("3bmd-ext-math" "3bmd-tests" "fiasco")
+  :serial t
+  :components ((:module "tests"
+                :components ((:module "extensions"
+                              :components ((:file "math"))))))
+  :perform (asdf:test-op (o s)
+             (or (uiop:symbol-call '#:fiasco '#:run-package-tests
+                                   :package '#:3bmd-ext-math-tests)
+                 (error "tests failed"))))

extensions.lisp

@@ -41,9 +41,11 @@
               (push new (cdr (nthcdr (1- min) list)))
               list)))))
 
-(defun %make-definer (extension-flag name expression options var rule exp)
+(defun %make-definer (extension-flag name expression options var rule exp
+                      extension-to-md-chars-to-escape)
   (let ((characters (cdr (assoc :character-rule options)))
         (escapes (cdr (assoc :escape-char-rule options)))
+        (md-chars-to-escapes (cdr (assoc :md-chars-to-escape options)))
         (after (cdr (assoc :after options)))
         (before (cdr (assoc :before options))))
     `(progn
@@ -76,20 +78,36 @@
          ,@(remove-if (lambda (a)
                         (member (car a) '(:character-rule
                                           :escape-char-rule
+                                          :md-chars-to-escape
                                           :after :before)))
                       options))
        (setf ,var
              (add-expression-to-list ',name
                                      ,var
                                      ,@(when before `(:before ',before))
                                      ,@(when after `(:after ',after)) ))
-       (esrap:change-rule ',rule ,exp))))
+       (esrap:change-rule ',rule ,exp)
+       (add-to-extension-to-md-chars-to-escape ,extension-to-md-chars-to-escape
+                                               ',extension-flag
+                                               ',md-chars-to-escapes))))
 
 (defmacro define-extension-inline (extension-flag name expression &body options)
   (%make-definer extension-flag name expression options '%inline-rules%
-                 '%inline '(cons 'or %inline-rules%)))
+                 '%inline '(cons 'or %inline-rules%)
+                 '3bmd::*extension-to-md-inline-chars-to-escape*))
 
 (defmacro define-extension-block (extension-flag name expression &body options)
   (%make-definer extension-flag name expression options '%block-rules% '%block
-                 '`(and (* blank-line) (or ,@%block-rules%))))
+                 '`(and (* blank-line) (or ,@%block-rules%))
+                 '3bmd::*extension-to-md-block-chars-to-escape*))
 
+;;; EXTENSION-FLAG to list of character hash tables where
+;;; DEFINE-EXTENSION-INLINE and DEFINE-EXTENSION-BLOCK register the
+;;; characters to escape when printing to Markdown with the
+;;; corresponding extension enabled at the time of printing.
+(defvar 3bmd::*extension-to-md-inline-chars-to-escape* (make-hash-table))
+(defvar 3bmd::*extension-to-md-block-chars-to-escape* (make-hash-table))
+
+(defun add-to-extension-to-md-chars-to-escape (ht extension-flag chars)
+  (setf (gethash extension-flag ht)
+        (append (gethash extension-flag ht) chars)))

markdown-printer.lisp

@@ -35,16 +35,37 @@
 ;;; These are some of the 3BMD-GRAMMAR::SPECIAL-CHARs. The ! character
 ;;; is not necessary to escape if [ is. Similary, no need to escape >
 ;;; if < is. Backslash should never be escaped.
-(defparameter *block-chars-to-escape* "*_`&[]<#")
-(defparameter *inline-chars-to-escape* (remove #\# *block-chars-to-escape*))
+(defparameter *md-default-block-chars-to-escape* "#")
+(defparameter *md-default-inline-chars-to-escape* "*_`&[]<")
+
+(defvar *md-block-chars-to-escape*)
+(defvar *md-inline-chars-to-escape*)
+
+(defun chars-to-escape-with-extensions (default extension-to-md-chars-to-escape)
+  (let ((strings (list default)))
+    (maphash (lambda (extension-flag chars)
+               (when (symbol-value extension-flag)
+                 (push (coerce chars 'string) strings)))
+             extension-to-md-chars-to-escape)
+    (apply #'concatenate 'string strings)))
+
+(defmacro with-md-escapes (&body body)
+  `(let ((*md-block-chars-to-escape*
+           (chars-to-escape-with-extensions
+            *md-default-block-chars-to-escape*
+            *extension-to-md-block-chars-to-escape*))
+         (*md-inline-chars-to-escape*
+           (chars-to-escape-with-extensions
+            *md-default-inline-chars-to-escape*
+            *extension-to-md-inline-chars-to-escape*)))
+     ,@body))
 
 (defun print-md-escaped (string stream)
   (loop for char across string
         do (when (and (not *in-code*)
-                      (find char
-                            (if (eq *md-in-block* :right-after-indent)
-                                *block-chars-to-escape*
-                                *inline-chars-to-escape*)))
+                      (or (find char *md-inline-chars-to-escape*)
+                          (and (eq *md-in-block* :right-after-indent)
+                               (find char *md-block-chars-to-escape*))))
              ;; TODO: The escaping is overeager. For example, there is
              ;; no need for the escapes in "\\<->" and "\\&KEY " due
              ;; to how the parser works, but this needs information
@@ -247,8 +268,9 @@
         (*md-prefix* "")
         (*md-in-block* nil)
         (*md-block-seen-p* nil))
-    (dolist (element doc)
-      (print-md-element element stream))))
+    (with-md-escapes
+        (dolist (element doc)
+          (print-md-element element stream)))))
 
 #|
 

math.lisp

@@ -2,52 +2,119 @@
 ; Support math markup using libraries like MathJax
 ; Author: Lukasz Janyst <lukasz@jany.st>
 ;
-; Works both with inline math:
+; Works with inline math:
 ;
-; Begining of the paragraph $$ \sum_{i=0}^{10} (u_{i} x_{i})^2 $$ blah blah
+;     $x_0$
+;     $`x_0`$
+;     $$x_0$$ text
 ;
-; and with blocks:
+; and block (display) math:
+;
+;     $$x_0$$
+;
+; - To avoid rendering "between $5 and $6" with inline math, both the
+;   opening and the closing $ character must be followed / preceded by
+;   a non-space character. This agrees with Pandoc. The other forms do
+;   not have such restriction.
+;
+; - In the block format, the opening $$ can only be preceded by
+;   spaces, and the closing $$ can only be followed by spaces on its
+;   own line.
+;
+; TODO:
+;
+; - Escaping within math (of e.g. $ characters) is not implemented.
 ;
-; $$
-; \sum_{i=0}^{10} (u_{i} x_{i})^2
-; $$
 ;-------------------------------------------------------------------------------
 
 (defpackage #:3bmd-math
   (:use #:cl #:esrap #:3bmd-ext)
-  (:export #:*math*))
+  (:import-from #:3bmd #:ensure-block #:end-block #:print-md)
+  (:import-from #:3bmd-grammar #:eof #:escaped-character #:newline
+                #:sp #:space-char)
+  (:export #:*math*
+           #:*html-inline-start-marker*
+           #:*html-inline-end-marker*
+           #:*html-block-start-marker*
+           #:*html-block-end-marker*))
 
 (in-package #:3bmd-math)
 
-(defrule math-content (* (and (! "$$") character))
+(defvar *html-inline-start-marker* "\\(")
+(defvar *html-inline-end-marker* "\\)")
+(defvar *html-block-start-marker* "\\[")
+(defvar *html-block-end-marker* "\\]")
+
+(define-extension-inline *math* math-inline-1
+    (and "$" inline-math-content-1 "$")
+  (:character-rule math-extended-chars #\$)
+  (:escape-char-rule math-escaped-characters #\$)
+  (:md-chars-to-escape #\$)
+  (:after escaped-character)
+  (:destructure (s c e)
+                (declare (ignore s e))
+                (list :math-inline-1 c)))
+
+(defrule inline-math-content-1
+    (and (! space-char)
+         (* (and (* (and (! space-char) (! "$") character))
+                 space-char))
+         (+ (and (! (or space-char "$")) character)))
   (:text t))
 
-(define-extension-inline *math* math-inline
-    (and "$$" math-content "$$")
+(define-extension-inline *math* math-inline-2
+    (and "$`" inline-math-content-2 "`$")
   (:destructure (s c e)
                 (declare (ignore s e))
-                (list :math-inline c)))
+                (list :math-inline-2 c)))
 
-(define-extension-block *math* math-block
-    (and "$$" math-content "$$")
-    (:destructure (s c e)
+(defrule inline-math-content-2 (* (and (! "`$") character))
+  (:text t))
+
+(define-extension-inline *math* math-inline-3
+    (and "$$" inline-math-content-3 "$$")
+  (:destructure (s c e)
                 (declare (ignore s e))
+                (list :math-inline-3 c)))
+
+(defrule inline-math-content-3 (* (and (! "$$") character))
+  (:text t))
+
+(define-extension-block *math* math-block
+    (and "$$" block-math-content "$$" sp (or newline eof))
+    (:destructure (s c e sp l)
+                (declare (ignore s e sp l))
                 (list :math-block c)))
 
-(defmethod print-tagged-element ((tag (eql :math-inline)) stream rest)
-  (format stream "\\(~a\\)" (car rest)))
+(defrule block-math-content (* (and (! "$$") character))
+  (:text t))
+
+(defmethod print-tagged-element ((tag (eql :math-inline-1)) stream rest)
+  (format stream "~a~a~a" *html-inline-start-marker* (car rest)
+          *html-inline-end-marker*))
+
+(defmethod print-tagged-element ((tag (eql :math-inline-2)) stream rest)
+  (format stream "~a~a~a" *html-inline-start-marker* (car rest)
+          *html-inline-end-marker*))
+
+(defmethod print-tagged-element ((tag (eql :math-inline-3)) stream rest)
+  (format stream "~a~a~a" *html-inline-start-marker* (car rest)
+          *html-inline-end-marker*))
 
 (defmethod print-tagged-element ((tag (eql :math-block)) stream rest)
-  (format stream "\\[~a\\]" (car rest)))
+  (format stream "~a~a~a" *html-block-start-marker* (car rest)
+          *html-block-end-marker*))
+
+(defmethod print-md-tagged-element ((tag (eql :math-inline-1)) stream rest)
+  (format stream "$~a$" (car rest)))
 
-#++
-(let ((3bmd-math:*math* t))
-  (esrap:parse '%inline "$$ \sum_{i=0}^{10} (u_{i} x_{i})^2 $$"))
+(defmethod print-md-tagged-element ((tag (eql :math-inline-2)) stream rest)
+  (format stream "$`~a`$" (car rest)))
 
-#++(let ((3bmd-math:*math* t))
-  (with-output-to-string (s)
-    (3bmd:parse-string-and-print-to-stream "test $$ \sum_{i=0}^{10} (u_{i} x_{i})^2 $$ test" s)))
+(defmethod print-md-tagged-element ((tag (eql :math-inline-3)) stream rest)
+  (format stream "$$~a$$" (car rest)))
 
-#++(let ((3bmd-math:*math* t))
-  (with-output-to-string (s)
-    (3bmd:parse-string-and-print-to-stream "$$ \sum_{i=0}^{10} (u_{i} x_{i})^2 $$" s)))
+(defmethod print-md-tagged-element ((tag (eql :math-block)) stream rest)
+  (ensure-block stream)
+  (print-md (format nil "$$~a$$" (car rest)) stream)
+  (end-block stream))