blob: 546ec5cbd6335c9d1d54066ebff614a5efff5e7b (
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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
|
(declare (module (jimmy emit)))
(import scheme (chicken base)
(chicken format)
(chicken io)
(chicken irregex)
(chicken port)
(chicken process)
(chicken string)
(only utf8-srfi-13 string-join)
(jimmy util))
(define-public (emit doc)
(for-each display (map format-stanza doc)))
(define-public (emit-string doc)
(with-output-to-string
(lambda () (emit doc))))
;;; Change these for different output types
(define-public output-type
(make-parameter 'gemini))
(define-public formats
(make-parameter
;; (EL (line . LINE-FMT) (stanza . STANZA-FMT) (inline . INLINE-FMT))
'((para (line . "~A")
(stanza . "~A~%~%"))
(verb (line . "~A~%")
(stanza . "```~%~A```~%~%"))
(link (line . "=> ~A ~A~%") ; Note: link has 2 format arguments
(stanza . "~A~%")
(inline . "~%=> ~A ~A~%"))
(list (line . "* ~A~%")
(stanza . "~A~%"))
(quot (line . "~A")
(stanza . "> ~A~%~%"))
(hdr1 (line . "# ~A~%")
(stanza . "~A~%"))
(hdr2 (line . "## ~A~%")
(stanza . "~A~%"))
(hdr3 (line . "### ~A~%")
(stanza . "~A~%")))))
(define-public set-formats! formats)
(define-public filters
(make-parameter
;; (EL (line . LINE-FILTER) (stanza . STANZA-FILTER))
;; line-filter : (lambda (list-of-strs) ...) -> list-of-strs (for format)
;; stanza-filter : (lambda (list-of-strs) ...) -> str
`((verb
(stanza . ,(o ensure-newline (cut string-join <> "\n"))))
(default
(line . ,identity)
(stanza . ,flush-lines-left)))))
(define-public set-filters! filters)
;;; Implementation
(define (format-line line el)
(cond
((string? (car line)) ; regular stanza line
(format/filter el 'line line))
((symbol? (car line)) ; inline element
(format/filter (car line) '(inline . line) (cdr line)))
(else (error "Malformed line" line))))
(define (format-stanza stanza)
(let* ((el (caar stanza))
(text (map (lambda (ln)
(format-line ln el))
(cdr stanza))))
(case el
((verb) (format-verb stanza))
(else
(format/filter el 'stanza text)))))
(define (format-verb stanza)
(let ((el (car stanza))
(text (apply append (cdr stanza))))
(with-output-to-string
(lambda ()
(cond
((and (pair? (cdr el))
(equal? (cadr el) "|"))
;; special case: pipe to an external process
(let ((cmdline (cddr el)))
(if (find-command (car cmdline) #;<TODO:JIMMY_PATH>)
(receive (in out pid)
(process (car cmdline) (cdr cmdline)
`(("JIMMY_OUTPUT" . ,(->string (output-type)))))
(display (ensure-newline text) out)
(read-string #f in)))))
(else ; verbatim baby
(printf (get-format 'verb 'stanza)
((get-filter 'verb 'stanza) text))))))))
;;; Utilities
(define (get-from alist el scope)
(or (alist-walk alist el scope)
(alist-walk alist 'default scope)
(and (eq? scope 'inline)
(alist-walk alist 'default 'line))))
(define (get-format el scope)
(or (get-from (formats) el scope)
""))
(define (get-filter el scope) (get-from (filters) el scope))
(define (format/filter el scope text)
(define (sprintf* fmt lis)
(let loop ((num (length (irregex-extract "~[aA]" fmt)))
(lis (if (list? lis) lis (list lis)))
(out '()))
(cond
((null? lis)
(apply sprintf fmt (reverse out)))
((= 1 num)
(loop 0 '() (cons (string-join lis) out)))
(else
(loop (- num 1)
(cdr lis)
(cons (car lis) out))))))
(define-values (format-scope filter-scope)
(if (pair? scope)
(values (car scope) (cdr scope))
(values scope scope)))
(sprintf* (get-format el format-scope)
((get-filter el filter-scope) text)))
|
