about summary refs log tree commit diff stats
path: root/src/emit.scm
diff options
context:
space:
mode:
authorCase Duckworth2024-05-26 22:49:44 -0500
committerCase Duckworth2024-05-26 22:52:25 -0500
commit815e669310f5e73d13cc121bd7f6cdaec5b6ec0d (patch)
tree1d3ab042bb6ffc2302a0a03b61147e5b4a649960 /src/emit.scm
parentScheme bit! (diff)
downloadjimmy-815e669310f5e73d13cc121bd7f6cdaec5b6ec0d.tar.gz
jimmy-815e669310f5e73d13cc121bd7f6cdaec5b6ec0d.zip
Updates!
I totally forgot to actually commit things for a while, so uh

Updates!!!
Diffstat (limited to 'src/emit.scm')
-rw-r--r--src/emit.scm61
1 files changed, 37 insertions, 24 deletions
diff --git a/src/emit.scm b/src/emit.scm index aa36eb5..d6fe19e 100644 --- a/src/emit.scm +++ b/src/emit.scm
@@ -34,18 +34,6 @@
34 (line . "~A") 34 (line . "~A")
35 (block . "~A~%~%")))) 35 (block . "~A~%~%"))))
36 36
37(define (string-join ss #!optional sep)
38 (if (string? ss) ss
39 (string-intersperse ss (or sep " "))))
40
41(define (char->tag char beg end)
42 (lambda (str)
43 (irregex-replace/all `(: ($ (or bos space))
44 ,char ($ (+ (~ ,char))) ,char
45 ($ (or space eos)))
46 str
47 1 beg 2 end 3)))
48
49(define-public filters 37(define-public filters
50 `((para 38 `((para
51 (line . ,(o (char->tag "*" "<strong>" "</strong>") 39 (line . ,(o (char->tag "*" "<strong>" "</strong>")
@@ -58,16 +46,27 @@
58 (line . ,(lambda (ln) 46 (line . ,(lambda (ln)
59 (let ((ws (cond ((list? ln) ln) 47 (let ((ws (cond ((list? ln) ln)
60 ((string? ln) (string-split ln))))) 48 ((string? ln) (string-split ln)))))
61 (list (car ws) (string-join (cdr ws))))))) 49 (let ((x (list (car ws) (string-join (cdr ws)))))
50 x)))))
62 (default 51 (default
63 (line . ,list) 52 (line . ,(lambda (x) (print x) (if (list? x) x (list x))))
64 (block . ,identity)))) 53 (block . ,identity))))
65 54
55(define (string-join ss #!optional sep)
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
66(define (get-from from type subtype) 67(define (get-from from type subtype)
67 (or (alist-walk from type subtype) 68 (or (alist-walk from type subtype)
68 (if (eq? subtype 'inline) 69 (get-from from 'default subtype)))
69 (alist-walk from type 'list)
70 (lambda _ '("")))))
71 70
72(define (get-format type subtype) (get-from formats type subtype)) 71(define (get-format type subtype) (get-from formats type subtype))
73(define (get-filter type subtype) (get-from filters type subtype)) 72(define (get-filter type subtype) (get-from filters type subtype))
@@ -76,19 +75,19 @@
76 (cond 75 (cond
77 ;; if LINE is a string, wrap it in a list 76 ;; if LINE is a string, wrap it in a list
78 ((string? line) 77 ((string? line)
79 (set! line (list line))) 78 (sprintf (get-format type 'line)
79 ((get-filter type 'line) line)))
80 ;; if it's a list of strings, join them together and filter them 80 ;; if it's a list of strings, join them together and filter them
81 ((and (list? line) 81 ((and (list? line)
82 (string? (car line))) 82 (string? (car line)))
83 (set! line ((get-filter type 'line) line))) 83 (sprintf (get-format type 'line)
84 (apply string-append ((get-filter type 'line) line))))
84 ;; if the car of LINE is a symbol, it's an inline thing. 85 ;; if the car of LINE is a symbol, it's an inline thing.
85 ((and (list? line) 86 ((and (list? line)
86 (symbol? (car line))) 87 (symbol? (car line)))
87 (set! line (format-line (get-format (car line) 'inline) 88 (sprintf* (get-format (car line) 'inline)
88 ((get-filter (car line) 'line) (cdr line)) 89 ((get-filter (car line) 'line) (cdr line))))
89 type))) 90 (else (error "Malformed line" line))))
90 (else (error "Malformed line" line)))
91 (apply sprintf fmt line))
92 91
93(define (format-block block) 92(define (format-block block)
94 (if (assq (car block) formats) 93 (if (assq (car block) formats)
@@ -107,3 +106,17 @@
107 (sprintf (get-format type 'block) 106 (sprintf (get-format type 'block)
108 ((get-filter type 'block) text))) 107 ((get-filter type 'block) text)))
109 "")) 108 ""))
109
110(define (sprintf* fmt lis)
111 (let loop ((num (length (irregex-extract "~[aA]" fmt)))
112 (lis lis)
113 (out '()))
114 (cond
115 ((null? lis)
116 (apply sprintf fmt (reverse out)))
117 ((= 1 num)
118 (loop 0 '() (cons (string-join lis) out)))
119 (else
120 (loop (- num 1)
121 (cdr lis)
122 (cons (car lis) out))))))