Update things

1 files changed, 69 insertions, 27 deletions

@@ -2,8 +2,10 @@
 
 (import scheme (chicken base)
         (chicken format)
+        (chicken io)
         (chicken irregex)
         (chicken port)
+        (chicken process)
         (chicken string)
         (only utf8-srfi-13 string-join)
         (jimmy util))
@@ -15,9 +17,14 @@
   (with-output-to-string
     (lambda () (emit doc))))
 
+;;; Change these for different output types
+
+(define-public output-type
+  (make-parameter 'gemini))
+
 (define-public formats
   (make-parameter
-   ;; (TYPE (line . LINE-FMT) (stanza . STANZA-FMT) (inline . INLINE-FMT))
+   ;; (EL (line . LINE-FMT) (stanza . STANZA-FMT) (inline . INLINE-FMT))
    '((para (line . "~A")
            (stanza . "~A~%~%"))
      (verb (line . "~A~%")
@@ -36,35 +43,60 @@
      (hdr3 (line . "### ~A~%")
            (stanza . "~A~%")))))
 
+(define-public set-formats! formats)
+
 (define-public filters
   (make-parameter
-   ;; (TYPE (line . LINE-FILTER) (stanza . STANZA-FILTER))
+   ;; (EL (line . LINE-FILTER) (stanza . STANZA-FILTER))
    ;; line-filter : (lambda (list-of-strs) ...) -> list-of-strs (for format)
    ;; stanza-filter : (lambda (list-of-strs) ...) -> str
-   `((verb (line . ,identity)
-           (stanza . ,join-lines))
+   `((verb
+      (stanza . ,(o ensure-newline (cut string-join <> "\n"))))
      (default
        (line . ,identity)
        (stanza . ,flush-lines-left)))))
 
+(define-public set-filters! filters)
+
+;;; Implementation
+
 (define (format-line line el)
   (cond
    ((string? (car line))                ; regular stanza line
-    (sprintf* (get-format el 'line)
-              ((get-filter el 'line) line)))
+    (format/filter el 'line line))
    ((symbol? (car line))                ; inline element
-    (sprintf* (get-format (car line) 'inline)
-              ((get-filter (car line) 'line) (cdr line))))
+    (format/filter (car line) '(inline . line) (cdr line)))
    (else (error "Malformed line" line))))
 
 (define (format-stanza stanza)
-  (let* ((type (car stanza))
-         (data (cdr stanza))
+  (let* ((el (caar stanza))
          (text (map (lambda (ln)
-                      (format-line ln type))
-                    data)))
-    (sprintf (get-format type 'stanza)
-             ((get-filter type 'stanza) text))))
+                      (format-line ln el))
+                    (cdr stanza))))
+    (case el
+      ((verb) (format-verb stanza))
+      (else
+       (format/filter el 'stanza text)))))
+
+(define (format-verb stanza)
+  (let ((el (car stanza))
+        (text (apply append (cdr stanza))))
+    (with-output-to-string
+      (lambda ()
+        (cond
+         ((and (pair? (cdr el))
+               (equal? (cadr el) "|"))
+          ;; special case: pipe to an external process
+          (let ((cmdline (cddr el)))
+            (if (find-command (car cmdline) #;<TODO:JIMMY_PATH>)
+                (receive (in out pid)
+                    (process (car cmdline) (cdr cmdline)
+                             `(("JIMMY_OUTPUT" . ,(->string (output-type)))))
+                  (display (ensure-newline text) out)
+                  (read-string #f in)))))
+         (else                      ; verbatim baby
+          (printf (get-format 'verb 'stanza)
+                  ((get-filter 'verb 'stanza) text))))))))
 
 ;;; Utilities
 
@@ -77,18 +109,28 @@
 (define (get-format el scope)
   (or (get-from (formats) el scope)
       ""))
+
 (define (get-filter el scope) (get-from (filters) el scope))
 
-(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))))))
+(define (format/filter el scope text)
+  (define (sprintf* fmt lis)
+    (let loop ((num (length (irregex-extract "~[aA]" fmt)))
+               (lis (if (list? lis) lis (list 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))))))
+
+  (define-values (format-scope filter-scope)
+    (if (pair? scope)
+        (values (car scope) (cdr scope))
+        (values scope scope)))
+
+  (sprintf* (get-format el format-scope)
+            ((get-filter el filter-scope) text)))