about summary refs log tree commit diff stats
path: root/src
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
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')
-rw-r--r--src/emit.scm89
-rw-r--r--src/html.scm61
-rw-r--r--src/read.scm88
-rw-r--r--src/util.scm49
-rw-r--r--src/wrap.scm23
5 files changed, 0 insertions, 310 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))))))
diff --git a/src/html.scm b/src/html.scm deleted file mode 100644 index 07cd921..0000000 --- a/src/html.scm +++ /dev/null
@@ -1,61 +0,0 @@
1(declare (module (jimmy html)))
2
3(import scheme (chicken base)
4 (chicken irregex)
5 (jimmy emit)
6 (jimmy util))
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 deleted file mode 100644 index 1b611bb..0000000 --- a/src/read.scm +++ /dev/null
@@ -1,88 +0,0 @@
1(declare (module (jimmy read)))
2
3(import scheme (chicken base)
4 (jimmy util)
5 (only (chicken io) read-lines)
6 (only (chicken string) string-split))
7
8(define-public line-types
9 ;; (sigil type inlines word-select)
10 `((default para (link) ,identity) ; if nothing else matches
11 ("```" verb)
12 ("=>" link)
13 (">" quot)
14 ("#" hdr1)
15 ("##" hdr2)
16 ("###" hdr3)
17 ("*" list)
18 ;; extra!
19 (":" meta)))
20
21(define-public (parse #!optional port)
22 (parse-lines (read-lines (or port (current-input-port))) '()))
23
24(define (line-type line)
25 (let ((lin (if (string? line) (string-split line) line))
26 (def (cdr (assoc 'default line-types))))
27 (cond
28 ((null? lin) def) ; empty line
29 ((assoc (car lin) line-types) => cdr) ; a line type exists
30 (else def)))) ; otherwise ...
31
32(define (parse-lines lines doc)
33 (if (null? lines) (reverse doc)
34 (let ((words (string-split (car lines))))
35 (cond
36 ((null? words) ; empty line
37 (parse-lines (cdr lines) doc))
38 ((equal? (car words) "```") ; verbatim
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))
55 (else ; another line type
56 (apply parse-stanza lines doc '() (line-type words)))))))
57
58(define (parse-verbatim lines doc block bhead)
59 (define (close-verbatim) (cons (cons bhead (reverse block)) doc))
60 (cond
61 ((null? lines) ; end of document
62 (parse-lines lines (close-verbatim)))
63 ((equal? (car lines) "```") ; end of verbatim block
64 (parse-lines (cdr lines) (close-verbatim)))
65 (else ; verbatim block continues
66 (parse-verbatim (cdr lines) doc (cons (list (car lines)) block) bhead))))
67
68(define (parse-stanza lines doc stanza st-type
69 #!optional (st-inlines '()) (st-words cdr))
70 (define (close-stanza) (cons (cons st-type (reverse stanza)) doc))
71 (if (null? lines) ; end of document
72 (parse-lines lines (close-stanza))
73 (let* ((ln (car lines))
74 (ws (string-split ln))
75 (lt (line-type ln)))
76 (cond
77 ((null? ws) ; end of stanza (blank line)
78 (parse-lines (cdr lines) (close-stanza)))
79 ((memq (car lt) st-inlines) ; in-line for *this* stanza
80 (parse-stanza (cdr lines) doc
81 (cons (cons (car lt) (cdr ws)) stanza)
82 st-type st-inlines st-words))
83 ((not (eq? st-type (car (line-type ws)))) ; beginning of a new stanza
84 (parse-lines lines (close-stanza)))
85 (else ; continue this stanza
86 (parse-stanza (cdr lines) doc
87 (cons (st-words ws) stanza)
88 st-type st-inlines st-words))))))
diff --git a/src/util.scm b/src/util.scm deleted file mode 100644 index c71c600..0000000 --- a/src/util.scm +++ /dev/null
@@ -1,49 +0,0 @@
1(module (jimmy util) *
2
3 (import scheme (chicken base)
4 (chicken condition)
5 (only (chicken irregex) irregex-replace/all)
6 (chicken string))
7
8 (define-syntax define-public
9 (syntax-rules ()
10 ((define-public (name . arg) forms ...)
11 (begin (export name)
12 (define (name . arg) forms ...)))
13 ((define-public (name args ...) forms ...)
14 (begin (export name)
15 (define (name args ...) forms ...)))
16 ((define-public name value)
17 (begin (export name)
18 (define name value)))))
19
20 (define-syntax ignore-errors
21 (syntax-rules ()
22 ((ignore-errors x)
23 (handle-exceptions e #f x))))
24
25 (define (alist-walk lis . keys)
26 (if (null? keys)
27 lis
28 (let ((kv (assoc (car keys) lis)))
29 (cond
30 ((not kv) #f)
31 ((atom? (cdr kv))
32 (and (null? (cdr keys)) ; this shouldn't error...
33 (cdr kv)))
34 ((list? (cdr kv))
35 (apply alist-walk (cdr kv) (cdr keys)))))))
36
37 (define (string-join ss #!optional (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 )
48
49
diff --git a/src/wrap.scm b/src/wrap.scm deleted file mode 100644 index aa077d8..0000000 --- a/src/wrap.scm +++ /dev/null
@@ -1,23 +0,0 @@
1(declare (module (jimmy wrap)))
2
3(import scheme (chicken base)
4 (jimmy emit)
5 (jimmy util)
6 (only (chicken io) read-string)
7 (only (chicken port) with-output-to-string)
8 (only (chicken string) string-translate* string-intersperse))
9
10;; templates are strings with variables interpolated with "{{variables}}"
11
12(define-public (wrap document template)
13 (let* ((meta (map (lambda (el)
14 (cons (string-append "{{" (car el) "}}")
15 (string-intersperse (cdr el) " ")))
16 (alist-walk document 'meta)))
17 (body (cons "{{body}}"
18 (with-output-to-string
19 (lambda () (emit document))))))
20 (string-translate* template (cons body meta))))
21
22(define-public (wrap-with document file)
23 (wrap document (with-input-from-file file read-string)))