steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

xml: update syntax. XML-DOC[[ ]] and XML-CHUNK[[ ]]

modern-harvey2
Doug Coleman 2017-08-26 17:17:24 -05:00
parent 2551028f98
commit 4cba08aa8c
36 changed files with 237 additions and 239 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
basis/farkup/farkup.factor
View File

@ -218,7 +218,7 @@ CONSTANT: invalid-url "javascript:alert('Invalid URL in farkup');"
: render-code ( string mode -- xml ) : render-code ( string mode -- xml )
[ string-lines ] dip htmlize-lines [ string-lines ] dip htmlize-lines
[XML <pre><-></pre> XML] ; XML-CHUNK[[ <pre><-></pre> ]] ;
GENERIC: (write-farkup) ( farkup -- xml ) GENERIC: (write-farkup) ( farkup -- xml )
@ -243,15 +243,15 @@ M: table (write-farkup) "table" farkup-inside ;
: write-link ( href text -- xml ) : write-link ( href text -- xml )
[ check-url link-no-follow? get "nofollow" and ] dip [ check-url link-no-follow? get "nofollow" and ] dip
[XML <a href=<-> rel=<->><-></a> XML] ; XML-CHUNK[[ <a href=<-> rel=<->><-></a> ]] ;
: write-image-link ( href text -- xml ) : write-image-link ( href text -- xml )
disable-images? get [ disable-images? get [
2drop 2drop
[XML <strong>Images are not allowed</strong> XML] XML-CHUNK[[ <strong>Images are not allowed</strong> ]]
] [ ] [
[ check-url ] [ f like ] bi* [ check-url ] [ f like ] bi*
[XML <img src=<-> alt=<->/> XML] XML-CHUNK[[ <img src=<-> alt=<->/> ]]
] if ; ] if ;
: open-link ( link -- href text ) : open-link ( link -- href text )
@ -267,15 +267,15 @@ M: code (write-farkup)
[ string>> ] [ mode>> ] bi render-code ; [ string>> ] [ mode>> ] bi render-code ;
M: line (write-farkup) M: line (write-farkup)
drop [XML <hr/> XML] ; drop XML-CHUNK[[ <hr/> ]] ;
M: line-break (write-farkup) M: line-break (write-farkup)
drop [XML <br/> XML] ; drop XML-CHUNK[[ <br/> ]] ;
M: table-row (write-farkup) M: table-row (write-farkup)
child>> child>>
[ (write-farkup) [XML <td><-></td> XML] ] map [ (write-farkup) XML-CHUNK[[ <td><-></td> ]] ] map
[XML <tr><-></tr> XML] ; XML-CHUNK[[ <tr><-></tr> ]] ;
M: string (write-farkup) ; M: string (write-farkup) ;

12
basis/furnace/chloe-tags/chloe-tags.factor
View File

@ -74,12 +74,12 @@ CHLOE: a
[ [
[ a-attrs ] [ a-attrs ]
[ compile-children>xml-string ] bi [ compile-children>xml-string ] bi
[ <unescaped> [XML <a><-></a> XML] second swap >>attrs ] [ <unescaped> XML-CHUNK[[ <a><-></a> ]] second swap >>attrs ]
[xml-code] [xml-code]
] compile-with-scope ; ] compile-with-scope ;
CHLOE: base CHLOE: base
compile-a-url [ [XML <base href=<->/> XML] ] [xml-code] ; compile-a-url [ XML-CHUNK[[ <base href=<->/> ]] ] [xml-code] ;
: hidden-nested-fields ( -- xml ) : hidden-nested-fields ( -- xml )
nested-forms get " " join f like nested-forms-key nested-forms get " " join f like nested-forms-key
@ -93,7 +93,7 @@ CHLOE: base
_ render-hidden _ render-hidden
hidden-nested-fields hidden-nested-fields
form-modifications form-modifications
[XML <div style="display: none;"><-><-><-></div> XML] XML-CHUNK[[ <div style="display: none;"><-><-><-></div> ]]
] [code] ; ] [code] ;
: (compile-form-attrs) ( method action -- ) : (compile-form-attrs) ( method action -- )
@ -122,18 +122,18 @@ CHLOE: form
[ hidden-fields ] [ hidden-fields ]
[ compile-children>xml-string ] tri [ compile-children>xml-string ] tri
[ [
<unescaped> [XML <form><-><-></form> XML] second <unescaped> XML-CHUNK[[ <form><-><-></form> ]] second
swap >>attrs swap >>attrs
write-xml write-xml
] [code] ] [code]
] compile-with-scope ; ] compile-with-scope ;
: button-tag-markup ( -- xml ) : button-tag-markup ( -- xml )
<XML XML-DOC[[
<t:form class="inline" xmlns:t="http://factorcode.org/chloe/1.0"> <t:form class="inline" xmlns:t="http://factorcode.org/chloe/1.0">
<div style="display: inline;"><button type="submit"></button></div> <div style="display: inline;"><button type="submit"></button></div>
</t:form> </t:form>
XML> body>> clone ; ]] body>> clone ;
: add-tag-attrs ( attrs tag -- ) : add-tag-attrs ( attrs tag -- )
attrs>> swap assoc-union! drop ; attrs>> swap assoc-union! drop ;

4
basis/furnace/recaptcha/recaptcha.factor
View File

@ -23,7 +23,7 @@ M: recaptcha call-responder*
: (render-recaptcha) ( url -- xml ) : (render-recaptcha) ( url -- xml )
dup dup
[XML XML-CHUNK[[
<script type="text/javascript" <script type="text/javascript"
src=<->> src=<->>
</script> </script>
@ -36,7 +36,7 @@ M: recaptcha call-responder*
<input type="hidden" name="recaptcha_response_field" <input type="hidden" name="recaptcha_response_field"
value="manual_challenge"/> value="manual_challenge"/>
</noscript> </noscript>
XML] ; ]] ;
: recaptcha-url ( secure? -- ? ) : recaptcha-url ( secure? -- ? )
"https" "http" ? "://www.google.com/recaptcha/api/challenge" append "https" "http" ? "://www.google.com/recaptcha/api/challenge" append

2
basis/furnace/utilities/utilities.factor
View File

@ -86,7 +86,7 @@ M: object modify-form drop f ;
: hidden-form-field ( value name -- xml ) : hidden-form-field ( value name -- xml )
over [ over [
[XML <input type="hidden" value=<-> name=<->/> XML] XML-CHUNK[[ <input type="hidden" value=<-> name=<->/> ]]
] [ drop ] if ; ] [ drop ] if ;
CONSTANT: nested-forms-key "__n" CONSTANT: nested-forms-key "__n"

6
basis/help/html/html.factor
View File

@ -69,11 +69,11 @@ M: pathname url-of
: help-stylesheet ( stylesheet -- xml ) : help-stylesheet ( stylesheet -- xml )
"vocab:help/html/stylesheet.css" ascii file-contents "vocab:help/html/stylesheet.css" ascii file-contents
swap "\n" glue [XML <style><-></style> XML] ; swap "\n" glue XML-CHUNK[[ <style><-></style> ]] ;
: help-navbar ( -- xml ) : help-navbar ( -- xml )
"conventions" >link topic>filename "conventions" >link topic>filename
[XML XML-CHUNK[[
<div class="navbar"> <div class="navbar">
<b> Factor Documentation </b> | <b> Factor Documentation </b> |
<a href="/">Home</a> | <a href="/">Home</a> |
@ -84,7 +84,7 @@ M: pathname url-of
</form> </form>
<a href="http://factorcode.org" style="float:right; padding: 4px;">factorcode.org</a> <a href="http://factorcode.org" style="float:right; padding: 4px;">factorcode.org</a>
</div> </div>
XML] ; ]] ;
: bijective-base26 ( n -- name ) : bijective-base26 ( n -- name )
[ dup 0 > ] [ 1 - 26 /mod char: a + ] "" produce-as nip reverse! ; [ dup 0 > ] [ 1 - 26 /mod char: a + ] "" produce-as nip reverse! ;

2
basis/html/components/components-tests.factor
View File

@ -199,7 +199,7 @@ M: link-test link-href drop "http://www.apple.com/foo&bar" ;
! Test xml in html components ! Test xml in html components
{ } [ { } [
[XML <foo/> XML] "xmltest" set-value XML-CHUNK[[ <foo/> ]] "xmltest" set-value
] unit-test ] unit-test
{ "<foo/>" } [ { "<foo/>" } [

20
basis/html/components/components.factor
View File

@ -46,10 +46,10 @@ M: label render*
SINGLETON: hidden SINGLETON: hidden
M: hidden render* M: hidden render*
drop [XML <input value=<-> name=<-> type="hidden"/> XML] ; drop XML-CHUNK[[ <input value=<-> name=<-> type="hidden"/> ]] ;
: render-field ( value name size type -- xml ) : render-field ( value name size type -- xml )
[XML <input value=<-> name=<-> size=<-> type=<->/> XML] ; XML-CHUNK[[ <input value=<-> name=<-> size=<-> type=<->/> ]] ;
TUPLE: field size ; TUPLE: field size ;
@ -77,12 +77,12 @@ TUPLE: textarea rows cols ;
M:: textarea render* ( value name area -- xml ) M:: textarea render* ( value name area -- xml )
area rows>> :> rows area rows>> :> rows
area cols>> :> cols area cols>> :> cols
[XML XML-CHUNK[[
<textarea <textarea
name=<-name-> name=<-name->
rows=<-rows-> rows=<-rows->
cols=<-cols->><-value-></textarea> cols=<-cols->><-value-></textarea>
XML] ; ]] ;
! Choice ! Choice
TUPLE: choice size multiple choices ; TUPLE: choice size multiple choices ;
@ -92,7 +92,7 @@ TUPLE: choice size multiple choices ;
: render-option ( text selected? -- xml ) : render-option ( text selected? -- xml )
"selected" and swap "selected" and swap
[XML <option selected=<->><-></option> XML] ; XML-CHUNK[[ <option selected=<->><-></option> ]] ;
: render-options ( value choice -- xml ) : render-options ( value choice -- xml )
[ choices>> value ] [ multiple>> ] bi [ choices>> value ] [ multiple>> ] bi
@ -103,10 +103,10 @@ M:: choice render* ( value name choice -- xml )
choice size>> :> size choice size>> :> size
choice multiple>> "true" and :> multiple choice multiple>> "true" and :> multiple
value choice render-options :> contents value choice render-options :> contents
[XML <select XML-CHUNK[[ <select
name=<-name-> name=<-name->
size=<-size-> size=<-size->
multiple=<-multiple->><-contents-></select> XML] ; multiple=<-multiple->><-contents-></select> ]] ;
! Checkboxes ! Checkboxes
TUPLE: checkbox label ; TUPLE: checkbox label ;
@ -116,9 +116,9 @@ TUPLE: checkbox label ;
M: checkbox render* M: checkbox render*
[ "true" and ] [ ] [ label>> ] tri* [ "true" and ] [ ] [ label>> ] tri*
[XML <input XML-CHUNK[[ <input
type="checkbox" type="checkbox"
checked=<-> name=<->><-></input> XML] ; checked=<-> name=<->><-></input> ]] ;
! Link components ! Link components
GENERIC: link-title ( obj -- string ) GENERIC: link-title ( obj -- string )
@ -142,7 +142,7 @@ TUPLE: link target ;
M: link render* M: link render*
nip swap nip swap
[ target>> ] [ [ link-href ] [ link-title ] bi ] bi* [ target>> ] [ [ link-href ] [ link-title ] bi ] bi*
[XML <a target=<-> href=<->><-></a> XML] ; XML-CHUNK[[ <a target=<-> href=<->><-></a> ]] ;
! XMode code component ! XMode code component
TUPLE: code mode ; TUPLE: code mode ;

4
basis/html/forms/forms.factor
View File

@ -109,6 +109,6 @@ C: <validation-error-state> validation-error-state
: render-validation-errors ( -- ) : render-validation-errors ( -- )
form get errors>> form get errors>>
[ [
[ [XML <li><-></li> XML] ] map [ XML-CHUNK[[ <li><-></li> ]] ] map
[XML <ul class="errors"><-></ul> XML] write-xml XML-CHUNK[[ <ul class="errors"><-></ul> ]] write-xml
] unless-empty ; ] unless-empty ;

10
basis/html/html.factor
View File

@ -10,7 +10,7 @@ M: empty-prolog write-xml drop ;
: <empty-prolog> ( -- prolog ) \ empty-prolog new ; : <empty-prolog> ( -- prolog ) \ empty-prolog new ;
: simple-page ( title head body -- xml ) : simple-page ( title head body -- xml )
<XML XML-DOC[[
<!DOCTYPE html> <!DOCTYPE html>
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"> <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
<head> <head>
@ -19,13 +19,13 @@ M: empty-prolog write-xml drop ;
</head> </head>
<body><-></body> <body><-></body>
</html> </html>
XML> <empty-prolog> >>prolog ; ]] <empty-prolog> >>prolog ;
: render-error ( message -- xml ) : render-error ( message -- xml )
[XML <span class="error"><-></span> XML] ; XML-CHUNK[[ <span class="error"><-></span> ]] ;
: simple-link ( xml url -- xml' ) : simple-link ( xml url -- xml' )
url-encode swap [XML <a href=<->><-></a> XML] ; url-encode swap XML-CHUNK[[ <a href=<->><-></a> ]] ;
: simple-image ( url -- xml ) : simple-image ( url -- xml )
url-encode [XML <img src=<-> /> XML] ; url-encode XML-CHUNK[[ <img src=<-> /> ]] ;

12
basis/html/streams/streams.factor
View File

@ -72,7 +72,7 @@ MACRO: make-css ( pairs -- str )
: span-tag ( xml style -- xml ) : span-tag ( xml style -- xml )
span-css-style span-css-style
[ swap [XML <span style=<->><-></span> XML] ] unless-empty ; inline [ swap XML-CHUNK[[ <span style=<->><-></span> ]] ] unless-empty ; inline
: emit-html ( stream quot -- ) : emit-html ( stream quot -- )
dip data>> push ; inline dip data>> push ; inline
@ -125,7 +125,7 @@ CONSTANT: pre-css "white-space: pre; font-family: monospace; "
: div-tag ( xml style -- xml' ) : div-tag ( xml style -- xml' )
div-css-style div-css-style
[ swap [XML <div style=<->><-></div> XML] ] unless-empty ; [ swap XML-CHUNK[[ <div style=<->><-></div> ]] ] unless-empty ;
: format-html-div ( string style stream -- ) : format-html-div ( string style stream -- )
[ [ div-tag ] [ object-link-tag ] bi ] emit-html ; [ [ div-tag ] [ object-link-tag ] bi ] emit-html ;
@ -159,7 +159,7 @@ M: html-writer stream-format
format-html-span ; format-html-span ;
M: html-writer stream-nl M: html-writer stream-nl
[ [XML <br/> XML] ] emit-html ; [ XML-CHUNK[[ <br/> ]] ] emit-html ;
M: html-writer make-span-stream M: html-writer make-span-stream
html-span-stream new-html-sub-stream ; html-span-stream new-html-sub-stream ;
@ -173,10 +173,10 @@ M: html-writer make-cell-stream
M: html-writer stream-write-table M: html-writer stream-write-table
[ [
table-style swap [ table-style swap [
[ data>> [XML <td valign="top" style=<->><-></td> XML] ] with map [ data>> XML-CHUNK[[ <td valign="top" style=<->><-></td> ]] ] with map
[XML <tr><-></tr> XML] XML-CHUNK[[ <tr><-></tr> ]]
] with map ] with map
[XML <table style="display: inline-table; border-collapse: collapse;"><-></table> XML] XML-CHUNK[[ <table style="display: inline-table; border-collapse: collapse;"><-></table> ]]
] emit-html ; ] emit-html ;
M: html-writer dispose drop ; M: html-writer dispose drop ;

2
basis/html/templates/chloe/chloe-docs.factor
View File

@ -274,7 +274,7 @@ ARTICLE: "html.templates.chloe.extend.components.example" "An example of a custo
"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:" "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" } { $code "SINGLETON: image" }
"Now we define a method on the " { $link render* } " generic word which renders the image using " { $link { "xml.syntax" "literals" } } ":" "Now we define a method on the " { $link render* } " generic word which renders the image using " { $link { "xml.syntax" "literals" } } ":"
{ $code "M: image render* 2drop [XML <img src=<-> /> XML] ;" } { $code "M: image render* 2drop XML-CHUNK[[ <img src=<-> /> ]] ;" }
"Finally, we can define a Chloe component:" "Finally, we can define a Chloe component:"
{ $code "COMPONENT: image" } { $code "COMPONENT: image" }
"We can use it as follows, assuming the current form has a value named " { $snippet "image" } ":" "We can use it as follows, assuming the current form has a value named " { $snippet "image" } ":"

4
basis/html/templates/chloe/chloe.factor
View File

@ -19,7 +19,7 @@ CHLOE: write-title
drop drop
"head" tag-stack get member? "head" tag-stack get member?
"title" tag-stack get member? not and "title" tag-stack get member? not and
[ get-title [XML <title><-></title> XML] ] [ get-title XML-CHUNK[[ <title><-></title> ]] ]
[ get-title ] ? [ get-title ] ?
[xml-code] ; [xml-code] ;
@ -33,7 +33,7 @@ CHLOE: style
CHLOE: write-style CHLOE: write-style
drop [ drop [
get-style get-style
[XML <style type="text/css"> <-> </style> XML] XML-CHUNK[[ <style type="text/css"> <-> </style> ]]
] [xml-code] ; ] [xml-code] ;
CHLOE: even CHLOE: even

4
basis/html/templates/templates.factor
View File

@ -66,13 +66,13 @@ SYMBOL: atom-feeds
: get-atom-feeds ( -- xml ) : get-atom-feeds ( -- xml )
atom-feeds get [ atom-feeds get [
[XML XML-CHUNK[[
<link <link
rel="alternate" rel="alternate"
type="application/atom+xml" type="application/atom+xml"
title=<-> title=<->
href=<->/> href=<->/>
XML] ]]
] { } assoc>map ; ] { } assoc>map ;
: write-atom-feeds ( -- ) : write-atom-feeds ( -- )

4
basis/http/server/responses/responses.factor
View File

@ -19,14 +19,14 @@ IN: http.server.responses
"text/html" <content> ; "text/html" <content> ;
: trivial-response-body ( code message -- ) : trivial-response-body ( code message -- )
<XML XML-DOC[[
<!DOCTYPE html> <!DOCTYPE html>
<html> <html>
<body> <body>
<h1><-> <-></h1> <h1><-> <-></h1>
</body> </body>
</html> </html>
XML> write-xml ; ]] write-xml ;
: <trivial-response> ( code message -- response ) : <trivial-response> ( code message -- response )
2dup [ trivial-response-body ] with-string-writer 2dup [ trivial-response-body ] with-string-writer

8
basis/http/server/static/static.factor
View File

@ -59,13 +59,13 @@ TUPLE: file-responder root hook special index-names allow-listings ;
\ serve-file NOTICE add-input-logging \ serve-file NOTICE add-input-logging
:: file-html-template ( href size modified -- xml ) :: file-html-template ( href size modified -- xml )
[XML XML-CHUNK[[
<tr> <tr>
<td><a href=<-href->><-href-></a></td> <td><a href=<-href->><-href-></a></td>
<td align="right"><-modified-></td> <td align="right"><-modified-></td>
<td align="right"><-size-></td> <td align="right"><-size-></td>
</tr> </tr>
XML] ; ]] ;
: file>html ( name infos -- xml ) : file>html ( name infos -- xml )
[ [
@ -84,7 +84,7 @@ TUPLE: file-responder root hook special index-names allow-listings ;
url get [ path>> "Index of " prepend ] [ "" ] if* ; url get [ path>> "Index of " prepend ] [ "" ] if* ;
:: listing-html-template ( title listing ?parent CO-N CO-M CO-S -- xml ) :: listing-html-template ( title listing ?parent CO-N CO-M CO-S -- xml )
[XML <h1><-title-></h1> XML-CHUNK[[ <h1><-title-></h1>
<table> <table>
<tr> <tr>
<th><a href=<-CO-N->>Name</a></th> <th><a href=<-CO-N->>Name</a></th>
@ -96,7 +96,7 @@ TUPLE: file-responder root hook special index-names allow-listings ;
<-listing-> <-listing->
<tr><th colspan="5"><hr/></th></tr> <tr><th colspan="5"><hr/></th></tr>
</table> </table>
XML] ; ]] ;
: sort-column ( -- column ) params get "C" of "N" or ; : sort-column ( -- column ) params get "C" of "N" or ;

16
basis/lcs/diff2html/diff2html.factor
View File

@ -11,30 +11,30 @@ GENERIC: diff-line ( obj -- xml )
M: retain diff-line M: retain diff-line
item-string item-string
[XML <td class="retain"><-></td> XML] XML-CHUNK[[ <td class="retain"><-></td> ]]
dup [XML <tr><-><-></tr> XML] ; dup XML-CHUNK[[ <tr><-><-></tr> ]] ;
M: insert diff-line M: insert diff-line
item-string [XML item-string XML-CHUNK[[
<tr> <tr>
<td> </td> <td> </td>
<td class="insert"><-></td> <td class="insert"><-></td>
</tr> </tr>
XML] ; ]] ;
M: delete diff-line M: delete diff-line
item-string [XML item-string XML-CHUNK[[
<tr> <tr>
<td class="delete"><-></td> <td class="delete"><-></td>
<td> </td> <td> </td>
</tr> </tr>
XML] ; ]] ;
: htmlize-diff ( diff -- xml ) : htmlize-diff ( diff -- xml )
[ diff-line ] map [ diff-line ] map
[XML XML-CHUNK[[
<table width="100%" class="comparison"> <table width="100%" class="comparison">
<tr><th>Old</th><th>New</th></tr> <tr><th>Old</th><th>New</th></tr>
<-> <->
</table> </table>
XML] ; ]] ;

8
basis/syndication/syndication.factor
View File

@ -119,23 +119,23 @@ M: byte-array parse-feed [ bytes>xml xml>feed ] with-html-entities ;
[ date>> timestamp>rfc3339 ] [ date>> timestamp>rfc3339 ]
[ description>> ] [ description>> ]
} cleave } cleave
[XML XML-CHUNK[[
<entry> <entry>
<title type="html"><-></title> <title type="html"><-></title>
<link rel="alternate" href=<-> /> <link rel="alternate" href=<-> />
<published><-></published> <published><-></published>
<content type="html"><-></content> <content type="html"><-></content>
</entry> </entry>
XML] ; ]] ;
: feed>xml ( feed -- xml ) : feed>xml ( feed -- xml )
[ title>> ] [ title>> ]
[ url>> present ] [ url>> present ]
[ entries>> [ entry>xml ] map ] tri [ entries>> [ entry>xml ] map ] tri
<XML XML-DOC[[
<feed xmlns="http://www.w3.org/2005/Atom"> <feed xmlns="http://www.w3.org/2005/Atom">
<title><-></title> <title><-></title>
<link rel="alternate" href=<-> /> <link rel="alternate" href=<-> />
<-> <->
</feed> </feed>
XML> ; ]] ;

2
basis/tools/deploy/test/20/20.factor
View File

@ -2,7 +2,7 @@ USING: io xml.syntax xml.writer ;
IN: tools.deploy.test.20 IN: tools.deploy.test.20
: test-xml ( str -- str' ) : test-xml ( str -- str' )
<XML <foo><-></foo> XML> xml>string ; XML-DOC[[ <foo><-></foo> ]] xml>string ;
: main ( -- ) : main ( -- )
"Factor" test-xml print ; "Factor" test-xml print ;

34
basis/xml-rpc/xml-rpc.factor
View File

@ -16,34 +16,34 @@ GENERIC: item>xml ( object -- xml )
M: integer item>xml M: integer item>xml
dup 31 2^ neg 31 2^ 1 - between? dup 31 2^ neg 31 2^ 1 - between?
[ "Integers must fit in 32 bits" throw ] unless [ "Integers must fit in 32 bits" throw ] unless
[XML <i4><-></i4> XML] ; XML-CHUNK[[ <i4><-></i4> ]] ;
M: boolean item>xml M: boolean item>xml
"1" "0" ? [XML <boolean><-></boolean> XML] ; "1" "0" ? XML-CHUNK[[ <boolean><-></boolean> ]] ;
M: float item>xml M: float item>xml
number>string [XML <double><-></double> XML] ; number>string XML-CHUNK[[ <double><-></double> ]] ;
M: string item>xml M: string item>xml
[XML <string><-></string> XML] ; XML-CHUNK[[ <string><-></string> ]] ;
: struct-member ( name value -- tag ) : struct-member ( name value -- tag )
over string? [ "Struct member name must be string" throw ] unless over string? [ "Struct member name must be string" throw ] unless
item>xml item>xml
[XML XML-CHUNK[[
<member> <member>
<name><-></name> <name><-></name>
<value><-></value> <value><-></value>
</member> </member>
XML] ; ]] ;
M: hashtable item>xml M: hashtable item>xml
[ struct-member ] { } assoc>map [ struct-member ] { } assoc>map
[XML <struct><-></struct> XML] ; XML-CHUNK[[ <struct><-></struct> ]] ;
M: array item>xml M: array item>xml
[ item>xml [XML <value><-></value> XML] ] map [ item>xml XML-CHUNK[[ <value><-></value> ]] ] map
[XML <array><data><-></data></array> XML] ; XML-CHUNK[[ <array><data><-></data></array> ]] ;
TUPLE: base64 string ; TUPLE: base64 string ;
@ -51,33 +51,33 @@ C: <base64> base64
M: base64 item>xml M: base64 item>xml
string>> >base64 string>> >base64
[XML <base64><-></base64> XML] ; XML-CHUNK[[ <base64><-></base64> ]] ;
: params ( seq -- xml ) : params ( seq -- xml )
[ item>xml [XML <param><value><-></value></param> XML] ] map [ item>xml XML-CHUNK[[ <param><value><-></value></param> ]] ] map
[XML <params><-></params> XML] ; XML-CHUNK[[ <params><-></params> ]] ;
: method-call ( name seq -- xml ) : method-call ( name seq -- xml )
params params
<XML XML-DOC[[
<methodCall> <methodCall>
<methodName><-></methodName> <methodName><-></methodName>
<-> <->
</methodCall> </methodCall>
XML> ; ]] ;
: return-params ( seq -- xml ) : return-params ( seq -- xml )
params <XML <methodResponse><-></methodResponse> XML> ; params XML-DOC[[ <methodResponse><-></methodResponse> ]] ;
: return-fault ( fault-code fault-string -- xml ) : return-fault ( fault-code fault-string -- xml )
[ "faultString" ,, "faultCode" ,, ] H{ } make item>xml [ "faultString" ,, "faultCode" ,, ] H{ } make item>xml
<XML XML-DOC[[
<methodResponse> <methodResponse>
<fault> <fault>
<value><-></value> <value><-></value>
</fault> </fault>
</methodResponse> </methodResponse>
XML> ; ]] ;
TUPLE: rpc-method name params ; TUPLE: rpc-method name params ;

34
basis/xml/syntax/syntax-docs.factor
View File

@ -35,29 +35,29 @@ HELP: TAG:
ARTICLE: { "xml.syntax" "literals" } "XML literals" ARTICLE: { "xml.syntax" "literals" } "XML literals"
"The following words provide syntax for XML literals:" "The following words provide syntax for XML literals:"
{ $subsections { $subsections
postpone: <XML postpone: XML-DOC[[
postpone: [XML postpone: XML-CHUNK[[
} }
"These can be used for creating an XML literal, which can be used with variables or a fry-like syntax to interpolate data into XML." "These can be used for creating an XML literal, which can be used with variables or a fry-like syntax to interpolate data into XML."
{ $subsections { "xml.syntax" "interpolation" } } ; { $subsections { "xml.syntax" "interpolation" } } ;
HELP: <XML HELP: XML-DOC[[
{ $syntax "<XML <?xml version=\"1.0\"?><document>...</document> XML>" } { $syntax "XML-DOC[[ <?xml version=\"1.0\"?><document>...</document> ]]" }
{ $description "This gives syntax for literal XML documents. When evaluated, there is an XML document (" { $link xml } ") on the stack. It can be used for interpolation as well, if interpolation slots are used. For more information about XML interpolation, see " { $link { "xml.syntax" "interpolation" } } "." } ; { $description "This gives syntax for literal XML documents. When evaluated, there is an XML document (" { $link xml } ") on the stack. It can be used for interpolation as well, if interpolation slots are used. For more information about XML interpolation, see " { $link { "xml.syntax" "interpolation" } } "." } ;
HELP: [XML HELP: XML-CHUNK[[
{ $syntax "[XML foo <x>...</x> bar <y>...</y> baz XML]" } { $syntax "XML-CHUNK[[ foo <x>...</x> bar <y>...</y> baz ]]" }
{ $description "This gives syntax for literal XML documents. When evaluated, there is an XML chunk (" { $link xml-chunk } ") on the stack. For more information about XML interpolation, see " { $link { "xml.syntax" "interpolation" } } "." } ; { $description "This gives syntax for literal XML documents. When evaluated, there is an XML chunk (" { $link xml-chunk } ") on the stack. For more information about XML interpolation, see " { $link { "xml.syntax" "interpolation" } } "." } ;
ARTICLE: { "xml.syntax" "interpolation" } "XML interpolation syntax" ARTICLE: { "xml.syntax" "interpolation" } "XML interpolation syntax"
"XML interpolation has two forms for each of the words " { $link postpone: <XML } " and " { $link postpone: [XML } ": a fry-like form and a locals form. To splice locals in, use the syntax " { $snippet "<-variable->" } ". To splice something in from the stack, in the style of " { $vocab-link "fry" } ", use the syntax " { $snippet "<->" } ". An XML interpolation form may only use one of these styles." "XML interpolation has two forms for each of the words " { $link postpone: XML-DOC[[ } " and " { $link postpone: XML-CHUNK[[ } ": a fry-like form and a locals form. To splice locals in, use the syntax " { $snippet "<-variable->" } ". To splice something in from the stack, in the style of " { $vocab-link "fry" } ", use the syntax " { $snippet "<->" } ". An XML interpolation form may only use one of these styles."
$nl $nl
"These forms can be used where a tag might go, as in " { $snippet "[XML <foo><-></foo> XML]" } " or where an attribute might go, as in " { $snippet "[XML <foo bar=<->/> XML]" } ". When an attribute is spliced in, it is not included if the value is " { $snippet "f" } " and if the value is not a string, the value is put through " { $link present } ". Here is an example of the fry style of XML interpolation:" "These forms can be used where a tag might go, as in " { $snippet "XML-CHUNK[[ <foo><-></foo> ]]" } " or where an attribute might go, as in " { $snippet "XML-CHUNK[[ <foo bar=<->/> ]]" } ". When an attribute is spliced in, it is not included if the value is " { $snippet "f" } " and if the value is not a string, the value is put through " { $link present } ". Here is an example of the fry style of XML interpolation:"
{ $example { $example
"USING: splitting xml.writer xml.syntax ; "USING: splitting xml.writer xml.syntax ;
\"one two three\" \" \" split \"one two three\" \" \" split
[ [XML <item><-></item> XML] ] map [ XML-CHUNK[[ <item><-></item> ]] ] map
<XML <doc><-></doc> XML> pprint-xml" XML-DOC[[ <doc><-></doc> ]] pprint-xml"
"<?xml version=\"1.0\" encoding=\"UTF-8\"?> "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
<doc> <doc>
@ -80,14 +80,14 @@ let[
URL\" http://factorcode.org/\" :> url URL\" http://factorcode.org/\" :> url
\"hello\" :> string \"hello\" :> string
\\ drop :> word \\ drop :> word
<XML XML-DOC[[
<x <x
number=<-number-> number=<-number->
false=<-false-> false=<-false->
url=<-url-> url=<-url->
string=<-string-> string=<-string->
word=<-word-> /> word=<-word-> />
XML> pprint-xml ]] pprint-xml
]" ]"
"<?xml version=\"1.0\" encoding=\"UTF-8\"?> "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
@ -96,12 +96,12 @@ let[
{ $example "USING: xml.syntax inverse ; { $example "USING: xml.syntax inverse ;
: dispatch ( xml -- string ) : dispatch ( xml -- string )
{ {
{ [ [XML <a><-></a> XML] ] [ \"a\" prepend ] } { [ XML-CHUNK[[ <a><-></a> ]] ] [ \"a\" prepend ] }
{ [ [XML <b><-></b> XML] ] [ \"b\" prepend ] } { [ XML-CHUNK[[ <b><-></b> ]] ] [ \"b\" prepend ] }
{ [ [XML <b val='yes'/> XML] ] [ \"yes\" ] } { [ XML-CHUNK[[ <b val='yes'/> ]] ] [ \"yes\" ] }
{ [ [XML <b val=<->/> XML] ] [ \"no\" prepend ] } { [ XML-CHUNK[[ <b val=<->/> ]] ] [ \"no\" prepend ] }
} switch ; } switch ;
[XML <a>pple</a> XML] dispatch write" XML-CHUNK[[ <a>pple</a> ]] dispatch write"
"apple" } ; "apple" } ;
HELP: XML-NS: HELP: XML-NS:

82
basis/xml/syntax/syntax-tests.factor
View File

@ -55,10 +55,10 @@ XML-NS: foo http://blah.com
y y
<foo/> <foo/>
</x>" } [ </x>" } [
let[ "one" :> a "two" :> c "y" :> x [XML <-x-> <foo/> XML] :> d let[ "one" :> a "two" :> c "y" :> x XML-CHUNK[[ <-x-> <foo/> ]] :> d
<XML XML-DOC[[
<x> <-a-> <b val=<-c->/> <-d-> </x> <x> <-a-> <b val=<-c->/> <-d-> </x>
XML> pprint-xml>string ]] pprint-xml>string
] ]
] unit-test ] unit-test
@ -75,69 +75,69 @@ XML-NS: foo http://blah.com
</item> </item>
</doc>" } [ </doc>" } [
"one two three" " " split "one two three" " " split
[ [XML <item><-></item> XML] ] map [ XML-CHUNK[[ <item><-></item> ]] ] map
<XML <doc><-></doc> XML> pprint-xml>string XML-DOC[[ <doc><-></doc> ]] pprint-xml>string
] unit-test ] unit-test
{ "<?xml version=\"1.0\" encoding=\"UTF-8\"?> { "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
<x number=\"3\" url=\"http://factorcode.org/\" string=\"hello\" word=\"drop\"/>" } <x number=\"3\" url=\"http://factorcode.org/\" string=\"hello\" word=\"drop\"/>" }
[ 3 f "http://factorcode.org/" "hello" \ drop [ 3 f "http://factorcode.org/" "hello" \ drop
<XML <x number=<-> false=<-> url=<-> string=<-> word=<->/> XML> XML-DOC[[ <x number=<-> false=<-> url=<-> string=<-> word=<->/> ]]
pprint-xml>string ] unit-test pprint-xml>string ] unit-test
{ "<x>3</x>" } [ 3 [XML <x><-></x> XML] xml>string ] unit-test { "<x>3</x>" } [ 3 XML-CHUNK[[ <x><-></x> ]] xml>string ] unit-test
{ "<x></x>" } [ f [XML <x><-></x> XML] xml>string ] unit-test { "<x></x>" } [ f XML-CHUNK[[ <x><-></x> ]] xml>string ] unit-test
[ [XML <-> XML] ] must-infer [ XML-CHUNK[[ <-> ]] ] must-infer
[ [XML <foo><-></foo> <bar val=<->/> XML] ] must-infer [ XML-CHUNK[[ <foo><-></foo> <bar val=<->/> ]] ] must-infer
{ xml-chunk } [ [ [XML <foo/> XML] ] first class-of ] unit-test { xml-chunk } [ [ XML-CHUNK[[ <foo/> ]] ] first class-of ] unit-test
{ xml } [ [ <XML <foo/> XML> ] first class-of ] unit-test { xml } [ [ XML-DOC[[ <foo/> ]] ] first class-of ] unit-test
{ xml-chunk } [ [ [XML <foo val=<->/> XML] ] third class-of ] unit-test { xml-chunk } [ [ XML-CHUNK[[ <foo val=<->/> ]] ] third class-of ] unit-test
{ xml } [ [ <XML <foo val=<->/> XML> ] third class-of ] unit-test { xml } [ [ XML-DOC[[ <foo val=<->/> ]] ] third class-of ] unit-test
{ 1 } [ [ [XML <foo/> XML] ] length ] unit-test { 1 } [ [ XML-CHUNK[[ <foo/> ]] ] length ] unit-test
{ 1 } [ [ <XML <foo/> XML> ] length ] unit-test { 1 } [ [ XML-DOC[[ <foo/> ]] ] length ] unit-test
{ "" } [ [XML XML] concat ] unit-test { "" } [ XML-CHUNK[[ ]] concat ] unit-test
{ "foo" } [ [XML <a>foo</a> XML] [ [XML <a><-></a> XML] ] undo ] unit-test { "foo" } [ XML-CHUNK[[ <a>foo</a> ]] [ XML-CHUNK[[ <a><-></a> ]] ] undo ] unit-test
{ "foo" } [ [XML <a bar='foo'/> XML] [ [XML <a bar=<-> /> XML] ] undo ] unit-test { "foo" } [ XML-CHUNK[[ <a bar='foo'/> ]] [ XML-CHUNK[[ <a bar=<-> /> ]] ] undo ] unit-test
{ "foo" "baz" } [ [XML <a bar='foo'>baz</a> XML] [ [XML <a bar=<->><-></a> XML] ] undo ] unit-test { "foo" "baz" } [ XML-CHUNK[[ <a bar='foo'>baz</a> ]] [ XML-CHUNK[[ <a bar=<->><-></a> ]] ] undo ] unit-test
: dispatch ( xml -- string ) : dispatch ( xml -- string )
{ {
{ [ [XML <a><-></a> XML] ] [ "a" prepend ] } { [ XML-CHUNK[[ <a><-></a> ]] ] [ "a" prepend ] }
{ [ [XML <b><-></b> XML] ] [ "b" prepend ] } { [ XML-CHUNK[[ <b><-></b> ]] ] [ "b" prepend ] }
{ [ [XML <b val='yes'/> XML] ] [ "byes" ] } { [ XML-CHUNK[[ <b val='yes'/> ]] ] [ "byes" ] }
{ [ [XML <b val=<->/> XML] ] [ "bno" prepend ] } { [ XML-CHUNK[[ <b val=<->/> ]] ] [ "bno" prepend ] }
} switch ; } switch ;
{ "apple" } [ [XML <a>pple</a> XML] dispatch ] unit-test { "apple" } [ XML-CHUNK[[ <a>pple</a> ]] dispatch ] unit-test
{ "banana" } [ [XML <b>anana</b> XML] dispatch ] unit-test { "banana" } [ XML-CHUNK[[ <b>anana</b> ]] dispatch ] unit-test
{ "byes" } [ [XML <b val="yes"/> XML] dispatch ] unit-test { "byes" } [ XML-CHUNK[[ <b val="yes"/> ]] dispatch ] unit-test
{ "bnowhere" } [ [XML <b val="where"/> XML] dispatch ] unit-test { "bnowhere" } [ XML-CHUNK[[ <b val="where"/> ]] dispatch ] unit-test
{ "baboon" } [ [XML <b val="something">aboon</b> XML] dispatch ] unit-test { "baboon" } [ XML-CHUNK[[ <b val="something">aboon</b> ]] dispatch ] unit-test
{ "apple" } [ <XML <a>pple</a> XML> dispatch ] unit-test { "apple" } [ XML-DOC[[ <a>pple</a> ]] dispatch ] unit-test
{ "apple" } [ <XML <a>pple</a> XML> body>> dispatch ] unit-test { "apple" } [ XML-DOC[[ <a>pple</a> ]] body>> dispatch ] unit-test
: dispatch-doc ( xml -- string ) : dispatch-doc ( xml -- string )
{ {
{ [ <XML <a><-></a> XML> ] [ "a" prepend ] } { [ XML-DOC[[ <a><-></a> ]] ] [ "a" prepend ] }
{ [ <XML <b><-></b> XML> ] [ "b" prepend ] } { [ XML-DOC[[ <b><-></b> ]] ] [ "b" prepend ] }
{ [ <XML <b val='yes'/> XML> ] [ "byes" ] } { [ XML-DOC[[ <b val='yes'/> ]] ] [ "byes" ] }
{ [ <XML <b val=<->/> XML> ] [ "bno" prepend ] } { [ XML-DOC[[ <b val=<->/> ]] ] [ "bno" prepend ] }
} switch ; } switch ;
{ "apple" } [ <XML <a>pple</a> XML> dispatch-doc ] unit-test { "apple" } [ XML-DOC[[ <a>pple</a> ]] dispatch-doc ] unit-test
{ "apple" } [ [XML <a>pple</a> XML] dispatch-doc ] unit-test { "apple" } [ XML-CHUNK[[ <a>pple</a> ]] dispatch-doc ] unit-test
{ "apple" } [ <XML <a>pple</a> XML> body>> dispatch-doc ] unit-test { "apple" } [ XML-DOC[[ <a>pple</a> ]] body>> dispatch-doc ] unit-test
! Make sure nested XML documents interpolate correctly ! Make sure nested XML documents interpolate correctly
{ {
"<?xml version=\"1.0\" encoding=\"UTF-8\"?><color><blue>it's blue!</blue></color>" "<?xml version=\"1.0\" encoding=\"UTF-8\"?><color><blue>it's blue!</blue></color>"
} [ } [
"it's blue!" <XML <blue><-></blue> XML> "it's blue!" XML-DOC[[ <blue><-></blue> ]]
<XML <color><-></color> XML> xml>string XML-DOC[[ <color><-></color> ]] xml>string
] unit-test ] unit-test
{ {
@ -147,5 +147,5 @@ XML-NS: foo http://blah.com
"asdf" "asdf"
"asdf" f f <tag> "asdf" f f <tag>
"asdf2" <xml> "asdf2" <xml>
<XML <a><-></a> XML> xml>string XML-DOC[[ <a><-></a> ]] xml>string
] unit-test ] unit-test

10
basis/xml/syntax/syntax.factor
View File

@ -170,11 +170,13 @@ MACRO: interpolate-xml ( xml -- quot )
PRIVATE> PRIVATE>
SYNTAX: <XML SYNTAX: \XML-DOC[[ "]]" [ string>doc ] parse-def ;
"XML>" [ string>doc ] parse-def ; SYNTAX: \XML-DOC[=[ "]=]" [ string>doc ] parse-def ;
SYNTAX: \XML-DOC[==[ "]==]" [ string>doc ] parse-def ;
SYNTAX: [XML SYNTAX: \XML-CHUNK[[ "]]" [ string>chunk ] parse-def ;
"XML]" [ string>chunk ] parse-def ; SYNTAX: \XML-CHUNK[=[ "]=]" [ string>chunk ] parse-def ;
SYNTAX: \XML-CHUNK[==[ "]==]" [ string>chunk ] parse-def ;
USE: vocabs.loader USE: vocabs.loader

12
basis/xml/tests/templating.factor
View File

@ -20,17 +20,14 @@ M: object (r-ref) drop ;
! Example ! Example
CONSTANT: sample-doc [[ CONSTANT: sample-doc [[ <html xmlns:f='http://littledan.onigirihouse.com/namespaces/replace'>
<html xmlns:f='http://littledan.onigirihouse.com/namespaces/replace'>
<body> <body>
<span f:sub='foo'/> <span f:sub='foo'/>
<div f:sub='bar'/> <div f:sub='bar'/>
<p f:sub='baz'>paragraph</p> <p f:sub='baz'>paragraph</p>
</body></html> </body></html>]]
]]
CONSTANT: expected-result [[ CONSTANT: expected-result [[ <?xml version="1.0" encoding="UTF-8"?>
<?xml version="1.0" encoding="UTF-8"?>
<html xmlns:f="http://littledan.onigirihouse.com/namespaces/replace"> <html xmlns:f="http://littledan.onigirihouse.com/namespaces/replace">
<body> <body>
<span f:sub="foo"> <span f:sub="foo">
@ -42,8 +39,7 @@ CONSTANT: expected-result [[
</div> </div>
<p f:sub="baz"/> <p f:sub="baz"/>
</body> </body>
</html> </html>]]
]]
: test-refs ( -- string ) : test-refs ( -- string )
[ [

6
basis/xml/writer/writer-docs.factor
View File

@ -48,7 +48,7 @@ HELP: pprint-xml
HELP: indenter HELP: indenter
{ $var-description "Contains the string which is used for indenting in the XML prettyprinter. For example, to print an XML document using " { $snippet "%%%%" } " for indentation, you can use the following:" } { $var-description "Contains the string which is used for indenting in the XML prettyprinter. For example, to print an XML document using " { $snippet "%%%%" } " for indentation, you can use the following:" }
{ $example "USING: xml.syntax xml.writer namespaces ; { $example "USING: xml.syntax xml.writer namespaces ;
[XML <foo>bar</foo> XML] \"%%%%\" indenter [ pprint-xml ] with-variable " " XML-CHUNK[[ <foo>bar</foo> ]] \"%%%%\" indenter [ pprint-xml ] with-variable " "
<foo> <foo>
%%%%bar %%%%bar
</foo>" } ; </foo>" } ;
@ -56,9 +56,9 @@ HELP: indenter
HELP: sensitive-tags HELP: sensitive-tags
{ $var-description "Contains a sequence of " { $link name } "s where whitespace should be considered significant for prettyprinting purposes. The sequence can contain " { $link string } "s in place of names. For example, to preserve whitespace inside a " { $snippet "pre" } " tag:" } { $var-description "Contains a sequence of " { $link name } "s where whitespace should be considered significant for prettyprinting purposes. The sequence can contain " { $link string } "s in place of names. For example, to preserve whitespace inside a " { $snippet "pre" } " tag:" }
{ $example "USING: xml.syntax xml.writer namespaces ; { $example "USING: xml.syntax xml.writer namespaces ;
[XML <!DOCTYPE html> <html> <head> <title> something</title></head><body><pre>bing XML-CHUNK[[ <!DOCTYPE html> <html> <head> <title> something</title></head><body><pre>bing
bang bang
bong</pre></body></html> XML] { \"pre\" } sensitive-tags [ pprint-xml ] with-variable" bong</pre></body></html> ]] { \"pre\" } sensitive-tags [ pprint-xml ] with-variable"
" "
<!DOCTYPE html> <!DOCTYPE html>
<html> <html>

4
basis/xml/writer/writer-tests.factor
View File

@ -71,8 +71,8 @@ IN: xml.writer.tests
{ } [ { } [
{ 1 2 3 4 } [ { 1 2 3 4 } [
[ number>string ] [ sq number>string ] bi [ number>string ] [ sq number>string ] bi
[XML <tr><td><-></td><td><-></td></tr> XML] XML-CHUNK[[ <tr><td><-></td><td><-></td></tr> ]]
] map [XML <h2>Timings</h2> <table><-></table> XML] ] map XML-CHUNK[[ <h2>Timings</h2> <table><-></table> ]]
pprint-xml pprint-xml
] unit-test ] unit-test

8
basis/xmode/code2html/code2html.factor
View File

@ -7,7 +7,7 @@ IN: xmode.code2html
[ [
[ str>> ] [ id>> ] bi [ [ str>> ] [ id>> ] bi [
name>> swap name>> swap
[XML <span class=<->><-></span> XML] XML-CHUNK[[ <span class=<->><-></span> ]]
] when* ] when*
] map ; ] map ;
@ -21,14 +21,14 @@ IN: xmode.code2html
: default-stylesheet ( -- xml ) : default-stylesheet ( -- xml )
"resource:basis/xmode/code2html/stylesheet.css" "resource:basis/xmode/code2html/stylesheet.css"
utf8 file-contents utf8 file-contents
[XML <style><-></style> XML] ; XML-CHUNK[[ <style><-></style> ]] ;
:: htmlize-stream ( path stream -- xml ) :: htmlize-stream ( path stream -- xml )
stream stream-lines stream stream-lines
[ "" ] [ path over first find-mode htmlize-lines ] [ "" ] [ path over first find-mode htmlize-lines ]
if-empty :> input if-empty :> input
default-stylesheet :> stylesheet default-stylesheet :> stylesheet
<XML <!DOCTYPE html> <html> XML-DOC[[ <!DOCTYPE html> <html>
<head> <head>
<-stylesheet-> <-stylesheet->
<title><-path-></title> <title><-path-></title>
@ -36,7 +36,7 @@ IN: xmode.code2html
<body> <body>
<pre><-input-></pre> <pre><-input-></pre>
</body> </body>
</html> XML> ; </html> ]] ;
: htmlize-file ( path -- ) : htmlize-file ( path -- )
dup utf8 [ dup utf8 [

62
extra/codebook/codebook.factor
View File

@ -16,23 +16,23 @@ IN: codebook
CONSTANT: codebook-style CONSTANT: codebook-style
{ {
{ COMMENT1 [ [XML <i><font color="#555555"><-></font></i> XML] ] } { COMMENT1 [ XML-CHUNK[[ <i><font color="#555555"><-></font></i> ]] ] }
{ COMMENT2 [ [XML <i><font color="#555555"><-></font></i> XML] ] } { COMMENT2 [ XML-CHUNK[[ <i><font color="#555555"><-></font></i> ]] ] }
{ COMMENT3 [ [XML <i><font color="#555555"><-></font></i> XML] ] } { COMMENT3 [ XML-CHUNK[[ <i><font color="#555555"><-></font></i> ]] ] }
{ COMMENT4 [ [XML <i><font color="#555555"><-></font></i> XML] ] } { COMMENT4 [ XML-CHUNK[[ <i><font color="#555555"><-></font></i> ]] ] }
{ DIGIT [ [XML <font color="#333333"><-></font> XML] ] } { DIGIT [ XML-CHUNK[[ <font color="#333333"><-></font> ]] ] }
{ FUNCTION [ [XML <b><font color="#111111"><-></font></b> XML] ] } { FUNCTION [ XML-CHUNK[[ <b><font color="#111111"><-></font></b> ]] ] }
{ KEYWORD1 [ [XML <b><font color="#111111"><-></font></b> XML] ] } { KEYWORD1 [ XML-CHUNK[[ <b><font color="#111111"><-></font></b> ]] ] }
{ KEYWORD2 [ [XML <b><font color="#111111"><-></font></b> XML] ] } { KEYWORD2 [ XML-CHUNK[[ <b><font color="#111111"><-></font></b> ]] ] }
{ KEYWORD3 [ [XML <b><font color="#111111"><-></font></b> XML] ] } { KEYWORD3 [ XML-CHUNK[[ <b><font color="#111111"><-></font></b> ]] ] }
{ KEYWORD4 [ [XML <b><font color="#111111"><-></font></b> XML] ] } { KEYWORD4 [ XML-CHUNK[[ <b><font color="#111111"><-></font></b> ]] ] }
{ LABEL [ [XML <b><font color="#333333"><-></font></b> XML] ] } { LABEL [ XML-CHUNK[[ <b><font color="#333333"><-></font></b> ]] ] }
{ LITERAL1 [ [XML <font color="#333333"><-></font> XML] ] } { LITERAL1 [ XML-CHUNK[[ <font color="#333333"><-></font> ]] ] }
{ LITERAL2 [ [XML <font color="#333333"><-></font> XML] ] } { LITERAL2 [ XML-CHUNK[[ <font color="#333333"><-></font> ]] ] }
{ LITERAL3 [ [XML <font color="#333333"><-></font> XML] ] } { LITERAL3 [ XML-CHUNK[[ <font color="#333333"><-></font> ]] ] }
{ LITERAL4 [ [XML <font color="#333333"><-></font> XML] ] } { LITERAL4 [ XML-CHUNK[[ <font color="#333333"><-></font> ]] ] }
{ MARKUP [ [XML <b><font color="#333333"><-></font></b> XML] ] } { MARKUP [ XML-CHUNK[[ <b><font color="#333333"><-></font></b> ]] ] }
{ OPERATOR [ [XML <b><font color="#111111"><-></font></b> XML] ] } { OPERATOR [ XML-CHUNK[[ <b><font color="#111111"><-></font></b> ]] ] }
[ drop ] [ drop ]
} }
@ -70,7 +70,7 @@ TUPLE: code-file
: toc-list ( files -- list ) : toc-list ( files -- list )
[ name>> ] map natural-sort [ [ name>> ] map natural-sort [
[ file-html-name ] keep [ file-html-name ] keep
[XML <li><a href=<->><-></a></li> XML] XML-CHUNK[[ <li><a href=<->><-></a></li> ]]
] map ; ] map ;
! insert zero-width non-joiner between all characters so words can wrap anywhere ! insert zero-width non-joiner between all characters so words can wrap anywhere
@ -82,7 +82,7 @@ TUPLE: code-file
: htmlize-tokens ( tokens line# -- html-tokens ) : htmlize-tokens ( tokens line# -- html-tokens )
swap [ swap [
[ str>> zwnj ] [ id>> ] bi codebook-style case [ str>> zwnj ] [ id>> ] bi codebook-style case
] map [XML <tt><font size="-2" color="#666666"><-></font> <-></tt> XML] ] map XML-CHUNK[[ <tt><font size="-2" color="#666666"><-></font> <-></tt> ]]
"\n" 2array ; "\n" 2array ;
: line#>string ( i line#len -- i-string ) : line#>string ( i line#len -- i-string )
@ -96,7 +96,7 @@ TUPLE: code-file
file mode>> load-mode :> rules file mode>> load-mode :> rules
f lines |[ l i | l rules tokenize-line i 1 + line#len line#>string htmlize-tokens ] f lines |[ l i | l rules tokenize-line i 1 + line#len line#>string htmlize-tokens ]
map-index concat nip :> html-lines map-index concat nip :> html-lines
<XML <!DOCTYPE html> <html> XML-DOC[[ <!DOCTYPE html> <html>
<head> <head>
<title><-name-></title> <title><-name-></title>
<meta http-equiv="Content-type" content="text/html; charset=utf-8" /> <meta http-equiv="Content-type" content="text/html; charset=utf-8" />
@ -106,7 +106,7 @@ TUPLE: code-file
<pre><-html-lines-></pre> <pre><-html-lines-></pre>
<mbp:pagebreak xmlns:mbp="http://www.mobipocket.com/mbp" /> <mbp:pagebreak xmlns:mbp="http://www.mobipocket.com/mbp" />
</body> </body>
</html> XML> ; </html> ]] ;
:: code>toc-html ( dir name files -- html ) :: code>toc-html ( dir name files -- html )
"Generating HTML table of contents" print flush "Generating HTML table of contents" print flush
@ -116,7 +116,7 @@ TUPLE: code-file
dir [ dir [
files toc-list :> toc files toc-list :> toc
<XML <!DOCTYPE html> <html> XML-DOC[[ <!DOCTYPE html> <html>
<head> <head>
<title><-name-></title> <title><-name-></title>
<meta http-equiv="Content-type" content="text/html; charset=utf-8" /> <meta http-equiv="Content-type" content="text/html; charset=utf-8" />
@ -130,7 +130,7 @@ TUPLE: code-file
<ul><-toc-></ul> <ul><-toc-></ul>
<mbp:pagebreak xmlns:mbp="http://www.mobipocket.com/mbp" /> <mbp:pagebreak xmlns:mbp="http://www.mobipocket.com/mbp" />
</body> </body>
</html> XML> </html> ]]
] with-directory ; ] with-directory ;
:: code>ncx ( dir name files -- xml ) :: code>ncx ( dir name files -- xml )
@ -141,13 +141,13 @@ TUPLE: code-file
name file-html-name :> filename name file-html-name :> filename
i 2 + number>string :> istr i 2 + number>string :> istr
[XML <navPoint class="book" id=<-filename-> playOrder=<-istr->> XML-CHUNK[[ <navPoint class="book" id=<-filename-> playOrder=<-istr->>
<navLabel><text><-name-></text></navLabel> <navLabel><text><-name-></text></navLabel>
<content src=<-filename-> /> <content src=<-filename-> />
</navPoint> XML] </navPoint> ]]
] map-index :> file-nav-points ] map-index :> file-nav-points
<XML <?xml version="1.0" encoding="UTF-8" ?> XML-DOC[[ <?xml version="1.0" encoding="UTF-8" ?>
<ncx version="2005-1" xmlns="http://www.daisy.org/z3986/2005/ncx/"> <ncx version="2005-1" xmlns="http://www.daisy.org/z3986/2005/ncx/">
<navMap> <navMap>
<navPoint class="book" id="toc" playOrder="1"> <navPoint class="book" id="toc" playOrder="1">
@ -156,7 +156,7 @@ TUPLE: code-file
</navPoint> </navPoint>
<-file-nav-points-> <-file-nav-points->
</navMap> </navMap>
</ncx> XML> ; </ncx> ]] ;
:: code>opf ( dir name files -- xml ) :: code>opf ( dir name files -- xml )
"Generating OPF manifest" print flush "Generating OPF manifest" print flush
@ -164,12 +164,12 @@ TUPLE: code-file
files [ files [
name>> file-html-name dup name>> file-html-name dup
[XML <item id=<-> href=<-> media-type="text/html" /> XML] XML-CHUNK[[ <item id=<-> href=<-> media-type="text/html" /> ]]
] map :> html-manifest ] map :> html-manifest
files [ name>> file-html-name [XML <itemref idref=<-> /> XML] ] map :> html-spine files [ name>> file-html-name XML-CHUNK[[ <itemref idref=<-> /> ]] ] map :> html-spine
<XML <?xml version="1.0" encoding="UTF-8" ?> XML-DOC[[ <?xml version="1.0" encoding="UTF-8" ?>
<package <package
version="2.0" version="2.0"
xmlns="http://www.idpf.org/2007/opf" xmlns="http://www.idpf.org/2007/opf"
@ -192,7 +192,7 @@ TUPLE: code-file
<guide> <guide>
<reference type="toc" title="Table of Contents" href="_toc.html" /> <reference type="toc" title="Table of Contents" href="_toc.html" />
</guide> </guide>
</package> XML> ; </package> ]] ;
: write-dest-file ( xml name ext -- ) : write-dest-file ( xml name ext -- )
append utf8 [ write-xml ] with-file-writer ; append utf8 [ write-xml ] with-file-writer ;

26
extra/mason/report/report.factor
View File

@ -8,7 +8,7 @@ IN: mason.report
: git-link ( id -- link ) : git-link ( id -- link )
[ "http://github.com/factor/factor/commit/" "" prepend-as ] keep [ "http://github.com/factor/factor/commit/" "" prepend-as ] keep
[XML <a href=<->><-></a> XML] ; XML-CHUNK[[ <a href=<->><-></a> ]] ;
: common-report ( -- xml ) : common-report ( -- xml )
target-os get target-os get
@ -17,7 +17,7 @@ IN: mason.report
disk-usage disk-usage
build-dir build-dir
current-git-id get git-link current-git-id get git-link
[XML XML-CHUNK[[
<h1>Build report for <->/<-></h1> <h1>Build report for <->/<-></h1>
<table> <table>
<tr><td>Build machine:</td><td><-></td></tr> <tr><td>Build machine:</td><td><-></td></tr>
@ -25,14 +25,14 @@ IN: mason.report
<tr><td>Build directory:</td><td><-></td></tr> <tr><td>Build directory:</td><td><-></td></tr>
<tr><td>GIT ID:</td><td><-></td></tr> <tr><td>GIT ID:</td><td><-></td></tr>
</table> </table>
XML] ; ]] ;
: with-report ( quot: ( -- xml ) -- ) : with-report ( quot: ( -- xml ) -- )
[ "report" utf8 ] dip [ "report" utf8 ] dip
'[ '[
common-report common-report
_ call( -- xml ) _ call( -- xml )
[XML <div><-><-></div> XML] XML-CHUNK[[ <div><-><-></div> ]]
write-xml write-xml
] with-file-writer ; inline ] with-file-writer ; inline
@ -44,13 +44,13 @@ IN: mason.report
error [ error. ] with-string-writer :> error error [ error. ] with-string-writer :> error
file utf8 400 file-tail :> output file utf8 400 file-tail :> output
[XML XML-CHUNK[[
<h2><-what-></h2> <h2><-what-></h2>
Build output: Build output:
<pre><-output-></pre> <pre><-output-></pre>
Launcher error: Launcher error:
<pre><-error-></pre> <pre><-error-></pre>
XML] ]]
] with-report ] with-report
status-error ; status-error ;
@ -73,30 +73,30 @@ IN: mason.report
html-help-time-file html-help-time-file
} [ } [
dup eval-file nanos>time dup eval-file nanos>time
[XML <tr><td><-></td><td><-></td></tr> XML] XML-CHUNK[[ <tr><td><-></td><td><-></td></tr> ]]
] map [XML <h2>Timings</h2> <table><-></table> XML] ; ] map XML-CHUNK[[ <h2>Timings</h2> <table><-></table> ]] ;
: error-dump ( heading vocabs-file messages-file -- xml ) : error-dump ( heading vocabs-file messages-file -- xml )
[ eval-file ] dip over empty? [ 3drop f ] [ [ eval-file ] dip over empty? [ 3drop f ] [
[ ] [ ]
[ [ [XML <li><-></li> XML] ] map [XML <ul><-></ul> XML] ] [ [ XML-CHUNK[[ <li><-></li> ]] ] map XML-CHUNK[[ <ul><-></ul> ]] ]
[ utf8 file-contents ] [ utf8 file-contents ]
tri* tri*
[XML <h1><-></h1> <-> Details: <pre><-></pre> XML] XML-CHUNK[[ <h1><-></h1> <-> Details: <pre><-></pre> ]]
] if ; ] if ;
: benchmarks-table ( assoc -- xml ) : benchmarks-table ( assoc -- xml )
[ [
1,000,000,000 /f 1,000,000,000 /f
[XML <tr><td><-></td><td><-></td></tr> XML] XML-CHUNK[[ <tr><td><-></td><td><-></td></tr> ]]
] { } assoc>map ] { } assoc>map
[XML XML-CHUNK[[
<h2>Benchmarks</h2> <h2>Benchmarks</h2>
<table> <table>
<tr><th>Benchmark</th><th>Time (seconds)</th></tr> <tr><th>Benchmark</th><th>Time (seconds)</th></tr>
<-> <->
</table> </table>
XML] ; ]] ;
: successful-report ( -- ) : successful-report ( -- )
[ [

22
extra/spider/report/report.factor
View File

@ -56,18 +56,18 @@ SYMBOL: time-std
: info-table ( alist -- html ) : info-table ( alist -- html )
[ [
first2 dupd 1000000 /f first2 dupd 1000000 /f
[XML XML-CHUNK[[
<tr><td><a href=<->><-></a></td><td><-> seconds</td></tr> <tr><td><a href=<->><-></a></td><td><-> seconds</td></tr>
XML] ]]
] map [XML <table border="1"><-></table> XML] ; ] map XML-CHUNK[[ <table border="1"><-></table> ]] ;
: report-broken-pages ( -- html ) : report-broken-pages ( -- html )
broken-pages get info-table ; broken-pages get info-table ;
: report-network-failures ( -- html ) : report-network-failures ( -- html )
network-failures get [ network-failures get [
dup [XML <li><a href=<->><-></a></li> XML] dup XML-CHUNK[[ <li><a href=<->><-></a></li> ]]
] map [XML <ul><-></ul> XML] ; ] map XML-CHUNK[[ <ul><-></ul> ]] ;
: slowest-pages-table ( -- html ) : slowest-pages-table ( -- html )
slowest-pages get info-table ; slowest-pages get info-table ;
@ -76,31 +76,31 @@ SYMBOL: time-std
mean-time get mean-time get
median-time get median-time get
time-std get time-std get
[XML XML-CHUNK[[
<table border="1"> <table border="1">
<tr><th>Mean</th><td><-> seconds</td></tr> <tr><th>Mean</th><td><-> seconds</td></tr>
<tr><th>Median</th><td><-> seconds</td></tr> <tr><th>Median</th><td><-> seconds</td></tr>
<tr><th>Standard deviation</th><td><-> seconds</td></tr> <tr><th>Standard deviation</th><td><-> seconds</td></tr>
</table> </table>
XML] ; ]] ;
: report-timings ( -- html ) : report-timings ( -- html )
slowest-pages-table slowest-pages-table
timing-summary-table timing-summary-table
[XML XML-CHUNK[[
<h3>Slowest pages</h3> <h3>Slowest pages</h3>
<-> <->
<h3>Summary</h3> <h3>Summary</h3>
<-> <->
XML] ; ]] ;
: generate-report ( -- html ) : generate-report ( -- html )
url get dup url get dup
report-broken-pages report-broken-pages
report-network-failures report-network-failures
report-timings report-timings
[XML XML-CHUNK[[
<h1>Spider report</h1> <h1>Spider report</h1>
URL: <a href=<->><-></a> URL: <a href=<->><-></a>
@ -112,7 +112,7 @@ SYMBOL: time-std
<h2>Load times</h2> <h2>Load times</h2>
<-> <->
XML] ; ]] ;
: spider-report ( spider -- html ) : spider-report ( spider -- html )
[ "Spider report" f ] dip [ "Spider report" f ] dip

4
extra/talks/tc-lisp-talk/tc-lisp-talk.factor
View File

@ -27,8 +27,8 @@ CONSTANT: tc-lisp-slides
{ $code { $code
"USING: splitting xml.writer xml.syntax ; "USING: splitting xml.writer xml.syntax ;
{ \"one\" \"two\" \"three\" } { \"one\" \"two\" \"three\" }
[ [XML <item><-></item> XML] ] map [ XML-CHUNK[[ <item><-></item> ]] ] map
<XML <doc><-></doc> XML> pprint-xml" XML-DOC[[ <doc><-></doc> ]] pprint-xml"
} }
} }
{ $slide "Differences between Factor and Lisp" { $slide "Differences between Factor and Lisp"

6
extra/webapps/mason/backend/watchdog/watchdog.factor
View File

@ -5,8 +5,8 @@ webapps.mason.backend xml.syntax xml.writer ;
IN: webapps.mason.backend.watchdog IN: webapps.mason.backend.watchdog
: crashed-builder-body ( crashed-builders -- string content-type ) : crashed-builder-body ( crashed-builders -- string content-type )
[ os/cpu [XML <li><-></li> XML] ] map [ os/cpu XML-CHUNK[[ <li><-></li> ]] ] map
<XML XML-DOC[[
<!DOCTYPE html> <!DOCTYPE html>
<html> <html>
<body> <body>
@ -15,7 +15,7 @@ IN: webapps.mason.backend.watchdog
<a href="http://builds.factorcode.org/dashboard">Dashboard</a> <a href="http://builds.factorcode.org/dashboard">Dashboard</a>
</body> </body>
</html> </html>
XML> xml>string ]] xml>string
"text/html" ; "text/html" ;
: crashed-builder-subject ( crashed-builders -- string ) : crashed-builder-subject ( crashed-builders -- string )

10
extra/webapps/mason/dashboard/dashboard.factor
View File

@ -6,10 +6,10 @@ webapps.mason.utils ;
IN: webapps.mason.downloads IN: webapps.mason.downloads
CONSTANT: CRASHED CONSTANT: CRASHED
[XML <span style="background-color: yellow;">CRASHED</span> XML] XML-CHUNK[[ <span style="background-color: yellow;">CRASHED</span> ]]
CONSTANT: BROKEN CONSTANT: BROKEN
[XML <span style="background-color: red; color: white;">BROKEN</span> XML] XML-CHUNK[[ <span style="background-color: red; color: white;">BROKEN</span> ]]
: builder-status ( builder -- status/f ) : builder-status ( builder -- status/f )
{ {
@ -22,10 +22,10 @@ CONSTANT: BROKEN
[ os/cpu ] sort-with [ os/cpu ] sort-with
[ [
[ report-url ] [ os/cpu ] [ builder-status ] tri [ report-url ] [ os/cpu ] [ builder-status ] tri
[XML <li><a href=<->><-></a> <-></li> XML] XML-CHUNK[[ <li><a href=<->><-></a> <-></li> ]]
] map ] map
[ [XML <p>No machines.</p> XML] ] [ XML-CHUNK[[ <p>No machines.</p> ]] ]
[ [XML <ul><-></ul> XML] ] [ XML-CHUNK[[ <ul><-></ul> ]] ]
if-empty ; if-empty ;
: <dashboard-action> ( -- action ) : <dashboard-action> ( -- action )

12
extra/webapps/mason/grids/grids.factor
View File

@ -9,8 +9,8 @@ IN: webapps.mason.grids
: render-grid-cell ( cpu os quot -- xml ) : render-grid-cell ( cpu os quot -- xml )
call( cpu os -- url label ) call( cpu os -- url label )
2dup and 2dup and
[ link [XML <td class="supported"><div class="bigdiv"><-></div></td> XML] ] [ link XML-CHUNK[[ <td class="supported"><div class="bigdiv"><-></div></td> ]] ]
[ 2drop [XML <td class="doesnotexist" /> XML] ] [ 2drop XML-CHUNK[[ <td class="doesnotexist" /> ]] ]
if ; if ;
CONSTANT: oses CONSTANT: oses
@ -27,21 +27,21 @@ CONSTANT: cpus
} }
: render-grid-header ( -- xml ) : render-grid-header ( -- xml )
oses values [ [XML <th align='center' scope='col'><-></th> XML] ] map ; oses values [ XML-CHUNK[[ <th align='center' scope='col'><-></th> ]] ] map ;
:: render-grid-row ( cpu quot -- xml ) :: render-grid-row ( cpu quot -- xml )
cpu second oses keys |[ os | cpu os quot render-grid-cell ] map cpu second oses keys |[ os | cpu os quot render-grid-cell ] map
[XML <tr><th align='center' scope='row'><-></th><-></tr> XML] ; XML-CHUNK[[ <tr><th align='center' scope='row'><-></th><-></tr> ]] ;
:: render-grid ( quot -- xml ) :: render-grid ( quot -- xml )
render-grid-header render-grid-header
cpus [ quot render-grid-row ] map cpus [ quot render-grid-row ] map
[XML XML-CHUNK[[
<table id="downloads" cellspacing="0"> <table id="downloads" cellspacing="0">
<tr><th class="nobg">OS/CPU</th><-></tr> <tr><th class="nobg">OS/CPU</th><-></tr>
<-> <->
</table> </table>
XML] ; ]] ;
: package-date ( filename -- date ) : package-date ( filename -- date )
"." split1 drop 16 tail* 6 head* ; "." split1 drop 16 tail* 6 head* ;

2
extra/webapps/mason/package/package.factor
View File

@ -9,7 +9,7 @@ IN: webapps.mason.package
: building ( builder string -- xml ) : building ( builder string -- xml )
swap current-git-id>> git-link swap current-git-id>> git-link
[XML <-> for <-> XML] ; XML-CHUNK[[ <-> for <-> ]] ;
: status-string ( builder -- string ) : status-string ( builder -- string )
dup status>> { dup status>> {

2
extra/webapps/mason/report/report.factor
View File

@ -20,4 +20,4 @@ IN: webapps.mason.report
[ URL" report" clone ] dip [ URL" report" clone ] dip
[ os>> "os" set-query-param ] [ os>> "os" set-query-param ]
[ cpu>> "cpu" set-query-param ] bi [ cpu>> "cpu" set-query-param ] bi
[XML <a href=<->>Latest build report</a> XML] ; XML-CHUNK[[ <a href=<->>Latest build report</a> ]] ;

4
extra/webapps/mason/utils/utils.factor
View File

@ -7,7 +7,7 @@ webapps.mason.version.data xml.syntax ;
IN: webapps.mason.utils IN: webapps.mason.utils
: link ( url label -- xml ) : link ( url label -- xml )
[XML <a href=<->><-></a> XML] ; XML-CHUNK[[ <a href=<->><-></a> ]] ;
: validate-os/cpu ( -- ) : validate-os/cpu ( -- )
{ {
@ -35,7 +35,7 @@ IN: webapps.mason.utils
? ?
] [ drop f ] if ] [ drop f ] if
] bi ] bi
2array sift [ [XML <li><-></li> XML] ] map [XML <ul><-></ul> XML] ; 2array sift [ XML-CHUNK[[ <li><-></li> ]] ] map XML-CHUNK[[ <ul><-></ul> ]] ;
: download-url ( string -- string' ) : download-url ( string -- string' )
"http://downloads.factorcode.org/" prepend ; "http://downloads.factorcode.org/" prepend ;