Merge commit 'origin/master' into emacs
commit
96d84731e3
|
@ -1,4 +1,4 @@
|
||||||
IN: eval.tests
|
IN: eval.tests
|
||||||
USING: eval tools.test ;
|
USING: eval tools.test ;
|
||||||
|
|
||||||
[ "4\n" ] [ "USING: math prettyprint ; 2 2 + ." eval>string ] unit-testv
|
[ "4\n" ] [ "USING: math prettyprint ; 2 2 + ." eval>string ] unit-test
|
||||||
|
|
|
@ -14,8 +14,8 @@ HELP: parse-farkup ( string -- farkup )
|
||||||
{ $description "Parses Farkup and outputs a tree of " { $link "farkup-ast" } "." } ;
|
{ $description "Parses Farkup and outputs a tree of " { $link "farkup-ast" } "." } ;
|
||||||
|
|
||||||
HELP: (write-farkup)
|
HELP: (write-farkup)
|
||||||
{ $values { "farkup" "a Farkup syntax tree node" } }
|
{ $values { "farkup" "a Farkup syntax tree node" } { "xml" "an XML chunk" } }
|
||||||
{ $description "Writes a Farkup syntax tree as HTML on " { $link output-stream } "." } ;
|
{ $description "Converts a Farkup syntax tree node to XML." } ;
|
||||||
|
|
||||||
ARTICLE: "farkup-ast" "Farkup syntax tree nodes"
|
ARTICLE: "farkup-ast" "Farkup syntax tree nodes"
|
||||||
"The " { $link parse-farkup } " word outputs a tree of nodes corresponding to the Farkup syntax of the input string. This tree can be programatically traversed and mutated before being passed on to " { $link write-farkup } "."
|
"The " { $link parse-farkup } " word outputs a tree of nodes corresponding to the Farkup syntax of the input string. This tree can be programatically traversed and mutated before being passed on to " { $link write-farkup } "."
|
||||||
|
|
|
@ -7,7 +7,7 @@ HELP: printf
|
||||||
{ $values { "format-string" string } }
|
{ $values { "format-string" string } }
|
||||||
{ $description
|
{ $description
|
||||||
"Writes the arguments (specified on the stack) formatted according to the format string.\n"
|
"Writes the arguments (specified on the stack) formatted according to the format string.\n"
|
||||||
"\n"
|
$nl
|
||||||
"Several format specifications exist for handling arguments of different types, and "
|
"Several format specifications exist for handling arguments of different types, and "
|
||||||
"specifying attributes for the result string, including such things as maximum width, "
|
"specifying attributes for the result string, including such things as maximum width, "
|
||||||
"padding, and decimals.\n"
|
"padding, and decimals.\n"
|
||||||
|
@ -24,10 +24,10 @@ HELP: printf
|
||||||
{ "%+Px" "Hexadecimal" "hex" }
|
{ "%+Px" "Hexadecimal" "hex" }
|
||||||
{ "%+PX" "Hexadecimal uppercase" "hex" }
|
{ "%+PX" "Hexadecimal uppercase" "hex" }
|
||||||
}
|
}
|
||||||
"\n"
|
$nl
|
||||||
"A plus sign ('+') is used to optionally specify that the number should be "
|
"A plus sign ('+') is used to optionally specify that the number should be "
|
||||||
"formatted with a '+' preceeding it if positive.\n"
|
"formatted with a '+' preceeding it if positive.\n"
|
||||||
"\n"
|
$nl
|
||||||
"Padding ('P') is used to optionally specify the minimum width of the result "
|
"Padding ('P') is used to optionally specify the minimum width of the result "
|
||||||
"string, the padding character, and the alignment. By default, the padding "
|
"string, the padding character, and the alignment. By default, the padding "
|
||||||
"character defaults to a space and the alignment defaults to right-aligned. "
|
"character defaults to a space and the alignment defaults to right-aligned. "
|
||||||
|
@ -38,7 +38,7 @@ HELP: printf
|
||||||
"\"%'#5f\" formats a float padding with '#' up to 3 characters wide."
|
"\"%'#5f\" formats a float padding with '#' up to 3 characters wide."
|
||||||
"\"%-10d\" formats an integer to 10 characters wide and left-aligns."
|
"\"%-10d\" formats an integer to 10 characters wide and left-aligns."
|
||||||
}
|
}
|
||||||
"\n"
|
$nl
|
||||||
"Digits ('D') is used to optionally specify the maximum digits in the result "
|
"Digits ('D') is used to optionally specify the maximum digits in the result "
|
||||||
"string. For example:\n"
|
"string. For example:\n"
|
||||||
{ $list
|
{ $list
|
||||||
|
@ -83,7 +83,7 @@ HELP: strftime
|
||||||
{ $values { "format-string" string } }
|
{ $values { "format-string" string } }
|
||||||
{ $description
|
{ $description
|
||||||
"Writes the timestamp (specified on the stack) formatted according to the format string.\n"
|
"Writes the timestamp (specified on the stack) formatted according to the format string.\n"
|
||||||
"\n"
|
$nl
|
||||||
"Different attributes of the timestamp can be retrieved using format specifications.\n"
|
"Different attributes of the timestamp can be retrieved using format specifications.\n"
|
||||||
{ $table
|
{ $table
|
||||||
{ "%a" "Abbreviated weekday name." }
|
{ "%a" "Abbreviated weekday name." }
|
||||||
|
@ -118,7 +118,7 @@ HELP: strftime
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
ARTICLE: "formatting" "Formatted printing"
|
ARTICLE: "formatting" "Formatted printing"
|
||||||
"The " { $vocab-link "formatting" } " vocabulary is used for formatted printing.\n"
|
"The " { $vocab-link "formatting" } " vocabulary is used for formatted printing."
|
||||||
{ $subsection printf }
|
{ $subsection printf }
|
||||||
{ $subsection sprintf }
|
{ $subsection sprintf }
|
||||||
{ $subsection strftime }
|
{ $subsection strftime }
|
||||||
|
|
|
@ -29,7 +29,7 @@ HELP: feed-entry-date
|
||||||
HELP: feed-entry-description
|
HELP: feed-entry-description
|
||||||
{ $values
|
{ $values
|
||||||
{ "object" object }
|
{ "object" object }
|
||||||
{ "description" null }
|
{ "description" string }
|
||||||
}
|
}
|
||||||
{ $contract "Outputs a feed entry description." } ;
|
{ $contract "Outputs a feed entry description." } ;
|
||||||
|
|
||||||
|
|
|
@ -70,8 +70,8 @@ HELP: render
|
||||||
{ $description "Renders an HTML component to the " { $link output-stream } "." } ;
|
{ $description "Renders an HTML component to the " { $link output-stream } "." } ;
|
||||||
|
|
||||||
HELP: render*
|
HELP: render*
|
||||||
{ $values { "value" "a value" } { "name" "a value name" } { "renderer" "a component renderer" } }
|
{ $values { "value" "a value" } { "name" "a value name" } { "renderer" "a component renderer" } { "xml" "an XML chunk" } }
|
||||||
{ $contract "Renders an HTML component to the " { $link output-stream } "." } ;
|
{ $contract "Renders an HTML component, outputting an XHTML snippet." } ;
|
||||||
|
|
||||||
ARTICLE: "html.components" "HTML components"
|
ARTICLE: "html.components" "HTML components"
|
||||||
"The " { $vocab-link "html.components" } " vocabulary provides various HTML form components."
|
"The " { $vocab-link "html.components" } " vocabulary provides various HTML form components."
|
||||||
|
|
|
@ -3,7 +3,7 @@
|
||||||
USING: accessors kernel namespaces io math.parser assocs classes
|
USING: accessors kernel namespaces io math.parser assocs classes
|
||||||
classes.tuple words arrays sequences splitting mirrors
|
classes.tuple words arrays sequences splitting mirrors
|
||||||
hashtables combinators continuations math strings inspector
|
hashtables combinators continuations math strings inspector
|
||||||
fry locals calendar calendar.format xml.entities
|
fry locals calendar calendar.format xml.entities xml.data
|
||||||
validators urls present xml.writer xml.interpolate xml
|
validators urls present xml.writer xml.interpolate xml
|
||||||
xmode.code2html lcs.diff2html farkup io.streams.string
|
xmode.code2html lcs.diff2html farkup io.streams.string
|
||||||
html.elements html.streams html.forms ;
|
html.elements html.streams html.forms ;
|
||||||
|
@ -65,12 +65,15 @@ TUPLE: textarea rows cols ;
|
||||||
: <textarea> ( -- renderer )
|
: <textarea> ( -- renderer )
|
||||||
textarea new ;
|
textarea new ;
|
||||||
|
|
||||||
M: textarea render* ( value name area -- xml )
|
M:: textarea render* ( value name area -- xml )
|
||||||
rot [ [ rows>> ] [ cols>> ] bi ] dip
|
area rows>> :> rows
|
||||||
[XML <textarea
|
area cols>> :> cols
|
||||||
name=<->
|
[XML
|
||||||
rows=<->
|
<textarea
|
||||||
cols=<->><-></textarea> XML] ;
|
name=<-name->
|
||||||
|
rows=<-rows->
|
||||||
|
cols=<-cols->><-value-></textarea>
|
||||||
|
XML] ;
|
||||||
|
|
||||||
! Choice
|
! Choice
|
||||||
TUPLE: choice size multiple choices ;
|
TUPLE: choice size multiple choices ;
|
||||||
|
@ -160,8 +163,9 @@ M: farkup render*
|
||||||
SINGLETON: inspector
|
SINGLETON: inspector
|
||||||
|
|
||||||
M: inspector render*
|
M: inspector render*
|
||||||
2drop [ [ describe ] with-html-writer ] with-string-writer
|
2drop [
|
||||||
string>xml-chunk ;
|
[ describe ] with-html-writer
|
||||||
|
] with-string-writer <unescaped> ;
|
||||||
|
|
||||||
! Diff component
|
! Diff component
|
||||||
SINGLETON: comparison
|
SINGLETON: comparison
|
||||||
|
|
|
@ -159,7 +159,7 @@ TUPLE: person first-name last-name ;
|
||||||
"true" "b" set-value
|
"true" "b" set-value
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ "<input type='checkbox' name='a'>a</input><input type='checkbox' name='b' checked='true'>b</input>" ] [
|
[ "<input type=\"checkbox\" name=\"a\">a</input><input type=\"checkbox\" checked=\"true\" name=\"b\">b</input>" ] [
|
||||||
[
|
[
|
||||||
"test12" test-template call-template
|
"test12" test-template call-template
|
||||||
] run-template
|
] run-template
|
||||||
|
|
|
@ -18,7 +18,8 @@ HELP: <interval-map>
|
||||||
{ $description "From a specification, produce an interval tree. The specification is an assoc where the keys are intervals, or pairs of numbers to represent intervals, or individual numbers to represent singleton intervals. The values are the values int he interval map. Construction time is O(n log n)." } ;
|
{ $description "From a specification, produce an interval tree. The specification is an assoc where the keys are intervals, or pairs of numbers to represent intervals, or individual numbers to represent singleton intervals. The values are the values int he interval map. Construction time is O(n log n)." } ;
|
||||||
|
|
||||||
ARTICLE: "interval-maps" "Interval maps"
|
ARTICLE: "interval-maps" "Interval maps"
|
||||||
"Interval maps are a mechanism, similar to assocs, where a set of closed intervals of keys are associated with values. As such, interval maps do not conform to the assoc protocol, because intervals of floats, for example, can be used, and it is impossible to get a list of keys in between."
|
"The " { $vocab-link "interval-maps" } " vocabulary implements a data structure, similar to assocs, where a set of closed intervals of keys are associated with values. As such, interval maps do not conform to the assoc protocol, because intervals of floats, for example, can be used, and it is impossible to get a list of keys in between."
|
||||||
|
$nl
|
||||||
"The following operations are used to query interval maps:"
|
"The following operations are used to query interval maps:"
|
||||||
{ $subsection interval-at* }
|
{ $subsection interval-at* }
|
||||||
{ $subsection interval-at }
|
{ $subsection interval-at }
|
||||||
|
|
|
@ -4,7 +4,7 @@ USING: help.syntax help.markup io.encodings.8-bit.private
|
||||||
strings ;
|
strings ;
|
||||||
IN: io.encodings.8-bit
|
IN: io.encodings.8-bit
|
||||||
|
|
||||||
ARTICLE: "io.encodings.8-bit" "8-bit encodings"
|
ARTICLE: "io.encodings.8-bit" "Legacy 8-bit encodings"
|
||||||
"Many encodings are a simple mapping of bytes onto characters. The " { $vocab-link "io.encodings.8-bit" } " vocabulary implements these generically using existing resource files. These encodings should be used with extreme caution, as fully general Unicode encodings like UTF-8 are nearly always more appropriate. The following 8-bit encodings are already defined:"
|
"Many encodings are a simple mapping of bytes onto characters. The " { $vocab-link "io.encodings.8-bit" } " vocabulary implements these generically using existing resource files. These encodings should be used with extreme caution, as fully general Unicode encodings like UTF-8 are nearly always more appropriate. The following 8-bit encodings are already defined:"
|
||||||
{ $subsection latin1 }
|
{ $subsection latin1 }
|
||||||
{ $subsection latin2 }
|
{ $subsection latin2 }
|
||||||
|
|
|
@ -55,7 +55,7 @@ HELP: human-sort-values
|
||||||
|
|
||||||
{ <=> >=< human-compare human-sort human-sort-keys human-sort-values } related-words
|
{ <=> >=< human-compare human-sort human-sort-keys human-sort-values } related-words
|
||||||
|
|
||||||
ARTICLE: "sorting.human" "sorting.human"
|
ARTICLE: "sorting.human" "Human-friendly sorting"
|
||||||
"The " { $vocab-link "sorting.human" } " vocabulary sorts by numbers as a human would -- by comparing their magnitudes -- rather than in a lexicographic way. For example, sorting a1, a10, a03, a2 with human sort returns a1, a2, a03, a10, while sorting with natural sort returns a03, a1, a10, a2." $nl
|
"The " { $vocab-link "sorting.human" } " vocabulary sorts by numbers as a human would -- by comparing their magnitudes -- rather than in a lexicographic way. For example, sorting a1, a10, a03, a2 with human sort returns a1, a2, a03, a10, while sorting with natural sort returns a03, a1, a10, a2." $nl
|
||||||
"Comparing two objects:"
|
"Comparing two objects:"
|
||||||
{ $subsection human<=> }
|
{ $subsection human<=> }
|
||||||
|
|
|
@ -185,7 +185,9 @@ $nl
|
||||||
{ $subsection add-gadgets }
|
{ $subsection add-gadgets }
|
||||||
{ $subsection clear-gadget }
|
{ $subsection clear-gadget }
|
||||||
"The children of a gadget are available via the "
|
"The children of a gadget are available via the "
|
||||||
{ $snippet "children" } " slot. " "Working with gadget children:"
|
{ $snippet "children" } " slot. "
|
||||||
|
$nl
|
||||||
|
"Working with gadget children:"
|
||||||
{ $subsection gadget-child }
|
{ $subsection gadget-child }
|
||||||
{ $subsection nth-gadget }
|
{ $subsection nth-gadget }
|
||||||
{ $subsection each-child }
|
{ $subsection each-child }
|
||||||
|
|
|
@ -83,7 +83,6 @@ ARTICLE: "unix.groups" "Unix groups"
|
||||||
$nl
|
$nl
|
||||||
"Listing all groups:"
|
"Listing all groups:"
|
||||||
{ $subsection all-groups }
|
{ $subsection all-groups }
|
||||||
"Returning a passwd tuple:"
|
|
||||||
"Real groups:"
|
"Real groups:"
|
||||||
{ $subsection real-group-name }
|
{ $subsection real-group-name }
|
||||||
{ $subsection real-group-id }
|
{ $subsection real-group-id }
|
||||||
|
|
|
@ -91,7 +91,6 @@ ARTICLE: "unix.users" "Unix users"
|
||||||
$nl
|
$nl
|
||||||
"Listing all users:"
|
"Listing all users:"
|
||||||
{ $subsection all-users }
|
{ $subsection all-users }
|
||||||
"Returning a passwd tuple:"
|
|
||||||
"Real user:"
|
"Real user:"
|
||||||
{ $subsection real-user-name }
|
{ $subsection real-user-name }
|
||||||
{ $subsection real-user-id }
|
{ $subsection real-user-id }
|
||||||
|
|
|
@ -219,3 +219,6 @@ PREDICATE: open-tag < tag children>> ;
|
||||||
|
|
||||||
UNION: xml-data
|
UNION: xml-data
|
||||||
tag comment string directive instruction ;
|
tag comment string directive instruction ;
|
||||||
|
|
||||||
|
TUPLE: unescaped string ;
|
||||||
|
C: <unescaped> unescaped
|
||||||
|
|
|
@ -0,0 +1,2 @@
|
||||||
|
collections
|
||||||
|
assocs
|
|
@ -0,0 +1 @@
|
||||||
|
Daniel Ehrenberg
|
|
@ -0,0 +1 @@
|
||||||
|
'Generic words' that dispatch on XML tag names
|
|
@ -0,0 +1 @@
|
||||||
|
syntax
|
|
@ -23,10 +23,11 @@ ARTICLE: { "xml.interpolate" "in-depth" } "XML interpolation syntax"
|
||||||
$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 <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:"
|
||||||
{ $example
|
{ $example
|
||||||
{" "one two three" " " split
|
{" USING: splitting sequences xml.writer xml.interpolate ;
|
||||||
|
"one two three" " " split
|
||||||
[ [XML <item><-></item> XML] ] map
|
[ [XML <item><-></item> XML] ] map
|
||||||
<XML <doc><-></doc> XML> pprint-xml>string "}
|
<XML <doc><-></doc> XML> pprint-xml"}
|
||||||
{" <' <?xml version="1.0" encoding="UTF-8"?>
|
{" <?xml version="1.0" encoding="UTF-8"?>
|
||||||
<doc>
|
<doc>
|
||||||
<item>
|
<item>
|
||||||
one
|
one
|
||||||
|
@ -37,10 +38,11 @@ $nl
|
||||||
<item>
|
<item>
|
||||||
three
|
three
|
||||||
</item>
|
</item>
|
||||||
</doc>'> "} }
|
</doc>"} }
|
||||||
"Here is an example of the locals version:"
|
"Here is an example of the locals version:"
|
||||||
{ $example
|
{ $example
|
||||||
{" [let |
|
{" USING: locals urls xml.interpolate xml.writer ;
|
||||||
|
[let |
|
||||||
number [ 3 ]
|
number [ 3 ]
|
||||||
false [ f ]
|
false [ f ]
|
||||||
url [ URL" http://factorcode.org/" ]
|
url [ URL" http://factorcode.org/" ]
|
||||||
|
@ -53,6 +55,6 @@ $nl
|
||||||
url=<-url->
|
url=<-url->
|
||||||
string=<-string->
|
string=<-string->
|
||||||
word=<-word-> />
|
word=<-word-> />
|
||||||
XML> pprint-xml>string ] "}
|
XML> pprint-xml ] "}
|
||||||
{" <' <?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"/>"} } ;
|
||||||
|
|
|
@ -53,3 +53,7 @@ IN: xml.interpolate.tests
|
||||||
|
|
||||||
[ "<x>3</x>" ] [ 3 [XML <x><-></x> XML] xml-chunk>string ] unit-test
|
[ "<x>3</x>" ] [ 3 [XML <x><-></x> XML] xml-chunk>string ] unit-test
|
||||||
[ "<x></x>" ] [ f [XML <x><-></x> XML] xml-chunk>string ] unit-test
|
[ "<x></x>" ] [ f [XML <x><-></x> XML] xml-chunk>string ] unit-test
|
||||||
|
|
||||||
|
\ parse-def must-infer
|
||||||
|
[ "" interpolate-chunk ] must-infer
|
||||||
|
[ [XML <foo><-></foo> <bar val=<->/> XML] ] must-infer
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: xml xml.state kernel sequences fry assocs xml.data
|
USING: xml xml.state kernel sequences fry assocs xml.data
|
||||||
accessors strings make multiline parser namespaces macros
|
accessors strings make multiline parser namespaces macros
|
||||||
sequences.deep generalizations locals words combinators
|
sequences.deep generalizations words combinators
|
||||||
math present arrays ;
|
math present arrays ;
|
||||||
IN: xml.interpolate
|
IN: xml.interpolate
|
||||||
|
|
||||||
|
@ -48,23 +48,23 @@ M: interpolated interpolate-item
|
||||||
: interpolate-xml-doc ( table xml -- xml )
|
: interpolate-xml-doc ( table xml -- xml )
|
||||||
(clone) [ interpolate-tag ] change-body ;
|
(clone) [ interpolate-tag ] change-body ;
|
||||||
|
|
||||||
GENERIC# (each-interpolated) 1 ( item quot -- ) inline
|
: (each-interpolated) ( item quot: ( interpolated -- ) -- )
|
||||||
M: interpolated (each-interpolated) call ;
|
{
|
||||||
M: tag (each-interpolated)
|
{ [ over interpolated? ] [ call ] }
|
||||||
swap attrs>> values
|
{ [ over tag? ] [
|
||||||
[ interpolated? ] filter
|
[ attrs>> values [ interpolated? ] filter ] dip each
|
||||||
swap each ;
|
] }
|
||||||
M: xml (each-interpolated)
|
{ [ over xml? ] [ [ body>> ] dip (each-interpolated) ] }
|
||||||
[ body>> ] dip (each-interpolated) ;
|
[ 2drop ]
|
||||||
M: object (each-interpolated) 2drop ;
|
} cond ; inline recursive
|
||||||
|
|
||||||
: each-interpolated ( xml quot -- )
|
: each-interpolated ( xml quot -- )
|
||||||
'[ _ (each-interpolated) ] deep-each ; inline
|
'[ _ (each-interpolated) ] deep-each ; inline
|
||||||
|
|
||||||
:: number<-> ( doc -- doc )
|
: number<-> ( doc -- dup )
|
||||||
0 :> n! doc [
|
0 over [
|
||||||
dup var>> [ n >>var n 1+ n! ] unless drop
|
dup var>> [ over >>var [ 1+ ] dip ] unless drop
|
||||||
] each-interpolated doc ;
|
] each-interpolated drop ;
|
||||||
|
|
||||||
MACRO: interpolate-xml ( string -- doc )
|
MACRO: interpolate-xml ( string -- doc )
|
||||||
string>doc number<-> '[ _ interpolate-xml-doc ] ;
|
string>doc number<-> '[ _ interpolate-xml-doc ] ;
|
||||||
|
|
|
@ -0,0 +1 @@
|
||||||
|
Syntax for XML interpolation
|
|
@ -0,0 +1,2 @@
|
||||||
|
syntax
|
||||||
|
enterprise
|
|
@ -1,4 +1,4 @@
|
||||||
! Copyright (C) 2005, 2006 Daniel Ehrenberg
|
! Copyright (C) 2005, 2009 Daniel Ehrenberg
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
IN: xml.tests
|
IN: xml.tests
|
||||||
USING: kernel xml tools.test io namespaces make sequences
|
USING: kernel xml tools.test io namespaces make sequences
|
||||||
|
@ -8,7 +8,7 @@ sequences.deep accessors io.streams.string ;
|
||||||
|
|
||||||
! This is insufficient
|
! This is insufficient
|
||||||
\ read-xml must-infer
|
\ read-xml must-infer
|
||||||
[ [ drop ] sax ] must-infer
|
[ [ drop ] each-element ] must-infer
|
||||||
\ string>xml must-infer
|
\ string>xml must-infer
|
||||||
|
|
||||||
SYMBOL: xml-file
|
SYMBOL: xml-file
|
||||||
|
|
|
@ -0,0 +1 @@
|
||||||
|
syntax
|
|
@ -59,3 +59,4 @@ IN: xml.writer.tests
|
||||||
[ "<foo>bar</foo>" string>xml [ " baz" append ] map xml>string ] unit-test
|
[ "<foo>bar</foo>" string>xml [ " baz" append ] map xml>string ] unit-test
|
||||||
[ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<foo>\n bar\n</foo>" ]
|
[ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<foo>\n bar\n</foo>" ]
|
||||||
[ "<foo> bar </foo>" string>xml pprint-xml>string ] unit-test
|
[ "<foo> bar </foo>" string>xml pprint-xml>string ] unit-test
|
||||||
|
[ "<foo'>" ] [ "<foo'>" <unescaped> xml-chunk>string ] unit-test
|
||||||
|
|
|
@ -98,6 +98,9 @@ M: open-tag write-xml-chunk
|
||||||
} cleave
|
} cleave
|
||||||
] dip xml-pprint? set ;
|
] dip xml-pprint? set ;
|
||||||
|
|
||||||
|
M: unescaped write-xml-chunk
|
||||||
|
string>> write ;
|
||||||
|
|
||||||
M: comment write-xml-chunk
|
M: comment write-xml-chunk
|
||||||
"<!--" write text>> write "-->" write ;
|
"<!--" write text>> write "-->" write ;
|
||||||
|
|
||||||
|
|
|
@ -1,66 +1,82 @@
|
||||||
! Copyright (C) 2005, 2009 Daniel Ehrenberg
|
! Copyright (C) 2005, 2009 Daniel Ehrenberg
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: help.markup help.syntax xml.data io ;
|
USING: help.markup help.syntax xml.data io strings ;
|
||||||
IN: xml
|
IN: xml
|
||||||
|
|
||||||
HELP: string>xml
|
HELP: string>xml
|
||||||
{ $values { "string" "a string" } { "xml" "an xml document" } }
|
{ $values { "string" string } { "xml" xml } }
|
||||||
{ $description "converts a string into an " { $link xml }
|
{ $description "Converts a string into an " { $link xml }
|
||||||
" datatype for further processing" } ;
|
" tree for further processing." } ;
|
||||||
|
|
||||||
HELP: read-xml
|
HELP: read-xml
|
||||||
{ $values { "stream" "a stream that supports readln" }
|
{ $values { "stream" "an input stream" } { "xml" xml } }
|
||||||
{ "xml" "an XML document" } }
|
{ $description "Exausts the given stream, reading an XML document from it. A binary stream, one without encoding, should be used as input, and the encoding is automatically detected." } ;
|
||||||
{ $description "exausts the given stream, reading an XML document from it. A binary stream, one without encoding, should be used as input, and the encoding is automatically detected." } ;
|
|
||||||
|
|
||||||
HELP: file>xml
|
HELP: file>xml
|
||||||
{ $values { "filename" "a string representing a filename" }
|
{ $values { "filename" string } { "xml" xml } }
|
||||||
{ "xml" "an XML document" } }
|
{ $description "Opens the given file, reads it in as XML, closes the file and returns the corresponding XML tree. The encoding is automatically detected." } ;
|
||||||
{ $description "opens the given file, reads it in as XML, closes the file and returns the corresponding XML tree" } ;
|
|
||||||
|
|
||||||
{ string>xml read-xml file>xml } related-words
|
{ string>xml read-xml file>xml } related-words
|
||||||
|
|
||||||
HELP: read-xml-chunk
|
HELP: read-xml-chunk
|
||||||
{ $values { "stream" "an input stream" } { "seq" "a sequence of elements" } }
|
{ $values { "stream" "an input stream" } { "seq" "a sequence of elements" } }
|
||||||
{ $description "rather than parse a document, as " { $link read-xml } " does, this word parses and returns a sequence of XML elements (tags, strings, etc), ie a document fragment. This is useful for pieces of XML which may have more than one main tag." }
|
{ $description "Rather than parse a document, as " { $link read-xml } " does, this word parses and returns a sequence of XML elements (tags, strings, etc), ie a document fragment. This is useful for pieces of XML which may have more than one main tag." }
|
||||||
{ $see-also read-xml } ;
|
{ $see-also read-xml } ;
|
||||||
|
|
||||||
HELP: sax
|
HELP: each-element
|
||||||
{ $values { "stream" "an input stream" } { "quot" "a quotation ( xml-elem -- )" } }
|
{ $values { "stream" "an input stream" } { "quot" "a quotation ( xml-elem -- )" } }
|
||||||
{ $description "parses the XML document, and whenever an event is encountered (a tag piece, comment, parsing instruction, directive or string element), the quotation is called with that event on the stack. The quotation has all responsibility to deal with the event properly, and it is advised that generic words be used in dispatching on the event class." }
|
{ $description "Parses the XML document, and whenever an event is encountered (a tag piece, comment, parsing instruction, directive or string element), the quotation is called with that event on the stack. The quotation has all responsibility to deal with the event properly, and it is advised that generic words be used in dispatching on the event class." }
|
||||||
{ $notes "It is important to note that this is not SAX, merely an event-based XML view" }
|
{ $notes "It is important to note that this is not SAX, merely an event-based XML view" }
|
||||||
{ $see-also read-xml } ;
|
{ $see-also read-xml } ;
|
||||||
|
|
||||||
HELP: pull-xml
|
HELP: pull-xml
|
||||||
{ $class-description "represents the state of a pull-parser for XML. Has one slot, scope, which is a namespace which contains all relevant state information." }
|
{ $class-description "Represents the state of a pull-parser for XML. Has one slot, scope, which is a namespace which contains all relevant state information." }
|
||||||
{ $see-also <pull-xml> pull-event pull-elem } ;
|
{ $see-also <pull-xml> pull-event pull-elem } ;
|
||||||
|
|
||||||
HELP: <pull-xml>
|
HELP: <pull-xml>
|
||||||
{ $values { "pull-xml" "a pull-xml tuple" } }
|
{ $values { "pull-xml" "a pull-xml tuple" } }
|
||||||
{ $description "creates an XML pull-based parser which reads from " { $link input-stream } ", executing all initial XML commands to set up the parser." }
|
{ $description "Creates an XML pull-based parser which reads from " { $link input-stream } ", executing all initial XML commands to set up the parser." }
|
||||||
{ $see-also pull-xml pull-elem pull-event } ;
|
{ $see-also pull-xml pull-elem pull-event } ;
|
||||||
|
|
||||||
HELP: pull-elem
|
HELP: pull-elem
|
||||||
{ $values { "pull" "an XML pull parser" } { "xml-elem/f" "an XML tag, string, or f" } }
|
{ $values { "pull" "an XML pull parser" } { "xml-elem/f" "an XML tag, string, or f" } }
|
||||||
{ $description "gets the next XML element from the given XML pull parser. Returns f upon exhaustion." }
|
{ $description "Gets the next XML element from the given XML pull parser. Returns f upon exhaustion." }
|
||||||
{ $see-also pull-xml <pull-xml> pull-event } ;
|
{ $see-also pull-xml <pull-xml> pull-event } ;
|
||||||
|
|
||||||
HELP: pull-event
|
HELP: pull-event
|
||||||
{ $values { "pull" "an XML pull parser" } { "xml-event/f" "an XML tag event, string, or f" } }
|
{ $values { "pull" "an XML pull parser" } { "xml-event/f" "an XML tag event, string, or f" } }
|
||||||
{ $description "gets the next XML event from the given XML pull parser. Returns f upon exhaustion." }
|
{ $description "Gets the next XML event from the given XML pull parser. Returns f upon exhaustion." }
|
||||||
{ $see-also pull-xml <pull-xml> pull-elem } ;
|
{ $see-also pull-xml <pull-xml> pull-elem } ;
|
||||||
|
|
||||||
|
HELP: read-dtd
|
||||||
|
{ $values { "stream" "an input stream" } { "dtd" dtd } }
|
||||||
|
{ $description "Exhausts a stream, producing a " { $link dtd } " from the contents." } ;
|
||||||
|
|
||||||
|
HELP: file>dtd
|
||||||
|
{ $values { "filename" string } { "dtd" dtd } }
|
||||||
|
{ $description "Reads a file in UTF-8, converting it into an XML " { $link dtd } "." } ;
|
||||||
|
|
||||||
|
HELP: string>dtd
|
||||||
|
{ $values { "string" string } { "dtd" dtd } }
|
||||||
|
{ $description "Interprets a string as an XML " { $link dtd } "." } ;
|
||||||
|
|
||||||
|
{ read-dtd file>dtd string>dtd } related-words
|
||||||
|
|
||||||
ARTICLE: { "xml" "reading" } "Reading XML"
|
ARTICLE: { "xml" "reading" } "Reading XML"
|
||||||
"The following words are used to read something into an XML document"
|
"The following words are used to read something into an XML document"
|
||||||
{ $subsection string>xml }
|
{ $subsection string>xml }
|
||||||
{ $subsection read-xml }
|
{ $subsection read-xml }
|
||||||
{ $subsection read-xml-chunk }
|
{ $subsection read-xml-chunk }
|
||||||
{ $subsection string>xml-chunk }
|
{ $subsection string>xml-chunk }
|
||||||
{ $subsection file>xml } ;
|
{ $subsection file>xml }
|
||||||
|
"To read a DTD:"
|
||||||
|
{ $subsection read-dtd }
|
||||||
|
{ $subsection file>dtd }
|
||||||
|
{ $subsection string>dtd } ;
|
||||||
|
|
||||||
ARTICLE: { "xml" "events" } "Event-based XML parsing"
|
ARTICLE: { "xml" "events" } "Event-based XML parsing"
|
||||||
"In addition to DOM-style parsing based around " { $link read-xml } ", the XML module also provides SAX-style event-based parsing. This uses much of the same data structures as normal XML, with the exception of the classes " { $link xml } " and " { $link tag } " and as such, the article " { $vocab-link "xml.data" } " may be useful in learning how to process documents in this way. Other useful words are:"
|
"In addition to DOM-style parsing based around " { $link read-xml } ", the XML module also provides SAX-style event-based parsing. This uses much of the same data structures as normal XML, with the exception of the classes " { $link xml } " and " { $link tag } " and as such, the article " { $vocab-link "xml.data" } " may be useful in learning how to process documents in this way. Other useful words are:"
|
||||||
{ $subsection sax }
|
{ $subsection each-element }
|
||||||
{ $subsection opener }
|
{ $subsection opener }
|
||||||
{ $subsection closer }
|
{ $subsection closer }
|
||||||
{ $subsection contained }
|
{ $subsection contained }
|
||||||
|
|
|
@ -6,7 +6,7 @@ xml.data xml.errors xml.elements ascii xml.entities
|
||||||
xml.writer xml.state xml.autoencoding assocs xml.tokenize xml.name ;
|
xml.writer xml.state xml.autoencoding assocs xml.tokenize xml.name ;
|
||||||
IN: xml
|
IN: xml
|
||||||
|
|
||||||
! -- Overall parser with data tree
|
<PRIVATE
|
||||||
|
|
||||||
: add-child ( object -- )
|
: add-child ( object -- )
|
||||||
xml-stack get peek second push ;
|
xml-stack get peek second push ;
|
||||||
|
@ -89,6 +89,8 @@ M: closer process
|
||||||
|
|
||||||
SYMBOL: text-now?
|
SYMBOL: text-now?
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
TUPLE: pull-xml scope ;
|
TUPLE: pull-xml scope ;
|
||||||
: <pull-xml> ( -- pull-xml )
|
: <pull-xml> ( -- pull-xml )
|
||||||
[
|
[
|
||||||
|
@ -106,6 +108,8 @@ TUPLE: pull-xml scope ;
|
||||||
] if text-now? set
|
] if text-now? set
|
||||||
] bind ;
|
] bind ;
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
: done? ( -- ? )
|
: done? ( -- ? )
|
||||||
xml-stack get length 1 = ;
|
xml-stack get length 1 = ;
|
||||||
|
|
||||||
|
@ -116,27 +120,33 @@ TUPLE: pull-xml scope ;
|
||||||
[ (pull-elem) ] if
|
[ (pull-elem) ] if
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
: pull-elem ( pull -- xml-elem/f )
|
: pull-elem ( pull -- xml-elem/f )
|
||||||
[ init-xml-stack (pull-elem) ] with-scope ;
|
[ init-xml-stack (pull-elem) ] with-scope ;
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
: call-under ( quot object -- quot )
|
: call-under ( quot object -- quot )
|
||||||
swap dup slip ; inline
|
swap dup slip ; inline
|
||||||
|
|
||||||
: sax-loop ( quot: ( xml-elem -- ) -- )
|
: xml-loop ( quot: ( xml-elem -- ) -- )
|
||||||
parse-text call-under
|
parse-text call-under
|
||||||
get-char [ make-tag call-under sax-loop ]
|
get-char [ make-tag call-under xml-loop ]
|
||||||
[ drop ] if ; inline recursive
|
[ drop ] if ; inline recursive
|
||||||
|
|
||||||
: sax ( stream quot: ( xml-elem -- ) -- )
|
PRIVATE>
|
||||||
|
|
||||||
|
: each-element ( stream quot: ( xml-elem -- ) -- )
|
||||||
swap [
|
swap [
|
||||||
reset-prolog init-ns-stack
|
reset-prolog init-ns-stack
|
||||||
start-document [ call-under ] when*
|
start-document [ call-under ] when*
|
||||||
sax-loop
|
xml-loop
|
||||||
] with-state ; inline recursive
|
] with-state ; inline
|
||||||
|
|
||||||
: (read-xml) ( -- )
|
: (read-xml) ( -- )
|
||||||
start-document [ process ] when*
|
start-document [ process ] when*
|
||||||
[ process ] sax-loop ; inline
|
[ process ] xml-loop ; inline
|
||||||
|
|
||||||
: (read-xml-chunk) ( stream -- prolog seq )
|
: (read-xml-chunk) ( stream -- prolog seq )
|
||||||
[
|
[
|
||||||
|
@ -155,7 +165,8 @@ TUPLE: pull-xml scope ;
|
||||||
[ (read-xml-chunk) nip ] with-variable ;
|
[ (read-xml-chunk) nip ] with-variable ;
|
||||||
|
|
||||||
: string>xml ( string -- xml )
|
: string>xml ( string -- xml )
|
||||||
<string-reader> read-xml ;
|
t string-input?
|
||||||
|
[ <string-reader> read-xml ] with-variable ;
|
||||||
|
|
||||||
: string>xml-chunk ( string -- xml )
|
: string>xml-chunk ( string -- xml )
|
||||||
t string-input?
|
t string-input?
|
||||||
|
|
|
@ -15,7 +15,7 @@ IN: xmode.code2html
|
||||||
tokenize-line htmlize-tokens ;
|
tokenize-line htmlize-tokens ;
|
||||||
|
|
||||||
: htmlize-lines ( lines mode -- xml )
|
: htmlize-lines ( lines mode -- xml )
|
||||||
f -rot load-mode [ htmlize-line ] curry map nip ;
|
[ f ] 2dip load-mode [ htmlize-line ] curry map nip ;
|
||||||
|
|
||||||
: default-stylesheet ( -- xml )
|
: default-stylesheet ( -- xml )
|
||||||
"resource:basis/xmode/code2html/stylesheet.css"
|
"resource:basis/xmode/code2html/stylesheet.css"
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
USING: help.markup help.syntax kernel kernel.private
|
USING: help.markup help.syntax kernel kernel.private
|
||||||
continuations.private vectors arrays namespaces
|
continuations.private vectors arrays namespaces
|
||||||
assocs words quotations lexer sequences ;
|
assocs words quotations lexer sequences math ;
|
||||||
IN: continuations
|
IN: continuations
|
||||||
|
|
||||||
ARTICLE: "errors-restartable" "Restartable errors"
|
ARTICLE: "errors-restartable" "Restartable errors"
|
||||||
|
@ -241,7 +241,7 @@ HELP: attempt-all
|
||||||
|
|
||||||
HELP: retry
|
HELP: retry
|
||||||
{ $values
|
{ $values
|
||||||
{ "quot" quotation } { "n" null }
|
{ "quot" quotation } { "n" integer }
|
||||||
}
|
}
|
||||||
{ $description "Tries the quotation up to " { $snippet "n" } " times until it returns true. Retries the quotation if an exception is thrown or if the quotation returns " { $link f } ". The quotation is expected to have side effects that may fail, such as generating a random name for a new file until successful." }
|
{ $description "Tries the quotation up to " { $snippet "n" } " times until it returns true. Retries the quotation if an exception is thrown or if the quotation returns " { $link f } ". The quotation is expected to have side effects that may fail, such as generating a random name for a new file until successful." }
|
||||||
{ $examples
|
{ $examples
|
||||||
|
|
|
@ -84,10 +84,9 @@ $nl
|
||||||
{ $subsection initial-value } ;
|
{ $subsection initial-value } ;
|
||||||
|
|
||||||
ARTICLE: "slots" "Slots"
|
ARTICLE: "slots" "Slots"
|
||||||
"A " { $emphasis "slot" } " is a component of an object which can store a value."
|
"The " { $vocab-link "slots" } " vocabulary contains words for introspecting the slots of an object. A " { $emphasis "slot" } " is a component of an object which can store a value."
|
||||||
$nl
|
$nl
|
||||||
{ $link "tuples" } " are composed entirely of slots, and instances of " { $link "builtin-classes" } " consist of slots together with intrinsic data."
|
{ $link "tuples" } " are composed entirely of slots, and instances of " { $link "builtin-classes" } " consist of slots together with intrinsic data."
|
||||||
"The " { $vocab-link "slots" } " vocabulary contains words for introspecting the slots of an object."
|
|
||||||
$nl
|
$nl
|
||||||
"The " { $snippet "\"slots\"" } " word property of built-in and tuple classes holds an array of " { $emphasis "slot specifiers" } " describing the slot layout of each instance."
|
"The " { $snippet "\"slots\"" } " word property of built-in and tuple classes holds an array of " { $emphasis "slot specifiers" } " describing the slot layout of each instance."
|
||||||
{ $subsection slot-spec }
|
{ $subsection slot-spec }
|
||||||
|
|
|
@ -57,7 +57,7 @@ IN: scratchpad
|
||||||
|
|
||||||
{ n-based-assoc <n-based-assoc> } related-words
|
{ n-based-assoc <n-based-assoc> } related-words
|
||||||
|
|
||||||
ARTICLE: "sequences.n-based" "sequences.n-based"
|
ARTICLE: "sequences.n-based" "N-based sequences"
|
||||||
"The " { $vocab-link "sequences.n-based" } " vocabulary provides a sequence adaptor that allows a sequence to be treated as an assoc with non-zero-based keys."
|
"The " { $vocab-link "sequences.n-based" } " vocabulary provides a sequence adaptor that allows a sequence to be treated as an assoc with non-zero-based keys."
|
||||||
{ $subsection n-based-assoc }
|
{ $subsection n-based-assoc }
|
||||||
{ $subsection <n-based-assoc> }
|
{ $subsection <n-based-assoc> }
|
||||||
|
|
Loading…
Reference in New Issue