diff options
Diffstat (limited to 'chicken-scratch.scm')
-rwxr-xr-x | chicken-scratch.scm | 98 |
1 files changed, 20 insertions, 78 deletions
diff --git a/chicken-scratch.scm b/chicken-scratch.scm index e47ad67..6d06fb6 100755 --- a/chicken-scratch.scm +++ b/chicken-scratch.scm | |||
@@ -1,78 +1,20 @@ | |||
1 | ;;; CHICKEN-SCRATCH --- heredocs for CHICKEN | 1 | #!/bin/sh |
2 | ;; written by Case Duckworth <acdw@acdw.net> off an idea by evhan | 2 | #| -*- scheme -*- |
3 | ;; Licensed under BSD-3. See COPYING for details. | 3 | exec csi -ss "$0" "$@" |
4 | 4 | CHICKEN-SCRATCH: here-doc templating for CHICKEN scheme | |
5 | ;; CHICKEN has "Multiline string constants with embedded expressions" syntax, | 5 | (C) Case Duckworth <acdw@acdw.net> |
6 | ;; which is basically shell here-doc syntax but schemier and with a real | 6 | License: BSD-3. See COPYING for details. |
7 | ;; programming langugage to embed. evhan's beaker tool (which is great, btw) | 7 | |# |
8 | ;; uses this facility to do a quick-and-dirty templating for wiki generation. I | 8 | |
9 | ;; realized that I could use the same facility for the same kind of | 9 | (import chicken-scratch |
10 | ;; heredoc-style templating I have done in various other SSGs like unk and | 10 | (chicken file) |
11 | ;; vienna, but with scheme. Thus, CHICKEN-SCRATCH was born. | 11 | (chicken process-context)) |
12 | 12 | ||
13 | ;; USAGE | 13 | (define (main args) |
14 | 14 | (for-each (lambda (file) | |
15 | ;; `expand-string' is the main entry point to this module. It takes a string and | 15 | (when (file-exists? file) |
16 | ;; returns a string with all #( ... ) forms expanded according to the CHICKEN | 16 | (display (with-input-from-file file expand-port)) |
17 | ;; rules. `expand-port' is a port version of `expand-string'. | 17 | (newline))) |
18 | 18 | args)) | |
19 | ;; To enable truly invisible definitions within the expanded string, the `def' | 19 | |
20 | ;; macro is provided which performs a `set!' on its variables, then returns a | 20 | (main (command-line-arguments)) |
21 | ;; string guaranteed not to be in the input string, which is then filtered out | ||
22 | ;; in the expanded string. | ||
23 | |||
24 | ;; Finally, to enable CHICKEN-SCRATCH to be used in a shebang, if the first line | ||
25 | ;; of the input string begins with #!, it's deleted from the input. | ||
26 | |||
27 | (module chicken-scratch | ||
28 | (expand-string | ||
29 | expand-port | ||
30 | def | ||
31 | %def/replacer) | ||
32 | |||
33 | (import scheme | ||
34 | (chicken base) | ||
35 | (only (chicken io) | ||
36 | read-string) | ||
37 | (only (chicken irregex) | ||
38 | irregex-replace | ||
39 | irregex-replace/all | ||
40 | irregex-search) | ||
41 | (only (chicken port) | ||
42 | make-concatenated-port) | ||
43 | (only (chicken random) | ||
44 | pseudo-random-real)) | ||
45 | |||
46 | (define %def/replacer (make-parameter #f)) | ||
47 | |||
48 | (define (expand-string str) | ||
49 | (parameterize ((%def/replacer (random-string-not-in str))) | ||
50 | (let* ((delim (random-string-not-in str)) | ||
51 | (template (make-concatenated-port | ||
52 | (open-input-string (string-append "#<#" delim "\n")) | ||
53 | (open-input-string (irregex-replace "^#!.*\n" str "")) | ||
54 | (open-input-string (string-append "\n" delim "\n")))) | ||
55 | (expanded (open-output-string)) | ||
56 | (output (begin | ||
57 | (display (eval (read template)) expanded) | ||
58 | (get-output-string expanded)))) | ||
59 | (irregex-replace/all `(seq ,(%def/replacer) (* "\n")) | ||
60 | output | ||
61 | "")))) | ||
62 | |||
63 | (define (expand-port #!optional port) | ||
64 | (let ((port (or port (current-input-port)))) | ||
65 | (expand-string (read-string #f port)))) | ||
66 | |||
67 | (define-syntax def | ||
68 | (syntax-rules () | ||
69 | ((def var val) | ||
70 | ;; I think this only works in CHICKEN. | ||
71 | (begin (set! var val) | ||
72 | (%def/replacer))))) | ||
73 | |||
74 | (define (random-string-not-in str) | ||
75 | (let ((attempt (number->string (pseudo-random-real)))) | ||
76 | (if (irregex-search attempt str) | ||
77 | (random-string-not-in str) | ||
78 | attempt)))) | ||