From 22c3f2da96853b3b1a36efe6766cf643545848b7 Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Sun, 2 Jul 2023 14:32:26 -0500
Subject: Add scratchdown

---
 .gitignore              |  1 +
 chicken-scratch.mod.scm | 10 +++++----
 chicken-scratch.scm     |  2 ++
 makefile                |  8 +++++--
 scratchdown.scm         | 55 +++++++++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 70 insertions(+), 6 deletions(-)
 create mode 100755 scratchdown.scm

diff --git a/.gitignore b/.gitignore
index 8b6a74a..5b41b96 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,4 +1,5 @@
 chicken-scratch
+scratchdown
 *.link
 *.so
 *.o
diff --git a/chicken-scratch.mod.scm b/chicken-scratch.mod.scm
index e47ad67..0ba704e 100755
--- a/chicken-scratch.mod.scm
+++ b/chicken-scratch.mod.scm
@@ -27,8 +27,7 @@
 (module chicken-scratch
     (expand-string
      expand-port
-     def
-     %def/replacer)
+     def %def/replacer)
 
   (import scheme
           (chicken base)
@@ -50,13 +49,16 @@
       (let* ((delim (random-string-not-in str))
              (template (make-concatenated-port
                         (open-input-string (string-append "#<#" delim "\n"))
-                        (open-input-string (irregex-replace "^#!.*\n" str ""))
+                        (open-input-string "#(import chicken-scratch)")
+                        (open-input-string str)
                         (open-input-string (string-append "\n" delim "\n"))))
              (expanded (open-output-string))
              (output (begin
                        (display (eval (read template)) expanded)
                        (get-output-string expanded))))
-        (irregex-replace/all `(seq ,(%def/replacer) (* "\n"))
+        (irregex-replace/all `(: (or "#<unspecified>"
+                                     ,(%def/replacer))
+                                 (* whitespace))
                              output
                              ""))))
 
diff --git a/chicken-scratch.scm b/chicken-scratch.scm
index 6d06fb6..307aa8d 100755
--- a/chicken-scratch.scm
+++ b/chicken-scratch.scm
@@ -11,6 +11,8 @@ License: BSD-3.  See COPYING for details.
         (chicken process-context))
 
 (define (main args)
+  ;; XXX: handle standard input piping
+  ;; XXX: Must have an #(import chicken-scratch at the beginning)
   (for-each (lambda (file)
               (when (file-exists? file)
                 (display (with-input-from-file file expand-port))
diff --git a/makefile b/makefile
index ffa747a..7587a65 100644
--- a/makefile
+++ b/makefile
@@ -9,9 +9,12 @@ SOURCES = chicken-scratch.scm chicken-scratch.mod.scm
 chicken-scratch: $(SOURCES)
 	chicken-install -n
 
+scratchdown: scratchdown.scm chicken-scratch
+	csc $<
+
 .PHONY: install
-install: chicken-scratch
-	install -Dt $(PREFIX)/bin $<
+install: chicken-scratch scratchdown
+	install -Dt $(PREFIX)/bin $^
 
 .PHONY: chicken-install
 chicken-install: chicken-scratch
@@ -20,3 +23,4 @@ chicken-install: chicken-scratch
 .PHONY: clean
 clean:
 	rm -f *.link *.so *.o *.build.sh *.import.scm *.install.sh
+	rm -f chicken-scratch scratchdown
diff --git a/scratchdown.scm b/scratchdown.scm
new file mode 100755
index 0000000..2775e3f
--- /dev/null
+++ b/scratchdown.scm
@@ -0,0 +1,55 @@
+#!/bin/sh
+#| -*- scheme -*-
+exec csi -s "$0" "$@"
+SCRATCHDOWN --- Combine markdown and chicken-scratch
+|#
+
+(import (chicken io)
+        (chicken irregex)
+        (chicken process-context)
+        (chicken-scratch)
+        (html-parser)
+        (lowdown)
+        (sxml-transforms)
+        (utf8))
+
+(define (expand* text)
+  (expand-string
+   (irregex-replace/all '(or (: #\# #\# (look-ahead (or #\{ #\()))
+                             (: #\# (look-ahead (~ #\{ #\()))
+                             (: #\# eos))
+                        text
+                        "##")))
+
+#;(define (list-of-strings? xs)
+  (cond
+   ((null? xs) #t)
+   ((not (string? (car xs))) #f)
+   (else (list-of-strings? (cdr xs)))))
+
+#;(define (expand-text x)
+  (print x)
+  (cond
+   ((symbol? x) x)
+   ((string? x)
+    (expand* x))
+   ((list-of-strings? x)
+    (expand* (apply string-append x)))
+   ((list-of-strings? (cdr x))
+    (cons (car x)
+          (expand-text (cdr x))))
+   ((list? x)
+    (map expand-text x))
+   (else x)))
+
+(define (read-and-expand file)
+  (let* ((text (with-input-from-file file read-string))
+         (expd (irregex-replace "^#!.*\n" (expand* text) ""))
+         #;(sexp (markdown->sxml expd))
+         )
+    (markdown->html expd)))
+
+(define (main args)
+  (for-each read-and-expand args))
+
+(main (command-line-arguments))
-- 
cgit 1.4.1-21-gabe81