From 45c15fe30496311e60dba14399a0676fe084ad56 Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Sun, 27 Aug 2023 22:22:52 -0500
Subject: Initial commit

---
 schmaltz.scm | 58 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 58 insertions(+)
 create mode 100644 schmaltz.scm

(limited to 'schmaltz.scm')

diff --git a/schmaltz.scm b/schmaltz.scm
new file mode 100644
index 0000000..f1d5e24
--- /dev/null
+++ b/schmaltz.scm
@@ -0,0 +1,58 @@
+;;; schmaltz --- the command-line program
+;; This is not written portably.
+
+(cond-expand
+  (chicken (import r7rs utf8))
+  (else))
+
+(import (schmaltz)
+        (scheme file)
+        (scheme eval)
+        (scheme repl)
+        (srfi 1))
+
+(cond-expand
+  (chicken
+   (render-specials
+    (cons (cons #\@ (lambda (port)           ; wrap the next form in `sxml->html'
+                      ;; wow this is ugly ... how can i make this better?
+                      (eval '(import (html-parser)) (interaction-environment))
+                      `(sxml->html ,(list 'quasiquote (read port)))))
+          (render-specials)))
+   (render-unprintables
+    (list (cons "#<unspecified>" (lambda _ '()))
+          (cons "#!eof" (lambda (ch) (list ch #\#))))))
+  (else))
+
+(define (main args)
+  (define (display-render)
+    (display (render))
+    (newline))
+  (define (rout file)
+    (with-input-from-file file display-render))
+  (cond
+   ((and (null? args)                   ; input from stdin
+         (char-ready?))
+    (display-render))
+   ((member "-" args)
+    (let-values (((fs1 fs2)
+                  (break (lambda (x) (equal? x "-"))
+                         args)))
+      (for-each rout fs1)
+      (display-render)
+      (for-each rout (cdr fs2))))
+   ((< 0 (length args))
+    (for-each rout args))
+   (else
+    (display "Usage: schmaltz FILE...\n" (current-error-port))
+    (exit 1))))
+
+(cond-expand
+  ((and chicken
+        (or chicken-script compiling))
+   (import (chicken process-context))
+   (main (command-line-arguments)))
+  (chicken)
+  (else
+   (import (scheme process-context))
+   (main (cdr (command-line)))))
-- 
cgit 1.4.1-21-gabe81