html.templates: reverse order of style and scripts

[factor.git] / basis / html / templates / templates.factor

diff --git a/basis/html/templates/templates.factor b/basis/html/templates/templates.factor
index efaf8d6a62ad940f4d486eaeb3fb590f1a4f0f1a..89a9921a54121ce7806acf9da416342dcc5fbfc7 100644 (file)
--- a/basis/html/templates/templates.factor
+++ b/basis/html/templates/templates.factor
@@ -1,9 +1,9 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel fry io io.encodings.utf8 io.files
-debugger prettyprint continuations namespaces boxes sequences
-arrays strings html io.streams.string
-quotations xml.data xml.writer xml.literals ;
+USING: accessors arrays assocs boxes continuations debugger io
+io.encodings.utf8 io.files io.streams.string kernel namespaces
+prettyprint quotations sequences strings xml.data xml.syntax
+xml.writer ;
 IN: html.templates
 
 MIXIN: template
@@ -12,7 +12,7 @@ GENERIC: call-template* ( template -- )
 
 M: string call-template* write ;
 
-M: callable call-template* call ;
+M: callable call-template* call( -- ) ;
 
 M: xml call-template* write-xml ;
 
@@ -29,38 +29,77 @@ M: template-error error.
 : call-template ( template -- )
     [ call-template* ] [ \ template-error boa rethrow ] recover ;
 
+ERROR: no-boilerplate ;
+
+M: no-boilerplate error.
+    drop
+    "get-title and set-title can only be used from within" print
+    "a with-boilerplate form" print ;
+
 SYMBOL: title
 
 : set-title ( string -- )
-    title get >box ;
+    title get [ >box ] [ no-boilerplate ] if* ;
+
+: get-title ( -- string )
+    title get [ value>> ] [ no-boilerplate ] if* ;
 
 : write-title ( -- )
-    title get value>> write ;
+    get-title write ;
 
 SYMBOL: style
 
 : add-style ( string -- )
-    "\n" style get push-all
-         style get push-all ;
+    style get push ;
+
+: get-style ( -- string )
+    style get <reversed> "\n" join ;
 
 : write-style ( -- )
-    style get >string write ;
+    get-style write ;
+
+SYMBOL: script
+
+: add-script ( string -- )
+    script get push ;
+
+: get-script ( -- string )
+    script get <reversed> "\n" join ;
+
+: write-script ( -- )
+    get-script write ;
+
+SYMBOL: meta
+
+: add-meta ( name content -- )
+    2array meta get push ;
+
+: get-meta ( -- xml )
+    meta get [
+        [XML <meta name=<-> content=<->/> XML]
+    ] { } assoc>map ;
+
+: write-meta ( -- )
+    get-meta write-xml ;
 
 SYMBOL: atom-feeds
 
 : add-atom-feed ( title url -- )
     2array atom-feeds get push ;
 
-: write-atom-feeds ( -- )
+: get-atom-feeds ( -- xml )
     atom-feeds get [
-        first2 [XML
+        [XML
             <link
                 rel="alternate"
                 type="application/atom+xml"
                 title=<->
                 href=<->/>
-        XML] write-xml
-    ] each ;
+        XML]
+    ] { } assoc>map ;
+
+: write-atom-feeds ( -- )
+    get-atom-feeds write-xml ;
 
 SYMBOL: nested-template?
 
@@ -73,8 +112,10 @@ M: f call-template* drop call-next-template ;
 
 : with-boilerplate ( child master -- )
     [
-        title [ <box> or ] change
-        style [ SBUF" " clone or ] change
+        title [ [ <box> ] unless* ] change
+        style [ [ V{ } clone ] unless* ] change
+        script [ [ V{ } clone ] unless* ] change
+        meta [ [ V{ } clone ] unless* ] change
         atom-feeds [ V{ } like ] change
 
         [