From 423ac382f9e73bf1ca7fc6b400f98db087cd7d22 Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Wed, 5 Jun 2024 09:21:25 -0500
Subject: Write executable

This involved moving `src' to `lib' and making `bin'.
`bin' holds the program, which only imports `jimmy.main' from lib.
---
 lib/html.scm | 61 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 61 insertions(+)
 create mode 100644 lib/html.scm

(limited to 'lib/html.scm')

diff --git a/lib/html.scm b/lib/html.scm
new file mode 100644
index 0000000..07cd921
--- /dev/null
+++ b/lib/html.scm
@@ -0,0 +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