tri
[ =href a> ] [code] ;
-: a-end-tag ( tag -- )
- drop [ </a> ] [code] ;
+: process-attrs ( assoc -- newassoc )
+ [ "@" ?head [ value present ] when ] assoc-map ;
+
+: non-chloe-attrs ( tag -- )
+ attrs>> non-chloe-attrs-only [ process-attrs ] [code-with] ;
+
+: a-attrs ( tag -- )
+ [ non-chloe-attrs ]
+ [ compile-link-attrs ]
+ [ compile-a-url ] tri
+ [ swap "href" swap set-at ] [code] ;
CHLOE: a
- [
- [ a-start-tag ] [ compile-children ] [ a-end-tag ] tri
- ] compile-with-scope ;
+ [ a-attrs ]
+ [ compile-children>string ] bi
+ [ <unescaped> [XML <a><-></a> XML] swap >>attrs ]
+ [xml-code] ;
CHLOE: base
- compile-a-url [ <base =href base/> ] [code] ;
+ compile-a-url [ [XML <base href=<->/> XML] ] [xml-code] ;
: compile-hidden-form-fields ( for -- )
'[
<t:form class="inline" xmlns:t="http://factorcode.org/chloe/1.0">
<div style="display: inline;"><button type="submit"></button></div>
</t:form>
- XML> ;
+ XML> body>> clone ;
: add-tag-attrs ( attrs tag -- )
attrs>> swap update ;
CHLOE: button
- button-tag-markup body>>
+ button-tag-markup
{
[ [ attrs>> chloe-attrs-only ] dip add-tag-attrs ]
[ [ attrs>> non-chloe-attrs-only ] dip "button" deep-tag-named add-tag-attrs ]
"a/b/c" split-path main-responder get call-responder body>>
] unit-test
-[ "<input type='hidden' name='foo' value='&&&'/>" ]
+[ "<input type=\"hidden\" value=\"&&&\" name=\"foo\"/>" ]
[ [ "&&&" "foo" hidden-form-field ] with-string-writer ]
unit-test
continuations fry calendar combinators combinators.short-circuit
destructors alarms io.sockets db db.tuples db.types
http http.server http.server.dispatchers http.server.filters
-html.elements furnace.cache furnace.scopes furnace.utilities ;
+furnace.cache furnace.scopes furnace.utilities ;
IN: furnace.sessions
TUPLE: session < scope user-agent client ;
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces make assocs sequences kernel classes splitting
words vocabs.loader accessors strings combinators arrays
-continuations present fry urls html.elements http http.server
+continuations present fry urls http http.server xml.literals xml.writer
http.server.redirection http.server.remapping ;
IN: furnace.utilities
: hidden-form-field ( value name -- )
over [
- <input
- "hidden" =type
- =name
- present =value
- input/>
+ [XML <input type="hidden" value=<-> name=<->/> XML]
+ write-xml
] [ 2drop ] if ;
: nested-forms-key "__n" ;
"<a href=\"http://mysite.org/wiki/view/Factor\""
" class=\"small-link\">"
" View"
- "s</a>"
+ "</a>"
}
} }
{ { $snippet "t:base" } { "Outputs an HTML " { $snippet "<base>" } " tag. The attributes are interpreted in the same manner as the attributes of " { $snippet "t:a" } "." } }
ARTICLE: "html.templates.chloe.extend.components.example" "An example of a custom Chloe component"
"As an example, let's develop a custom Chloe component which renders an image stored in a form value. Since the component does not require any configuration, we can define a singleton class:"
{ $code "SINGLETON: image" }
-"Now we define a method on the " { $link render* } " generic word which renders the image using " { $vocab-link "html.elements" } ":"
-{ $code "M: image render* 2drop <img =src img/> ;" }
+"Now we define a method on the " { $link render* } " generic word which renders the image using " { $vocab-link "xml.literals" } ":"
+{ $code "M: image render* 2drop [XML <img src=<-> /> XML] ;" }
"Finally, we can define a Chloe component:"
{ $code "COMPONENT: image" }
"We can use it as follows, assuming the current form has a value named " { $snippet "image" } ":"
[ ] [ H{ { "a" H{ { "b" "c" } } } } values set ] unit-test
-[ "<form method='post' action='foo'><div style='display: none;'><input type='hidden' name='__n' value='a'/></div></form>" ] [
+[ "<form method='post' action='foo'><div style='display: none;'><input type=\"hidden\" value=\"a\" name=\"__n\"/></div></form>" ] [
[
"test10" test-template call-template
] run-template
xml.data xml.writer xml.literals strings
html.forms
html
-html.elements
html.components
html.templates
html.templates.chloe.compiler
drop
"head" tag-stack get member?
"title" tag-stack get member? not and
- [ <title> write-title </title> ] [ write-title ] ? [code] ;
+ [ get-title [XML <title><-></title> XML] ]
+ [ get-title ] ?
+ [xml-code] ;
CHLOE: style
dup "include" optional-attr [
CHLOE: write-style
drop [
- <style "text/css" =type style>
- write-style
- </style>
- ] [code] ;
+ get-style
+ [XML <style type="text/css"> <-> </style> XML]
+ ] [xml-code] ;
CHLOE: even
[ "index" value even? swap when ] process-children ;
: [code-with] ( obj quot -- )
reset-buffer [ , ] [ % ] bi* ;
+: [xml-code] ( quot -- )
+ [ write-xml ] compose [code] ;
+
: expand-attr ( value -- )
[ value present write ] [code-with] ;
! 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
+arrays strings html io.streams.string assocs
quotations xml.data xml.writer xml.literals ;
IN: html.templates
: set-title ( string -- )
title get >box ;
+: get-title ( -- string )
+ title get value>> ;
+
: write-title ( -- )
- title get value>> write ;
+ get-title write ;
SYMBOL: style
"\n" style get push-all
style get push-all ;
+: get-style ( -- string )
+ style get >string ;
+
: write-style ( -- )
- style get >string write ;
+ get-style write ;
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?
USING: kernel sequences accessors namespaces combinators words
assocs db.tuples arrays splitting strings validators urls
html.forms
-html.elements
html.components
furnace
furnace.boilerplate
projects / factor.git / commitdiff