3 files changed, 99 insertions, 77 deletions

@@ -34,18 +34,6 @@
       (line . "~A")
       (block . "~A~%~%"))))
 
-(define (string-join ss #!optional sep)
-  (if (string? ss) ss
-      (string-intersperse ss (or sep " "))))
-
-(define (char->tag char beg end)
-  (lambda (str)
-    (irregex-replace/all `(: ($ (or bos space))
-                             ,char ($ (+ (~ ,char))) ,char
-                             ($ (or space eos)))
-                         str
-                         1 beg 2 end 3)))
-
 (define-public filters
   `((para
      (line . ,(o (char->tag "*" "<strong>" "</strong>")
@@ -58,16 +46,27 @@
      (line . ,(lambda (ln)
                 (let ((ws (cond ((list? ln) ln)
                                 ((string? ln) (string-split ln)))))
-                  (list (car ws) (string-join (cdr ws)))))))
+                  (let ((x (list (car ws) (string-join (cdr ws)))))
+                    x)))))
     (default
-      (line . ,list)
+      (line . ,(lambda (x) (print x) (if (list? x) x (list x))))
       (block . ,identity))))
 
+(define (string-join ss #!optional sep)
+  (if (string? ss) ss
+      (string-intersperse ss (or sep " "))))
+
+(define (char->tag char beg end)
+  (lambda (str)
+    (irregex-replace/all `(: ($ (or bos space))
+                             ,char ($ (+ (~ ,char))) ,char
+                             ($ (or space eos)))
+                         str
+                         1 beg 2 end 3)))
+
 (define (get-from from type subtype)
   (or (alist-walk from type subtype)
-      (if (eq? subtype 'inline)
-          (alist-walk from type 'list)
-          (lambda _ '("")))))
+      (get-from from 'default subtype)))
 
 (define (get-format type subtype) (get-from formats type subtype))
 (define (get-filter type subtype) (get-from filters type subtype))
@@ -76,19 +75,19 @@
   (cond
    ;; if LINE is a string, wrap it in a list
    ((string? line)
-    (set! line (list line)))
+    (sprintf (get-format type 'line)
+             ((get-filter type 'line) line)))
    ;; if it's a list of strings, join them together and filter them
    ((and (list? line)
          (string? (car line)))
-    (set! line ((get-filter type 'line) line)))
+    (sprintf (get-format type 'line)
+             (apply string-append ((get-filter type 'line) line))))
    ;; if the car of LINE is a symbol, it's an inline thing.
    ((and (list? line)
          (symbol? (car line)))
-    (set! line (format-line (get-format (car line) 'inline)
-                            ((get-filter (car line) 'line) (cdr line))
-                            type)))
-   (else (error "Malformed line" line)))
-  (apply sprintf fmt line))
+    (sprintf* (get-format (car line) 'inline)
+              ((get-filter (car line) 'line) (cdr line))))
+   (else (error "Malformed line" line))))
 
 (define (format-block block)
   (if (assq (car block) formats)
@@ -107,3 +106,17 @@
         (sprintf (get-format type 'block)
                  ((get-filter type 'block) text)))
       ""))
+
+(define (sprintf* fmt lis)
+  (let loop ((num (length (irregex-extract "~[aA]" fmt)))
+             (lis lis)
+             (out '()))
+    (cond
+     ((null? lis)
+      (apply sprintf fmt (reverse out)))
+     ((= 1 num)
+      (loop 0 '() (cons (string-join lis) out)))
+     (else
+      (loop (- num 1)
+            (cdr lis)
+            (cons (car lis) out))))))
@@ -2,73 +2,72 @@
 
 (import scheme (chicken base)
         (jimmy util)
-        (only (chicken condition) handle-exceptions)
         (only (chicken io) read-lines)
         (only (chicken string) string-split))
 
 (define-public line-types
-  ;; (sigil type inlines preproc)
-  '(("=>" link)
+  ;; (sigil type inlines word-select)
+  `((default para (link) ,identity) ; if nothing else matches
+    ("```" verb)
+    ("=>" link)
     (">" quot)
     ("#" hdr1)
     ("##" hdr2)
     ("###" hdr3)
     ("*" list)
-    ("```" verb)
     ;; extra!
     (":" meta)))
 
-(define-public (parse inport)
-  (parse-lines (read-lines inport) '()))
+(define-public (parse #!optional port)
+  (parse-lines (read-lines (or port (current-input-port))) '()))
 
 (define (line-type line)
-  (let ((it (assoc (car (string-split line)) line-types)))
-    (if it (cadr it)
-        'para)))
+  (let ((lin (if (string? line) (string-split line) line))
+        (def (cdr (assoc 'default line-types))))
+    (cond
+     ((null? lin) def)                             ; empty line
+     ((assoc (car lin) line-types) => cdr)         ; a line type exists
+     (else def))))                                 ; otherwise ...
 
-(define (parse-lines lines document)
-  (if (null? lines) (reverse document)
+(define (parse-lines lines doc)
+  (if (null? lines) (reverse doc)
       (let ((words (string-split (car lines))))
         (cond
-         ((null? words)
-          (parse-lines (cdr lines) document))
-         ((equal? (car words) "```")
-          (parse-verbatim (cdr lines) document '()))
-         ((assoc (car words) line-types)
-          => (lambda (it)
-               (apply parse-block lines document '() (cdr it))))
-         (else
-          (parse-block lines document '() 'para '(link) identity))))))
+         ((null? words)                            ; empty line
+          (parse-lines (cdr lines) doc))
+         ((equal? (car words) "```")               ; verbatim
+          (parse-verbatim (cdr lines) doc '()))
+         (else                                     ; another line type
+          (apply parse-stanza lines doc '() (line-type words)))))))
 
-(define (parse-verbatim lines document verb)
+(define (parse-verbatim lines doc block)
+  (define (close-verbatim) (cons (cons 'verb (reverse block)) doc))
   (cond
-   ((null? lines)
-    (parse-lines lines (cons (cons 'verb (reverse verb)) document)))
-   ((equal? (car lines) "```")
-    (parse-lines (cdr lines) (cons (cons 'verb (reverse verb)) document)))
-   (else
-    (parse-verbatim (cdr lines) document (cons (car lines) verb)))))
+   ((null? lines)                                  ; end of document
+    (parse-lines lines (close-verbatim)))
+   ((equal? (car lines) "```")                     ; end of verbatim block
+    (parse-lines (cdr lines) (close-verbatim)))
+   (else                                           ; verbatim block continues
+    (parse-verbatim (cdr lines) doc (cons (car lines) block)))))
 
-(define (parse-block lines document block type #!optional inlines preproc)
-  (let ((inlines (or inlines '()))
-        (preproc (or preproc (lambda (ln) (cdr (string-split ln))))))
-    (cond
-     ((null? lines)
-      (parse-lines lines (cons (cons type (reverse block)) document)))
-     ((equal? (car lines) "")
-      (parse-lines (cdr lines) (cons (cons type (reverse block)) document)))
-     ((and (not (eq? type (line-type (car lines))))
-           (not (memq (line-type (car lines)) inlines)))
-      (parse-lines lines (cons (cons type (reverse block)) document)))
-     ((memq (line-type (car lines)) inlines)
+(define (parse-stanza lines doc stanza st-type
+                      #!optional (st-inlines '()) (st-words cdr))
+  (define (close-stanza) (cons (cons st-type (reverse stanza)) doc))
+  (if (null? lines)                                ; end of document
+      (parse-lines lines (close-stanza))
       (let* ((ln (car lines))
              (ws (string-split ln))
-             (lt (cdr (assoc (car ws) line-types))))
-        (parse-block (cdr lines) document
-                     (cons (cons (car lt)
-                                 ((or (ignore-errors (caddr lt)) cdr) ws))
-                           block)
-                     type inlines preproc)))
-     (else
-      (parse-block (cdr lines) document (cons (preproc (car lines)) block)
-                   type inlines preproc)))))
+             (lt (line-type ln)))
+        (cond
+         ((null? ws)                               ; end of stanza (blank line)
+          (parse-lines (cdr lines) (close-stanza)))
+         ((memq (car lt) st-inlines)               ; in-line for *this* stanza
+          (parse-stanza (cdr lines) doc
+                        (cons (cons (car lt) (cdr ws)) stanza)
+                        st-type st-inlines st-words))
+         ((not (eq? st-type (car (line-type ws)))) ; beginning of a new stanza
+          (parse-lines lines (close-stanza)))
+         (else                                     ; continue this stanza
+          (parse-stanza (cdr lines) doc
+                        (cons (st-words ws) stanza)
+                        st-type st-inlines st-words))))))
@@ -1,13 +1,23 @@
 (declare (module (jimmy wrap)))
 
 (import scheme (chicken base)
+        (jimmy emit)
         (jimmy util)
-        (chicken format))
+        (only (chicken io) read-string)
+        (only (chicken port) with-output-to-string)
+        (only (chicken string) string-translate*))
 
-;;; open question: how to do templating?
+;; templates are strings with variables interpolated with "{{variables}}"
 
 (define-public (wrap document template)
-  #f)
+  (let* ((meta (map (lambda (el)
+                      (cons (string-append "{{" (car el) "}}")
+                            (string-intersperse (cdr el) " ")))
+                    (alist-walk document 'meta)))
+         (body (cons "{{body}}"
+                     (with-output-to-string
+                       (lambda () (emit document))))))
+    (string-translate* template (cons body meta))))
 
-(define (meta-get key document)
-  (alist-walk document 'meta key))
+(define-public (wrap-with document file)
+  (wrap document (with-input-from-file file read-string)))