lassik
/
pandoc
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Add more Pandoc JSON types

This commit is contained in:
Lassi Kortela 2021-08-25 09:17:40 +03:00
parent 745dc5c91c
commit 8d5bd6b1ed
1 changed files with 29 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
pandoc.r5rs.scm
View File

@ -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)