Add more Pandoc JSON types
This commit is contained in:
parent
745dc5c91c
commit
8d5bd6b1ed
|
@ -10,6 +10,9 @@
|
||||||
(cons (car list) new-list))
|
(cons (car list) new-list))
|
||||||
(cdr list)))))
|
(cdr list)))))
|
||||||
|
|
||||||
|
(define (join-adjacent-strings list)
|
||||||
|
(join-adjacent string? string-append list))
|
||||||
|
|
||||||
(define (vector-refs vec . indexes)
|
(define (vector-refs vec . indexes)
|
||||||
(let loop ((obj vec) (indexes indexes))
|
(let loop ((obj vec) (indexes indexes))
|
||||||
(if (null? indexes) obj
|
(if (null? indexes) obj
|
||||||
|
@ -17,8 +20,10 @@
|
||||||
(cdr indexes)))))
|
(cdr indexes)))))
|
||||||
|
|
||||||
(define (pandoc-json->sxml json)
|
(define (pandoc-json->sxml json)
|
||||||
|
|
||||||
(define (convert-block-or-inline element)
|
(define (convert-block-or-inline element)
|
||||||
(if (string? element) element (convert-block element)))
|
(if (string? element) element (convert-block element)))
|
||||||
|
|
||||||
(define (convert-block block)
|
(define (convert-block block)
|
||||||
(let ((type (cdr (assq 't block))))
|
(let ((type (cdr (assq 't block))))
|
||||||
(define (contents) (cdr (assq 'c block)))
|
(define (contents) (cdr (assq 'c block)))
|
||||||
|
@ -27,20 +32,41 @@
|
||||||
" ")
|
" ")
|
||||||
((equal? type "Str")
|
((equal? type "Str")
|
||||||
(contents))
|
(contents))
|
||||||
|
((equal? type "BulletList")
|
||||||
|
`(ul
|
||||||
|
,@(map (lambda (list-element)
|
||||||
|
`(li ,@(convert-many (vector->list list-element))))
|
||||||
|
(contents-list))))
|
||||||
|
((equal? type "BlockQuote")
|
||||||
|
`(blockquote
|
||||||
|
,@(convert-many (contents-list))))
|
||||||
((equal? type "Code")
|
((equal? type "Code")
|
||||||
`(code ,@(convert-many (cdr (contents-list)))))
|
`(code ,@(convert-many (cdr (contents-list)))))
|
||||||
|
((equal? type "CodeBlock")
|
||||||
|
`(pre (@ (data-syntax ,(join-adjacent-strings
|
||||||
|
(vector->list
|
||||||
|
(vector-refs (contents) 0 1)))))
|
||||||
|
,@(convert-many (cdr (contents-list)))))
|
||||||
|
((equal? type "Emph")
|
||||||
|
`(em ,@(convert-many (cdr (contents-list)))))
|
||||||
((equal? type "Header")
|
((equal? type "Header")
|
||||||
(let* ((level (car (contents-list)))
|
(let* ((level (car (contents-list)))
|
||||||
(h-tag (string->symbol
|
(h-tag (string->symbol
|
||||||
(string-append "h" (number->string level)))))
|
(string-append "h" (number->string level)))))
|
||||||
`(,h-tag ,@(convert-many (vector->list
|
`(,h-tag ,@(convert-many (vector->list
|
||||||
(list-ref (contents-list) 2))))))
|
(list-ref (contents-list) 2))))))
|
||||||
|
((equal? type "Link")
|
||||||
|
`(a (@ (href ,(join-adjacent-strings
|
||||||
|
(vector->list (vector-ref (contents) 2)))))
|
||||||
|
,@(convert-many (vector->list (vector-ref (contents) 1)))))
|
||||||
((equal? type "Plain")
|
((equal? type "Plain")
|
||||||
`(span ,@(convert-many (contents-list))))
|
`(span ,@(convert-many (contents-list))))
|
||||||
((equal? type "Para")
|
((equal? type "Para")
|
||||||
`(p ,@(convert-many (contents-list))))
|
`(p ,@(convert-many (contents-list))))
|
||||||
((equal? type "SoftBreak")
|
((equal? type "SoftBreak")
|
||||||
"\n")
|
"\n")
|
||||||
|
((equal? type "Strong")
|
||||||
|
`(strong ,@(convert-many (contents-list))))
|
||||||
((equal? type "Table")
|
((equal? type "Table")
|
||||||
(let ((headings (vector-refs (contents) 3 1 0 1)))
|
(let ((headings (vector-refs (contents) 3 1 0 1)))
|
||||||
`(table
|
`(table
|
||||||
|
@ -60,10 +86,10 @@
|
||||||
(vector->list (vector-refs row 1)))))
|
(vector->list (vector-refs row 1)))))
|
||||||
(vector->list (vector-refs (contents) 4 0 3))))))
|
(vector->list (vector-refs (contents) 4 0 3))))))
|
||||||
(else
|
(else
|
||||||
(error "Unknown type" type)))))
|
(error "Unknown type in pandoc JSON" type)))))
|
||||||
|
|
||||||
(define (convert-many elements)
|
(define (convert-many elements)
|
||||||
(join-adjacent string? string-append
|
(join-adjacent-strings (map convert-block-or-inline elements)))
|
||||||
(map convert-block-or-inline elements)))
|
|
||||||
(convert-many (vector->list (cdr (assq 'blocks json)))))
|
(convert-many (vector->list (cdr (assq 'blocks json)))))
|
||||||
|
|
||||||
(define (pandoc-port->json input-format input-port)
|
(define (pandoc-port->json input-format input-port)
|
||||||
|
|
Loading…
Reference in New Issue