Commits

Moritz Heidkamp  committed fa0ed20

Emphasis, strong and tab handling

  • Participants
  • Parent commits a47ff96

Comments (0)

Files changed (1)

File lowdown-impl.scm

 (import chicken scheme)
-(use comparse clojurian-syntax latch sxml-transforms
+(use comparse clojurian-syntax latch sxml-transforms irregex
      srfi-1 srfi-14 data-structures char-set-literals)
 
 (define (node el parser)
   (char-set #\space #\tab))
 
 (define space-char
-  (satisfies space-chars))
+  (preceded-by (satisfies space-chars)
+               (result #\space)))
 
 ;; Sp
 (define space*
 
 ;; Space
 (define space+
-  (preceded-by (one-or-more space-char)
-               (result #\space)))
+  (one-or-more space-char))
 
 (define new-line
   (is #\newline))
           reference-link
           auto-link))
 
-
-;; # This keeps the parser from getting bogged down on long strings of '*' or '_',
-;; # or strings of '*' or '_' with space on each side:
-;; UlOrStarLine =  (UlLine | StarLine) { $$ = mk_str(yytext); }
-;; StarLine =      < "****" '*'* > | < Spacechar '*'+ &Spacechar >
-;; UlLine   =      < "____" '_'* > | < Spacechar '_'+ &Spacechar >
-
 (define (line-of char)
   (any-of (repeated (is char) min: 4)
           (-> (sequence space-char (one-or-more (is char)))
               (followed-by space-char))))
 
-(define star-line
-  (line-of #\*))
-
-(define ul-line
-  (line-of #\_))
-
-(define ul-or-star-line
-  (as-string (any-of ul-line star-line)))
-
-;; OneStarOpen  =  !StarLine '*' !Spacechar !Newline
-
-(define one-star-open
-  (preceded-by (none-of star-line)
-               (is #\*)
-               (none-of space-char new-line)))
-
-;; OneStarClose =  !Spacechar !Newline a:Inline '*' { $$ = a; }
-
-(define one-star-close
-  (mutually-recursive-parser
-   (enclosed-by (none-of space-char new-line)
+(define (surrounded-by char parser)
+  (let ((close (enclosed-by
+                (none-of space-char new-line)
                 inline
-                (is #\*))))
-
-;; EmphStar =  OneStarOpen
-;;             a:StartList
-;;             ( !OneStarClose Inline { a = cons($$, a); } )*
-;;             OneStarClose { a = cons($$, a); }
-;;             { $$ = mk_list(EMPH, a); }
-
-(define emph-star
-  (mutually-recursive-parser
-   (preceded-by one-star-open
-                (-> (preceded-by (none-of (one-star-close)) inline)
-                    (zero-or-more))
-                (one-star-close))))
-
-
-;; OneUlOpen  =  !UlLine '_' !Spacechar !Newline
-
-(define one-ul-open
-  (preceded-by (none-of ul-line)
-               (is #\_)
-               (none-of space-char new-line)))
-
-;; OneUlClose =  !Spacechar !Newline a:Inline '_' !Alphanumeric { $$ = a; }
+                parser)))
+    (preceded-by (none-of (line-of char))
+                 parser
+                 (none-of space-char new-line)
+                 (sequence
+                   (-> (preceded-by (none-of close) inline)
+                       (zero-or-more))
+                   close))))
 
-(define one-ul-close
+(define emph
   (mutually-recursive-parser
-   (enclosed-by (none-of space-char new-line)
-                inline
-                (is #\_))))
+   (->> (any-of (surrounded-by #\* (is #\*))
+                (surrounded-by #\_ (is #\_)))
+        (node 'emphasis))))
 
-;; EmphUl =    OneUlOpen
-;;             a:StartList
-;;             ( !OneUlClose Inline { a = cons($$, a); } )*
-;;             OneUlClose { a = cons($$, a); }
-;;             { $$ = mk_list(EMPH, a); }
-
-(define emph-ul
+(define strong
   (mutually-recursive-parser
-   (preceded-by one-ul-open
-                (-> (preceded-by (none-of (one-ul-close)) inline)
-                    (zero-or-more))
-                (one-ul-close))))
-
-;; Emph =      EmphStar | EmphUl
-
-(define emph
-  (->> (any-of (emph-star) (emph-ul))
-       (node 'emph)))
-
-
-;; Strong = StrongStar | StrongUl
-
-;; TwoStarOpen =   !StarLine "**" !Spacechar !Newline
-;; TwoStarClose =  !Spacechar !Newline a:Inline "**" { $$ = a; }
-
-;; StrongStar =    TwoStarOpen
-;;                 a:StartList
-;;                 ( !TwoStarClose Inline { a = cons($$, a); } )*
-;;                 TwoStarClose { a = cons($$, a); }
-;;                 { $$ = mk_list(STRONG, a); }
-
-;; TwoUlOpen =     !UlLine "__" !Spacechar !Newline
-;; TwoUlClose =    !Spacechar !Newline a:Inline "__" !Alphanumeric { $$ = a; }
-
-;; StrongUl =  TwoUlOpen
-;;             a:StartList
-;;             ( !TwoUlClose Inline { a = cons($$, a); } )*
-;;             TwoUlClose { a = cons($$, a); }
-;;             { $$ = mk_list(STRONG, a); }
-
+   (->> (any-of (surrounded-by #\* (char-seq "**"))
+                (surrounded-by #\_ (char-seq "__")))
+        (node 'strong))))
 
 (define inline
   (any-of (as-string (one-or-more normal-char))
           line-end
           space+
-          emph
+          (strong)
+          (emph)
           link
           special-char))
 
           (sequence (one-or-more item) end-of-input)))
 
 (define line
-  (as-string raw-line))
+  (sequence* ((line (as-string raw-line)))
+    (result (irregex-replace/all
+             '(seq (submatch (* (~ #\tab))) #\tab)
+             line
+             (lambda (m)
+               (let ((prefix (irregex-match-substring m 1)))
+                 (string-append
+                  prefix
+                  (make-string (- 4 (modulo (string-length prefix) 4)) #\space))))))))
 
 ;; Indent =            "\t" | "    "
 
               (text (one-or-more non-blank-indented-line)))
     (result (append blank-lines text))))
 
+
+;; Verbatim =     a:StartList ( VerbatimChunk { a = cons($$, a); } )+
+;;                { $$ = mk_str_from_list(a, false);
+;;                  $$->key = VERBATIM; }
+
 (define verbatim
   (sequence* ((chunks (one-or-more verbatim-chunk)))
     (result `(verbatim . ,chunks))))
 (define horizontal-rule-char
   (satisfies horizontal-rule-chars))
 
+;; HorizontalRule = NonindentSpace
+;;                  ( '*' Sp '*' Sp '*' (Sp '*')*
+;;                  | '-' Sp '-' Sp '-' (Sp '-')*
+;;                  | '_' Sp '_' Sp '_' (Sp '_')*)
+;;                  Sp Newline BlankLine+
+;;                  { $$ = mk_element(HRULE); }
+
 (define horizontal-rule
   (sequence* ((_ non-indent-space)
               (char horizontal-rule-char)
               (_ space*)
-              (_ (repeated (preceded-by (is char) space*) min: 2)))
+              (_ (repeated (preceded-by (is char) space*) min: 2))
+              (_ (preceded-by space* new-line))
+              (_ (one-or-more blank-line)))
     (result '(hr))))
 
 
                         (cdr contents))))
     (paragraph . ,(lambda (_ contents)
                     `(p . ,contents)))
+    (emphasis . ,(lambda (_ text)
+                   `(em . ,text)))
+    (strong . ,(lambda (_ text)
+                 `(strong . ,text)))
     . ,alist-conv-rules*))
 
 (define (ref->alist-entry ref)