Add support for ~strike-through~ text!

I've never worked with any kind of parser before so I'm just doing
this semi-blindly and it may be a highly inefficient way to do
things for all I know. That said, it's basically a copy of the
backtick code, so apart from duplication it can't be *that* bad...

commonmark/inlines.scm

@@ -29,7 +29,9 @@
 
 (define re-start-ticks (make-regexp "^`+"))
 (define re-ticks (make-regexp "`+"))
-(define re-main (make-regexp "^[^`*_\\\n[!<&]+"))
+(define re-start-tildes (make-regexp "^~+"))
+(define re-tildes (make-regexp "~+"))
+(define re-main (make-regexp "^[^`*_+~\\\n[!<&]+"))
 (define re-link-destination-brackets (make-regexp (string-append "^<(([^ <>\n\t\\]|"
                                                                  escaped-characters
                                                                  ")*)>")))
@@ -50,6 +52,12 @@
 (define (end-ticks? text)
   (regexp-exec re-ticks (text-value text) (text-position text)))
 
+(define (start-tildes? text)
+  (regexp-exec re-start-tildes (text-value text) (text-position text)))
+
+(define (end-tildes? text)
+  (regexp-exec re-tildes (text-value text) (text-position text)))
+
 (define (normal-text? text)
   (regexp-exec re-main (text-value text) (text-position text)))
 
@@ -346,6 +354,23 @@
     (parse-char (text-move text pos) (cons node nodes)
                 delim-stack ref-proc)))
 
+(define (parse-tildes text)
+  (let ((start-tildes (start-tildes? text)))
+    (let loop ((end-tildes (end-tildes? (text-move text (match:end start-tildes 0)))))
+      (cond ((not end-tildes)
+             (values (match:end start-tildes 0)
+                     (make-text-node (match:substring start-tildes 0))))
+            ((= (match-length start-tildes) (match-length end-tildes))
+             (values (match:end end-tildes 0)
+                     (make-strike-through-node (text-substring text (match:end start-tildes 0)
+                                                          (match:start end-tildes 0)))))
+            (else (loop (end-tildes? (text-move text (match:end end-tildes 0)))))))))
+
+(define (parse-strike-through text nodes delim-stack ref-proc)
+  (let-values (((pos node) (parse-tildes text)))
+    (parse-char (text-move text pos) (cons node nodes)
+                delim-stack ref-proc)))
+
 (define* (link-text? text ref-proc #:optional (ignore-links #f))
   (and (eq? (text-char text) #\[)
        (let loop ((text (text-advance text 1))
@@ -362,6 +387,7 @@
                            (text-advance text 1)
                            (loop (text-advance text 1) (- open-bracket-count 1))))
                 ((#\`) (loop (text-move text (parse-ticks text)) open-bracket-count))
+		((#\~) (loop (text-move text (parse-tildes text)) open-bracket-count))
                 ((#\<) (let-values (((autolink autolink-text) (parse-autolink text)))
                          (loop (if autolink autolink-text (text-advance autolink-text 1))
                                 open-bracket-count)))
@@ -513,6 +539,7 @@
         ((#\newline) (parse-newline text nodes delim-stack ref-proc))
         ((#\\) (parse-backslash text nodes delim-stack ref-proc))
         ((#\`) (parse-code-span text nodes delim-stack ref-proc))
+	((#\~) (parse-strike-through text nodes delim-stack ref-proc))
         ((#\* #\_) (parse-emphasis text nodes delim-stack ref-proc))
         ((#\[) (parse-link text nodes delim-stack ref-proc))
         ((#\!) (parse-image text nodes delim-stack ref-proc))

commonmark/node.scm

@@ -58,6 +58,8 @@
             blank-node?
             make-code-span-node
             code-span-node?
+	    make-strike-through-node
+	    strike-through-node?
             make-emphasis-node
             emphasis-node?
             make-link-node
@@ -91,6 +93,7 @@
 ;; - 'hardbreak
 ;; - 'blank
 ;; - 'code-span
+;; - 'strike-through
 ;; - 'emphasis
 ;; - 'link
 ;; interp. The type of CommonMark block node
@@ -283,6 +286,15 @@
 (define (code-span-node? node)
   (node-type? node 'code-span))
 
+;; Code span node
+(define (make-strike-through-node text)
+  (define (collapse-spaces)
+    (regexp-substitute/global #f "[ \t\n]+" text 'pre " " 'post))
+  (make-node 'strike-through #f (list (string-trim-both (collapse-spaces)))))
+
+(define (strike-through-node? node)
+  (node-type? node 'strike-through))
+
 ;; Emphasis node
 (define (make-emphasis-node nodes type)
   (make-node 'emphasis `((type . ,type)) nodes))

commonmark/sxml.scm

@@ -48,6 +48,7 @@ the current input port into SXML."
         ((list-node? n) (list-node->sxml n))
         ((text-node? n) (text-node->sxml n))
         ((code-span-node? n) (code-span-node->sxml n))
+	((strike-through-node? n) (strike-through-node->sxml n))
         ((softbreak-node? n) (softbreak-node->sxml n))
         ((hardbreak-node? n) (hardbreak-node->sxml n))
         ((emphasis-node? n) (emphasis-node->sxml n))
@@ -67,6 +68,9 @@ the current input port into SXML."
 (define (code-span-node->sxml n)
   `(code ,@(node-children n)))
 
+(define (strike-through-node->sxml n)
+  `(del ,@(node-children n)))
+
 (define (block-quote-node->sxml n)
   `(blockquote ,@(fold-nodes node->sxml (node-children n))))