;; @module expand-string.lsp
;; @author Ralph Ronnquist, Real Thing Entertainment Pty. Ltd.
;; @location http://www.realthing.com.au/files/newlisp/expand-string.lsp
;; @version 1.1
;; @description Inclusion module providing string templating using expansion.
;
;; This is an inclusion module that provides an <expand-string>
;; function to process a string template and replace key tokens as
;; declared in a rules list of token-to-replacement associations with
;; their associated values. It offers a similar function to <expand>
;; but for strings, but uses string pattern match (without
;; tokenization) to determine the replacement points, and evaluates
;; the value parts to make the replacements.
;;
;; @syntax (expand-string <text> <rules>)
;
;; Processes the given text for the occurrences of the rule keys, and
;; replaces these with the values obtained by evaluating the
;; associated value expressions. The result is the new string with
;; replacements. Note that a value expression may affect variable
;; <txt>, which is the rest of the input following the expanding key,
;; to optionally consume additional text in the replacement. See
;; function <.expand-map> for an example.
;;
;; @syntax (expand-file file rules)
;; Reads the file and expand it using <expand-string> with the given
;; rules.
;;
;; @syntax (.expand-eval <ctx> <end>)
;
;; This function is intended as expansion value function for an
;; <expand-string> rule, to implement template expression
;; evaluation. The <ctx> parameter tells the context for symbol
;; creations. The optional <end> parameter tells the end of the
;; replacement fragment. This function extracts the text fragment
;; until the nearest <end> text, then evaluates this with
;; <eval-string>, makes the result a string, and uses that as value to
;; replace the whole block. See <default-expand-rules> below how a
;; rule using this function may look.
;;
;; @syntax (.expand-map <ctx> <end>)
;
;; This function is intended as expansion value function for an
;; <expand-string> rule, to implement template fragment
;; repetition. The optional <ctx> parameter tells the context for
;; symbol creations. The optional <end> parameter tells the end of the
;; fragment portion, which is "&lt;/MAP&gt;" by default. The function
;; pulls two s-expression from the template using <read-expr>. The
;; first is a list of keys, and the second a list of binding lists for
;; those keys. The rest of the fragment is then expanded recursively,
;; repeatedly, with the keys having their subsequent bindings, and the
;; block is replaced by the concatenation of these results. See
;; <default-expand-rules> below how a rule using this function may
;; look.
;;
;; @syntax default-expand-rules
;; This constant holds a few default rules for using repetition end
;; expression evaluation. Currently set to the following:
;; <pre>
;; (constant 'default-expand-rules
;;           '(("&lt;MAP1&gt;" (.expand-map MAIN "&lt;/MAP1&gt;"))
;;             ("&lt;MAP2&gt;" (.expand-map MAIN "&lt;/MAP2&gt;"))
;;             ("&lt;MAP3&gt;" (.expand-map MAIN "&lt;/MAP3&gt;"))
;;             ("&lt;MAP&gt;" (.expand-map MAIN "&lt;/MAP&gt;"))
;;             ("&lt;EVAL&gt;" (.expand-eval MAIN "&lt;/EVAL&gt;"))))
;; </pre> These default rules obviously favours HTML templates.
;; <center>&sect;</center><br/>
;; <b>Example:</b> The following is an illustration of <expand-string>
;; using <.expand-map>:
;; <pre>(expand-string
;;          "&lt;MAP&gt;(A B) '((1 2) (3 4)) A B B A&lt;/MAP&gt;"
;;          '(("&lt;MAP&gt;" (.expand-map)) ))
;; </pre>
;; The example results in the string " 1 2 2 1 3 4 4 3".
;;
;; Note that the binding lists expression is evaluated in the given
;; context, or MAIN, if nil is given. Thus, the rule above is
;; equivalent with the following: <tt>(.expand-map MAIN "&lt;/MAP&gt;")</tt>
;;
;; Note also that the fragment blocks cannot be nested. To achieve
;; nested repetition, use several tag pairs, as in the following rule set:
;; <pre> '(("&lt;MAP1&gt;" (.expand-map nil "&lt;/MAP1&gt;"))
;;   ("&lt;MAP2&gt;" (.expand-map nil "&lt;/MAP2&gt;"))
;;   ("&lt;MAP3&gt;" (.expand-map nil "&lt;/MAP3&gt;")) )</pre>
;; In that case, the outer expansion keys may be used in the inner
;; repetition although they are not actually bound to the values.
;;
;; <b>Example:</b>
;; <pre>(expand-string
;;          {&lt;EVAL&gt;(first (exec "uname -mrs"))&lt;/EVAL&gt;}
;;          default-expand-rules )</pre>
;; This example results in the machine details as reported by the
;; <uname> program with the <-mrs> command line argument.
;;
;; <b>Example:</b> This example illustrates HTML rendering, with a
;; template file that includes certain keys for expansion. In this
;; case I have a list if paragraps as value of variable <texts>, and
;; want them inserted nicely into an HTML page. Note that the spaces
;; following the two s-expressions in the <MAP>..</MAP> construct are
;; compulsory, and they get consumed by the <read-expr> function.
;
;; <pre> @PAGEDOCTYPE@
;; &lt;html&gt;&lt;head&gt;&lt;title&gt;@TITLE@&lt;/title&gt;&lt;/head&gt;
;; &lt;body&gt;&lt;h1&gt;@TITLE@&lt;/h1&gt;
;; &lt;MAP&gt;(text) texts &lt;p&gt;text&lt;/p&gt;&lt;/MAP&gt;
;; &lt;/body&gt;&lt;/html&gt;</pre>
;
;; This template would be used in a context that provides suitable
;; expansion rules for the "@PAGEDOCTYPE@" and "@TITLE@" keys, as well
;; as the default "&lt;MAP&gt;" expansion rule.
############################################################

(define (rule-key rule)
  (replace "[\\?*.()]" (first rule) (string "\\" $it) 0))

(define (expand-string txt (rules default-expand-rules))
  (if (null? rules) txt
    (let ((pat (string "(" (join (map string (map rule-key rules)) "|") ")"))
          (out "") (i 0))
      (while (setf i (find pat txt 0))
        (extend out (0 i txt))
        (setf txt ((+ i (length $1)) txt))
        (extend out (string (eval (lookup $1 rules)))))
      (extend out txt))))

(define (expand-file file (rules default-expand-rules))
  (expand-string (read-file file) rules))

(define (.expand-map ctx (end "</MAP>")) ; uses txt rules
  (let ((A (map term (read-expr txt (or ctx MAIN) nil 0)))
        (dlist (read-expr txt (or ctx MAIN) nil $count))
        (frag ($count (- (find end txt nil $count) $count) txt))
        (out ""))
    (setf txt ((+ $count (length frag) (length end)) txt))
    (dolist (d (eval dlist))
      (extend out (expand-string frag (extend (map list A d) rules))))
    out))

(define (.expand-eval ctx (end "</EVAL>")) ; uses txt rules
  (let ((frag (0 (find end txt nil 0) txt)))  
    (setf txt ((+ (length frag) (length end)) txt))
    (string (eval-string frag))))

(constant 'default-expand-rules
          '(("<MAP1>" (.expand-map MAIN "</MAP1>"))
            ("<MAP2>" (.expand-map MAIN "</MAP2>"))
            ("<MAP3>" (.expand-map MAIN "</MAP3>"))
            ("<MAP>" (.expand-map MAIN "</MAP>"))
            ("<EVAL>" (.expand-eval MAIN "</EVAL>"))
            ("<?newlisp" (.expand-eval MAIN "?>"))))

(global 'expand-string 'expand-file '.expand-map 'default-expand-rules)

"expand-string.lsp"