4 files changed, 103 insertions, 41 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)))
@@ -3,7 +3,10 @@
 (import scheme (chicken base)
         (chicken irregex)
         (jimmy emit)
-        (jimmy util))
+        (jimmy util)
+        utf8-srfi-13)
+
+(output-type 'html)
 
 (define (escape-entities s)
   (irregex-replace/all "[&<>]" s
@@ -24,7 +27,7 @@
       (char->tag "_" "i")
       (char->tag "`" "code")) s))
 
-(formats
+(set-formats!
   '((para (line . "~a~%")
           (stanza . "<p>~% ~a</p>~%"))
     (verb (line . "~a~%")
@@ -43,7 +46,7 @@
     (hdr3 (line . "~a")
           (stanza . "<h3>~a</h3>~%"))))
 
-(filters
+(set-filters!
   `((verb (line . ,identity)
           (stanza . ,join-lines))
     (link (line . ,(lambda (ln)
@@ -26,7 +26,7 @@
         (def (cdr (assoc 'default line-types))))
     (cond
      ((null? lin) def)                             ; empty line
-     ((assoc (car lin) line-types) => cdr)         ; a line type exists
+     ((assoc (car lin) line-types) => cdr)         ; a known line type
      (else def))))                                 ; otherwise ...
 
 (define (parse-lines lines doc)
@@ -48,10 +48,8 @@
           ;;;; FIXME: I think this necessitates a special emit-verbatim
           ;;;; function.
           (parse-verbatim (cdr lines) doc '()
-                   #;       (if (< 1 (length words))
-                              (cons 'verb (cdr words))
-                          'verb)
-                          'verb))
+                          ;;; FIXME
+                          (cons 'verb (cdr words))))
          (else                                     ; another line type
           (apply parse-stanza lines doc '() (line-type words)))))))
 
@@ -67,7 +65,7 @@
 
 (define (parse-stanza lines doc stanza st-type
                       #!optional (st-inlines '()) (st-words cdr))
-  (define (close-stanza) (cons (cons st-type (reverse stanza)) doc))
+  (define (close-stanza) (cons (cons (list st-type) (reverse stanza)) doc))
   (if (null? lines)                                ; end of document
       (parse-lines lines (close-stanza))
       (let* ((ln (car lines))
@@ -2,8 +2,12 @@
 
   (import scheme (chicken base)
           (chicken condition)
-          (only (chicken irregex) irregex-replace/all)
-          (chicken string))
+          (chicken file)
+          (chicken irregex)
+          (chicken process-context)
+          (chicken string)
+          (srfi 1)
+          utf8-srfi-13)
 
   (define-syntax define-public
     (syntax-rules ()
@@ -34,9 +38,6 @@
            ((list? (cdr kv))
             (apply alist-walk (cdr kv) (cdr keys)))))))
 
-  (define (string-join ss #!optional (sep " "))
-    (string-intersperse ss sep))
-
   (define (flush-lines-left lines)
     (irregex-replace/all '(: bol (* space))
                          (string-join lines) ""))
@@ -44,6 +45,24 @@
   (define (join-lines lines)
     (apply string-append lines))
 
+  (define (find-command command . dirs)
+    (define (find-command-in-dir dir)
+      (and (directory-exists? dir)
+           (find-files dir
+                       limit: 0
+                       test: `(: (* any) "/" ,command eos))))
+    (define path+
+      (append (string-split (get-environment-variable "PATH") ":") dirs))
+    (define found
+      (filter file-executable?
+              (apply append (filter-map find-command-in-dir path+))))
+    (if (pair? found) (car found) #f))
+
+  (define (ensure-newline str)
+    (if (string-suffix? "\n" str)
+        str
+        (string-append str "\n")))
+
   )