diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2005-02-15 12:31:56 +0000 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2005-02-15 12:31:56 +0000 |
commit | fdd28fed99dd659869555deefc5c4e1624c4daea (patch) | |
tree | 4674e4b14ee2381becbcee455c1cc3f502d62ff1 | |
parent | be9343816946d88f80e558b27730c832a78be321 (diff) | |
download | ellinika-fdd28fed99dd659869555deefc5c4e1624c4daea.tar.gz ellinika-fdd28fed99dd659869555deefc5c4e1624c4daea.tar.bz2 |
(expand-template): New function
git-svn-id: file:///home/puszcza/svnroot/ellinika/trunk@314 941c8c0f-9102-463b-b60b-cd22ce0e6858
-rw-r--r-- | ellinika/cgi.scmi | 41 |
1 files changed, 41 insertions, 0 deletions
diff --git a/ellinika/cgi.scmi b/ellinika/cgi.scmi index 604d71b..7a08e5b 100644 --- a/ellinika/cgi.scmi +++ b/ellinika/cgi.scmi @@ -86,6 +86,47 @@ arglist (cons "?" arglist)))))) +(define-public (expand-template explist template) + "(expand-template EXPLIST TEMPLATE) + +Expands string TEMPLATE in accordance with EXPLIST. EXPLIST is a list +of elements: + + (cons WORD THUNK) + +Each occurrence of WORD in TEMPLATE is replaced with the return value of +THUNK. +" + (let loop ((template template)) + (cond + ((string-index template #\@) => + (lambda (w) + (display (substring template 0 w)) + (if (and (< (+ w 2) (string-length template)) + (char=? (string-ref template (1+ w)) #\@)) + (let ((end-pos (string-index template #\@ (+ w 2)))) + (if (and end-pos + (< (1+ end-pos) (string-length template)) + (char=? (string-ref template (1+ end-pos)) #\@)) + (let* ((name (substring template w (+ end-pos 2))) + (entry (assoc name explist))) + (cond + (entry + ((cdr entry)) + (loop (substring template (+ end-pos 2)))) + (else + (display "@@") + (loop (substring template (+ w 2)))))) + (begin + (display "@") + (loop (substring template (+ w 1)))))) + (begin + (display "@") + (loop (substring template (1+ w))))))) + (else + (display template))))) + + (define-public (ellinika-cgi-init template-file-name) ;;; Load the site defaults (let ((rc-file (string-append sysconf-dir "/" config-file-name))) |