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