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

Fix conflict

db4
Slava Pestov 2009-01-27 15:49:49 -06:00
parent 8b6ae748b9 b655f71d5b
commit 5cd4f65e59
44 changed files with 225 additions and 208 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/eval/eval-tests.factor
View File

@ -1,4 +1,4 @@
IN: eval.tests
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

4
basis/farkup/farkup-docs.factor
View File

@ -14,8 +14,8 @@ HELP: parse-farkup ( string -- farkup )
{ $description "Parses Farkup and outputs a tree of " { $link "farkup-ast" } "." } ;
HELP: (write-farkup)
{ $values { "farkup" "a Farkup syntax tree node" } }
{ $description "Writes a Farkup syntax tree as HTML on " { $link output-stream } "." } ;
{ $values { "farkup" "a Farkup syntax tree node" } { "xml" "an XML chunk" } }
{ $description "Converts a Farkup syntax tree node to XML." } ;
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 } "."

12
basis/formatting/formatting-docs.factor
View File

@ -7,7 +7,7 @@ HELP: printf
{ $values { "format-string" string } }
{ $description
"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 "
"specifying attributes for the result string, including such things as maximum width, "
"padding, and decimals.\n"
@ -24,10 +24,10 @@ HELP: printf
{ "%+Px" "Hexadecimal" "hex" }
{ "%+PX" "Hexadecimal uppercase" "hex" }
}
"\n"
$nl
"A plus sign ('+') is used to optionally specify that the number should be "
"formatted with a '+' preceeding it if positive.\n"
"\n"
$nl
"Padding ('P') is used to optionally specify the minimum width of the result "
"string, the padding character, and the alignment. By default, the padding "
"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."
"\"%-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 "
"string. For example:\n"
{ $list
@ -83,7 +83,7 @@ HELP: strftime
{ $values { "format-string" string } }
{ $description
"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"
{ $table
{ "%a" "Abbreviated weekday name." }
@ -118,7 +118,7 @@ HELP: strftime
} ;
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 sprintf }
{ $subsection strftime }

2
basis/furnace/syndication/syndication-docs.factor
View File

@ -29,7 +29,7 @@ HELP: feed-entry-date
HELP: feed-entry-description
{ $values
{ "object" object }
{ "description" null }
{ "description" string }
}
{ $contract "Outputs a feed entry description." } ;

4
basis/html/components/components-docs.factor
View File

@ -70,8 +70,8 @@ HELP: render
{ $description "Renders an HTML component to the " { $link output-stream } "." } ;
HELP: render*
{ $values { "value" "a value" } { "name" "a value name" } { "renderer" "a component renderer" } }
{ $contract "Renders an HTML component to the " { $link output-stream } "." } ;
{ $values { "value" "a value" } { "name" "a value name" } { "renderer" "a component renderer" } { "xml" "an XML chunk" } }
{ $contract "Renders an HTML component, outputting an XHTML snippet." } ;
ARTICLE: "html.components" "HTML components"
"The " { $vocab-link "html.components" } " vocabulary provides various HTML form components."

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

@ -159,7 +159,7 @@ TUPLE: person first-name last-name ;
"true" "b" set-value
] 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
] run-template

3
basis/interval-maps/interval-maps-docs.factor
View File

@ -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)." } ;
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:"
{ $subsection interval-at* }
{ $subsection interval-at }

2
basis/io/encodings/8-bit/8-bit-docs.factor
View File

@ -4,7 +4,7 @@ USING: help.syntax help.markup io.encodings.8-bit.private
strings ;
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:"
{ $subsection latin1 }
{ $subsection latin2 }

6
basis/lcs/diff2html/diff2html-tests.factor Normal file
View File

@ -0,0 +1,6 @@
! Copyright (C) 2009 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: lcs.diff2html lcs kernel tools.test strings sequences xml.writer ;
IN: lcs.diff2html.tests
[ ] [ "hello" "heyo" [ 1string ] { } map-as diff htmlize-diff xml-chunk>string drop ] unit-test

2
basis/sorting/human/human-docs.factor
View File

@ -55,7 +55,7 @@ HELP: human-sort-values
{ <=> >=< 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
"Comparing two objects:"
{ $subsection human<=> }

10
basis/ui/tools/tools-docs.factor
View File

@ -1,9 +1,7 @@
USING: editors help.markup help.syntax summary inspector io
io.styles listener parser prettyprint tools.profiler
tools.walker ui.commands ui.gadgets.panes
ui.gadgets.presentations ui.operations
ui.tools.operations ui.tools.profiler
ui.tools.common vocabs ;
USING: editors help.markup help.syntax summary inspector io io.styles
listener parser prettyprint tools.profiler tools.walker ui.commands
ui.gadgets.panes ui.gadgets.presentations ui.operations
ui.tools.operations ui.tools.profiler ui.tools.common vocabs ;
IN: ui.tools
ARTICLE: "starting-ui-tools" "Starting the UI tools"

4
basis/ui/ui-docs.factor
View File

@ -185,7 +185,9 @@ $nl
{ $subsection add-gadgets }
{ $subsection clear-gadget }
"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 nth-gadget }
{ $subsection each-child }

1
basis/unix/groups/groups-docs.factor
View File

@ -83,7 +83,6 @@ ARTICLE: "unix.groups" "Unix groups"
$nl
"Listing all groups:"
{ $subsection all-groups }
"Returning a passwd tuple:"
"Real groups:"
{ $subsection real-group-name }
{ $subsection real-group-id }

1
basis/unix/users/users-docs.factor
View File

@ -91,7 +91,6 @@ ARTICLE: "unix.users" "Unix users"
$nl
"Listing all users:"
{ $subsection all-users }
"Returning a passwd tuple:"
"Real user:"
{ $subsection real-user-name }
{ $subsection real-user-id }

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

@ -3,7 +3,7 @@
USING: accessors kernel xml arrays math generic http.client
combinators hashtables namespaces io base64 sequences strings
calendar xml.data xml.writer xml.utilities assocs math.parser
debugger calendar.format math.order xml.interpolate ;
debugger calendar.format math.order xml.interpolate xml.dispatch ;
IN: xml-rpc
! * Sending RPC requests
@ -15,7 +15,7 @@ GENERIC: item>xml ( object -- xml )
M: integer item>xml
dup 31 2^ neg 31 2^ 1 - between?
[ "Integers must fit in 32 bits" throw ] unless
number>string [XML <i4><-></i4> XML] ;
[XML <i4><-></i4> XML] ;
UNION: boolean t POSTPONE: f ;
@ -176,10 +176,3 @@ TAG: array xml>item
: invoke-method ( params method url -- )
[ swap <rpc-method> ] dip post-rpc ;
: put-http-response ( string -- )
"HTTP/1.1 200 OK\nConnection: close\nContent-Length: " write
dup length number>string write
"\nContent-Type: text/xml\nDate: " write
now timestamp>http-string write "\n\n" write
write ;

2
basis/xml/data/tags.txt Normal file
View File

@ -0,0 +1,2 @@
collections
assocs

1
basis/xml/dispatch/authors.txt Normal file
View File

@ -0,0 +1 @@
Daniel Ehrenberg

25
basis/xml/dispatch/dispatch-docs.factor Normal file
View File

@ -0,0 +1,25 @@
! Copyright (C) 2005, 2009 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: help.markup help.syntax ;
IN: xml.dispatch
ABOUT: "xml.dispatch"
ARTICLE: "xml.dispatch" "Dispatch on XML tag names"
"Two parsing words define a system, analogous to generic words, for processing XML. A word can dispatch off the name of the tag that is passed to it. To define such a word, use"
{ $subsection POSTPONE: PROCESS: }
"and to define a new 'method' for this word, use"
{ $subsection POSTPONE: TAG: } ;
HELP: PROCESS:
{ $syntax "PROCESS: word" }
{ $values { "word" "a new word to define" } }
{ $description "creates a new word to process XML tags" }
{ $see-also POSTPONE: TAG: } ;
HELP: TAG:
{ $syntax "TAG: tag word definition... ;" }
{ $values { "tag" "an xml tag name" } { "word" "an XML process" } }
{ $description "defines what a process should do when it encounters a specific tag" }
{ $examples { $code "PROCESS: x ( tag -- )\nTAG: a x drop \"hi\" write ;" } }
{ $see-also POSTPONE: PROCESS: } ;

7
basis/xml/tests/arithmetic.factor → basis/xml/dispatch/dispatch-tests.factor
View File

@ -1,7 +1,8 @@
! Copyright (C) 2005, 2006 Daniel Ehrenberg
! Copyright (C) 2005, 2009 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
IN: xml.tests
USING: xml io kernel math sequences strings xml.utilities tools.test math.parser ;
USING: xml io kernel math sequences strings xml.utilities
tools.test math.parser xml.dispatch ;
IN: xml.dispatch.tests
PROCESS: calculate ( tag -- n )

27
basis/xml/dispatch/dispatch.factor Normal file
View File

@ -0,0 +1,27 @@
! Copyright (C) 2005, 2009 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: words assocs kernel accessors parser sequences summary
lexer splitting fry ;
IN: xml.dispatch
TUPLE: process-missing process tag ;
M: process-missing summary
drop "Tag not implemented on process" ;
: run-process ( tag word -- )
2dup "xtable" word-prop
[ dup main>> ] dip at* [ 2nip call ] [
drop \ process-missing boa throw
] if ;
: PROCESS:
CREATE
dup H{ } clone "xtable" set-word-prop
dup '[ _ run-process ] define ; parsing
: TAG:
scan scan-word
parse-definition
swap "xtable" word-prop
rot "/" split [ [ 2dup ] dip swap set-at ] each 2drop ;
parsing

1
basis/xml/dispatch/summary.txt Normal file
View File

@ -0,0 +1 @@
'Generic words' that dispatch on XML tag names

1
basis/xml/dispatch/tags.txt Normal file
View File

@ -0,0 +1 @@
syntax

18
basis/xml/interpolate/interpolate-docs.factor
View File

@ -23,10 +23,11 @@ ARTICLE: { "xml.interpolate" "in-depth" } "XML interpolation syntax"
$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:"
{ $example
{" "one two three" " " split
{" USING: splitting sequences xml.writer xml.interpolate ;
"one two three" " " split
[ [XML <item><-></item> XML] ] map
<XML <doc><-></doc> XML> pprint-xml>string "}
{" <' <?xml version="1.0" encoding="UTF-8"?>
<XML <doc><-></doc> XML> pprint-xml"}
{" <?xml version="1.0" encoding="UTF-8"?>
<doc>
<item>
one
@ -37,10 +38,11 @@ $nl
<item>
three
</item>
</doc>'> "} }
</doc>"} }
"Here is an example of the locals version:"
{ $example
{" [let |
{" USING: locals urls xml.interpolate xml.writer ;
[let |
number [ 3 ]
false [ f ]
url [ URL" http://factorcode.org/" ]
@ -53,6 +55,6 @@ $nl
url=<-url->
string=<-string->
word=<-word-> />
XML> pprint-xml>string ] "}
{" <' <?xml version="1.0" encoding="UTF-8"?>
<x number="3" url="http://factorcode.org/" string="hello" word="drop"/>'> "} } ;
XML> pprint-xml ] "}
{" <?xml version="1.0" encoding="UTF-8"?>
<x number="3" url="http://factorcode.org/" string="hello" word="drop"/>"} } ;

7
basis/xml/interpolate/interpolate-tests.factor
View File

@ -50,3 +50,10 @@ IN: xml.interpolate.tests
[ 3 f URL" http://factorcode.org/" "hello" \ drop
<XML <x number=<-> false=<-> url=<-> string=<-> word=<->/> XML>
pprint-xml>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
\ parse-def must-infer
[ "" interpolate-chunk ] must-infer
[ [XML <foo><-></foo> <bar val=<->/> XML] ] must-infer

29
basis/xml/interpolate/interpolate.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: xml xml.state kernel sequences fry assocs xml.data
accessors strings make multiline parser namespaces macros
sequences.deep generalizations locals words combinators
sequences.deep generalizations words combinators
math present arrays ;
IN: xml.interpolate
@ -34,6 +34,7 @@ M: xml-data push-item , ;
M: object push-item present , ;
M: sequence push-item
[ dup array? [ % ] [ , ] if ] each ;
M: number push-item present , ;
GENERIC: interpolate-item ( table item -- )
M: object interpolate-item nip , ;
@ -47,23 +48,23 @@ M: interpolated interpolate-item
: interpolate-xml-doc ( table xml -- xml )
(clone) [ interpolate-tag ] change-body ;
GENERIC# (each-interpolated) 1 ( item quot -- ) inline
M: interpolated (each-interpolated) call ;
M: tag (each-interpolated)
swap attrs>> values
[ interpolated? ] filter
swap each ;
M: xml (each-interpolated)
[ body>> ] dip (each-interpolated) ;
M: object (each-interpolated) 2drop ;
: (each-interpolated) ( item quot: ( interpolated -- ) -- )
{
{ [ over interpolated? ] [ call ] }
{ [ over tag? ] [
[ attrs>> values [ interpolated? ] filter ] dip each
] }
{ [ over xml? ] [ [ body>> ] dip (each-interpolated) ] }
[ 2drop ]
} cond ; inline recursive
: each-interpolated ( xml quot -- )
'[ _ (each-interpolated) ] deep-each ; inline
:: number<-> ( doc -- doc )
0 :> n! doc [
dup var>> [ n >>var n 1+ n! ] unless drop
] each-interpolated doc ;
: number<-> ( doc -- dup )
0 over [
dup var>> [ over >>var [ 1+ ] dip ] unless drop
] each-interpolated drop ;
MACRO: interpolate-xml ( string -- doc )
string>doc number<-> '[ _ interpolate-xml-doc ] ;

1
basis/xml/interpolate/summary.txt Normal file
View File

@ -0,0 +1 @@
Syntax for XML interpolation

2
basis/xml/interpolate/tags.txt Normal file
View File

@ -0,0 +1,2 @@
syntax
enterprise

4
basis/xml/tests/test.factor
View File

@ -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.
IN: xml.tests
USING: kernel xml tools.test io namespaces make sequences
@ -8,7 +8,7 @@ sequences.deep accessors io.streams.string ;
! This is insufficient
\ read-xml must-infer
[ [ drop ] sax ] must-infer
[ [ drop ] each-element ] must-infer
\ string>xml must-infer
SYMBOL: xml-file

1
basis/xml/utilities/tags.txt Normal file
View File

@ -0,0 +1 @@
syntax

56
basis/xml/utilities/utilities-docs.factor
View File

@ -6,11 +6,6 @@ IN: xml.utilities
ABOUT: "xml.utilities"
ARTICLE: "xml.utilities" "Utilities for processing XML"
"Utilities for processing XML include..."
$nl
"System sfor creating words which dispatch on XML tags:"
{ $subsection POSTPONE: PROCESS: }
{ $subsection POSTPONE: TAG: }
"Getting parts of an XML document or tag:"
$nl
"Note: the difference between deep-tag-named and tag-named is that the former searches recursively among all children and children of children of the tag, while the latter only looks at the direct children, and is therefore more efficient."
@ -19,11 +14,7 @@ ARTICLE: "xml.utilities" "Utilities for processing XML"
{ $subsection deep-tag-named }
{ $subsection deep-tags-named }
{ $subsection get-id }
"Words for simplified generation of XML:"
{ $subsection build-tag* }
{ $subsection build-tag }
{ $subsection build-xml }
"Other relevant words:"
"To get at the contents of a single tag, use"
{ $subsection children>string }
{ $subsection children-tags }
{ $subsection first-child-tag }
@ -31,71 +22,42 @@ ARTICLE: "xml.utilities" "Utilities for processing XML"
HELP: deep-tag-named
{ $values { "tag" "an XML tag or document" } { "name/string" "an XML name or string representing a name" } { "matching-tag" tag } }
{ $description "finds an XML tag with a matching name, recursively searching children and children of children" }
{ $description "Finds an XML tag with a matching name, recursively searching children and children of children." }
{ $see-also tags-named tag-named deep-tags-named } ;
HELP: deep-tags-named
{ $values { "tag" "an XML tag or document" } { "name/string" "an XML name or string representing a name" } { "tags-seq" "a sequence of tags" } }
{ $description "returns a sequence of all tags of a matching name, recursively searching children and children of children" }
{ $description "Returns a sequence of all tags of a matching name, recursively searching children and children of children." }
{ $see-also tag-named deep-tag-named tags-named } ;
HELP: children>string
{ $values { "tag" "an XML tag or document" } { "string" "a string" } }
{ $description "concatenates the children of the tag, ignoring everything that's not a string" } ;
{ $description "Concatenates the children of the tag, throwing an exception when there is a non-string child." } ;
HELP: children-tags
{ $values { "tag" "an XML tag or document" } { "sequence" sequence } }
{ $description "gets the children of the tag that are themselves tags" }
{ $description "Gets the children of the tag that are themselves tags." }
{ $see-also first-child-tag } ;
HELP: first-child-tag
{ $values { "tag" "an XML tag or document" } { "tag" tag } }
{ $description "returns the first child of the given tag that is a tag" }
{ $description "Returns the first child of the given tag that is a tag." }
{ $see-also children-tags } ;
HELP: tag-named
{ $values { "tag" "an XML tag or document" }
{ "name/string" "an XML name or string representing the name" }
{ "matching-tag" tag } }
{ $description "finds the first tag with matching name which is the direct child of the given tag" }
{ $description "Finds the first tag with matching name which is the direct child of the given tag." }
{ $see-also deep-tags-named deep-tag-named tags-named } ;
HELP: tags-named
{ $values { "tag" "an XML tag or document" }
{ "name/string" "an XML name or string representing the name" }
{ "tags-seq" "a sequence of tags" } }
{ $description "finds all tags with matching name that are the direct children of the given tag" }
{ $description "Finds all tags with matching name that are the direct children of the given tag." }
{ $see-also deep-tag-named deep-tags-named tag-named } ;
HELP: get-id
{ $values { "tag" "an XML tag or document" } { "id" "a string" } { "elem" "an XML element or f" } }
{ $description "finds the XML tag with the specified id, ignoring the namespace" } ;
HELP: PROCESS:
{ $syntax "PROCESS: word" }
{ $values { "word" "a new word to define" } }
{ $description "creates a new word to process XML tags" }
{ $see-also POSTPONE: TAG: } ;
HELP: TAG:
{ $syntax "TAG: tag word definition... ;" }
{ $values { "tag" "an xml tag name" } { "word" "an XML process" } }
{ $description "defines what a process should do when it encounters a specific tag" }
{ $examples { $code "PROCESS: x ( tag -- )\nTAG: a x drop \"hi\" write ;" } }
{ $see-also POSTPONE: PROCESS: } ;
HELP: build-tag*
{ $values { "items" "sequence of elements" } { "name" "string" }
{ "tag" tag } }
{ $description "builds a " { $link tag } " with the specified name, in the namespace \"\" and URL \"\" containing the children listed in item" }
{ $see-also build-tag build-xml } ;
HELP: build-tag
{ $values { "item" "an element" } { "name" string } { "tag" tag } }
{ $description "builds a " { $link tag } " with the specified name containing the single child item" }
{ $see-also build-tag* build-xml } ;
HELP: build-xml
{ $values { "tag" tag } { "xml" "an XML document" } }
{ $description "builds an XML document out of a tag" }
{ $see-also build-tag* build-tag } ;
{ $description "Finds the XML tag with the specified id, ignoring the namespace." } ;

8
basis/xml/utilities/utilities-tests.factor
View File

@ -1,8 +1,14 @@
! Copyright (C) 2005, 2009 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: xml xml.utilities tools.test xml.data ;
IN: xml.utilities.tests
USING: xml xml.utilities tools.test ;
[ "bar" ] [ "<foo>bar</foo>" string>xml children>string ] unit-test
[ "" ] [ "<foo></foo>" string>xml children>string ] unit-test
[ "" ] [ "<foo/>" string>xml children>string ] unit-test
XML-NS: foo http://blah.com
[ T{ name { main "bling" } { url "http://blah.com" } } ] [ "bling" foo ] unit-test

50
basis/xml/utilities/utilities.factor
View File

@ -1,52 +1,10 @@
! Copyright (C) 2005, 2006 Daniel Ehrenberg
! Copyright (C) 2005, 2009 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel namespaces sequences words io assocs
quotations strings parser lexer arrays xml.data xml.writer debugger
splitting vectors sequences.deep combinators fry ;
splitting vectors sequences.deep combinators fry memoize ;
IN: xml.utilities
! * System for words specialized on tag names
TUPLE: process-missing process tag ;
M: process-missing error.
"Tag <" write
dup tag>> print-name
"> not implemented on process process " write
name>> print ;
: run-process ( tag word -- )
2dup "xtable" word-prop
[ dup main>> ] dip at* [ 2nip call ] [
drop \ process-missing boa throw
] if ;
: PROCESS:
CREATE
dup H{ } clone "xtable" set-word-prop
dup '[ _ run-process ] define ; parsing
: TAG:
scan scan-word
parse-definition
swap "xtable" word-prop
rot "/" split [ [ 2dup ] dip swap set-at ] each 2drop ;
parsing
! * Common utility functions
: build-tag* ( items name -- tag )
assure-name swap f swap <tag> ;
: build-tag ( item name -- tag )
[ 1array ] dip build-tag* ;
: standard-prolog ( -- prolog )
T{ prolog f "1.0" "UTF-8" f } ;
: build-xml ( tag -- xml )
standard-prolog { } rot { } <xml> ;
: children>string ( tag -- string )
children>> {
{ [ dup empty? ] [ drop "" ] }
@ -115,3 +73,7 @@ M: process-missing error.
: insert-child ( child tag -- )
[ 1vector ] dip insert-children ;
: XML-NS:
CREATE-WORD (( string -- name )) over set-stack-effect
scan '[ f swap _ <name> ] define-memoized ; parsing

59
basis/xml/xml-docs.factor
View File

@ -1,66 +1,82 @@
! Copyright (C) 2005, 2009 Daniel Ehrenberg
! 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
HELP: string>xml
{ $values { "string" "a string" } { "xml" "an xml document" } }
{ $description "converts a string into an " { $link xml }
" datatype for further processing" } ;
{ $values { "string" string } { "xml" xml } }
{ $description "Converts a string into an " { $link xml }
" tree for further processing." } ;
HELP: read-xml
{ $values { "stream" "a stream that supports readln" }
{ "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." } ;
{ $values { "stream" "an input stream" } { "xml" xml } }
{ $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
{ $values { "filename" "a string representing a filename" }
{ "xml" "an XML document" } }
{ $description "opens the given file, reads it in as XML, closes the file and returns the corresponding XML tree" } ;
{ $values { "filename" string } { "xml" xml } }
{ $description "Opens the given file, reads it in as XML, closes the file and returns the corresponding XML tree. The encoding is automatically detected." } ;
{ string>xml read-xml file>xml } related-words
HELP: read-xml-chunk
{ $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 } ;
HELP: sax
HELP: each-element
{ $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" }
{ $see-also read-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 } ;
HELP: <pull-xml>
{ $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 } ;
HELP: pull-elem
{ $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 } ;
HELP: pull-event
{ $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 } ;
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"
"The following words are used to read something into an XML document"
{ $subsection string>xml }
{ $subsection read-xml }
{ $subsection read-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"
"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 closer }
{ $subsection contained }
@ -74,10 +90,11 @@ ARTICLE: "xml" "XML parser"
"The " { $vocab-link "xml" } " vocabulary implements the XML 1.0 and 1.1 standards, converting strings of text into XML and vice versa."
{ $subsection { "xml" "reading" } }
{ $subsection { "xml" "events" } }
{ $vocab-subsection "Utilities for processing XML" "xml.utilities" }
{ $vocab-subsection "Writing XML" "xml.writer" }
{ $vocab-subsection "XML parsing errors" "xml.errors" }
{ $vocab-subsection "XML entities" "xml.entities" }
{ $vocab-subsection "XML data types" "xml.data" } ;
{ $vocab-subsection "XML data types" "xml.data" }
{ $vocab-subsection "Utilities for processing XML" "xml.utilities" }
{ $vocab-subsection "Dispatch on XML tag names" "xml.dispatch" } ;
ABOUT: "xml"

27
basis/xml/xml.factor
View File

@ -6,7 +6,7 @@ xml.data xml.errors xml.elements ascii xml.entities
xml.writer xml.state xml.autoencoding assocs xml.tokenize xml.name ;
IN: xml
! -- Overall parser with data tree
<PRIVATE
: add-child ( object -- )
xml-stack get peek second push ;
@ -89,6 +89,8 @@ M: closer process
SYMBOL: text-now?
PRIVATE>
TUPLE: pull-xml scope ;
: <pull-xml> ( -- pull-xml )
[
@ -106,6 +108,8 @@ TUPLE: pull-xml scope ;
] if text-now? set
] bind ;
<PRIVATE
: done? ( -- ? )
xml-stack get length 1 = ;
@ -116,27 +120,33 @@ TUPLE: pull-xml scope ;
[ (pull-elem) ] if
] if ;
PRIVATE>
: pull-elem ( pull -- xml-elem/f )
[ init-xml-stack (pull-elem) ] with-scope ;
<PRIVATE
: call-under ( quot object -- quot )
swap dup slip ; inline
: sax-loop ( quot: ( xml-elem -- ) -- )
: xml-loop ( quot: ( xml-elem -- ) -- )
parse-text call-under
get-char [ make-tag call-under sax-loop ]
get-char [ make-tag call-under xml-loop ]
[ drop ] if ; inline recursive
: sax ( stream quot: ( xml-elem -- ) -- )
PRIVATE>
: each-element ( stream quot: ( xml-elem -- ) -- )
swap [
reset-prolog init-ns-stack
start-document [ call-under ] when*
sax-loop
] with-state ; inline recursive
xml-loop
] with-state ; inline
: (read-xml) ( -- )
start-document [ process ] when*
[ process ] sax-loop ; inline
[ process ] xml-loop ; inline
: (read-xml-chunk) ( stream -- prolog seq )
[
@ -155,7 +165,8 @@ TUPLE: pull-xml scope ;
[ (read-xml-chunk) nip ] with-variable ;
: string>xml ( string -- xml )
<string-reader> read-xml ;
t string-input?
[ <string-reader> read-xml ] with-variable ;
: string>xml-chunk ( string -- xml )
t string-input?

4
core/continuations/continuations-docs.factor
View File

@ -1,6 +1,6 @@
USING: help.markup help.syntax kernel kernel.private
continuations.private vectors arrays namespaces
assocs words quotations lexer sequences ;
assocs words quotations lexer sequences math ;
IN: continuations
ARTICLE: "errors-restartable" "Restartable errors"
@ -241,7 +241,7 @@ HELP: attempt-all
HELP: retry
{ $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." }
{ $examples

3
core/slots/slots-docs.factor
View File

@ -84,10 +84,9 @@ $nl
{ $subsection initial-value } ;
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
{ $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
"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 }

14
extra/4DNav/space-file-decoder/space-file-decoder.factor
View File

@ -1,17 +1,7 @@
! Copyright (C) 2008 Jeff Bigot
! See http://factorcode.org/license.txt for BSD license.
USING: adsoda
xml
xml.utilities
accessors
combinators
sequences
math.parser
kernel
splitting
values
continuations
;
USING: adsoda xml xml.utilities xml.dispatch accessors combinators
sequences math.parser kernel splitting values continuations ;
IN: 4DNav.space-file-decoder
: decode-number-array ( x -- y ) "," split [ string>number ] map ;

4
extra/partial-continuations/partial-continuations-docs.factor
View File

@ -12,9 +12,9 @@ HELP: bshift
{ $notes "It is important to note that even if the quotation discards items on the stack, the stack will be restored to the way it was before it is called (which is true of continuation usage in general)." } ;
ARTICLE: "partial-continuations" "Partial continuations"
"Based on Scheme code for bshift and breset from"
"Based on Scheme code for bshift and breset from "
{ $url "http://groups.google.com/group/comp.lang.scheme/msg/9f0d61da01540816" } "."
"See this blog entry for more details:"
" See this blog entry for more details:"
{ $url "http://www.bluishcoder.co.nz/2006/03/factor-partial-continuation-updates.html" }
{ $subsection breset }
{ $subsection bshift } ;

2
extra/sequences/n-based/n-based-docs.factor
View File

@ -57,7 +57,7 @@ IN: scratchpad
{ 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."
{ $subsection n-based-assoc }
{ $subsection <n-based-assoc> }