diff options
Diffstat (limited to 'lib')
-rw-r--r-- | lib/emit.scm | 96 | ||||
-rw-r--r-- | lib/html.scm | 9 | ||||
-rw-r--r-- | lib/read.scm | 10 | ||||
-rw-r--r-- | lib/util.scm | 29 |
4 files changed, 103 insertions, 41 deletions
diff --git a/lib/emit.scm b/lib/emit.scm index 2a8ab97..546ec5c 100644 --- a/lib/emit.scm +++ b/lib/emit.scm | |||
@@ -2,8 +2,10 @@ | |||
2 | 2 | ||
3 | (import scheme (chicken base) | 3 | (import scheme (chicken base) |
4 | (chicken format) | 4 | (chicken format) |
5 | (chicken io) | ||
5 | (chicken irregex) | 6 | (chicken irregex) |
6 | (chicken port) | 7 | (chicken port) |
8 | (chicken process) | ||
7 | (chicken string) | 9 | (chicken string) |
8 | (only utf8-srfi-13 string-join) | 10 | (only utf8-srfi-13 string-join) |
9 | (jimmy util)) | 11 | (jimmy util)) |
@@ -15,9 +17,14 @@ | |||
15 | (with-output-to-string | 17 | (with-output-to-string |
16 | (lambda () (emit doc)))) | 18 | (lambda () (emit doc)))) |
17 | 19 | ||
20 | ;;; Change these for different output types | ||
21 | |||
22 | (define-public output-type | ||
23 | (make-parameter 'gemini)) | ||
24 | |||
18 | (define-public formats | 25 | (define-public formats |
19 | (make-parameter | 26 | (make-parameter |
20 | ;; (TYPE (line . LINE-FMT) (stanza . STANZA-FMT) (inline . INLINE-FMT)) | 27 | ;; (EL (line . LINE-FMT) (stanza . STANZA-FMT) (inline . INLINE-FMT)) |
21 | '((para (line . "~A") | 28 | '((para (line . "~A") |
22 | (stanza . "~A~%~%")) | 29 | (stanza . "~A~%~%")) |
23 | (verb (line . "~A~%") | 30 | (verb (line . "~A~%") |
@@ -36,35 +43,60 @@ | |||
36 | (hdr3 (line . "### ~A~%") | 43 | (hdr3 (line . "### ~A~%") |
37 | (stanza . "~A~%"))))) | 44 | (stanza . "~A~%"))))) |
38 | 45 | ||
46 | (define-public set-formats! formats) | ||
47 | |||
39 | (define-public filters | 48 | (define-public filters |
40 | (make-parameter | 49 | (make-parameter |
41 | ;; (TYPE (line . LINE-FILTER) (stanza . STANZA-FILTER)) | 50 | ;; (EL (line . LINE-FILTER) (stanza . STANZA-FILTER)) |
42 | ;; line-filter : (lambda (list-of-strs) ...) -> list-of-strs (for format) | 51 | ;; line-filter : (lambda (list-of-strs) ...) -> list-of-strs (for format) |
43 | ;; stanza-filter : (lambda (list-of-strs) ...) -> str | 52 | ;; stanza-filter : (lambda (list-of-strs) ...) -> str |
44 | `((verb (line . ,identity) | 53 | `((verb |
45 | (stanza . ,join-lines)) | 54 | (stanza . ,(o ensure-newline (cut string-join <> "\n")))) |
46 | (default | 55 | (default |
47 | (line . ,identity) | 56 | (line . ,identity) |
48 | (stanza . ,flush-lines-left))))) | 57 | (stanza . ,flush-lines-left))))) |
49 | 58 | ||
59 | (define-public set-filters! filters) | ||
60 | |||
61 | ;;; Implementation | ||
62 | |||
50 | (define (format-line line el) | 63 | (define (format-line line el) |
51 | (cond | 64 | (cond |
52 | ((string? (car line)) ; regular stanza line | 65 | ((string? (car line)) ; regular stanza line |
53 | (sprintf* (get-format el 'line) | 66 | (format/filter el 'line line)) |
54 | ((get-filter el 'line) line))) | ||
55 | ((symbol? (car line)) ; inline element | 67 | ((symbol? (car line)) ; inline element |
56 | (sprintf* (get-format (car line) 'inline) | 68 | (format/filter (car line) '(inline . line) (cdr line))) |
57 | ((get-filter (car line) 'line) (cdr line)))) | ||
58 | (else (error "Malformed line" line)))) | 69 | (else (error "Malformed line" line)))) |
59 | 70 | ||
60 | (define (format-stanza stanza) | 71 | (define (format-stanza stanza) |
61 | (let* ((type (car stanza)) | 72 | (let* ((el (caar stanza)) |
62 | (data (cdr stanza)) | ||
63 | (text (map (lambda (ln) | 73 | (text (map (lambda (ln) |
64 | (format-line ln type)) | 74 | (format-line ln el)) |
65 | data))) | 75 | (cdr stanza)))) |
66 | (sprintf (get-format type 'stanza) | 76 | (case el |
67 | ((get-filter type 'stanza) text)))) | 77 | ((verb) (format-verb stanza)) |
78 | (else | ||
79 | (format/filter el 'stanza text))))) | ||
80 | |||
81 | (define (format-verb stanza) | ||
82 | (let ((el (car stanza)) | ||
83 | (text (apply append (cdr stanza)))) | ||
84 | (with-output-to-string | ||
85 | (lambda () | ||
86 | (cond | ||
87 | ((and (pair? (cdr el)) | ||
88 | (equal? (cadr el) "|")) | ||
89 | ;; special case: pipe to an external process | ||
90 | (let ((cmdline (cddr el))) | ||
91 | (if (find-command (car cmdline) #;<TODO:JIMMY_PATH>) | ||
92 | (receive (in out pid) | ||
93 | (process (car cmdline) (cdr cmdline) | ||
94 | `(("JIMMY_OUTPUT" . ,(->string (output-type))))) | ||
95 | (display (ensure-newline text) out) | ||
96 | (read-string #f in))))) | ||
97 | (else ; verbatim baby | ||
98 | (printf (get-format 'verb 'stanza) | ||
99 | ((get-filter 'verb 'stanza) text)))))))) | ||
68 | 100 | ||
69 | ;;; Utilities | 101 | ;;; Utilities |
70 | 102 | ||
@@ -77,18 +109,28 @@ | |||
77 | (define (get-format el scope) | 109 | (define (get-format el scope) |
78 | (or (get-from (formats) el scope) | 110 | (or (get-from (formats) el scope) |
79 | "")) | 111 | "")) |
112 | |||
80 | (define (get-filter el scope) (get-from (filters) el scope)) | 113 | (define (get-filter el scope) (get-from (filters) el scope)) |
81 | 114 | ||
82 | (define (sprintf* fmt lis) | 115 | (define (format/filter el scope text) |
83 | (let loop ((num (length (irregex-extract "~[aA]" fmt))) | 116 | (define (sprintf* fmt lis) |
84 | (lis lis) | 117 | (let loop ((num (length (irregex-extract "~[aA]" fmt))) |
85 | (out '())) | 118 | (lis (if (list? lis) lis (list lis))) |
86 | (cond | 119 | (out '())) |
87 | ((null? lis) | 120 | (cond |
88 | (apply sprintf fmt (reverse out))) | 121 | ((null? lis) |
89 | ((= 1 num) | 122 | (apply sprintf fmt (reverse out))) |
90 | (loop 0 '() (cons (string-join lis) out))) | 123 | ((= 1 num) |
91 | (else | 124 | (loop 0 '() (cons (string-join lis) out))) |
92 | (loop (- num 1) | 125 | (else |
93 | (cdr lis) | 126 | (loop (- num 1) |
94 | (cons (car lis) out)))))) | 127 | (cdr lis) |
128 | (cons (car lis) out)))))) | ||
129 | |||
130 | (define-values (format-scope filter-scope) | ||
131 | (if (pair? scope) | ||
132 | (values (car scope) (cdr scope)) | ||
133 | (values scope scope))) | ||
134 | |||
135 | (sprintf* (get-format el format-scope) | ||
136 | ((get-filter el filter-scope) text))) | ||
diff --git a/lib/html.scm b/lib/html.scm index 07cd921..26cdff4 100644 --- a/lib/html.scm +++ b/lib/html.scm | |||
@@ -3,7 +3,10 @@ | |||
3 | (import scheme (chicken base) | 3 | (import scheme (chicken base) |
4 | (chicken irregex) | 4 | (chicken irregex) |
5 | (jimmy emit) | 5 | (jimmy emit) |
6 | (jimmy util)) | 6 | (jimmy util) |
7 | utf8-srfi-13) | ||
8 | |||
9 | (output-type 'html) | ||
7 | 10 | ||
8 | (define (escape-entities s) | 11 | (define (escape-entities s) |
9 | (irregex-replace/all "[&<>]" s | 12 | (irregex-replace/all "[&<>]" s |
@@ -24,7 +27,7 @@ | |||
24 | (char->tag "_" "i") | 27 | (char->tag "_" "i") |
25 | (char->tag "`" "code")) s)) | 28 | (char->tag "`" "code")) s)) |
26 | 29 | ||
27 | (formats | 30 | (set-formats! |
28 | '((para (line . "~a~%") | 31 | '((para (line . "~a~%") |
29 | (stanza . "<p>~% ~a</p>~%")) | 32 | (stanza . "<p>~% ~a</p>~%")) |
30 | (verb (line . "~a~%") | 33 | (verb (line . "~a~%") |
@@ -43,7 +46,7 @@ | |||
43 | (hdr3 (line . "~a") | 46 | (hdr3 (line . "~a") |
44 | (stanza . "<h3>~a</h3>~%")))) | 47 | (stanza . "<h3>~a</h3>~%")))) |
45 | 48 | ||
46 | (filters | 49 | (set-filters! |
47 | `((verb (line . ,identity) | 50 | `((verb (line . ,identity) |
48 | (stanza . ,join-lines)) | 51 | (stanza . ,join-lines)) |
49 | (link (line . ,(lambda (ln) | 52 | (link (line . ,(lambda (ln) |
diff --git a/lib/read.scm b/lib/read.scm index 1b611bb..f84b3a5 100644 --- a/lib/read.scm +++ b/lib/read.scm | |||
@@ -26,7 +26,7 @@ | |||
26 | (def (cdr (assoc 'default line-types)))) | 26 | (def (cdr (assoc 'default line-types)))) |
27 | (cond | 27 | (cond |
28 | ((null? lin) def) ; empty line | 28 | ((null? lin) def) ; empty line |
29 | ((assoc (car lin) line-types) => cdr) ; a line type exists | 29 | ((assoc (car lin) line-types) => cdr) ; a known line type |
30 | (else def)))) ; otherwise ... | 30 | (else def)))) ; otherwise ... |
31 | 31 | ||
32 | (define (parse-lines lines doc) | 32 | (define (parse-lines lines doc) |
@@ -48,10 +48,8 @@ | |||
48 | ;;;; FIXME: I think this necessitates a special emit-verbatim | 48 | ;;;; FIXME: I think this necessitates a special emit-verbatim |
49 | ;;;; function. | 49 | ;;;; function. |
50 | (parse-verbatim (cdr lines) doc '() | 50 | (parse-verbatim (cdr lines) doc '() |
51 | #; (if (< 1 (length words)) | 51 | ;;; FIXME |
52 | (cons 'verb (cdr words)) | 52 | (cons 'verb (cdr words)))) |
53 | 'verb) | ||
54 | 'verb)) | ||
55 | (else ; another line type | 53 | (else ; another line type |
56 | (apply parse-stanza lines doc '() (line-type words))))))) | 54 | (apply parse-stanza lines doc '() (line-type words))))))) |
57 | 55 | ||
@@ -67,7 +65,7 @@ | |||
67 | 65 | ||
68 | (define (parse-stanza lines doc stanza st-type | 66 | (define (parse-stanza lines doc stanza st-type |
69 | #!optional (st-inlines '()) (st-words cdr)) | 67 | #!optional (st-inlines '()) (st-words cdr)) |
70 | (define (close-stanza) (cons (cons st-type (reverse stanza)) doc)) | 68 | (define (close-stanza) (cons (cons (list st-type) (reverse stanza)) doc)) |
71 | (if (null? lines) ; end of document | 69 | (if (null? lines) ; end of document |
72 | (parse-lines lines (close-stanza)) | 70 | (parse-lines lines (close-stanza)) |
73 | (let* ((ln (car lines)) | 71 | (let* ((ln (car lines)) |
diff --git a/lib/util.scm b/lib/util.scm index c71c600..f42878b 100644 --- a/lib/util.scm +++ b/lib/util.scm | |||
@@ -2,8 +2,12 @@ | |||
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 file) |
6 | (chicken string)) | 6 | (chicken irregex) |
7 | (chicken process-context) | ||
8 | (chicken string) | ||
9 | (srfi 1) | ||
10 | utf8-srfi-13) | ||
7 | 11 | ||
8 | (define-syntax define-public | 12 | (define-syntax define-public |
9 | (syntax-rules () | 13 | (syntax-rules () |
@@ -34,9 +38,6 @@ | |||
34 | ((list? (cdr kv)) | 38 | ((list? (cdr kv)) |
35 | (apply alist-walk (cdr kv) (cdr keys))))))) | 39 | (apply alist-walk (cdr kv) (cdr keys))))))) |
36 | 40 | ||
37 | (define (string-join ss #!optional (sep " ")) | ||
38 | (string-intersperse ss sep)) | ||
39 | |||
40 | (define (flush-lines-left lines) | 41 | (define (flush-lines-left lines) |
41 | (irregex-replace/all '(: bol (* space)) | 42 | (irregex-replace/all '(: bol (* space)) |
42 | (string-join lines) "")) | 43 | (string-join lines) "")) |
@@ -44,6 +45,24 @@ | |||
44 | (define (join-lines lines) | 45 | (define (join-lines lines) |
45 | (apply string-append lines)) | 46 | (apply string-append lines)) |
46 | 47 | ||
48 | (define (find-command command . dirs) | ||
49 | (define (find-command-in-dir dir) | ||
50 | (and (directory-exists? dir) | ||
51 | (find-files dir | ||
52 | limit: 0 | ||
53 | test: `(: (* any) "/" ,command eos)))) | ||
54 | (define path+ | ||
55 | (append (string-split (get-environment-variable "PATH") ":") dirs)) | ||
56 | (define found | ||
57 | (filter file-executable? | ||
58 | (apply append (filter-map find-command-in-dir path+)))) | ||
59 | (if (pair? found) (car found) #f)) | ||
60 | |||
61 | (define (ensure-newline str) | ||
62 | (if (string-suffix? "\n" str) | ||
63 | str | ||
64 | (string-append str "\n"))) | ||
65 | |||
47 | ) | 66 | ) |
48 | 67 | ||
49 | 68 | ||