[html-template-devel] Proposed new feature for HTML-TEMPLATE

Marijn Haverbeke marijnh at gmail.com
Mon Dec 11 19:15:26 UTC 2006


>
> Your proposal sounds fine to me and I think we should include it.  If
> you want this to be released quickly, please send a clean patch that
> not only includes the code with doc string but also updates the test
> file and the HTML documentation accordingly.


Attached is the path which should do all that. I also included a small
refactoring which splits up create-simple-printer, but that should be easy
to remove if you don't like it.

Regards,
Marijn
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/html-template-devel/attachments/20061211/b0c482d3/attachment.html>
-------------- next part --------------
Only in html-template.mine/: api.fasl
diff -ur html-template-0.7.0/doc/index.html html-template.mine/doc/index.html
--- html-template-0.7.0/doc/index.html	2006-09-30 00:36:28.000000000 +0200
+++ html-template.mine/doc/index.html	2006-12-11 04:16:53.000000000 +0100
@@ -31,10 +31,9 @@
 for.)
 <p>
 It is loosely modeled after the Perl module <a
-href="http://html-template.sf.net/">HTML::Template</a> and compatible
-with a subset of its syntax, i.e. it should be possible to use your
-HTML-TEMPLATE templates with HTML::Template as well (but usually not
-the other way around).
+href="http://html-template.sf.net/">HTML::Template</a> and partially
+compatible with a its syntax, though both libraries contain some
+extensions that the other does not support.
 <p>
 HTML-TEMPLATE translates templates into <a href="#main">efficient closures</a> which
 can be re-used as often as needed. It uses an intelligent <a href="#cache">cache
@@ -57,9 +56,9 @@
 href="http://www.cliki.net/Lisp%20Markup%20Languages">Lisp markup
 languages</a> but found that HTML::Template's approach usually works
 best for me: The graphical designers only need to learn a minimal set
-of new tags (three of them) and can update their templates
-independently from the work done on the backend. It is simple and it
-just works. YMMV, of course...
+of new tags and can update their templates independently from the work
+done on the backend. It is simple and it just works. YMMV, of
+course...
 <p>
 HTML-TEMPLATE is intended to be portable and should work with all
 conforming Common Lisp implementations but is mainly tested and
@@ -111,6 +110,8 @@
       <li><a href="#*template-symbol-package*"><code>*template-symbol-package*</code></a>
       <li><a href="#*force-default*"><code>*force-default*</code></a>
       <li><a href="#*value-access-function*"><code>*value-access-function*</code></a>
+      <li><a href="#*call-template-access-function*"><code>*call-template-access-function*</code></a>
+      <li><a href="#*call-value-access-function*"><code>*call-value-access-function*</code></a>
       <li><a href="#*ignore-empty-lines*"><code>*ignore-empty-lines*</code></a>
       <li><a href="#*warn-on-creation*"><code>*warn-on-creation*</code></a>
     </ol>
@@ -398,13 +399,13 @@
 </pre>
 
 where <em>name</em> is one of <code>TMPL_VAR</code>,
-<code>TMPL_LOOP</code>, <code>TMPL_REPEAT</code>, <code>TMPL_IF</code>, <code>TMPL_UNLESS</code>,
+<code>TMPL_LOOP</code>, <code>TMPL_REPEAT</code>, <code>TMPL_CALL</code>, <code>TMPL_IF</code>, <code>TMPL_UNLESS</code>,
 <code>TMPL_INCLUDE</code>, <code>/TMPL_LOOP</code>, <code>/TMPL_REPEAT</code>,
 <code>/TMPL_IF</code>, <code>/TMPL_UNLESS</code>, or <code>TMPL_ELSE</code>. Case doesn't matter,
 i.e. <code>tmpl_var</code> or <code>Tmpl_Var</code> would also be
 legal names.
 <p>
-If <em>name</em> is one of the first four listed above then
+If <em>name</em> is one of the first seven listed above then
 <em>attribute</em> must follow, otherwise it must not follow where
 <em>attribute</em> is any sequence of characters delimited by
 <code>"</code>, <code>'</code>, or by whitespace. There's
@@ -465,10 +466,10 @@
 "<code>NAME=</code>" notation which is not supported by
 HTML-TEMPLATE.
 <p>
-The <code>TMPL_VAR</code> and <code>TMPL_INCLUDE</code> tags can
-appear anywhere and as often as you like in your templates while the
-other tags must obey certain rules - they must follow one of these
-patterns
+The <code>TMPL_VAR</code>, <code>TMPL_INCLUDE</code>, and
+<code>TMPL_CALL</code> tags can appear anywhere and as often as you
+like in your templates while the other tags must obey certain rules -
+they must follow one of these patterns
 
 <pre>
   <!-- TMPL_IF <em>attribute</em> --> <em>text</em> <!-- /TMPL_IF -->
@@ -520,7 +521,7 @@
 to fill and print a template.
 <p>
 Each of the template tags <code>TMPL_VAR</code>, <code>TMPL_IF</code>, <code>TMPL_UNLESS</code>,
-<code>TMPL_LOOP</code>, and <code>TMPL_REPEAT</code> is associated with a particular symbol at
+<code>TMPL_LOOP</code>, <code>TMPL_CALL</code>, and <code>TMPL_REPEAT</code> is associated with a particular symbol at
 generation time. This symbol is the result of <a href="http://www.lispworks.com/documentation/HyperSpec/Body/f_intern.htm"><code>INTERN</code></a>ing
 the tag's attribute string into the package <a
 href="#*template-symbol-package*"><code>*TEMPLATE-SYMBOL-PACKAGE*</code></a>. The
@@ -687,6 +688,50 @@
 including printer.
 </blockquote>
 
+<p><b><code><!-- TMPL_CALL <em>symbol</em> --></code></b>
+
+<blockquote>
+The value associated with <em>symbol</em> should be a sequence (as
+specified by <a
+href="#*sequences-are-lists*"><code>*SEQUENCES-ARE-LISTS*</code></a>)
+of template calls, each of which specifies a substructure and a
+template to apply to that. By default, calls are just lists, with the
+CAR specifying the template name and the CDR containing the
+substructure. (See <a
+href="#*call-template-access-function*"><code>*CALL-TEMPLATE-ACCESS-FUNCTION*</code></a>
+and <a
+href="#*call-value-access-function*"><code>*CALL-VALUE-ACCESS-FUNCTION*</code></a>
+for ways to customize what calls look like.)
+<p>
+<code>TMPL_CALL</code> combines aspects of <code>TMPL_LOOP</code> and
+<code>TMPL_INCLUDE</code>, it iterates over a sequence of values the
+way loops do, but instead of using part of the current template to
+print the values each value contains its own information about which
+subtemplate should be applied to it.
+
+<pre>
+* (with-open-file (s "/tmp/paragraph" :direction :output :if-exists :supersede)
+    (write-string "<p class='fancy'><!-- TMPL_VAR text --></p>" s))
+"<p class='fancy'><!-- TMPL_VAR text --></p>"
+* (with-open-file (s "/tmp/header" :direction :output :if-exists :supersede)
+    (write-string "<h1><!-- TMPL_VAR text --></h1>" s))
+"<h1><!-- TMPL_VAR text --></h1>"
+* (fill-and-print-template "<body><!-- TMPL_CALL parts --></body>"
+                           '(:parts ((#P"/tmp/header" :text "Chapter 1")
+                                     (#P"/tmp/paragraph" :text "There once was a platypus...")
+                                     (#P"/tmp/header" :text "Chapter 5")
+                                     (#P"/tmp/paragraph" :text "And lived happily ever after."))))
+<h1>Chapter 1</h1><p class='fancy'>There once was a platypus...</p><h1>Chapter 5</h1><p class='fancy'>And lived happily ever after.</p></body>
+</pre>
+<p>
+Note that you do not have to include full pathnames in the call
+structures. You can use <a
+href="#*default-template-pathname*"><code>*DEFAULT-TEMPLATE-PATHNAME*</code></a>
+to specify most of it, or set <a
+href="#*call-template-access-function*"><code>*CALL-TEMPLATE-ACCESS-FUNCTION*</code></a>
+to a function that creates pathnames any way you like.
+</blockquote>
+
 <br> <br><h3><a class=none name="dictionary">The HTML-TEMPLATE dictionary</a></h3>
 
 HTML-TEMPLATE exports the following symbols (some of which are also
@@ -1037,7 +1082,7 @@
 list</a> <code><i>(symbol values <tt>&optional</tt> in-loop-p)</i></code> which is
 used to associate symbols with their values when a template printer is
 invoked.  <code><i>in-loop-p</i></code> is true whenever this
-function is called from within a <code>TMPL_LOOP</code> tag.
+function is called from within a <code>TMPL_LOOP</code> or <code>TMPL_CALL</code> tag.
 <p>
 The default
 value is
@@ -1068,6 +1113,35 @@
 </blockquote>
 
 <p><br>[Special variable]
+<br><a class=none name="*call-template-access-function*"><b>*call-template-access-function*</b></a>
+
+<blockquote><br> The value of this variable should be a <a
+href="http://www.lispworks.com/documentation/HyperSpec/Body/01_dae.htm">designator</a>
+for a function which takes one argument (the call structure) and
+returns either a template printer or a value that can be used as the
+first argument to <a
+href="#create-template-printer"><code>create-template-printer</code></a>.
+This function will be used to determine the template that should be
+used for a call in a <code>TMPL_CALL</code> tag.
+<p>The default value
+is #'<a
+href="http://www.lispworks.com/documentation/HyperSpec/Body/f_car_c.htm#car"><code>CAR</code></a>.
+This variable takes effect at <a href="#semantics">invocation
+time</a>. </blockquote>
+
+<p><br>[Special variable]
+<br><a class=none name="*call-value-access-function*"><b>*call-value-access-function*</b></a>
+
+<blockquote><br> The value of this variable should be a <a
+href="http://www.lispworks.com/documentation/HyperSpec/Body/01_dae.htm">designator</a>
+for a function which takes one argument (the call structure) and
+returns a structure to use as the value for a call in a
+<code>TMPL_CALL</code> tag. <p>The default value is #'<a
+href="http://www.lispworks.com/documentation/HyperSpec/Body/f_car_c.htm#cdr"><code>CDR</code></a>.
+This variable takes effect at <a href="#semantics">invocation
+time</a>. </blockquote>
+
+<p><br>[Special variable]
 <br><a class=none name="*ignore-empty-lines*"><b>*ignore-empty-lines*</b></a>
 
 <blockquote><br>
Only in html-template.mine/: errors.fasl
Only in html-template.mine/: packages.fasl
diff -ur html-template-0.7.0/packages.lisp html-template.mine/packages.lisp
--- html-template-0.7.0/packages.lisp	2006-09-14 13:44:31.000000000 +0200
+++ html-template.mine/packages.lisp	2006-11-19 05:50:14.000000000 +0100
@@ -32,7 +32,9 @@
 (defpackage :html-template
   (:nicknames :template)
   (:use :cl)
-  (:export :*convert-nil-to-empty-string*
+  (:export :*call-template-access-function*
+	   :*call-values-access-function*
+	   :*convert-nil-to-empty-string*
            :*default-template-output*
            :*default-template-pathname*
            :*escape-char-p*
Only in html-template.mine/: specials.fasl
diff -ur html-template-0.7.0/specials.lisp html-template.mine/specials.lisp
--- html-template-0.7.0/specials.lisp	2006-09-14 16:02:00.000000000 +0200
+++ html-template.mine/specials.lisp	2006-12-11 03:59:26.000000000 +0100
@@ -105,6 +105,14 @@
   "The function which associates \(attribute) symbols with their
 values.")
 
+(defvar *call-template-access-function* #'car
+  "Accessor function for extracting the called template from a
+TMPL_CALL form.")
+
+(defvar *call-value-access-function* #'cdr
+  "Accessor function for extracting the values from a TMPL_CALL
+form.")
+
 (defvar *force-default* nil
   "The default value for the FORCE keyword argument to
 CREATE-TEMPLATE-PRINTER.")
Only in html-template.mine/: template.fasl
diff -ur html-template-0.7.0/template.lisp html-template.mine/template.lisp
--- html-template-0.7.0/template.lisp	2006-09-30 00:36:26.000000000 +0200
+++ html-template.mine/template.lisp	2006-12-11 03:59:26.000000000 +0100
@@ -50,49 +50,54 @@
 #+:lispworks
 (editor:setup-indent "with-use-value-restart" 1 2 4)
 
-(defun create-simple-printer (string-list &optional symbol/pathname (next-fn #'no-values))
-  "Used internally to create template printers for TMPL_VAR,
-TMPL_INCLUDE, and for strings which don't include template
-tags. SYMBOL/PATHNAME is the symbol or pathname associated with the
-tag. NEXT-FN is the next function to be called in the chain of
-closures. STRING-LIST is a list of strings in reverse order to be
-printed first."
+(defun create-simple-printer (string-list &optional (next-fn #'no-values))
+  "Used internally to create template printers for strings which don't
+include template tags. NEXT-FN is the next function to be called in
+the chain of closures. STRING-LIST is a list of strings in reverse
+order to be printed first."
   (let ((string (list-to-string string-list)))
-    (etypecase symbol/pathname
-      (null
-        ;; no tag, just print STRING
-        (lambda (values)
-          (write-string string *template-output*)
-          (funcall next-fn values)))
-      (symbol
-        ;; TMPL_VAR tag
-        (lambda (values)
-          (write-string string *template-output*)
-          (let* ((value (funcall *value-access-function* symbol/pathname values))
-                 (string (typecase value
-                           (null
-                            (if *convert-nil-to-empty-string*
-                              ""
-                              (with-use-value-restart (symbol/pathname)
-                                (signal-template-missing-value-error 
-                                 "Value for symbol ~S is NIL"
-                                 symbol/pathname))))
-                           (string value)                            
-                           (otherwise
-                            (cond (*format-non-strings* (format nil "~A" value))
-                                  (t (with-use-value-restart (symbol/pathname)
-                                       (error 'template-not-a-string-error
-                                              :value value
-                                              :format-control "Value ~S for symbol ~S is not a string"
-                                              :format-arguments (list value symbol/pathname)))))))))
-            (write-string (funcall *string-modifier* string) *template-output*))
-          (funcall next-fn values)))
-      (pathname
-        ;; TMPL_INCLUDE tag
-        (lambda (values)
-          (write-string string *template-output*)
-          (funcall (car (gethash symbol/pathname *printer-hash*)) values)
-          (funcall next-fn values))))))
+    (lambda (values)
+      (write-string string *template-output*)
+      (funcall next-fn values))))
+
+(defun create-var-printer (string-list symbol next-fn)
+  "Used internally to create template printers for TMPL_VAR. SYMBOL is
+the symbol associated with the tag. NEXT-FN is the next function to be
+called in the chain of closures. STRING-LIST is a list of strings in
+reverse order to be printed first."
+  (let ((string (list-to-string string-list)))
+    (lambda (values)
+      (write-string string *template-output*)
+      (let* ((value (funcall *value-access-function* symbol values))
+             (string (typecase value
+                       (null
+                        (if *convert-nil-to-empty-string*
+                            ""
+                            (with-use-value-restart (symbol)
+                              (signal-template-missing-value-error 
+                               "Value for symbol ~S is NIL"
+                               symbol))))
+                       (string value)                            
+                       (otherwise
+                        (cond (*format-non-strings* (format nil "~A" value))
+                              (t (with-use-value-restart (symbol)
+                                   (error 'template-not-a-string-error
+                                          :value value
+                                          :format-control "Value ~S for symbol ~S is not a string"
+                                          :format-arguments (list value symbol)))))))))
+        (write-string (funcall *string-modifier* string) *template-output*))
+      (funcall next-fn values))))
+
+(defun create-include-printer (string-list pathname next-fn)
+  "Used internally to create template printers for TMPL_INCLUDE.
+PATHNAME is the pathname associated with the tag. NEXT-FN is the next
+function to be called in the chain of closures. STRING-LIST is a list
+of strings in reverse order to be printed first."
+  (let ((string (list-to-string string-list)))
+    (lambda (values)
+      (write-string string *template-output*)
+      (funcall (car (gethash pathname *printer-hash*)) values)
+      (funcall next-fn values))))
   
 (defun create-if-printer (string-list symbol if-fn else-fn next-fn unlessp)
   "Used internally to create template printers for TMPL_IF and
@@ -148,6 +153,34 @@
                 do (funcall body-fn values))))
       (funcall next-fn values))))
 
+(defun create-call-printer (string-list symbol next-fn)
+  "Used internally to create template printers for TMPL_CALL tags.
+SYMBOL is the symbol associated with the tag. BODY-FN is the template
+printer for the body of the loop. NEXT-FN is the next function to be
+called in the chain of closures. STRING-LIST is a list of strings in
+reverse order to be printed first."
+  (let ((string (list-to-string string-list)))
+    (cond (*sequences-are-lists*
+           (lambda (values)
+             (write-string string *template-output*)
+             (dolist (call (funcall *value-access-function*
+                                    symbol values t))
+               (fill-and-print-template
+                (funcall *call-template-access-function* call)
+                (funcall *call-value-access-function* call)
+                :stream *template-output*))
+             (funcall next-fn values)))
+          (t
+           (lambda (values)
+             (write-string string *template-output*)
+             (loop for call across (funcall *value-access-function*
+                                            symbol values t)
+                   do (fill-and-print-template
+                       (funcall *call-template-access-function* call)
+                       (funcall *call-value-access-function* call)
+                       :stream *template-output*))
+             (funcall next-fn values))))))
+
 (defun create-template-printer-aux (string-stack end-token)
   "Reads from *STANDARD-INPUT* and returns a template printer from
 what it reads.  When this function is entered the stream pointer must
@@ -227,10 +260,10 @@
                 ;; then we combine it with the strings before the tag
                 ;; to create a template printer for TMPL_INCLUDE
                 (values
-                 (create-simple-printer (cons (skip-leading-whitespace string)
-                                              string-stack)
-                                        merged-pathname
-                                        next-fn)
+                 (create-include-printer (cons (skip-leading-whitespace string)
+                                               string-stack)
+                                         merged-pathname
+                                         next-fn)
                  else-follows))))
           ((string-equal token "TMPL_VAR")
             ;; TMPL_VAR tag - first read the symbol which has to
@@ -245,7 +278,7 @@
                  ;; to create a template printer for TMPL_VAR - note
                  ;; that we don't skip leading and trailing whitespace
                  ;; here
-                 (create-simple-printer (cons string string-stack)
+                 (create-var-printer (cons string string-stack)
                                         symbol
                                         next-fn)
                  else-follows))))
@@ -283,6 +316,24 @@
                           body-fn
                           next-fn)
                  else-follows))))
+	  ((string-equal token "TMPL_CALL")
+            ;; TMPL_CALL tag - first read the symbol which has to
+            ;; follow and intern it
+           (let ((symbol (read-tag-rest :read-attribute t)))
+             (multiple-value-bind (next-fn else-follows)
+                  ;; recursively create the template printer for the
+                  ;; rest of the stream
+                 (create-template-printer-aux (skip-trailing-whitespace)
+                                               end-token)
+               ;; create the printer that will output the strings
+               ;; before this tag and call the templates stored under
+               ;; SYMBOL
+               (values (funcall #'create-call-printer
+                                (cons (skip-leading-whitespace string)
+                                      string-stack)
+                                symbol
+                                next-fn)
+                       else-follows))))
           ((string-equal token "/TMPL_LOOP")
             (unless (eq end-token :loop)
               ;; check if we expected /TMPL_LOOP here, i.e. if an open
Only in html-template.mine/: test.fasl
diff -ur html-template-0.7.0/test.lisp html-template.mine/test.lisp
--- html-template-0.7.0/test.lisp	2006-09-30 00:36:26.000000000 +0200
+++ html-template.mine/test.lisp	2006-12-11 04:30:06.000000000 +0100
@@ -121,6 +121,12 @@
 (test "2" "<!-- TMPL_IF foo --><!-- TMPL_IF bar -->1<!-- TMPL_ELSE -->2<!-- /TMPL_IF --><!-- TMPL_ELSE --><!-- TMPL_IF baz -->3<!-- TMPL_ELSE -->4<!-- /TMPL_IF --><!-- /TMPL_IF -->" '(:foo t :bar nil))
 (test "3" "<!-- TMPL_IF foo --><!-- TMPL_IF bar -->1<!-- TMPL_ELSE -->2<!-- /TMPL_IF --><!-- TMPL_ELSE --><!-- TMPL_IF baz -->3<!-- TMPL_ELSE -->4<!-- /TMPL_IF --><!-- /TMPL_IF -->" '(:foo nil :baz t))
 (test "4" "<!-- TMPL_IF foo --><!-- TMPL_IF bar -->1<!-- TMPL_ELSE -->2<!-- /TMPL_IF --><!-- TMPL_ELSE --><!-- TMPL_IF baz -->3<!-- TMPL_ELSE -->4<!-- /TMPL_IF --><!-- /TMPL_IF -->" '(:foo nil :baz nil))
+(test "X" "<!-- TMPL_CALL foo -->" '(:foo (("X"))))
+(test "QUUX" "<!-- TMPL_VAR baz --><!-- TMPL_CALL foo -->" '(:baz "Q"
+                                                             :foo (("<!-- TMPL_VAR bar -->" :bar "U")
+                                                                   ("<!-- TMPL_VAR bar -->X" :bar "U"))))
+(test "" "<!-- TMPL_IF foo --><!-- TMPL_CALL bar --><!-- /TMPL_IF -->" '(:foo (("---"))))
+(test nil "<!-- TMPL_CALL foo -->" '(:foo 57))
 
 (let ((temp-name (make-pathname :name (format nil "template-test-~A" (random 1000000))
                                 :defaults tmp-dir)))
@@ -213,7 +219,11 @@
         "<!-- TMPL_LOOP vector -->[<!-- TMPL_VAR item -->]<!-- /TMPL_LOOP -->"
         '(:vector #((:item "1")
                     (:item "2")
-                    (:item "3")))))
+                    (:item "3"))))
+  (test "QUUX" "<!-- TMPL_VAR baz --><!-- TMPL_CALL foo -->"
+        '(:baz "Q"
+          :foo #(("<!-- TMPL_VAR bar -->" :bar "U")
+                 ("<!-- TMPL_VAR bar -->X" :bar "U")))))
 
 (let ((*upcase-attribute-strings* nil))
   (test "The slow brown fox"
Only in html-template.mine/: util.fasl


More information about the Html-template-devel mailing list