[XML <-> XML] second swap >>attrs ]
+ [xml-code]
] compile-with-scope ;
CHLOE: base
- compile-a-url [ ] [code] ;
+ compile-a-url [ [XML /> XML] ] [xml-code] ;
: compile-hidden-form-fields ( for -- )
'[
-
- _ [ "," split [ hidden render ] each ] when*
- nested-forms get " " join f like nested-forms-key hidden-form-field
- [ modify-form ] each-responder
-
+ _ [ "," split [ hidden render>xml ] map ] [ f ] if*
+ nested-forms get " " join f like nested-forms-key hidden-form-field>xml
+ [ [ modify-form ] each-responder ] with-string-writer
+ [XML <-><-><->
XML]
] [code] ;
-: compile-form-attrs ( method action attrs -- )
- [ ] [code] ;
+: compile-form-attrs ( tag -- )
+ [ non-chloe-attrs ]
+ [ compile-link-attrs ]
+ [ compile-method/action ] tri ;
+
+: hidden-fields ( tag -- )
+ "for" optional-attr compile-hidden-form-fields ;
CHLOE: form
[
- {
- [ compile-link-attrs ]
- [ form-start-tag ]
- [ compile-children ]
- [ form-end-tag ]
- } cleave
+ [ compile-form-attrs ]
+ [ hidden-fields ]
+ [ compile-children>string ] tri
+ [
+ [XML XML] second
+ swap >>attrs
+ write-xml
+ ] [code]
] compile-with-scope ;
: button-tag-markup ( -- xml )
@@ -121,13 +126,13 @@ CHLOE: 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 ]
diff --git a/basis/furnace/furnace-tests.factor b/basis/furnace/furnace-tests.factor
index f6e5434997..f01260c68b 100644
--- a/basis/furnace/furnace-tests.factor
+++ b/basis/furnace/furnace-tests.factor
@@ -30,7 +30,7 @@ M: base-path-check-responder call-responder*
"a/b/c" split-path main-responder get call-responder body>>
] unit-test
-[ "" ]
+[ "" ]
[ [ "&&&" "foo" hidden-form-field ] with-string-writer ]
unit-test
diff --git a/basis/furnace/sessions/sessions.factor b/basis/furnace/sessions/sessions.factor
index 8b7e1ab83f..52e705c153 100644
--- a/basis/furnace/sessions/sessions.factor
+++ b/basis/furnace/sessions/sessions.factor
@@ -5,7 +5,7 @@ strings random accessors quotations hashtables sequences
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 ;
diff --git a/basis/furnace/utilities/utilities.factor b/basis/furnace/utilities/utilities.factor
index e09047b74a..a2d4c4d996 100755
--- a/basis/furnace/utilities/utilities.factor
+++ b/basis/furnace/utilities/utilities.factor
@@ -2,7 +2,7 @@
! 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.syntax xml.writer
http.server.redirection http.server.remapping ;
IN: furnace.utilities
@@ -81,14 +81,13 @@ GENERIC: modify-form ( responder -- )
M: object modify-form drop ;
-: hidden-form-field ( value name -- )
+: hidden-form-field>xml ( value name -- xml )
over [
-
- ] [ 2drop ] if ;
+ [XML name=<->/> XML]
+ ] [ drop ] if ;
+
+: hidden-form-field ( value name -- )
+ hidden-form-field>xml write-xml ;
: nested-forms-key "__n" ;
diff --git a/basis/html/components/components.factor b/basis/html/components/components.factor
index 82bb75015e..2b18e28351 100644
--- a/basis/html/components/components.factor
+++ b/basis/html/components/components.factor
@@ -11,7 +11,7 @@ IN: html.components
GENERIC: render* ( value name renderer -- xml )
-: render ( name renderer -- )
+: render>xml ( name renderer -- xml )
prepare-value
[
dup validation-error?
@@ -20,7 +20,10 @@ GENERIC: render* ( value name renderer -- xml )
if
] 2dip
render*
- swap 2array write-xml ;
+ swap 2array ;
+
+: render ( name renderer -- )
+ render>xml write-xml ;
SINGLETON: label
diff --git a/basis/html/templates/chloe/chloe-docs.factor b/basis/html/templates/chloe/chloe-docs.factor
index f6408d3b59..b2259e629e 100644
--- a/basis/html/templates/chloe/chloe-docs.factor
+++ b/basis/html/templates/chloe/chloe-docs.factor
@@ -128,7 +128,7 @@ ARTICLE: "html.templates.chloe.tags.form" "Chloe link and form tags"
""
" View"
- "s"
+ ""
}
} }
{ { $snippet "t:base" } { "Outputs an HTML " { $snippet "" } " tag. The attributes are interpreted in the same manner as the attributes of " { $snippet "t:a" } "." } }
@@ -261,8 +261,8 @@ $nl
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
;" }
+"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
/> 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" } ":"
diff --git a/basis/html/templates/chloe/chloe-tests.factor b/basis/html/templates/chloe/chloe-tests.factor
index 19b67f7018..4e454dcee4 100644
--- a/basis/html/templates/chloe/chloe-tests.factor
+++ b/basis/html/templates/chloe/chloe-tests.factor
@@ -135,7 +135,7 @@ TUPLE: person first-name last-name ;
[ ] [ H{ { "a" H{ { "b" "c" } } } } values set ] unit-test
-[ "" ] [
+[ "" ] [
[
"test10" test-template call-template
] run-template
diff --git a/basis/html/templates/chloe/chloe.factor b/basis/html/templates/chloe/chloe.factor
index 6ab6722afe..89d00e1f6e 100644
--- a/basis/html/templates/chloe/chloe.factor
+++ b/basis/html/templates/chloe/chloe.factor
@@ -8,7 +8,6 @@ logging continuations
xml.data xml.writer xml.syntax strings
html.forms
html
-html.elements
html.components
html.templates
html.templates.chloe.compiler
@@ -28,7 +27,9 @@ CHLOE: write-title
drop
"head" tag-stack get member?
"title" tag-stack get member? not and
- [ write-title ] [ write-title ] ? [code] ;
+ [ get-title [XML <-> XML] ]
+ [ get-title ] ?
+ [xml-code] ;
CHLOE: style
dup "include" optional-attr [
@@ -39,10 +40,9 @@ CHLOE: style
CHLOE: write-style
drop [
-
- ] [code] ;
+ get-style
+ [XML XML]
+ ] [xml-code] ;
CHLOE: even
[ "index" value even? swap when ] process-children ;
diff --git a/basis/html/templates/chloe/compiler/compiler.factor b/basis/html/templates/chloe/compiler/compiler.factor
index 7180e8cdbc..394b5ef359 100644
--- a/basis/html/templates/chloe/compiler/compiler.factor
+++ b/basis/html/templates/chloe/compiler/compiler.factor
@@ -42,6 +42,9 @@ DEFER: compile-element
: [code-with] ( obj quot -- )
reset-buffer [ , ] [ % ] bi* ;
+: [xml-code] ( quot -- )
+ [ write-xml ] compose [code] ;
+
: expand-attr ( value -- )
[ value present write ] [code-with] ;
diff --git a/basis/html/templates/templates.factor b/basis/html/templates/templates.factor
index 4aca73cc57..4a416e353f 100644
--- a/basis/html/templates/templates.factor
+++ b/basis/html/templates/templates.factor
@@ -2,7 +2,7 @@
! 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.syntax ;
IN: html.templates
@@ -34,8 +34,11 @@ SYMBOL: title
: set-title ( string -- )
title get >box ;
+: get-title ( -- string )
+ title get value>> ;
+
: write-title ( -- )
- title get value>> write ;
+ get-title write ;
SYMBOL: style
@@ -43,24 +46,30 @@ 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
href=<->/>
- XML] write-xml
- ] each ;
+ XML]
+ ] { } assoc>map ;
+
+: write-atom-feeds ( -- )
+ get-atom-feeds write-xml ;
SYMBOL: nested-template?
diff --git a/basis/unicode/case/case-tests.factor b/basis/unicode/case/case-tests.factor
index 6e26a36a19..52a8d9755e 100644
--- a/basis/unicode/case/case-tests.factor
+++ b/basis/unicode/case/case-tests.factor
@@ -1,4 +1,7 @@
-USING: unicode.case tools.test namespaces ;
+! Copyright (C) 2008, 2009 Daniel Ehrenberg.
+! See http://factorcode.org/license.txt for BSD license.
+USING: unicode.case unicode.case.private tools.test namespaces strings unicode.normalize ;
+IN: unicode.case.tests
\ >upper must-infer
\ >lower must-infer
@@ -9,12 +12,21 @@ USING: unicode.case tools.test namespaces ;
[ "\u0003C3a\u0003C2 \u0003C3\u0003C2 \u0003C3a\u0003C2" ] [ "\u0003A3A\u0003A3 \u0003A3\u0003A3 \u0003A3A\u0003A3" >lower ] unit-test
[ t ] [ "hello how are you?" lower? ] unit-test
[
+ [ f ] [ i-dot? ] unit-test
+ [ f ] [ lt? ] unit-test
"tr" locale set
+ [ t ] [ i-dot? ] unit-test
+ [ f ] [ lt? ] unit-test
[ "i\u000131i \u000131jj" ] [ "i\u000131I\u000307 IJj" >lower ] unit-test
[ "I\u000307\u000131i Ijj" ] [ "i\u000131I\u000307 IJj" >title ] unit-test
[ "I\u000307II\u000307 IJJ" ] [ "i\u000131I\u000307 IJj" >upper ] unit-test
"lt" locale set
- ! Lithuanian casing tests
+ [ f ] [ i-dot? ] unit-test
+ [ t ] [ lt? ] unit-test
+ [ "i\u000307\u000300" ] [ HEX: CC 1string nfd >lower ] unit-test
+ [ "\u00012f\u000307" ] [ HEX: 12E 1string nfd >lower nfc ] unit-test
+ [ "I\u000300" ] [ "i\u000307\u000300" >upper ] unit-test
+! [ "I\u000300" ] [ "i\u000307\u000300" >title ] unit-test
] with-scope
[ t ] [ "asdf" lower? ] unit-test
diff --git a/basis/unicode/case/case.factor b/basis/unicode/case/case.factor
index 65fab0ac38..3ac98cd57f 100644
--- a/basis/unicode/case/case.factor
+++ b/basis/unicode/case/case.factor
@@ -1,8 +1,8 @@
-! Copyright (C) 2008 Daniel Ehrenberg.
+! Copyright (C) 2008, 2009 Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: unicode.data sequences namespaces
sbufs make unicode.syntax unicode.normalize math hints
-unicode.categories combinators unicode.syntax assocs
+unicode.categories combinators unicode.syntax assocs combinators.short-circuit
strings splitting kernel accessors unicode.breaks fry locals ;
QUALIFIED: ascii
IN: unicode.case
@@ -26,6 +26,9 @@ SYMBOL: locale ! Just casing locale, or overall?
: i-dot? ( -- ? )
locale get { "tr" "az" } member? ;
+: lt? ( -- ? )
+ locale get "lt" = ;
+
: lithuanian? ( -- ? ) locale get "lt" = ;
: dot-over ( -- ch ) HEX: 307 ;
@@ -37,18 +40,21 @@ SYMBOL: locale ! Just casing locale, or overall?
: mark-above? ( ch -- ? )
combining-class 230 = ;
-: with-rest ( seq quot: ( seq -- seq ) -- seq )
- [ unclip ] dip swap slip prefix ; inline
+:: with-rest ( seq quot: ( seq -- seq ) -- seq )
+ seq unclip quot dip prefix ; inline
: add-dots ( seq -- seq )
- [ [ "" ] [
- dup first mark-above?
- [ CHAR: combining-dot-above prefix ] when
+ [ [ { } ] [
+ [
+ dup first
+ { [ mark-above? ] [ CHAR: combining-ogonek = ] } 1||
+ [ CHAR: combining-dot-above prefix ] when
+ ] map
] if-empty ] with-rest ; inline
: lithuanian>lower ( string -- lower )
- "i" split add-dots "i" join
- "j" split add-dots "i" join ; inline
+ "I" split add-dots "I" join
+ "J" split add-dots "J" join ; inline
: turk>upper ( string -- upper-i )
"i" "I\u000307" replace ; inline
@@ -88,13 +94,16 @@ SYMBOL: locale ! Just casing locale, or overall?
PRIVATE>
: >lower ( string -- lower )
- i-dot? [ turk>lower ] when final-sigma
+ i-dot? [ turk>lower ] when
+ lt? [ lithuanian>lower ] when
+ final-sigma
[ lower>> ] [ ch>lower ] map-case ;
HINTS: >lower string ;
: >upper ( string -- upper )
i-dot? [ turk>upper ] when
+ lt? [ lithuanian>upper ] when
[ upper>> ] [ ch>upper ] map-case ;
HINTS: >upper string ;
@@ -103,6 +112,7 @@ HINTS: >upper string ;
: (>title) ( string -- title )
i-dot? [ turk>upper ] when
+ lt? [ lithuanian>upper ] when
[ title>> ] [ ch>title ] map-case ; inline
: title-word ( string -- title )
diff --git a/basis/html/elements/authors.txt b/extra/html/elements/authors.txt
similarity index 100%
rename from basis/html/elements/authors.txt
rename to extra/html/elements/authors.txt
diff --git a/basis/html/elements/elements-docs.factor b/extra/html/elements/elements-docs.factor
similarity index 100%
rename from basis/html/elements/elements-docs.factor
rename to extra/html/elements/elements-docs.factor
diff --git a/basis/html/elements/elements-tests.factor b/extra/html/elements/elements-tests.factor
similarity index 100%
rename from basis/html/elements/elements-tests.factor
rename to extra/html/elements/elements-tests.factor
diff --git a/basis/html/elements/elements.factor b/extra/html/elements/elements.factor
similarity index 100%
rename from basis/html/elements/elements.factor
rename to extra/html/elements/elements.factor
diff --git a/basis/html/elements/summary.txt b/extra/html/elements/summary.txt
similarity index 100%
rename from basis/html/elements/summary.txt
rename to extra/html/elements/summary.txt
diff --git a/basis/html/elements/tags.txt b/extra/html/elements/tags.txt
similarity index 100%
rename from basis/html/elements/tags.txt
rename to extra/html/elements/tags.txt
diff --git a/extra/webapps/user-admin/user-admin.factor b/extra/webapps/user-admin/user-admin.factor
index 9d4e348596..c0cd601af5 100644
--- a/extra/webapps/user-admin/user-admin.factor
+++ b/extra/webapps/user-admin/user-admin.factor
@@ -3,7 +3,6 @@
USING: kernel sequences accessors namespaces combinators words
assocs db.tuples arrays splitting strings validators urls
html.forms
-html.elements
html.components
furnace
furnace.boilerplate