From ddc2a19b6591dc254462d44aefa37bc25aaaf9bb Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Mon, 27 May 2024 00:01:46 -0500
Subject: Fix emit and read, add imports, fix makefile

---
 src/emit.scm | 140 +++++++++++++++++++++++------------------------------------
 1 file changed, 54 insertions(+), 86 deletions(-)

(limited to 'src/emit.scm')

diff --git a/src/emit.scm b/src/emit.scm
index d6fe19e..e57e437 100644
--- a/src/emit.scm
+++ b/src/emit.scm
@@ -1,111 +1,79 @@
-(declare (module (jimmy emit)))
-
 (import scheme (chicken base)
-        (jimmy util)
         (chicken format)
         (chicken irregex)
-        (chicken string))
+        (chicken string)
+        (only utf8-srfi-13 string-join)
+        (jimmy util))
 
-(define-public (emit document)
-  (for-each display
-            (map format-block document)))
+(define-public (emit doc)
+  (for-each display (map format-stanza doc)))
 
 (define-public formats
-  ;;; (type line-format block-format [line-in-block-format])
-  ;; these default to gemtext
-  '((para (line . "~A ")
-          (block . "~A~%~%"))
+  ;;; (TYPE (line . LINE-FMT) (stanza . STANZA-FMT) (inline . INLINE-FMT))
+  '((para (line . "~A")
+          (stanza . "~A~%~%"))
     (verb (line . "~A~%")
-          (block . "```~%~A```~%~%"))
-    (link (line . "=> ~A ~A~%")
-          (block . "~A~%")
-          (inline . "~%=> ~A ~A~%")) ;TODO: have 2 args to format
+          (stanza . "```~%~A```~%~%"))
+    (link (line . "=> ~A ~A~%")         ; Note: link has 2 format arguments
+          (stanza . "~A~%")
+          (inline . "~%=> ~A ~A~%"))
     (list (line . "* ~A~%")
-          (block . "~A~%"))
-    (quot (line . "~A ")
-          (block . "> ~A~%~%"))
+          (stanza . "~A~%"))
+    (quot (line . "~A")
+          (stanza . "> ~A~%~%"))
     (hdr1 (line . "# ~A~%")
-          (block . "~A~%"))
+          (stanza . "~A~%"))
     (hdr2 (line . "## ~A~%")
-          (block . "~A~%"))
+          (stanza . "~A~%"))
     (hdr3 (line . "### ~A~%")
-          (block . "~A~%"))
+          (stanza . "~A~%"))
+    (meta (line . "")
+          (stanza . ""))
     (default
       (line . "~A")
-      (block . "~A~%~%"))))
+      (stanza . "~A~%~%"))))
 
 (define-public filters
-  `((para
-     (line . ,(o (char->tag "*" "<strong>" "</strong>")
-                 (char->tag "_" "<em>" "</em>")
-                 (char->tag "`" "<code>" "</code>")
-                 string-join))
-     (block . ,(lambda (ln)
-                 (irregex-replace/all '(: bol (* " ")) ln ""))))
-    (link
-     (line . ,(lambda (ln)
-                (let ((ws (cond ((list? ln) ln)
-                                ((string? ln) (string-split ln)))))
-                  (let ((x (list (car ws) (string-join (cdr ws)))))
-                    x)))))
+  ;;; (TYPE (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 . ,(lambda (lines) (apply string-append lines))))
     (default
-      (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)
-      (get-from from 'default subtype)))
+      (line . ,identity)
+      (stanza . ,(lambda (lines)
+                   (irregex-replace/all '(: bol (* space))
+                                        (string-join lines) ""))))))
 
-(define (get-format type subtype) (get-from formats type subtype))
-(define (get-filter type subtype) (get-from filters type subtype))
-
-(define (format-line fmt line type)
+(define (format-line line el)
   (cond
-   ;; if LINE is a string, wrap it in a list
-   ((string? 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)))
-    (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)))
+   ((string? (car line))                ; regular stanza line
+    (sprintf* (get-format el 'line)
+              ((get-filter el 'line) line)))
+   ((symbol? (car line))                ; inline element
     (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)
-      (let* ((type (car block))
-             (data (cdr block))
-             (text (cond
-                    ((string? data) data)
-                    ((list? data)
-                     (apply string-append
-                            (map (lambda (ln)
-                                   (format-line (get-format type 'line)
-                                                ln
-                                                type))
-                                 data)))
-                    (else (error "Malformed block" block)))))
-        (sprintf (get-format type 'block)
-                 ((get-filter type 'block) text)))
-      ""))
+(define (format-stanza stanza)
+  (let* ((type (car stanza))
+         (data (cdr stanza))
+         (text (map (lambda (ln)
+                      (format-line ln type))
+                    data)))
+    (sprintf (get-format type 'stanza)
+             ((get-filter type 'stanza) text))))
+
+;;; Utilities
+
+(define (get-from alist el scope)
+  (or (alist-walk alist el scope)
+      (alist-walk alist 'default scope)
+      (and (eq? scope 'inline)
+           (alist-walk alist 'default 'line))))
+
+(define (get-format el scope) (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)))
-- 
cgit 1.4.1-21-gabe81