From 2597a4a8f6cf19436da375746ba5c3c617da650b Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Mon, 2 Mar 2020 15:57:19 -0800
Subject: [PATCH] html.templates: adding meta tag and some chloe tests.

---
 basis/html/templates/chloe/chloe-tests.factor | 18 +++++++++++++
 basis/html/templates/chloe/chloe.factor       | 10 ++++++-
 basis/html/templates/templates.factor         | 26 ++++++++++++++++---
 3 files changed, 49 insertions(+), 5 deletions(-)

diff --git a/basis/html/templates/chloe/chloe-tests.factor b/basis/html/templates/chloe/chloe-tests.factor
index 9128eef6b7..2a205f929f 100644
--- a/basis/html/templates/chloe/chloe-tests.factor
+++ b/basis/html/templates/chloe/chloe-tests.factor
@@ -194,3 +194,21 @@ TUPLE: person first-name last-name ;
         ] run-template
     ] with-scope
 ] [ error>> tag-not-allowed-here? ] must-fail-with
+
+{ "This is     <style type=\"text/css\"> * { font-family: monospace; } </style>" } [
+    SBUF" " clone style [
+        [ "test16" test-template call-template ] run-template
+    ] with-variable
+] unit-test
+
+{ "<script type=\"text/javascript\"> function testAlerts() {    window.alert(\"Hello, world!\");} </script>" } [
+    SBUF" " clone script [
+        [ "test17" test-template call-template ] run-template
+    ] with-variable
+] unit-test
+
+{ "<meta name=\"author\" content=\"John Doe\"/><meta name=\"viewport\" content=\"width=device-width, initial-scale=1.0\"/>" } [
+    V{ } clone meta [
+        [ "test18" test-template call-template ] run-template
+    ] with-variable
+] unit-test
diff --git a/basis/html/templates/chloe/chloe.factor b/basis/html/templates/chloe/chloe.factor
index 89feebecd0..483f31c3db 100644
--- a/basis/html/templates/chloe/chloe.factor
+++ b/basis/html/templates/chloe/chloe.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs html.components html.forms
+USING: accessors arrays assocs fry html.components html.forms
 html.templates html.templates.chloe.compiler
 html.templates.chloe.components html.templates.chloe.syntax
 io.encodings.utf8 io.files io.files.info kernel logging make
@@ -49,6 +49,14 @@ CHLOE: write-script
         [XML <script type="text/javascript"> <-> </script> XML]
     ] [xml-code] ;
 
+CHLOE: meta
+    [ "name" optional-attr ]
+    [ "content" optional-attr ] bi
+    '[ _ _ add-meta ] [code] ;
+
+CHLOE: write-meta
+    drop [ get-meta ] [xml-code] ;
+
 CHLOE: even
     [ "index" value even? swap when ] process-children ;
 
diff --git a/basis/html/templates/templates.factor b/basis/html/templates/templates.factor
index 9fe3b1bb7d..3966b1ac83 100644
--- a/basis/html/templates/templates.factor
+++ b/basis/html/templates/templates.factor
@@ -1,9 +1,13 @@
 ! 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 assocs
-quotations xml.data xml.writer xml.syntax ;
+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 ;
+! USING: accessors kernel fry io io.encodings.utf8 io.files
+! debugger prettyprint continuations namespaces boxes sequences
+! arrays strings html io.streams.string assocs
+! quotations xml.data xml.writer xml.syntax ;
 IN: html.templates
 
 MIXIN: template
@@ -71,6 +75,19 @@ SYMBOL: script
 : 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 -- )
@@ -104,6 +121,7 @@ M: f call-template* drop call-next-template ;
         title [ [ <box> ] unless* ] change
         style [ [ SBUF" " clone ] unless* ] change
         script [ [ SBUF" " clone ] unless* ] change
+        meta [ [ V{ } clone ] unless* ] change
         atom-feeds [ V{ } like ] change
 
         [