about summary refs log tree commit diff stats
path: root/src/emit.scm
diff options
context:
space:
mode:
Diffstat (limited to 'src/emit.scm')
-rw-r--r--src/emit.scm140
1 files changed, 54 insertions, 86 deletions
diff --git a/src/emit.scm b/src/emit.scm index d6fe19e..e57e437 100644 --- a/src/emit.scm +++ b/src/emit.scm
@@ -1,111 +1,79 @@
1(declare (module (jimmy emit)))
2
3(import scheme (chicken base) 1(import scheme (chicken base)
4 (jimmy util)
5 (chicken format) 2 (chicken format)
6 (chicken irregex) 3 (chicken irregex)
7 (chicken string)) 4 (chicken string)
5 (only utf8-srfi-13 string-join)
6 (jimmy util))
8 7
9(define-public (emit document) 8(define-public (emit doc)
10 (for-each display 9 (for-each display (map format-stanza doc)))
11 (map format-block document)))
12 10
13(define-public formats 11(define-public formats
14 ;;; (type line-format block-format [line-in-block-format]) 12 ;;; (TYPE (line . LINE-FMT) (stanza . STANZA-FMT) (inline . INLINE-FMT))
15 ;; these default to gemtext 13 '((para (line . "~A")
16 '((para (line . "~A ") 14 (stanza . "~A~%~%"))
17 (block . "~A~%~%"))
18 (verb (line . "~A~%") 15 (verb (line . "~A~%")
19 (block . "```~%~A```~%~%")) 16 (stanza . "```~%~A```~%~%"))
20 (link (line . "=> ~A ~A~%") 17 (link (line . "=> ~A ~A~%") ; Note: link has 2 format arguments
21 (block . "~A~%") 18 (stanza . "~A~%")
22 (inline . "~%=> ~A ~A~%")) ;TODO: have 2 args to format 19 (inline . "~%=> ~A ~A~%"))
23 (list (line . "* ~A~%") 20 (list (line . "* ~A~%")
24 (block . "~A~%")) 21 (stanza . "~A~%"))
25 (quot (line . "~A ") 22 (quot (line . "~A")
26 (block . "> ~A~%~%")) 23 (stanza . "> ~A~%~%"))
27 (hdr1 (line . "# ~A~%") 24 (hdr1 (line . "# ~A~%")
28 (block . "~A~%")) 25 (stanza . "~A~%"))
29 (hdr2 (line . "## ~A~%") 26 (hdr2 (line . "## ~A~%")
30 (block . "~A~%")) 27 (stanza . "~A~%"))
31 (hdr3 (line . "### ~A~%") 28 (hdr3 (line . "### ~A~%")
32 (block . "~A~%")) 29 (stanza . "~A~%"))
30 (meta (line . "")
31 (stanza . ""))
33 (default 32 (default
34 (line . "~A") 33 (line . "~A")
35 (block . "~A~%~%")))) 34 (stanza . "~A~%~%"))))
36 35
37(define-public filters 36(define-public filters
38 `((para 37 ;;; (TYPE (line . LINE-FILTER) (stanza . STANZA-FILTER))
39 (line . ,(o (char->tag "*" "<strong>" "</strong>") 38 ;; line-filter : (lambda (list-of-strs) ...) -> list-of-strs (for format)
40 (char->tag "_" "<em>" "</em>") 39 ;; stanza-filter : (lambda (list-of-strs) ...) -> str
41 (char->tag "`" "<code>" "</code>") 40 `((verb (line . ,identity)
42 string-join)) 41 (stanza . ,(lambda (lines) (apply string-append lines))))
43 (block . ,(lambda (ln)
44 (irregex-replace/all '(: bol (* " ")) ln ""))))
45 (link
46 (line . ,(lambda (ln)
47 (let ((ws (cond ((list? ln) ln)
48 ((string? ln) (string-split ln)))))
49 (let ((x (list (car ws) (string-join (cdr ws)))))
50 x)))))
51 (default 42 (default
52 (line . ,(lambda (x) (print x) (if (list? x) x (list x)))) 43 (line . ,identity)
53 (block . ,identity)))) 44 (stanza . ,(lambda (lines)
54 45 (irregex-replace/all '(: bol (* space))
55(define (string-join ss #!optional sep) 46 (string-join lines) ""))))))
56 (if (string? ss) ss
57 (string-intersperse ss (or sep " "))))
58
59(define (char->tag char beg end)
60 (lambda (str)
61 (irregex-replace/all `(: ($ (or bos space))
62 ,char ($ (+ (~ ,char))) ,char
63 ($ (or space eos)))
64 str
65 1 beg 2 end 3)))
66
67(define (get-from from type subtype)
68 (or (alist-walk from type subtype)
69 (get-from from 'default subtype)))
70 47
71(define (get-format type subtype) (get-from formats type subtype)) 48(define (format-line line el)
72(define (get-filter type subtype) (get-from filters type subtype))
73
74(define (format-line fmt line type)
75 (cond 49 (cond
76 ;; if LINE is a string, wrap it in a list 50 ((string? (car line)) ; regular stanza line
77 ((string? line) 51 (sprintf* (get-format el 'line)
78 (sprintf (get-format type 'line) 52 ((get-filter el 'line) line)))
79 ((get-filter type 'line) line))) 53 ((symbol? (car line)) ; inline element
80 ;; if it's a list of strings, join them together and filter them
81 ((and (list? line)
82 (string? (car line)))
83 (sprintf (get-format type 'line)
84 (apply string-append ((get-filter type 'line) line))))
85 ;; if the car of LINE is a symbol, it's an inline thing.
86 ((and (list? line)
87 (symbol? (car line)))
88 (sprintf* (get-format (car line) 'inline) 54 (sprintf* (get-format (car line) 'inline)
89 ((get-filter (car line) 'line) (cdr line)))) 55 ((get-filter (car line) 'line) (cdr line))))
90 (else (error "Malformed line" line)))) 56 (else (error "Malformed line" line))))
91 57
92(define (format-block block) 58(define (format-stanza stanza)
93 (if (assq (car block) formats) 59 (let* ((type (car stanza))
94 (let* ((type (car block)) 60 (data (cdr stanza))
95 (data (cdr block)) 61 (text (map (lambda (ln)
96 (text (cond 62 (format-line ln type))
97 ((string? data) data) 63 data)))
98 ((list? data) 64 (sprintf (get-format type 'stanza)
99 (apply string-append 65 ((get-filter type 'stanza) text))))
100 (map (lambda (ln) 66
101 (format-line (get-format type 'line) 67;;; Utilities
102 ln 68
103 type)) 69(define (get-from alist el scope)
104 data))) 70 (or (alist-walk alist el scope)
105 (else (error "Malformed block" block))))) 71 (alist-walk alist 'default scope)
106 (sprintf (get-format type 'block) 72 (and (eq? scope 'inline)
107 ((get-filter type 'block) text))) 73 (alist-walk alist 'default 'line))))
108 "")) 74
75(define (get-format el scope) (get-from formats el scope))
76(define (get-filter el scope) (get-from filters el scope))
109 77
110(define (sprintf* fmt lis) 78(define (sprintf* fmt lis)
111 (let loop ((num (length (irregex-extract "~[aA]" fmt))) 79 (let loop ((num (length (irregex-extract "~[aA]" fmt)))