[Wisp-cvs] wisp/src/builtin parser.wisp,1.117,1.118 stdenv.wisp,1.358,1.359

[<di...@us...>]

Update of /cvsroot/wisp/wisp/src/builtin
In directory usw-pr-cvs1:/tmp/cvs-serv32455/src/builtin

Modified Files:
	parser.wisp stdenv.wisp 
Log Message:
Implemented generic string templates.

Index: parser.wisp
===================================================================
RCS file: /cvsroot/wisp/wisp/src/builtin/parser.wisp,v
retrieving revision 1.117
retrieving revision 1.118
diff -u -d -r1.117 -r1.118
--- parser.wisp	4 Sep 2002 14:34:29 -0000	1.117
+++ parser.wisp	4 Sep 2002 14:38:13 -0000	1.118
@@ -431,24 +431,40 @@
                                  (if (not (eqv? t #\]))
                                    (raise 'syntax t)))
                                item))
-                           ((#\[ #\open #\,)
+                           ((#\open)
                              (read-simple-structure port))
                            (else ; can't happen
                              (raise 'invalid-dollar-construct c)))
-                  (cons! tail (list (if unquote?
-                                      'dwim-stringify
-                                      'structure->string) item))))
+                  (if unquote?
+                    (set! item (list 'unquote item)))
+                  (if (string? item)
+                    (set! item (list 'begin item)))
+                  (cons! tail item)))
               (loop))
-            (begin
-              (if (null? tail)
-                (car p)
-                (begin
-                  (my s (car p)
-                    (if (not (string-null? s))
-                      (cons! tail s)))
-                  (if (null? (cdr tail))
-                    (car tail)
-                    (cons 'string-append (reverse tail))))))))))))
+            (if (null? tail)
+              (car p)
+              (begin
+                (my s (car p)
+                  (if (not (string-null? s))
+                    (cons! tail s)))
+                (if (and (null? (cdr tail)) (string? (car tail)))
+                  (car tail)
+                  (cons 'string-template (reverse tail)))))))))))
+
+(defmacro (string-template . items)
+  (if (null? items)
+    `(string)
+    (cons 'string-append
+          (map (lambda (item)
+                 (cond
+                   ((string? item) item)
+                   ((and (cons? item)
+                         (eq? (car item) 'unquote)
+                         (cons? (cdr item))
+                         (null? (cddr item)))
+                     `(dwim-stringify ,(cadr item)))
+                   (else `(structure->string ,item))))
+               items))))
 
 ;;;; Parsing of numbers
 

Index: stdenv.wisp
===================================================================
RCS file: /cvsroot/wisp/wisp/src/builtin/stdenv.wisp,v
retrieving revision 1.358
retrieving revision 1.359
diff -u -d -r1.358 -r1.359
--- stdenv.wisp	4 Sep 2002 14:36:25 -0000	1.358
+++ stdenv.wisp	4 Sep 2002 14:38:13 -0000	1.359
@@ -83,15 +83,15 @@
              string-append string-concatenate string-copy
              string-downcase string-downcase! string-fill! string-join
              string-length string-move! string-null? string-ref
-             string-upcase string-upcase! string<=? string<? string=?
-             string>=? string>? string? structure->string sub subclass?
-             substring superclass swap! swyde? symbol->string
-             symbol-length symbol-ref symbol<=? symbol<? symbol>=?
-             symbol>? symbol? system-constant tcchangeattr tcgetattr
-             tcgetattr-raw tcsetattr-raw tenth third toposplit
-             translate tree-copy truncate try tty? type type-of ubyte?
-             unix-time unpack-be-integer unpack-le-integer
-             unsure-collect use utf-8->c16string
+             string-template string-upcase string-upcase! string<=?
+             string<? string=? string>=? string>? string?
+             structure->string sub subclass? substring superclass swap!
+             swyde? symbol->string symbol-length symbol-ref symbol<=?
+             symbol<? symbol>=? symbol>? symbol? system-constant
+             tcchangeattr tcgetattr tcgetattr-raw tcsetattr-raw tenth
+             third toposplit translate tree-copy truncate try tty? type
+             type-of ubyte? unix-time unpack-be-integer
+             unpack-le-integer unsure-collect use utf-8->c16string
              utf-8-first-byte->length uwyde? vector vector->list
              vector-append vector-copy vector-fill! vector-length
              vector-move! vector-ref vector? void? wisp-string-hash