about summary refs log tree commit diff stats
diff options
context:
space:
mode:
authorCase Duckworth2024-05-27 00:01:46 -0500
committerCase Duckworth2024-05-27 00:01:46 -0500
commitddc2a19b6591dc254462d44aefa37bc25aaaf9bb (patch)
treeb79a35bc29dcf5e64c3f7669a06bf04781d4e896
parentUpdates! (diff)
downloadjimmy-ddc2a19b6591dc254462d44aefa37bc25aaaf9bb.tar.gz
jimmy-ddc2a19b6591dc254462d44aefa37bc25aaaf9bb.zip
Fix emit and read, add imports, fix makefile
-rw-r--r--Makefile7
-rw-r--r--src/emit.scm140
-rw-r--r--src/read.scm2
-rw-r--r--src/util.scm6
4 files changed, 63 insertions, 92 deletions
diff --git a/Makefile b/Makefile index 2be0ca1..b4f54b6 100644 --- a/Makefile +++ b/Makefile
@@ -4,6 +4,7 @@ LIBS = read emit util
4 4
5BUILD = $(PWD)/build 5BUILD = $(PWD)/build
6SRC = $(PWD)/src 6SRC = $(PWD)/src
7TESTS = $(PWD)/tests
7 8
8CSC = /usr/bin/csc 9CSC = /usr/bin/csc
9CSI = /usr/bin/csi 10CSI = /usr/bin/csi
@@ -14,8 +15,8 @@ CSC_OPTIONS = \
14 -emit-all-import-libraries \ 15 -emit-all-import-libraries \
15 -dynamic \ 16 -dynamic \
16 -regenerate-import-libraries \ 17 -regenerate-import-libraries \
17 -I $(PWD) \ 18 -I $(SRC) \
18 -C -I$(PWD) 19 -C -I$(SRC)
19 20
20CSC_OPTIONS_EXTRA = \ 21CSC_OPTIONS_EXTRA = \
21 -X utf8 \ 22 -X utf8 \
@@ -37,7 +38,7 @@ build: $(LIBS_)
37 38
38test: build 39test: build
39 cd $(BUILD) && \ 40 cd $(BUILD) && \
40 $(CSI) -setup-mode -s tests/run.scm $(NAME) 41 $(CSI) -setup-mode -s $(TESTS)/run.scm $(NAME)
41 42
42clean: 43clean:
43 -rm -rf $(BUILD) 44 -rm -rf $(BUILD)
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)))
diff --git a/src/read.scm b/src/read.scm index 5e655a7..94708ef 100644 --- a/src/read.scm +++ b/src/read.scm
@@ -48,7 +48,7 @@
48 ((equal? (car lines) "```") ; end of verbatim block 48 ((equal? (car lines) "```") ; end of verbatim block
49 (parse-lines (cdr lines) (close-verbatim))) 49 (parse-lines (cdr lines) (close-verbatim)))
50 (else ; verbatim block continues 50 (else ; verbatim block continues
51 (parse-verbatim (cdr lines) doc (cons (car lines) block))))) 51 (parse-verbatim (cdr lines) doc (cons (list (car lines)) block)))))
52 52
53(define (parse-stanza lines doc stanza st-type 53(define (parse-stanza lines doc stanza st-type
54 #!optional (st-inlines '()) (st-words cdr)) 54 #!optional (st-inlines '()) (st-words cdr))
diff --git a/src/util.scm b/src/util.scm index 7bf89ac..41da769 100644 --- a/src/util.scm +++ b/src/util.scm
@@ -1,7 +1,8 @@
1(module (jimmy util) * 1(module (jimmy util) *
2 2
3 (import scheme (chicken base) 3 (import scheme (chicken base)
4 (chicken condition)) 4 (chicken condition)
5 (chicken string))
5 6
6 (define-syntax define-public 7 (define-syntax define-public
7 (syntax-rules () 8 (syntax-rules ()
@@ -32,6 +33,7 @@
32 ((list? (cdr kv)) 33 ((list? (cdr kv))
33 (apply alist-walk (cdr kv) (cdr keys))))))) 34 (apply alist-walk (cdr kv) (cdr keys)))))))
34 35
35 ) 36 (define (string-join ss #!optional (sep " "))
37 (string-intersperse ss sep)))
36 38
37 39