about summary refs log tree commit diff stats
path: root/src/emit.scm
diff options
context:
space:
mode:
authorCase Duckworth2024-06-05 09:21:25 -0500
committerCase Duckworth2024-06-05 09:21:25 -0500
commit423ac382f9e73bf1ca7fc6b400f98db087cd7d22 (patch)
tree1992e3dc7e71cd40eb7cdbc0b6d0c3cdf82c4332 /src/emit.scm
parentUpdate README, add COPYING (diff)
downloadjimmy-423ac382f9e73bf1ca7fc6b400f98db087cd7d22.tar.gz
jimmy-423ac382f9e73bf1ca7fc6b400f98db087cd7d22.zip
Write executable
This involved moving `src' to `lib' and making `bin'.
`bin' holds the program, which only imports `jimmy.main' from lib.
Diffstat (limited to 'src/emit.scm')
-rw-r--r--src/emit.scm89
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))))))