From 0c594ea788f31c561a9d617d5c0764f99429599b Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Thu, 8 Jun 2023 23:03:54 -0500 Subject: Rewrite; rename to chicken-scratch --- COPYING | 26 ++++++++++++++++++ chicken-heredoc.scm | 60 ----------------------------------------- chicken-scratch.scm | 78 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 104 insertions(+), 60 deletions(-) create mode 100644 COPYING delete mode 100755 chicken-heredoc.scm create mode 100755 chicken-scratch.scm diff --git a/COPYING b/COPYING new file mode 100644 index 0000000..b6a7248 --- /dev/null +++ b/COPYING @@ -0,0 +1,26 @@ +Copyright 2023 Case Duckworth + +Redistribution and use in source and binary forms, with or without modification, +are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +3. Neither the name of the copyright holder nor the names of its contributors + may be used to endorse or promote products derived from this software without + specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON +ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/chicken-heredoc.scm b/chicken-heredoc.scm deleted file mode 100755 index e0e55ad..0000000 --- a/chicken-heredoc.scm +++ /dev/null @@ -1,60 +0,0 @@ -#!/bin/sh -#| -*- scheme -*- -exec csi -ss "$0" "$@" -heredocs for chicken -idea-https://git.sr.ht/~evhan/beaker/tree/master/item/aux/generate-wiki-page.scm -|# - -(import (only (chicken irregex) - irregex-replace/all - irregex-search) - (only (chicken io) - read-string) - (only (chicken port) - make-concatenated-port) - (only (chicken random) - pseudo-random-real) - (only (chicken time) - current-seconds)) - -(define filestr - (make-parameter #f)) - -(define def-end - (make-parameter "&def-end")) - -(define (randomizer #!optional str) - (let ((base (number->string (+ (current-seconds) - (pseudo-random-real))))) - (if (and str (irregex-search base str)) - (randomizer str) - base))) - -(define-syntax def - (syntax-rules () - ((def var val) - ;; I'm pretty sure this only works in CHICKEN. - (begin (set! var val) - (def-end))))) - -(define (heredoc-expand file) - (let* ((delim (string-append "END-" (randomizer))) - (template (make-concatenated-port - (open-input-string (string-append "#<#" delim "\n")) - (open-input-file file) - (open-input-string (string-append "\n" delim "\n")))) - (expanded (open-output-string)) - (str (begin - (display (eval (read template)) expanded) - (get-output-string expanded)))) - (irregex-replace/all `(seq ,(def-end) (* "\n")) - str - ""))) - -(define (main args) - (for-each (lambda (f) - ;; Is this overkill? Maybe.... - (parameterize ((filestr (with-input-from-file f read-string))) - (parameterize ((def-end (randomizer (filestr)))) - (display (heredoc-expand f))))) - args)) diff --git a/chicken-scratch.scm b/chicken-scratch.scm new file mode 100755 index 0000000..e47ad67 --- /dev/null +++ b/chicken-scratch.scm @@ -0,0 +1,78 @@ +;;; CHICKEN-SCRATCH --- heredocs for CHICKEN +;; written by Case Duckworth off an idea by evhan +;; Licensed under BSD-3. See COPYING for details. + +;; CHICKEN has "Multiline string constants with embedded expressions" syntax, +;; which is basically shell here-doc syntax but schemier and with a real +;; programming langugage to embed. evhan's beaker tool (which is great, btw) +;; uses this facility to do a quick-and-dirty templating for wiki generation. I +;; realized that I could use the same facility for the same kind of +;; heredoc-style templating I have done in various other SSGs like unk and +;; vienna, but with scheme. Thus, CHICKEN-SCRATCH was born. + +;; USAGE + +;; `expand-string' is the main entry point to this module. It takes a string and +;; returns a string with all #( ... ) forms expanded according to the CHICKEN +;; rules. `expand-port' is a port version of `expand-string'. + +;; To enable truly invisible definitions within the expanded string, the `def' +;; macro is provided which performs a `set!' on its variables, then returns a +;; string guaranteed not to be in the input string, which is then filtered out +;; in the expanded string. + +;; Finally, to enable CHICKEN-SCRATCH to be used in a shebang, if the first line +;; of the input string begins with #!, it's deleted from the input. + +(module chicken-scratch + (expand-string + expand-port + def + %def/replacer) + + (import scheme + (chicken base) + (only (chicken io) + read-string) + (only (chicken irregex) + irregex-replace + irregex-replace/all + irregex-search) + (only (chicken port) + make-concatenated-port) + (only (chicken random) + pseudo-random-real)) + + (define %def/replacer (make-parameter #f)) + + (define (expand-string str) + (parameterize ((%def/replacer (random-string-not-in str))) + (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 (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")) + output + "")))) + + (define (expand-port #!optional port) + (let ((port (or port (current-input-port)))) + (expand-string (read-string #f port)))) + + (define-syntax def + (syntax-rules () + ((def var val) + ;; I think this only works in CHICKEN. + (begin (set! var val) + (%def/replacer))))) + + (define (random-string-not-in str) + (let ((attempt (number->string (pseudo-random-real)))) + (if (irregex-search attempt str) + (random-string-not-in str) + attempt)))) -- cgit 1.4.1-21-gabe81