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

70
tekuti/marxdown.scm
View file

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