about summary refs log tree commit diff stats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/emit.scm96
-rw-r--r--lib/html.scm9
-rw-r--r--lib/read.scm10
-rw-r--r--lib/util.scm29
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