aliens/tekuti
1
0
Fork 0
Code Activity

Fix list parsing

Browse source
This commit is contained in:
Andy Wingo 2022-10-23 17:30:36 +02:00
parent 7652cb17cf
commit 105873854c
1 changed files with 48 additions and 22 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

66
tekuti/marxdown.scm
View file

@ -449,6 +449,11 @@
continue)))
(define (read-li marker marker-indent marker-size kup knext)
(define list-tag
(match marker
((? number?) 'enumerate)
((? char?) 'itemize)))
(define (list-tag? tag) (eq? tag list-tag))
(read-indent
(lambda (ch indent)
(match indent
@ -459,21 +464,19 @@
(append marker-outer
(list (+ marker-inner marker-size outer))
inner)))
(read-block
ch body-indent
(lambda (blocks ch next-indent)
(read-indented-block
ch marker-indent body-indent
(lambda (elt ch indent)
(read-indented-block ch marker-indent indent kup
ch marker-indent next-indent kup
(lambda (nodelist)
(knext (cons elt nodelist)))))
(lambda (nodelist)
(cons* 'li marker nodelist)))))))))))
(define (read-block ch indent kup knext)
(define (have-block read-block)
(read-block indent kup knext))
(define (have-text chars)
(read-para* chars indent kup knext))
(read-block-type ch #f have-block have-text))
(knext
(match nodelist
((((? list-tag?) . items) . nodelist)
`((,list-tag (item . ,blocks) . ,items) . ,nodelist))
(_
`((,list-tag (item . ,blocks)) . ,nodelist)))))))
identity)))))))))
(define (read-block-type ch in-text? kblock ktext)
(define (make-continue indent kup knext)
@ -576,16 +579,31 @@
(_
(ktext (list ch)))))
(define (read-block ch indent kup knext)
(define (have-block read-block)
(read-block indent kup knext))
(define (have-text chars)
(read-para* chars indent kup knext))
(read-block-type ch #f have-block have-text))
(define (finish-block-list blocks)
(match blocks
((block) block)
(_ `(begin . ,blocks))))
(define (finish-block-quote blocks)
(match blocks
((block) block)
(_ `(blockquote . ,blocks))))
(define (read-indented-block ch outer-indent indent kup knext)
(define (recurse kind recurse-indent)
(define (recurse finish recurse-indent)
(read-indented-block ch recurse-indent indent
(lambda (nested ch indent)
(read-indented-block ch outer-indent indent
kup
(lambda (nodelist)
(knext (cons nested nodelist)))))
(lambda (nodelist)
(cons kind nodelist))))
finish))
(match (compare-indents outer-indent indent)
('same
(read-block ch indent kup knext))
@ -594,9 +612,10 @@
'different-blockquote)
(kup (knext '()) ch indent))
('inner
(recurse 'begin indent))
(recurse finish-block-list indent))
('inner-blockquote
(recurse 'blockquote (list-head indent (1+ (length outer-indent)))))))
(recurse finish-block-quote
(list-head indent (1+ (length outer-indent)))))))
(define (parse-error reason)
(error reason))
@ -608,7 +627,7 @@
(read-block-list empty-indent
(lambda (nodelist ch indent) nodelist)
(lambda (nodelist) (cons 'top nodelist))))
finish-block-list))
(define* (smarxdown->shtml exp #:key
(heading-offset 0)
@ -627,7 +646,14 @@
(('block-xml xml) (handle-block-xml xml))
(('para . body) `(p . ,(map transform-inline body)))
(('blockquote . body) `(blockquote . ,(map transform-block body)))
(('list-item . body) (error "fixme"))
(('itemize ('item . item) ...)
`(ul . ,(map (lambda (blocks)
`(li . ,(map transform-block blocks)))
item)))
(('enumerate ('item . item) ...)
`(ol . ,(map (lambda (blocks)
`(li . ,(map transform-block blocks)))
item)))
(('pre #f . body) `(pre . ,body))
(('pre info . body) `(pre (@ (class ,(string-append "pre-" info)))
. ,body))