about summary refs log tree commit diff stats
diff options
context:
space:
mode:
authorCase Duckworth2023-06-08 21:21:32 -0500
committerCase Duckworth2023-06-08 21:21:32 -0500
commit6149ba565e1f811057960805035db182ccf76dca (patch)
treef82bab3ab5bf23bb2b0b5ee538d669470b5eebc3
downloadchicken-scratch-6149ba565e1f811057960805035db182ccf76dca.tar.gz
chicken-scratch-6149ba565e1f811057960805035db182ccf76dca.zip
Initial commit
-rwxr-xr-xchicken-heredoc.scm60
1 files changed, 60 insertions, 0 deletions
diff --git a/chicken-heredoc.scm b/chicken-heredoc.scm new file mode 100755 index 0000000..e0e55ad --- /dev/null +++ b/chicken-heredoc.scm
@@ -0,0 +1,60 @@
1#!/bin/sh
2#| -*- scheme -*-
3exec csi -ss "$0" "$@"
4heredocs for chicken
5idea-https://git.sr.ht/~evhan/beaker/tree/master/item/aux/generate-wiki-page.scm
6|#
7
8(import (only (chicken irregex)
9 irregex-replace/all
10 irregex-search)
11 (only (chicken io)
12 read-string)
13 (only (chicken port)
14 make-concatenated-port)
15 (only (chicken random)
16 pseudo-random-real)
17 (only (chicken time)
18 current-seconds))
19
20(define filestr
21 (make-parameter #f))
22
23(define def-end
24 (make-parameter "&def-end"))
25
26(define (randomizer #!optional str)
27 (let ((base (number->string (+ (current-seconds)
28 (pseudo-random-real)))))
29 (if (and str (irregex-search base str))
30 (randomizer str)
31 base)))
32
33(define-syntax def
34 (syntax-rules ()
35 ((def var val)
36 ;; I'm pretty sure this only works in CHICKEN.
37 (begin (set! var val)
38 (def-end)))))
39
40(define (heredoc-expand file)
41 (let* ((delim (string-append "END-" (randomizer)))
42 (template (make-concatenated-port
43 (open-input-string (string-append "#<#" delim "\n"))
44 (open-input-file file)
45 (open-input-string (string-append "\n" delim "\n"))))
46 (expanded (open-output-string))
47 (str (begin
48 (display (eval (read template)) expanded)
49 (get-output-string expanded))))
50 (irregex-replace/all `(seq ,(def-end) (* "\n"))
51 str
52 "")))
53
54(define (main args)
55 (for-each (lambda (f)
56 ;; Is this overkill? Maybe....
57 (parameterize ((filestr (with-input-from-file f read-string)))
58 (parameterize ((def-end (randomizer (filestr))))
59 (display (heredoc-expand f)))))
60 args))