[Wisp-cvs] wisp/modules shell.wisp,1.33,1.34

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

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

Modified Files:
	shell.wisp 
Log Message:
Implemented generic string templates.

Index: shell.wisp
===================================================================
RCS file: /cvsroot/wisp/wisp/modules/shell.wisp,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -d -r1.33 -r1.34
--- shell.wisp	4 Sep 2002 14:29:42 -0000	1.33
+++ shell.wisp	4 Sep 2002 14:37:34 -0000	1.34
@@ -22,16 +22,14 @@
 ; l11n mechanism for the shell.  Yet.
 (define messages
   ; FIXME: use string templates here
-  '((#f (greeting-start . "This is Wisp ") ; version number goes here
-        (greeting-end . ", interactive mode.")
+  '((#f (greeting . "This is Wisp $,[version], interactive mode.")
         (profexc . "Exception occurred during interpreting .wisp_profile")
         (farewell . "May the Source be with you.")
         (proc-origin . "Origin:")
         (proc-cname . "cname:")
         (no-docstring . "No docstring.")
         (wid-loaded . "Loaded"))
-    (et (greeting-start . "See on Wisp ")
-        (greeting-end . " kasutajaga suhtlemise moodis.")
+    (et (greeting . "See on Wisp $,[version] kasutajaga suhtlemise moodis.")
         (profexc . "Faili .wisp_profile t\u[e4]itmisel ilmnes eriolukord.")
         (farewell . "Kood Sinuga.")
         (proc-origin . "Allikas:")
@@ -223,6 +221,35 @@
                                             doc))))))))
 ; }}}
 
+(define (expand-string-template tpl vars)
+  (my interpret (lambda (part)
+                  (cond
+                    ((symbol? part)
+                      (my c (assq part vars)
+                        (if c
+                          (cdr c)
+                          (raise 'unknown part))))
+                    (else (raise 'unknown part))))
+    (cond
+      ((string? tpl) tpl)
+      ((and (cons? tpl)
+            (eq? (car tpl) 'string-template))
+        (collect-string
+          (lambda (emit)
+            (for-each (lambda (part)
+                        (cond
+                          ((string? part) (emit part))
+                          ((and (cons? part)
+                                (eq? (car part) 'unquote)
+                                (cons? (cdr part))
+                                (null? (cddr part)))
+                            (emit (dwim-stringify
+                                    (interpret (cadr part)))))
+                          (else (emit (structure->string
+                                        (interpret part))))))
+                      (cdr tpl)))))
+      (else (raise 'string-template? tpl)))))
+
 (set! (dict-ref *user-dictionary* 'unquote)
   (procedure->macro
     (lambda (*source-dictionary* arg)
@@ -247,8 +274,9 @@
              (except ()
                (print "$,(message 'profexc)\n")
                (print "-/-> $[sig] $[dat]\n\n"))))))
-  (print "$,(message 'greeting-start)$,[wisp-version]\
-         $,(message 'greeting-end)\n")
+  (write-string (expand-string-template (message 'greeting)
+                                        `((version . ,wisp-version))))
+  (newline)
   (let (loop)
     (try (begin
            (print ". ")