diff options
Diffstat (limited to 'src/emit.scm')
-rw-r--r-- | src/emit.scm | 89 |
1 files changed, 0 insertions, 89 deletions
diff --git a/src/emit.scm b/src/emit.scm deleted file mode 100644 index 4c3581f..0000000 --- a/src/emit.scm +++ /dev/null | |||
@@ -1,89 +0,0 @@ | |||
1 | (declare (module (jimmy emit))) | ||
2 | |||
3 | (import scheme (chicken base) | ||
4 | (chicken format) | ||
5 | (chicken irregex) | ||
6 | (chicken string) | ||
7 | (only utf8-srfi-13 string-join) | ||
8 | (jimmy util)) | ||
9 | |||
10 | (define-public (emit doc) | ||
11 | (for-each display (map format-stanza doc))) | ||
12 | |||
13 | (define-public formats | ||
14 | (make-parameter | ||
15 | ;; (TYPE (line . LINE-FMT) (stanza . STANZA-FMT) (inline . INLINE-FMT)) | ||
16 | '((para (line . "~A") | ||
17 | (stanza . "~A~%~%")) | ||
18 | (verb (line . "~A~%") | ||
19 | (stanza . "```~%~A```~%~%")) | ||
20 | (link (line . "=> ~A ~A~%") ; Note: link has 2 format arguments | ||
21 | (stanza . "~A~%") | ||
22 | (inline . "~%=> ~A ~A~%")) | ||
23 | (list (line . "* ~A~%") | ||
24 | (stanza . "~A~%")) | ||
25 | (quot (line . "~A") | ||
26 | (stanza . "> ~A~%~%")) | ||
27 | (hdr1 (line . "# ~A~%") | ||
28 | (stanza . "~A~%")) | ||
29 | (hdr2 (line . "## ~A~%") | ||
30 | (stanza . "~A~%")) | ||
31 | (hdr3 (line . "### ~A~%") | ||
32 | (stanza . "~A~%"))))) | ||
33 | |||
34 | (define-public filters | ||
35 | (make-parameter | ||
36 | ;; (TYPE (line . LINE-FILTER) (stanza . STANZA-FILTER)) | ||
37 | ;; line-filter : (lambda (list-of-strs) ...) -> list-of-strs (for format) | ||
38 | ;; stanza-filter : (lambda (list-of-strs) ...) -> str | ||
39 | `((verb (line . ,identity) | ||
40 | (stanza . ,join-lines)) | ||
41 | (default | ||
42 | (line . ,identity) | ||
43 | (stanza . ,flush-lines-left))))) | ||
44 | |||
45 | (define (format-line line el) | ||
46 | (cond | ||
47 | ((string? (car line)) ; regular stanza line | ||
48 | (sprintf* (get-format el 'line) | ||
49 | ((get-filter el 'line) line))) | ||
50 | ((symbol? (car line)) ; inline element | ||
51 | (sprintf* (get-format (car line) 'inline) | ||
52 | ((get-filter (car line) 'line) (cdr line)))) | ||
53 | (else (error "Malformed line" line)))) | ||
54 | |||
55 | (define (format-stanza stanza) | ||
56 | (let* ((type (car stanza)) | ||
57 | (data (cdr stanza)) | ||
58 | (text (map (lambda (ln) | ||
59 | (format-line ln type)) | ||
60 | data))) | ||
61 | (sprintf (get-format type 'stanza) | ||
62 | ((get-filter type 'stanza) text)))) | ||
63 | |||
64 | ;;; Utilities | ||
65 | |||
66 | (define (get-from alist el scope) | ||
67 | (or (alist-walk alist el scope) | ||
68 | (alist-walk alist 'default scope) | ||
69 | (and (eq? scope 'inline) | ||
70 | (alist-walk alist 'default 'line)))) | ||
71 | |||
72 | (define (get-format el scope) | ||
73 | (or (get-from (formats) el scope) | ||
74 | "")) | ||
75 | (define (get-filter el scope) (get-from (filters) el scope)) | ||
76 | |||
77 | (define (sprintf* fmt lis) | ||
78 | (let loop ((num (length (irregex-extract "~[aA]" fmt))) | ||
79 | (lis lis) | ||
80 | (out '())) | ||
81 | (cond | ||
82 | ((null? lis) | ||
83 | (apply sprintf fmt (reverse out))) | ||
84 | ((= 1 num) | ||
85 | (loop 0 '() (cons (string-join lis) out))) | ||
86 | (else | ||
87 | (loop (- num 1) | ||
88 | (cdr lis) | ||
89 | (cons (car lis) out)))))) | ||