From ed4e86f47935994fb424c977e4123bde625ddff1 Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Mon, 3 Jun 2024 16:56:30 -0500
Subject: Fix html/other sourcing; re-scramble Makefile

---
 src/emit.scm | 69 ++++++++++++++++++++++++++++++------------------------------
 src/html.scm | 58 ++++++++++++++++++++++++++++++++++++++++++++++++++
 src/read.scm | 29 +++++++++++++++++++------
 src/util.scm | 12 ++++++++++-
 src/wrap.scm |  2 +-
 5 files changed, 126 insertions(+), 44 deletions(-)

(limited to 'src')

diff --git a/src/emit.scm b/src/emit.scm
index e57e437..4c3581f 100644
--- a/src/emit.scm
+++ b/src/emit.scm
@@ -1,3 +1,5 @@
+(declare (module (jimmy emit)))
+
 (import scheme (chicken base)
         (chicken format)
         (chicken irregex)
@@ -9,41 +11,36 @@
   (for-each display (map format-stanza doc)))
 
 (define-public formats
-  ;;; (TYPE (line . LINE-FMT) (stanza . STANZA-FMT) (inline . INLINE-FMT))
-  '((para (line . "~A")
-          (stanza . "~A~%~%"))
-    (verb (line . "~A~%")
-          (stanza . "```~%~A```~%~%"))
-    (link (line . "=> ~A ~A~%")         ; Note: link has 2 format arguments
-          (stanza . "~A~%")
-          (inline . "~%=> ~A ~A~%"))
-    (list (line . "* ~A~%")
-          (stanza . "~A~%"))
-    (quot (line . "~A")
-          (stanza . "> ~A~%~%"))
-    (hdr1 (line . "# ~A~%")
-          (stanza . "~A~%"))
-    (hdr2 (line . "## ~A~%")
-          (stanza . "~A~%"))
-    (hdr3 (line . "### ~A~%")
-          (stanza . "~A~%"))
-    (meta (line . "")
-          (stanza . ""))
-    (default
-      (line . "~A")
-      (stanza . "~A~%~%"))))
+  (make-parameter
+   ;; (TYPE (line . LINE-FMT) (stanza . STANZA-FMT) (inline . INLINE-FMT))
+   '((para (line . "~A")
+           (stanza . "~A~%~%"))
+     (verb (line . "~A~%")
+           (stanza . "```~%~A```~%~%"))
+     (link (line . "=> ~A ~A~%")         ; Note: link has 2 format arguments
+           (stanza . "~A~%")
+           (inline . "~%=> ~A ~A~%"))
+     (list (line . "* ~A~%")
+           (stanza . "~A~%"))
+     (quot (line . "~A")
+           (stanza . "> ~A~%~%"))
+     (hdr1 (line . "# ~A~%")
+           (stanza . "~A~%"))
+     (hdr2 (line . "## ~A~%")
+           (stanza . "~A~%"))
+     (hdr3 (line . "### ~A~%")
+           (stanza . "~A~%")))))
 
 (define-public filters
-  ;;; (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 . ,identity)
-      (stanza . ,(lambda (lines)
-                   (irregex-replace/all '(: bol (* space))
-                                        (string-join lines) ""))))))
+  (make-parameter
+   ;; (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 . ,join-lines))
+     (default
+       (line . ,identity)
+       (stanza . ,flush-lines-left)))))
 
 (define (format-line line el)
   (cond
@@ -72,8 +69,10 @@
       (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 (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)))
diff --git a/src/html.scm b/src/html.scm
index 371d407..07cd921 100644
--- a/src/html.scm
+++ b/src/html.scm
@@ -1,3 +1,61 @@
 (declare (module (jimmy html)))
 
+(import scheme (chicken base)
+        (chicken irregex)
+        (jimmy emit)
+        (jimmy util))
 
+(define (escape-entities s)
+  (irregex-replace/all "[&<>]" s
+                       (lambda (m)
+                         (let ((c (irregex-match-substring m)))
+                           (cond
+                            ((equal? c "&") "&amp;")
+                            ((equal? c "<") "&lt;")
+                            ((equal? c ">") "&gt;"))))))
+
+(define (add-inline-markup s)
+  (define (char->tag ch tag)
+    (lambda (s)
+      (irregex-replace/all `(: ,ch ($ (* (~ ,ch))) ,ch) s
+                           "<" tag ">" 1 "</" tag ">")))
+
+  ((o (char->tag "*" "b")
+      (char->tag "_" "i")
+      (char->tag "`" "code")) s))
+
+(formats
+  '((para (line . "~a~%")
+          (stanza . "<p>~% ~a</p>~%"))
+    (verb (line . "~a~%")
+          (stanza . "<pre><code>~a</code></pre>~%"))
+    (link (line . "<li><a href=\"~a\">~a</a></li>~%")
+          (stanza . "<ul>~% ~a</ul>~%")
+          (inline . "<a href=\"~a\">~a</a>~%"))
+    (list (line . "<li>~a</li>~%")
+          (stanza . "<ul>~% ~a</ul>~%"))
+    (quot (line . "~a~%")
+          (stanza . "<blockquote>~% ~a</blockquote>~%"))
+    (hdr1 (line . "~a")
+          (stanza . "<h1>~a</h1>~%"))
+    (hdr2 (line . "~a")
+          (stanza . "<h2>~a</h2>~%"))
+    (hdr3 (line . "~a")
+          (stanza . "<h3>~a</h3>~%"))))
+
+(filters
+  `((verb (line . ,identity)
+          (stanza . ,join-lines))
+    (link (line . ,(lambda (ln)
+                     (cons (car ln)
+                           ((o list
+                               add-inline-markup
+                               escape-entities
+                               string-join)
+                            (cdr ln))))))
+    (default
+      (line . ,(o list
+                  add-inline-markup
+                  escape-entities
+                  string-join))
+      (stanza . ,string-join))))
diff --git a/src/read.scm b/src/read.scm
index 94708ef..1b611bb 100644
--- a/src/read.scm
+++ b/src/read.scm
@@ -36,19 +36,34 @@
          ((null? words)                            ; empty line
           (parse-lines (cdr lines) doc))
          ((equal? (car words) "```")               ; verbatim
-          (parse-verbatim (cdr lines) doc '()))
+          ;; Format for verbatim header:
+          ;; ``` ?html | command ...
+          ;;     -- only run command on block with html output.
+          ;;        other outputs process the block normally
+          ;; ``` ?!html | command ...
+          ;;     -- only run command on block when *not* outputting html.
+          ;;        html processes the block normally
+          ;; ``` ?:html | command ...
+          ;;     -- like ?html, but ignore the block in non-html outputs.
+          ;;;; 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))
          (else                                     ; another line type
           (apply parse-stanza lines doc '() (line-type words)))))))
 
-(define (parse-verbatim lines doc block)
-  (define (close-verbatim) (cons (cons 'verb (reverse block)) doc))
+(define (parse-verbatim lines doc block bhead)
+  (define (close-verbatim) (cons (cons bhead (reverse block)) doc))
   (cond
-   ((null? lines)                                  ; end of document
+   ((null? lines)                       ; end of document
     (parse-lines lines (close-verbatim)))
-   ((equal? (car lines) "```")                     ; end of verbatim block
+   ((equal? (car lines) "```")          ; end of verbatim block
     (parse-lines (cdr lines) (close-verbatim)))
-   (else                                           ; verbatim block continues
-    (parse-verbatim (cdr lines) doc (cons (list (car lines)) block)))))
+   (else                                ; verbatim block continues
+    (parse-verbatim (cdr lines) doc (cons (list (car lines)) block) bhead))))
 
 (define (parse-stanza lines doc stanza st-type
                       #!optional (st-inlines '()) (st-words cdr))
diff --git a/src/util.scm b/src/util.scm
index 41da769..c71c600 100644
--- a/src/util.scm
+++ b/src/util.scm
@@ -2,6 +2,7 @@
 
   (import scheme (chicken base)
           (chicken condition)
+          (only (chicken irregex) irregex-replace/all)
           (chicken string))
 
   (define-syntax define-public
@@ -34,6 +35,15 @@
             (apply alist-walk (cdr kv) (cdr keys)))))))
 
   (define (string-join ss #!optional (sep " "))
-  (string-intersperse ss sep)))
+    (string-intersperse ss sep))
+
+  (define (flush-lines-left lines)
+    (irregex-replace/all '(: bol (* space))
+                         (string-join lines) ""))
+
+  (define (join-lines lines)
+    (apply string-append lines))
+
+  )
 
 
diff --git a/src/wrap.scm b/src/wrap.scm
index 0ed8868..aa077d8 100644
--- a/src/wrap.scm
+++ b/src/wrap.scm
@@ -5,7 +5,7 @@
         (jimmy util)
         (only (chicken io) read-string)
         (only (chicken port) with-output-to-string)
-        (only (chicken string) string-translate*))
+        (only (chicken string) string-translate* string-intersperse))
 
 ;; templates are strings with variables interpolated with "{{variables}}"
 
-- 
cgit 1.4.1-21-gabe81