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/html.scm | 58 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 58 insertions(+)

(limited to 'src/html.scm')

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))))
-- 
cgit 1.4.1-21-gabe81