about summary refs log tree commit diff stats
path: root/src
diff options
context:
space:
mode:
authorCase Duckworth2024-06-03 16:56:30 -0500
committerCase Duckworth2024-06-03 16:56:30 -0500
commited4e86f47935994fb424c977e4123bde625ddff1 (patch)
treefa7e3b16c1e66741cef68d29e72b7e762ff2f8bd /src
parentFix emit and read, add imports, fix makefile (diff)
downloadjimmy-ed4e86f47935994fb424c977e4123bde625ddff1.tar.gz
jimmy-ed4e86f47935994fb424c977e4123bde625ddff1.zip
Fix html/other sourcing; re-scramble Makefile
Diffstat (limited to 'src')
-rw-r--r--src/emit.scm69
-rw-r--r--src/html.scm58
-rw-r--r--src/read.scm29
-rw-r--r--src/util.scm12
-rw-r--r--src/wrap.scm2
5 files changed, 126 insertions, 44 deletions
diff --git a/src/emit.scm b/src/emit.scm index e57e437..4c3581f 100644 --- a/src/emit.scm +++ b/src/emit.scm
@@ -1,3 +1,5 @@
1(declare (module (jimmy emit)))
2
1(import scheme (chicken base) 3(import scheme (chicken base)
2 (chicken format) 4 (chicken format)
3 (chicken irregex) 5 (chicken irregex)
@@ -9,41 +11,36 @@
9 (for-each display (map format-stanza doc))) 11 (for-each display (map format-stanza doc)))
10 12
11(define-public formats 13(define-public formats
12 ;;; (TYPE (line . LINE-FMT) (stanza . STANZA-FMT) (inline . INLINE-FMT)) 14 (make-parameter
13 '((para (line . "~A") 15 ;; (TYPE (line . LINE-FMT) (stanza . STANZA-FMT) (inline . INLINE-FMT))
14 (stanza . "~A~%~%")) 16 '((para (line . "~A")
15 (verb (line . "~A~%") 17 (stanza . "~A~%~%"))
16 (stanza . "```~%~A```~%~%")) 18 (verb (line . "~A~%")
17 (link (line . "=> ~A ~A~%") ; Note: link has 2 format arguments 19 (stanza . "```~%~A```~%~%"))
18 (stanza . "~A~%") 20 (link (line . "=> ~A ~A~%") ; Note: link has 2 format arguments
19 (inline . "~%=> ~A ~A~%")) 21 (stanza . "~A~%")
20 (list (line . "* ~A~%") 22 (inline . "~%=> ~A ~A~%"))
21 (stanza . "~A~%")) 23 (list (line . "* ~A~%")
22 (quot (line . "~A") 24 (stanza . "~A~%"))
23 (stanza . "> ~A~%~%")) 25 (quot (line . "~A")
24 (hdr1 (line . "# ~A~%") 26 (stanza . "> ~A~%~%"))
25 (stanza . "~A~%")) 27 (hdr1 (line . "# ~A~%")
26 (hdr2 (line . "## ~A~%") 28 (stanza . "~A~%"))
27 (stanza . "~A~%")) 29 (hdr2 (line . "## ~A~%")
28 (hdr3 (line . "### ~A~%") 30 (stanza . "~A~%"))
29 (stanza . "~A~%")) 31 (hdr3 (line . "### ~A~%")
30 (meta (line . "") 32 (stanza . "~A~%")))))
31 (stanza . ""))
32 (default
33 (line . "~A")
34 (stanza . "~A~%~%"))))
35 33
36(define-public filters 34(define-public filters
37 ;;; (TYPE (line . LINE-FILTER) (stanza . STANZA-FILTER)) 35 (make-parameter
38 ;; line-filter : (lambda (list-of-strs) ...) -> list-of-strs (for format) 36 ;; (TYPE (line . LINE-FILTER) (stanza . STANZA-FILTER))
39 ;; stanza-filter : (lambda (list-of-strs) ...) -> str 37 ;; line-filter : (lambda (list-of-strs) ...) -> list-of-strs (for format)
40 `((verb (line . ,identity) 38 ;; stanza-filter : (lambda (list-of-strs) ...) -> str
41 (stanza . ,(lambda (lines) (apply string-append lines)))) 39 `((verb (line . ,identity)
42 (default 40 (stanza . ,join-lines))
43 (line . ,identity) 41 (default
44 (stanza . ,(lambda (lines) 42 (line . ,identity)
45 (irregex-replace/all '(: bol (* space)) 43 (stanza . ,flush-lines-left)))))
46 (string-join lines) ""))))))
47 44
48(define (format-line line el) 45(define (format-line line el)
49 (cond 46 (cond
@@ -72,8 +69,10 @@
72 (and (eq? scope 'inline) 69 (and (eq? scope 'inline)
73 (alist-walk alist 'default 'line)))) 70 (alist-walk alist 'default 'line))))
74 71
75(define (get-format el scope) (get-from formats el scope)) 72(define (get-format el scope)
76(define (get-filter el scope) (get-from filters el scope)) 73 (or (get-from (formats) el scope)
74 ""))
75(define (get-filter el scope) (get-from (filters) el scope))
77 76
78(define (sprintf* fmt lis) 77(define (sprintf* fmt lis)
79 (let loop ((num (length (irregex-extract "~[aA]" fmt))) 78 (let loop ((num (length (irregex-extract "~[aA]" fmt)))
diff --git a/src/html.scm b/src/html.scm index 371d407..07cd921 100644 --- a/src/html.scm +++ b/src/html.scm
@@ -1,3 +1,61 @@
1(declare (module (jimmy html))) 1(declare (module (jimmy html)))
2 2
3(import scheme (chicken base)
4 (chicken irregex)
5 (jimmy emit)
6 (jimmy util))
3 7
8(define (escape-entities s)
9 (irregex-replace/all "[&<>]" s
10 (lambda (m)
11 (let ((c (irregex-match-substring m)))
12 (cond
13 ((equal? c "&") "&amp;")
14 ((equal? c "<") "&lt;")
15 ((equal? c ">") "&gt;"))))))
16
17(define (add-inline-markup s)
18 (define (char->tag ch tag)
19 (lambda (s)
20 (irregex-replace/all `(: ,ch ($ (* (~ ,ch))) ,ch) s
21 "<" tag ">" 1 "</" tag ">")))
22
23 ((o (char->tag "*" "b")
24 (char->tag "_" "i")
25 (char->tag "`" "code")) s))
26
27(formats
28 '((para (line . "~a~%")
29 (stanza . "<p>~% ~a</p>~%"))
30 (verb (line . "~a~%")
31 (stanza . "<pre><code>~a</code></pre>~%"))
32 (link (line . "<li><a href=\"~a\">~a</a></li>~%")
33 (stanza . "<ul>~% ~a</ul>~%")
34 (inline . "<a href=\"~a\">~a</a>~%"))
35 (list (line . "<li>~a</li>~%")
36 (stanza . "<ul>~% ~a</ul>~%"))
37 (quot (line . "~a~%")
38 (stanza . "<blockquote>~% ~a</blockquote>~%"))
39 (hdr1 (line . "~a")
40 (stanza . "<h1>~a</h1>~%"))
41 (hdr2 (line . "~a")
42 (stanza . "<h2>~a</h2>~%"))
43 (hdr3 (line . "~a")
44 (stanza . "<h3>~a</h3>~%"))))
45
46(filters
47 `((verb (line . ,identity)
48 (stanza . ,join-lines))
49 (link (line . ,(lambda (ln)
50 (cons (car ln)
51 ((o list
52 add-inline-markup
53 escape-entities
54 string-join)
55 (cdr ln))))))
56 (default
57 (line . ,(o list
58 add-inline-markup
59 escape-entities
60 string-join))
61 (stanza . ,string-join))))
diff --git a/src/read.scm b/src/read.scm index 94708ef..1b611bb 100644 --- a/src/read.scm +++ b/src/read.scm
@@ -36,19 +36,34 @@
36 ((null? words) ; empty line 36 ((null? words) ; empty line
37 (parse-lines (cdr lines) doc)) 37 (parse-lines (cdr lines) doc))
38 ((equal? (car words) "```") ; verbatim 38 ((equal? (car words) "```") ; verbatim
39 (parse-verbatim (cdr lines) doc '())) 39 ;; Format for verbatim header:
40 ;; ``` ?html | command ...
41 ;; -- only run command on block with html output.
42 ;; other outputs process the block normally
43 ;; ``` ?!html | command ...
44 ;; -- only run command on block when *not* outputting html.
45 ;; html processes the block normally
46 ;; ``` ?:html | command ...
47 ;; -- like ?html, but ignore the block in non-html outputs.
48 ;;;; FIXME: I think this necessitates a special emit-verbatim
49 ;;;; function.
50 (parse-verbatim (cdr lines) doc '()
51 #; (if (< 1 (length words))
52 (cons 'verb (cdr words))
53 'verb)
54 'verb))
40 (else ; another line type 55 (else ; another line type
41 (apply parse-stanza lines doc '() (line-type words))))))) 56 (apply parse-stanza lines doc '() (line-type words)))))))
42 57
43(define (parse-verbatim lines doc block) 58(define (parse-verbatim lines doc block bhead)
44 (define (close-verbatim) (cons (cons 'verb (reverse block)) doc)) 59 (define (close-verbatim) (cons (cons bhead (reverse block)) doc))
45 (cond 60 (cond
46 ((null? lines) ; end of document 61 ((null? lines) ; end of document
47 (parse-lines lines (close-verbatim))) 62 (parse-lines lines (close-verbatim)))
48 ((equal? (car lines) "```") ; end of verbatim block 63 ((equal? (car lines) "```") ; end of verbatim block
49 (parse-lines (cdr lines) (close-verbatim))) 64 (parse-lines (cdr lines) (close-verbatim)))
50 (else ; verbatim block continues 65 (else ; verbatim block continues
51 (parse-verbatim (cdr lines) doc (cons (list (car lines)) block))))) 66 (parse-verbatim (cdr lines) doc (cons (list (car lines)) block) bhead))))
52 67
53(define (parse-stanza lines doc stanza st-type 68(define (parse-stanza lines doc stanza st-type
54 #!optional (st-inlines '()) (st-words cdr)) 69 #!optional (st-inlines '()) (st-words cdr))
diff --git a/src/util.scm b/src/util.scm index 41da769..c71c600 100644 --- a/src/util.scm +++ b/src/util.scm
@@ -2,6 +2,7 @@
2 2
3 (import scheme (chicken base) 3 (import scheme (chicken base)
4 (chicken condition) 4 (chicken condition)
5 (only (chicken irregex) irregex-replace/all)
5 (chicken string)) 6 (chicken string))
6 7
7 (define-syntax define-public 8 (define-syntax define-public
@@ -34,6 +35,15 @@
34 (apply alist-walk (cdr kv) (cdr keys))))))) 35 (apply alist-walk (cdr kv) (cdr keys)))))))
35 36
36 (define (string-join ss #!optional (sep " ")) 37 (define (string-join ss #!optional (sep " "))
37 (string-intersperse ss sep))) 38 (string-intersperse ss sep))
39
40 (define (flush-lines-left lines)
41 (irregex-replace/all '(: bol (* space))
42 (string-join lines) ""))
43
44 (define (join-lines lines)
45 (apply string-append lines))
46
47 )
38 48
39 49
diff --git a/src/wrap.scm b/src/wrap.scm index 0ed8868..aa077d8 100644 --- a/src/wrap.scm +++ b/src/wrap.scm
@@ -5,7 +5,7 @@
5 (jimmy util) 5 (jimmy util)
6 (only (chicken io) read-string) 6 (only (chicken io) read-string)
7 (only (chicken port) with-output-to-string) 7 (only (chicken port) with-output-to-string)
8 (only (chicken string) string-translate*)) 8 (only (chicken string) string-translate* string-intersperse))
9 9
10;; templates are strings with variables interpolated with "{{variables}}" 10;; templates are strings with variables interpolated with "{{variables}}"
11 11