;;;; (ossau template) -- template file processor
;;; Copyright (C) 2005 Neil Jerram
;;;
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
;; License as published by the Free Software Foundation; either
;; version 2.1 of the License, or (at your option) any later version.
;;
;; This library is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Lesser General Public License for more details.
;;
;; You should have received a copy of the GNU Lesser General Public
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
(define-module (ossau template)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 regex)
#:export (template->code)
#:export-syntax (process-template))
;*****************************************************************************;
;* A template file is a file of content, such as HTML, that is complete *;
;* except for places where the content needs to be filled in *;
;* programmatically. In the case of the template processor code here, the *;
;* code to fill in the dynamic content is written in Scheme and appears *;
;* inline in the template file. *;
;* *;
;* Areas of Scheme code in the template file are delimited by $. For *;
;* example: *;
;* *;
;* This page was processed by Guile $(display (version))$ *;
;* *;
;* here (display (version)) is interpreted and processed as Scheme code; *;
;* the rest is normal (HTML) content. *;
;* *;
;* If either normal content or Scheme code needs to include a $ character, *;
;* it can do so by doubling the $, as in: Price $$10.20. *;
;* *;
;* Fragments of Scheme code do not have to be individually balanced. For *;
;* example: *;
;* *;
;* $(for-each (lambda (x)$ *;
;*
The square of $(display x)$ is $(display (* x x))$ *;
;* $ ) (iota 11))$ *;
;* *;
;* A shorthand is provided for cases where a fragment only wants to display *;
;* a variable. This is $~FORMAT VARNAME$, for example $~A x$. ~FORMAT is a *;
;* format specifier understood by (ice-9 format), and VARNAME is the name of *;
;* the variable to display. *;
;* *;
;* It may sometimes help to know the exact algorithm in order to write a *;
;* piece of template file code correctly. It is as follows. *;
;* *;
;* 1. Convert the template file - even the normal content - into a big *;
;* Scheme code string by: *;
;* *;
;* - converting each fragment of normal content to `(display FRAGMENT)' *;
;* *;
;* - converting each `~FORMAT VARNAME' fragment to *;
;* `(format #t ~FORMAT VARNAME)' *;
;* *;
;* - copying other Scheme code fragments as written. *;
;* *;
;* 2. Read and evaluate this string in an environment as specified by the *;
;* arguments to process-template. *;
;* *;
;*****************************************************************************;
;*****************************************************************************;
;* template->code *;
;* *;
;* Reads a template file and returns the Scheme code that should be read and *;
;* evaluated to generate the implied output. *;
;*****************************************************************************;
(define (template->code template)
;***************************************************************************;
;* Utility procedure: convert any occurrences of "$$" in STRING to just *;
;* "$". *;
;***************************************************************************;
(define (unescape-$$ string)
(cond ((string-match "\\$\\$" string)
=>
(lambda (match-data)
(string-append (substring string 0 (match:start match-data 0))
"$"
(unescape-$$ (substring string
(+ (match:start match-data
0)
1))))))
(else string)))
;***************************************************************************;
;* Utility procedure: given a string read from the template file, after *;
;* splitting between scheme and non-scheme parts, return the Scheme code *;
;* corresponding to the template string. *;
;***************************************************************************;
(define (make-code-string template-string in-scheme)
(if in-scheme
;*********************************************************************;
;* Template string should be interpreted as Scheme code. If it *;
;* begins with "~", it is a shorthand for a format expression; *;
;* otherwise, it is straight Scheme code and doesn't need any *;
;* further tweaking. *;
;*********************************************************************;
(cond ((string-match "^~[^ ]+ " template-string)
=>
(lambda (match-data)
(let ((beg (match:start match-data 0))
(end (match:end match-data 0)))
(format #f
"(format #t ~S ~A)"
(substring template-string beg (- end 1))
(substring template-string end)))))
(else template-string))
;*********************************************************************;
;* Template string is normal file content (i.e. outside Scheme *;
;* code). The corresponding Scheme code should display it. *;
;*********************************************************************;
(format #f "(display ~S)" template-string)))
;***************************************************************************;
;* Main procedure code. *;
;***************************************************************************;
(with-input-from-file template
(lambda ()
;***********************************************************************;
;* Loop reading lines from the template file. *;
;***********************************************************************;
(let loop ((template-line (read-line (current-input-port) 'concat))
(in-scheme #f)
(strings '()))
(if (eof-object? template-line)
;*****************************************************************;
;* EOF: return the concatenated Scheme code string. *;
;*****************************************************************;
; (let ((code
(string-append "(begin "
(apply string-append
(reverse strings))
")")
; ))
; (with-output-to-file "template-debug.scm"
; (lambda ()
; (display code)))
; code)
;*****************************************************************;
;* Not yet EOF: normal processing. First check for single "$"; *;
;* these mark the boundaries between Scheme code and normal *;
;* (non-Scheme) file content. *;
;*****************************************************************;
(cond ((string-match "(^|[^$])(\\$)($|[^$])" template-line)
=>
;**********************************************************;
;* Found a single "$", so process the part of the line *;
;* before the "$", then toggle the in-scheme flag and *;
;* loop to process the rest of the line. *;
;**********************************************************;
(lambda (match-data)
(let (($pos (match:start match-data 2)))
(loop (let ((rest (substring template-line (+ $pos 1))))
(if (<= (string-length rest) 1)
(read-line (current-input-port) 'concat)
rest))
(not in-scheme)
(cons (make-code-string (unescape-$$
(substring template-line
0
$pos))
in-scheme)
strings)))))
;***********************************************************;
;* No "$" in this line, so process whole line and loop to *;
;* read the next line. *;
;***********************************************************;
(else
(loop (read-line (current-input-port) 'concat)
in-scheme
(cons (make-code-string (unescape-$$ template-line)
in-scheme)
strings)))))))))
;*****************************************************************************;
;* process-template *;
;* *;
;* Processes a template file, with the generated output going to the current *;
;* output port. Returns unspecified. *;
;* *;
;* Args are: template - Name of template file. *;
;* vars - Variables to define for the Scheme code in the *;
;* template file, in the same form as a set of let *;
;* bindings, i.e. *;
;* ((variable1 value1) *;
;* (variable2 value2) *;
;* ...) *;
;* modules - List of modules that the Scheme code in the *;
;* template file uses. *;
;* *;
;*****************************************************************************;
(define-macro (process-template template vars . modules)
`(let ((module (make-module 31
(map resolve-interface
',modules))))
,@(map (lambda (vardef)
`(module-define! module
',(if (pair? vardef) (car vardef) vardef)
,(if (pair? vardef) (cadr vardef) vardef)))
vars)
(eval (with-input-from-string (template->code ,template) read)
module)))