blob: 00ffad467307df4f173a66aafa5475460f40852f (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
(declare (module (jimmy read)))
(import scheme (chicken base)
(jimmy util)
(only (chicken condition) handle-exceptions)
(only (chicken io) read-lines)
(only (chicken string) string-split))
(define-public line-types
;; (sigil type inlines preproc)
'(("=>" link)
(">" quot)
("#" hdr1)
("##" hdr2)
("###" hdr3)
("*" list)
("```" verb)
;; extra!
(":" meta)))
(define-public (parse inport)
(parse-lines (read-lines inport) '()))
(define (line-type line)
(let ((it (assoc (car (string-split line)) line-types)))
(if it (cadr it)
'para)))
(define (parse-lines lines document)
(if (null? lines) (reverse document)
(let ((words (string-split (car lines))))
(cond
((null? words)
(parse-lines (cdr lines) document))
((equal? (car words) "```")
(parse-verbatim (cdr lines) document '()))
((assoc (car words) line-types)
=> (lambda (it)
(apply parse-block lines document '() (cdr it))))
(else
(parse-block lines document '() 'para '(link) identity))))))
(define (parse-verbatim lines document verb)
(cond
((null? lines)
(parse-lines lines (cons (cons 'verb (reverse verb)) document)))
((equal? (car lines) "```")
(parse-lines (cdr lines) (cons (cons 'verb (reverse verb)) document)))
(else
(parse-verbatim (cdr lines) document (cons (car lines) verb)))))
(define (parse-block lines document block type #!optional inlines preproc)
(let ((inlines (or inlines '()))
(preproc (or preproc (lambda (ln) (cdr (string-split ln))))))
(cond
((null? lines)
(parse-lines lines (cons (cons type (reverse block)) document)))
((equal? (car lines) "")
(parse-lines (cdr lines) (cons (cons type (reverse block)) document)))
((and (not (eq? type (line-type (car lines))))
(not (memq (line-type (car lines)) inlines)))
(parse-lines lines (cons (cons type (reverse block)) document)))
((memq (line-type (car lines)) inlines)
(let* ((ln (car lines))
(ws (string-split ln))
(lt (cdr (assoc (car ws) line-types))))
(parse-block (cdr lines) document
(cons (cons (car lt)
((or (ignore-errors (caddr lt)) cdr) ws))
block)
type inlines preproc)))
(else
(parse-block (cdr lines) document (cons (preproc (car lines)) block)
type inlines preproc)))))
|
