4 files changed, 63 insertions, 92 deletions

@@ -4,6 +4,7 @@ LIBS = read emit util
 
 BUILD = $(PWD)/build
 SRC = $(PWD)/src
+TESTS = $(PWD)/tests
 
 CSC = /usr/bin/csc
 CSI = /usr/bin/csi
@@ -14,8 +15,8 @@ CSC_OPTIONS = \
         -emit-all-import-libraries \
         -dynamic \
         -regenerate-import-libraries \
-        -I $(PWD) \
-        -C -I$(PWD)
+        -I $(SRC) \
+        -C -I$(SRC)
 
 CSC_OPTIONS_EXTRA = \
         -X utf8 \
@@ -37,7 +38,7 @@ build: $(LIBS_)
 
 test: build
         cd $(BUILD) && \
-        $(CSI) -setup-mode -s tests/run.scm $(NAME)
+        $(CSI) -setup-mode -s $(TESTS)/run.scm $(NAME)
 
 clean:
         -rm -rf $(BUILD)
@@ -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)))
@@ -48,7 +48,7 @@
    ((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)))))
+    (parse-verbatim (cdr lines) doc (cons (list (car lines)) block)))))
 
 (define (parse-stanza lines doc stanza st-type
                       #!optional (st-inlines '()) (st-words cdr))
@@ -1,7 +1,8 @@
 (module (jimmy util) *
 
   (import scheme (chicken base)
-          (chicken condition))
+          (chicken condition)
+          (chicken string))
 
   (define-syntax define-public
     (syntax-rules ()
@@ -32,6 +33,7 @@
            ((list? (cdr kv))
             (apply alist-walk (cdr kv) (cdr keys)))))))
 
-  )
+  (define (string-join ss #!optional (sep " "))
+  (string-intersperse ss sep)))