Commits

Anonymous committed 9bebed7

18:1!!

Comments (0)

Files changed (1)

                 (surrounded-by #\_ (char-seq "__")))
         (node 'strong))))
 
+(define ul-or-star-line
+  (any-of (line-of #\*) (line-of #\_)))
+
 ;; EscapedChar =   '\\' !Newline < [-\\`|*_{}[\]()#+.!><] >
 
 (define escaped-char
             (as-string))
         (o result html-strip)))
 
+;; Quoted =        '"' (!'"' .)* '"' | '\'' (!'\'' .)* '\''
+
+(define quoted
+  (let ((delimiters (satisfies (char-set #\" #\'))))
+    (sequence* ((delimiter delimiters)
+                (text (zero-or-more (preceded-by (none-of (is delimiter)) item)))
+                (_ (is delimiter)))
+      (result text))))
+
+;; HtmlAttribute = (AlphanumericAscii | '-')+ Spnl ('=' Spnl (Quoted | (!'>' Nonspacechar)+))? Spnl
+
+(define html-attribute-value
+  (preceded-by (is #\=)
+               space-new-line
+               (->> non-space-char
+                    (preceded-by (none-of (is #\>)))
+                    (one-or-more)
+                    (any-of quoted)
+                    (as-string))))
+
+(define html-attribute
+  (sequence* ((name (-> (any-of alphanumeric-ascii (is #\-))
+                        (one-or-more)
+                        (as-string)))
+              (_ space-new-line)
+              (value (maybe html-attribute-value))
+              (_ space-new-line))
+    (let ((name (string->symbol name)))
+      (if value
+          (result (list name value))
+          (result name)))))
+
+;; HtmlComment =   "<!--" (!"-->" .)* "-->"
+
+(define html-comment
+  (sequence* ((_ (char-seq "<!--"))
+              (text (->> item
+                         (preceded-by (none-of (char-seq "-->")))
+                         (zero-or-more)
+                         (as-string)))
+              (_ (char-seq "-->")))
+    (result `(comment ,(tabs->spaces text)))))
+
+(define (html-element el attrs #!optional (contents '()))
+  (append (list 'html-element (string->symbol el))
+          (if (null? attrs)
+              '()
+              (list (cons '@ attrs)))
+          contents))
+
+(define (html-element-close-parser el)
+  (preceded-by (is #\<) space-new-line (is #\/)
+               (char-seq el) space-new-line (is #\>)))
+
+(define (html-element-parser element-parsers contents-parser)
+  (sequence* ((_ (preceded-by (is #\<) space-new-line))
+              (el (any-of element-parsers))
+              (close (result (html-element-close-parser el)))
+              (_ space-new-line)
+              (attrs (zero-or-more html-attribute))
+              (_ (is #\>))
+              (contents (contents-parser close))
+              (_ close))
+    (result (html-element el attrs contents))))
+
+(define html-inline-element
+  (mutually-recursive-parser
+   (html-element-parser
+    (list (char-seq "a") (char-seq "span"))
+    (lambda (close)
+      (->> (preceded-by (none-of close) inline)
+           (zero-or-more))))))
+
+;; RawHtml =   < (HtmlComment | HtmlBlockScript | HtmlTag) >
+
+(define raw-html
+  (any-of html-comment (html-inline-element)))
+
 (define inline
   (any-of (is #\>)
           (as-string (one-or-more normal-char))
           line-end
+          ul-or-star-line
           space+
           (strong)
           (emph)
           link
           code
+          raw-html
           entity
           (as-string escaped-char)
           (as-string special-char)))
                   (as-string))))
     (result (cons 'blockquote (parse document text)))))
 
-
-
 (define html-block-elements
-  (append-map
-   (lambda (el)
-     (map char-seq (list el (string-upcase el))))
-   '("address" "blockquote" "center" "dir" "div" "dl" "fieldset" "form" "h1" "h2" "h3"
-     "h4" "h5" "h6" "hr" "isindex" "menu" "noframes" "noscript" "ol" "p" "pre" "table"
-     "ul" "dd" "dt" "frameset" "li" "tbody" "td" "tfoot" "th" "thead" "tr" "script" )))
-
-;; Quoted =        '"' (!'"' .)* '"' | '\'' (!'\'' .)* '\''
-
-(define quoted
-  (let ((delimiters (satisfies (char-set #\" #\'))))
-    (sequence* ((delimiter delimiters)
-                (text (zero-or-more (preceded-by (none-of (is delimiter)) item)))
-                (_ (is delimiter)))
-      (result text))))
+  (->> '("address" "blockquote" "center" "dir" "div" "dl" "fieldset" "form" "h1" "h2" "h3"
+         "h4" "h5" "h6" "hr" "isindex" "menu" "noframes" "noscript" "ol" "p" "pre" "table"
+         "ul" "dd" "dt" "frameset" "li" "tbody" "td" "tfoot" "th" "thead" "tr" "script" )
+       (append-map
+        (lambda (el)
+          (list (char-seq el)
+                (char-seq (string-upcase el)))))))
 
-;; HtmlAttribute = (AlphanumericAscii | '-')+ Spnl ('=' Spnl (Quoted | (!'>' Nonspacechar)+))? Spnl
-
-(define html-attribute
-  (sequence* ((name (-> (any-of alphanumeric-ascii (is #\-))
-                        (one-or-more)
-                        (as-string)))
-              (_ space-new-line)
-              (value (maybe (preceded-by (is #\=)
-                                         space-new-line
-                                         (->> non-space-char
-                                              (preceded-by (none-of (is #\>)))
-                                              (one-or-more)
-                                              (any-of quoted)
-                                              (as-string)))))
-              (_ space-new-line))
-    (let ((name (string->symbol name)))
-      (if value
-          (result (list name value))
-          (result name)))))
 
 ;; HtmlBlockOpenAddress = '<' Spnl ("address" | "ADDRESS") Spnl HtmlAttribute* '>'
 ;; HtmlBlockCloseAddress = '<' Spnl '/' ("address" | "ADDRESS") Spnl '>'
 ;; HtmlBlockAddress = HtmlBlockOpenAddress (HtmlBlockAddress | !HtmlBlockCloseAddress .)* HtmlBlockCloseAddress
 
-(define (html-block-close el)
-  (preceded-by (is #\<) space-new-line (is #\/)
-               (char-seq el) space-new-line (is #\>)))
-
-(define (html-element el attrs #!optional (contents '()))
-  (append (list 'html-element (string->symbol el))
-          (if (null? attrs)
-              '()
-              (list (cons '@ attrs)))
-          contents))
-
-(define html-block-element
-  (mutually-recursive-parser
-   (sequence* ((_ (preceded-by (is #\<) space-new-line))
-               (el (any-of html-block-elements))
-               (close (result (html-block-close el)))
-               (_ space-new-line)
-               (attrs (zero-or-more html-attribute))
-               (_ (is #\>))
-               (contents (->> (preceded-by (none-of close (html-block-element)) item)
-                              (one-or-more)
-                              (as-string)
-                              (any-of (html-block-element))
-                              (zero-or-more)))
-               (_ close))
-     (result (html-element el attrs contents)))))
-
-;; HtmlComment =   "<!--" (!"-->" .)* "-->"
+(define (html-block-in-tags* element-parser)
+  (sequence* ((_ (preceded-by (is #\<) space-new-line))
+              (el (any-of html-block-elements))
+              (close (result (html-element-close-parser el)))
+              (_ space-new-line)
+              (attrs (zero-or-more html-attribute))
+              (_ (is #\>))
+              (contents (let ((element (html-block-in-tags* element-parser)))
+                          (->> (preceded-by (none-of close) item)
+                               (any-of element)
+                               (zero-or-more))))
+              (_ close))
+    (result (html-element el attrs contents))))
 
-(define html-comment
-  (sequence* ((_ (char-seq "<!--"))
-              (text (->> item
-                         (preceded-by (none-of (char-seq "-->")))
-                         (zero-or-more)
-                         (as-string)))
-              (_ (char-seq "-->")))
-    (result `(comment ,(tabs->spaces text)))))
+(define html-block-in-tags
+  (html-block-in-tags* html-block-elements))
 
 ;; HtmlBlockSelfClosing = '<' Spnl HtmlBlockType Spnl HtmlAttribute* '/' Spnl '>'
 
 ;;             }
 
 (define html-block
-  (any-of (html-block-element)
+  (any-of html-block-in-tags
           html-comment
           html-block-self-closing))