From d470bde42b85ed3e3ca8fbe53ba363f3a4c32ece Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 8 Sep 2008 02:52:42 -0500
Subject: [PATCH] Assorted fixes

---
 basis/furnace/chloe-tags/chloe-tags.factor    | 19 +++++++++-----
 basis/html/templates/chloe/chloe.factor       | 18 +++++++++----
 .../templates/chloe/compiler/compiler.factor  | 26 +++++++++++--------
 basis/xml/writer/writer-tests.factor          |  5 ++++
 basis/xml/writer/writer.factor                |  2 +-
 5 files changed, 46 insertions(+), 24 deletions(-)
 create mode 100644 basis/xml/writer/writer-tests.factor

diff --git a/basis/furnace/chloe-tags/chloe-tags.factor b/basis/furnace/chloe-tags/chloe-tags.factor
index 22eddd77a2..8822bca519 100644
--- a/basis/furnace/chloe-tags/chloe-tags.factor
+++ b/basis/furnace/chloe-tags/chloe-tags.factor
@@ -65,7 +65,10 @@ CHLOE: write-atom drop [ write-atom-feeds ] [code] ;
 : a-end-tag ( tag -- )
     drop [ </a> ] [code] ;
 
-CHLOE: a [ a-start-tag ] [ compile-children ] [ a-end-tag ] tri ;
+CHLOE: a
+    [
+        [ a-start-tag ] [ compile-children ] [ a-end-tag ] tri
+    ] compile-with-scope ;
 
 : compile-hidden-form-fields ( for -- )
     '[
@@ -95,12 +98,14 @@ CHLOE: a [ a-start-tag ] [ compile-children ] [ a-end-tag ] tri ;
     drop [ </form> ] [code] ;
 
 CHLOE: form
-    {
-        [ compile-link-attrs ]
-        [ form-start-tag ]
-        [ compile-children ]
-        [ form-end-tag ]
-    } cleave ;
+    [
+        {
+            [ compile-link-attrs ]
+            [ form-start-tag ]
+            [ compile-children ]
+            [ form-end-tag ]
+        } cleave
+    ] compile-with-scope ;
 
 STRING: button-tag-markup
 <t:form class="inline" xmlns:t="http://factorcode.org/chloe/1.0">
diff --git a/basis/html/templates/chloe/chloe.factor b/basis/html/templates/chloe/chloe.factor
index a03e42bb37..45e59c3b6d 100644
--- a/basis/html/templates/chloe/chloe.factor
+++ b/basis/html/templates/chloe/chloe.factor
@@ -88,13 +88,21 @@ CHLOE-TUPLE: choice
 CHLOE-TUPLE: checkbox
 CHLOE-TUPLE: code
 
-MEMO: template-quot ( chloe -- quot )
-    path>> ".xml" append utf8 <file-reader> read-xml
-    compile-template ;
+: read-template ( chloe -- xml )
+    path>> ".xml" append utf8 <file-reader> read-xml ;
 
-: reset-templates ( -- ) \ template-quot reset-memoized ;
+MEMO: template-quot ( chloe -- quot )
+    read-template compile-template ;
+
+MEMO: nested-template-quot ( chloe -- quot )
+    read-template compile-nested-template ;
+
+: reset-templates ( -- )
+    { template-quot nested-template-quot } [ reset-memoized ] each ;
 
 M: chloe call-template*
-    template-quot call ;
+    nested-template? get
+    [ nested-template-quot ] [ template-quot ] if
+    assert-depth ;
 
 INSTANCE: chloe template
diff --git a/basis/html/templates/chloe/compiler/compiler.factor b/basis/html/templates/chloe/compiler/compiler.factor
index 5722245f89..044d2edb90 100644
--- a/basis/html/templates/chloe/compiler/compiler.factor
+++ b/basis/html/templates/chloe/compiler/compiler.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs namespaces kernel sequences accessors combinators
-strings splitting io io.streams.string xml.writer xml.data
-xml.entities html.forms html.templates.chloe.syntax ;
+strings splitting io io.streams.string present xml.writer
+xml.data xml.entities html.forms html.templates.chloe.syntax ;
 IN: html.templates.chloe.compiler
 
 : chloe-attrs-only ( assoc -- assoc' )
@@ -42,10 +42,10 @@ DEFER: compile-element
     reset-buffer [ , ] [ % ] bi* ;
 
 : expand-attr ( value -- )
-    [ value write ] [code-with] ;
+    [ value present write ] [code-with] ;
 
 : compile-attr ( value -- )
-    reset-buffer "@" ?head [ , \ value ] when , ;
+    reset-buffer "@" ?head [ , [ value present ] % ] [ , ] if ;
 
 : compile-attrs ( assoc -- )
     [
@@ -103,19 +103,23 @@ DEFER: compile-element
 : compile-chunk ( seq -- )
     [ compile-element ] each ;
 
-: process-children ( tag quot -- )
+: compile-quot ( quot -- )
     reset-buffer
     [
-        [
-            SBUF" " string-buffer set
-            compile-children
-            reset-buffer
-        ] [ ] make ,
-    ] [ % ] bi* ;
+        SBUF" " string-buffer set
+        call
+        reset-buffer
+    ] [ ] make , ; inline
+
+: process-children ( tag quot -- )
+    [ [ compile-children ] compile-quot ] [ % ] bi* ; inline
 
 : compile-children>string ( tag -- )
      [ with-string-writer ] process-children ;
 
+: compile-with-scope ( quot -- )
+    compile-quot [ with-scope ] [code] ; inline
+
 : compile-template ( xml -- quot )
     [
         {
diff --git a/basis/xml/writer/writer-tests.factor b/basis/xml/writer/writer-tests.factor
new file mode 100644
index 0000000000..acfe4bfe1e
--- /dev/null
+++ b/basis/xml/writer/writer-tests.factor
@@ -0,0 +1,5 @@
+IN: xml.writer.tests
+USING: xml.data xml.writer tools.test ;
+
+[ "foo" ] [ T{ name { main "foo" } } name>string ] unit-test
+[ "ns:foo" ] [ T{ name { space "ns" } { main "foo" } } name>string ] unit-test
diff --git a/basis/xml/writer/writer.factor b/basis/xml/writer/writer.factor
index 6b60ec8a6d..ae6fddacc3 100644
--- a/basis/xml/writer/writer.factor
+++ b/basis/xml/writer/writer.factor
@@ -38,7 +38,7 @@ SYMBOL: indenter
     ] when ;
 
 : name>string ( name -- string )
-    [ main>> ] [ space>> ] bi [ ":" swap 3append ] unless-empty ;
+    [ main>> ] [ space>> ] bi [ ":" rot 3append ] unless-empty ;
 
 : print-name ( name -- )
     name>string write ;