diff --git a/extensions.lisp b/extensions.lisp index c044edb..f52299d 100644 --- a/extensions.lisp +++ b/extensions.lisp @@ -56,11 +56,12 @@ `((defrule ,(first characters) (or ,@(rest characters)) (:when ,extension-flag)) - (setf %extended-special-char-rules% - (add-expression-to-list ',(first characters) - %extended-special-char-rules%)) - (esrap:change-rule 'extended-special-char - (cons 'or %extended-special-char-rules%)))) + (if (assoc ',extension-flag %flag-to-extended-chars-alist%) + (setf (cdr (assoc ',extension-flag + %flag-to-extended-chars-alist%)) + ',(rest characters)) + (push '(,extension-flag ,@ (rest characters)) + %flag-to-extended-chars-alist%)))) ;; define a rule for escaped chars if any ,@ (when escapes `((defrule ,(first escapes) diff --git a/markdown-printer.lisp b/markdown-printer.lisp index fcfba18..2a22faa 100644 --- a/markdown-printer.lisp +++ b/markdown-printer.lisp @@ -223,11 +223,27 @@ (foo parse-tree)) n)) +(defun starts-with-backtick-p (parse-tree) + (let ((a (first parse-tree))) + (and (stringp a) + (plusp (length a)) + (char= (aref a 0) #\`)))) + +(defun ends-with-backtick-p (parse-tree) + (let ((a (first (last parse-tree)))) + (and (stringp a) + (plusp (length a)) + (char= (aref a (1- (length a))) #\`)))) + (defmethod print-md-tagged-element ((tag (eql :code)) stream rest) (let ((n (max-n-consecutive-backticks rest))) (loop repeat (1+ n) do (write-char #\` stream)) (let ((*in-code* t)) - (dolist (a rest) (print-md-element a stream))) + (when (starts-with-backtick-p rest) + (write-char #\Space stream)) + (dolist (a rest) (print-md-element a stream)) + (when (ends-with-backtick-p rest) + (write-char #\Space stream))) (loop repeat (1+ n) do (write-char #\` stream)))) (defmacro define-smart-quote-md-translation (name replacement) diff --git a/parser.lisp b/parser.lisp index cdd16db..98bd603 100644 --- a/parser.lisp +++ b/parser.lisp @@ -33,32 +33,51 @@ (defrule line-break (and " " normal-endline) (:constant '(:line-break))) (defrule endline (or line-break terminal-endline normal-endline)) -(defrule normal-char (and (! (or special-char space-char newline)) character) - (:text t)) -(defrule special-char (or #\* #\_ #\` #\& #\[ #\] #\< #\! #\# #\\ - extended-special-char) - (:text t)) (eval-when (:compile-toplevel :load-toplevel :execute) - (defparameter %extended-special-char-rules% nil)) -(defrule extended-special-char #.(cons 'or %extended-special-char-rules%) + (defparameter %standard-special-chars% + '(#\* #\_ #\` #\& #\[ #\] #\< #\! #\# #\\)) + ;; Elements like (*SMART-QUOTES* . ) where + ;; are from the corresponding :CHARACTER-RULE. + (defvar %flag-to-extended-chars-alist% ())) + +(declaim (inline extended-special-char-p)) +(defun extended-special-char-p (char) + (dolist (entry %flag-to-extended-chars-alist%) + (when (and (symbol-value (car entry)) + (member char (cdr entry))) + (return t)))) + +(declaim (inline newlinep)) +(defun newlinep (char next-char) + (or (char= char #\linefeed) + (and (char= char #\return) + (eql next-char #\linefeed)))) + +;;; A predicate equivalent to (AND (! (OR SPECIAL-CHAR SPACE-CHAR NEWLINE)). +(defun normal-char-p (char next-char) + (and (not (or (char= char #\space) + (char= char #\tab) + (special-char-p char) + (newlinep char next-char))))) + +(defun special-char-p (char) + (declare (type character char)) + (or (find char #.(coerce %standard-special-chars% 'string)) + (extended-special-char-p char))) + +(defrule special-char (special-char-p character) (:text t)) - (defrule non-space-char (and (! space-char) (! newline) character) (:text t)) -(defrule alphanumeric (alphanumericp character)) -(defrule dec-digit (or #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)) +(defrule alphanumeric (alphanumericp character) + (:use-cache nil)) +(defrule dec-digit (character-ranges (#\0 #\9))) (defrule hex-digit (or dec-digit #\a #\A #\b #\B #\c #\C #\d #\D #\e #\E #\f #\F)) -(defun ascii-char-p (c) - (let ((c (char-code c))) - (or (<= (char-code #\a) c (char-code #\z)) - (<= (char-code #\A) c (char-code #\Z)) - (<= (char-code #\0) c (char-code #\9))))) -(defrule |A-Za-z| #.`(or ,@(coerce "ABCDEFGHIJKLMNOPQRSTUVWXYZ" 'list) - ,@(coerce "abcdefghijklmnopqrstuvwxyz" 'list))) -(defrule ascii-character (ascii-char-p character)) -(defrule alphanumeric-ascii (ascii-char-p character)) +(defrule |A-Za-z| (character-ranges (#\a #\z) (#\A #\Z))) +(defrule ascii-character (character-ranges (#\a #\z) (#\A #\Z) (#\0 #\9))) +(defrule alphanumeric-ascii ascii-character) (defrule doc (and (* %block) (* blank-line)) (:destructure (content blanks) @@ -103,9 +122,31 @@ (defrule line raw-line (:text t)) -(defrule raw-line (or (and (* (and (! newline) character)) - newline) - (and (+ character) eof))) + +;;; This function is an optimized version of the rule +;;; +;;; (or (and (* (and (! newline) character)) newline) +;;; (and (+ character) eof)) +(defun parse-raw-line (text position end) + (declare (type string text) + (type fixnum position end)) + (if (>= position end) + (values nil position) + (let ((p position)) + (declare (type fixnum p)) + (let ((pos (loop while (< p end) + for char = (aref text p) + do (when (char= char #\linefeed) + (return (1+ p))) + (when (and (char= char #\return) + (< (1+ p) end) + (char= (aref text (1+ p)) #\linefeed)) + (return (+ p 2))) + (incf p) + finally (return p)))) + (values (subseq text position pos) pos))))) +(defrule raw-line (function parse-raw-line)) + (defrule optionally-indented-line (and (? indent) line) (:destructure (i l) (declare (ignore i)) @@ -446,7 +487,7 @@ (cons :plain a))) (eval-when (:compile-toplevel :load-toplevel :execute) - (defparameter %inline-rules% '(string + (defparameter %inline-rules% '(%string endline ul-or-star-line %space @@ -469,11 +510,56 @@ (defrule maybe-alphanumeric (& alphanumeric) (:constant "")) -(defrule string (or (and alphanumeric (* (or normal-char - (and (+ #\_) maybe-alphanumeric)))) - ;; This could be (+ NORMAL-CHAR), but that's a bit slower. - normal-char) - (:text t)) + +;;; This function is an optimized version of the rule +;;; +;;; (or (and alphanumeric (* (or normal-char +;;; (and (+ #\_) maybe-alphanumeric)))) +;;; (+ normal-char)) +(defun parse-string (text position end) + (declare (type string text) + (type fixnum position end)) + (if (<= end position) + (values nil position) + (let ((c (aref text position))) + (cond ((alphanumericp c) + (let ((p (1+ position))) + (declare (type fixnum p)) + (loop while (< p end) + for char = (aref text p) + for next-char = (when (< (1+ p) end) + (aref text (1+ p))) + do (cond + ((normal-char-p char next-char) + (incf p)) + ((char= char #\_) + (let ((i p)) + (declare (type fixnum i)) + (loop while (and (< i end) + (char= (aref text i) #\_)) + do (incf i)) + (if (and (< i end) + (alphanumericp (aref text i))) + (setq p i) + (return)))) + (t + (return)))) + (values (subseq text position p) p))) + ((normal-char-p c (when (< (1+ position) end) + (aref text (1+ position)))) + (let ((p (1+ position))) + (declare (type fixnum p)) + (loop while (< p end) + for char = (aref text p) + for next-char = (when (< (1+ p) end) + (aref text (1+ p))) + do (if (normal-char-p char next-char) + (incf p) + (return))) + (values (subseq text position p) p))) + (t + (values nil position)))))) +(defrule %string (function parse-string)) (defrule maybe-space-char (& space-char) (:constant "")) @@ -623,15 +709,17 @@ (ticks-code ticks3 code3 "```") (ticks-code ticks4 code4 "````") (ticks-code ticks5 code5 "`````")) -(defrule code (or code1 code2 code3 code4 code5) - (:lambda (a) +(defrule code (and (& #\`) (or code1 code2 code3 code4 code5)) + (:destructure (guard a) + (declare (ignore guard)) (list :code a))) -(defrule raw-html (or html-comment - html-processing-instruction - html-tag) - (:lambda (a) +(defrule raw-html (and (& #\<) (or html-comment + html-processing-instruction + html-tag)) + (:destructure (guard a) + (declare (ignore guard)) (list :raw-html a))) (defrule html-comment (and "") character)) "-->") (:text t)) diff --git a/tables.lisp b/tables.lisp index 9c676c2..fe205be 100644 --- a/tables.lisp +++ b/tables.lisp @@ -159,13 +159,13 @@ :body (((td (:plain "col" " " (:code "3") " " "is") left) (td (:plain "some" " " "wordy" " " "text") center) - (td (:plain "$1600") right)) + (td (:plain "$" "1600") right)) ((td (:plain "col" " " "2" " " "is") left) (td (:plain "centered") center) - (td (:plain "$12") right)) + (td (:plain "$" "12") right)) ((td (:plain "zebra" " " "stripes") left) (td (:plain "are" " " "neat") center) - (td (:plain "$1") right))))) + (td (:plain "$" "1") right))))) (parse-doc " | Left-Aligned | Center Aligned | Right Aligned | | :------------ |:---------------:| -----:| diff --git a/tests/grammar/blocks/heading.lisp b/tests/grammar/blocks/heading.lisp index b2168da..75d14cd 100644 --- a/tests/grammar/blocks/heading.lisp +++ b/tests/grammar/blocks/heading.lisp @@ -71,7 +71,7 @@ World! (:LIST-ITEM (:PLAIN "First" " " "line"))) (:PLAIN " " "The" " " "header" " " - " " "=" "=" "=" "=" "=" "=" "=" "=" "=" "="))) + " " "=========="))) (def-grammar-test atx-heading-in-a-list ;; bug 35 ;;; marked bug as invalid, since original markdown is inconsistent diff --git a/tests/grammar/inlines/link.lisp b/tests/grammar/inlines/link.lisp index a20d221..27a1f1b 100644 --- a/tests/grammar/inlines/link.lisp +++ b/tests/grammar/inlines/link.lisp @@ -140,5 +140,5 @@ x" :expected '((:PARAGRAPH (:REFERENCE-LINK :LABEL ("link") :TAIL NIL)) (:PLAIN (:REFERENCE-LINK :LABEL ("link") :TAIL NIL) - ":" " " "http://example.com/" " " "\"" "title\"" " " + ":" " " "http://example.com/" " " "\"title\"" " " "junk"))) diff --git a/tests/grammar/inlines/string.lisp b/tests/grammar/inlines/string.lisp index f311029..6aac1e7 100644 --- a/tests/grammar/inlines/string.lisp +++ b/tests/grammar/inlines/string.lisp @@ -2,25 +2,25 @@ (def-grammar-test string-test-1 - :rule 3bmd-grammar::string + :rule 3bmd-grammar::%string :text "Some string with spaces." :expected "Some" :remaining-text " string with spaces.") (def-grammar-test string-test-2 - :rule 3bmd-grammar::string + :rule 3bmd-grammar::%string :text "100500 string with spaces." :expected "100500" :remaining-text " string with spaces.") (def-grammar-test string-test-3 - :rule 3bmd-grammar::string + :rule 3bmd-grammar::%string :text "@a_symbol@ string with spaces." - :expected "@" - :remaining-text "a_symbol@ string with spaces.") + :expected "@a" + :remaining-text "_symbol@ string with spaces.") (def-grammar-test string-test-4 - :rule 3bmd-grammar::string + :rule 3bmd-grammar::%string :text "*a_symbol* string with spaces." ;; TODO: Probably this is not an error, because * surrounds ;; emphasised text. diff --git a/tests/printing/inline.lisp b/tests/printing/inline.lisp index 5bd2a6e..6065d68 100644 --- a/tests/printing/inline.lisp +++ b/tests/printing/inline.lisp @@ -163,3 +163,18 @@ :format :markdown :text "" :expected "") + +(def-print-test print-code-with-backticks-1 + :format :markdown + :text "``a`b``" + :expected "``a`b``") + +(def-print-test print-code-with-backticks-2 + :format :markdown + :text "``a` ``" + :expected "``a` ``") + +(def-print-test print-code-with-backticks-3 + :format :markdown + :text "`` `b``" + :expected "`` `b``")