blob: d6fe19e2fa9df19efb023f15a2faddfe3b318298 (
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
|
(declare (module (jimmy emit)))
(import scheme (chicken base)
(jimmy util)
(chicken format)
(chicken irregex)
(chicken string))
(define-public (emit document)
(for-each display
(map format-block document)))
(define-public formats
;;; (type line-format block-format [line-in-block-format])
;; these default to gemtext
'((para (line . "~A ")
(block . "~A~%~%"))
(verb (line . "~A~%")
(block . "```~%~A```~%~%"))
(link (line . "=> ~A ~A~%")
(block . "~A~%")
(inline . "~%=> ~A ~A~%")) ;TODO: have 2 args to format
(list (line . "* ~A~%")
(block . "~A~%"))
(quot (line . "~A ")
(block . "> ~A~%~%"))
(hdr1 (line . "# ~A~%")
(block . "~A~%"))
(hdr2 (line . "## ~A~%")
(block . "~A~%"))
(hdr3 (line . "### ~A~%")
(block . "~A~%"))
(default
(line . "~A")
(block . "~A~%~%"))))
(define-public filters
`((para
(line . ,(o (char->tag "*" "<strong>" "</strong>")
(char->tag "_" "<em>" "</em>")
(char->tag "`" "<code>" "</code>")
string-join))
(block . ,(lambda (ln)
(irregex-replace/all '(: bol (* " ")) ln ""))))
(link
(line . ,(lambda (ln)
(let ((ws (cond ((list? ln) ln)
((string? ln) (string-split ln)))))
(let ((x (list (car ws) (string-join (cdr ws)))))
x)))))
(default
(line . ,(lambda (x) (print x) (if (list? x) x (list x))))
(block . ,identity))))
(define (string-join ss #!optional sep)
(if (string? ss) ss
(string-intersperse ss (or sep " "))))
(define (char->tag char beg end)
(lambda (str)
(irregex-replace/all `(: ($ (or bos space))
,char ($ (+ (~ ,char))) ,char
($ (or space eos)))
str
1 beg 2 end 3)))
(define (get-from from type subtype)
(or (alist-walk from type subtype)
(get-from from 'default subtype)))
(define (get-format type subtype) (get-from formats type subtype))
(define (get-filter type subtype) (get-from filters type subtype))
(define (format-line fmt line type)
(cond
;; if LINE is a string, wrap it in a list
((string? line)
(sprintf (get-format type 'line)
((get-filter type 'line) line)))
;; if it's a list of strings, join them together and filter them
((and (list? line)
(string? (car line)))
(sprintf (get-format type 'line)
(apply string-append ((get-filter type 'line) line))))
;; if the car of LINE is a symbol, it's an inline thing.
((and (list? line)
(symbol? (car line)))
(sprintf* (get-format (car line) 'inline)
((get-filter (car line) 'line) (cdr line))))
(else (error "Malformed line" line))))
(define (format-block block)
(if (assq (car block) formats)
(let* ((type (car block))
(data (cdr block))
(text (cond
((string? data) data)
((list? data)
(apply string-append
(map (lambda (ln)
(format-line (get-format type 'line)
ln
type))
data)))
(else (error "Malformed block" block)))))
(sprintf (get-format type 'block)
((get-filter type 'block) text)))
""))
(define (sprintf* fmt lis)
(let loop ((num (length (irregex-extract "~[aA]" fmt)))
(lis 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))))))
|
