From ea741a786c6f90d5e8c779fd9d5bf8c1207d8444 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Tue, 27 Jan 2009 13:34:14 -0600 Subject: [PATCH 1/6] Splitting off PROCESS:/TAG: into a separate vocab; new word XML-NS: --- basis/xml/dispatch/dispatch-docs.factor | 25 +++++++++ basis/xml/dispatch/dispatch-tests.factor | 31 ++++++++++ basis/xml/dispatch/dispatch.factor | 27 +++++++++ .../xml/interpolate/interpolate-tests.factor | 3 + basis/xml/interpolate/interpolate.factor | 1 + basis/xml/utilities/utilities-docs.factor | 56 +++---------------- basis/xml/utilities/utilities-tests.factor | 8 ++- basis/xml/utilities/utilities.factor | 50 ++--------------- basis/xml/xml-docs.factor | 5 +- 9 files changed, 112 insertions(+), 94 deletions(-) create mode 100644 basis/xml/dispatch/dispatch-docs.factor create mode 100644 basis/xml/dispatch/dispatch-tests.factor create mode 100644 basis/xml/dispatch/dispatch.factor diff --git a/basis/xml/dispatch/dispatch-docs.factor b/basis/xml/dispatch/dispatch-docs.factor new file mode 100644 index 0000000000..572a75cd05 --- /dev/null +++ b/basis/xml/dispatch/dispatch-docs.factor @@ -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: } ; diff --git a/basis/xml/dispatch/dispatch-tests.factor b/basis/xml/dispatch/dispatch-tests.factor new file mode 100644 index 0000000000..6f3179bc02 --- /dev/null +++ b/basis/xml/dispatch/dispatch-tests.factor @@ -0,0 +1,31 @@ +! Copyright (C) 2005, 2009 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: xml io kernel math sequences strings xml.utilities +tools.test math.parser xml.dispatch ; +IN: xml.dispatch.tests + +PROCESS: calculate ( tag -- n ) + +: calc-2children ( tag -- n n ) + children-tags first2 [ calculate ] dip calculate ; + +TAG: number calculate + children>string string>number ; +TAG: add calculate + calc-2children + ; +TAG: minus calculate + calc-2children - ; +TAG: times calculate + calc-2children * ; +TAG: divide calculate + calc-2children / ; +TAG: neg calculate + children-tags first calculate neg ; + +: calc-arith ( string -- n ) + string>xml first-child-tag calculate ; + +[ 32 ] [ + "13-8" + calc-arith +] unit-test diff --git a/basis/xml/dispatch/dispatch.factor b/basis/xml/dispatch/dispatch.factor new file mode 100644 index 0000000000..23cb43cc47 --- /dev/null +++ b/basis/xml/dispatch/dispatch.factor @@ -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 diff --git a/basis/xml/interpolate/interpolate-tests.factor b/basis/xml/interpolate/interpolate-tests.factor index 83d8d76f34..621480abb9 100644 --- a/basis/xml/interpolate/interpolate-tests.factor +++ b/basis/xml/interpolate/interpolate-tests.factor @@ -50,3 +50,6 @@ IN: xml.interpolate.tests [ 3 f URL" http://factorcode.org/" "hello" \ drop false=<-> url=<-> string=<-> word=<->/> XML> pprint-xml>string ] unit-test + +[ "3" ] [ 3 [XML <-> XML] xml-chunk>string ] unit-test +[ "" ] [ f [XML <-> XML] xml-chunk>string ] unit-test diff --git a/basis/xml/interpolate/interpolate.factor b/basis/xml/interpolate/interpolate.factor index d8927ca728..9e39ba8fdc 100644 --- a/basis/xml/interpolate/interpolate.factor +++ b/basis/xml/interpolate/interpolate.factor @@ -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 , ; diff --git a/basis/xml/utilities/utilities-docs.factor b/basis/xml/utilities/utilities-docs.factor index 5e391832dd..161ca824c3 100644 --- a/basis/xml/utilities/utilities-docs.factor +++ b/basis/xml/utilities/utilities-docs.factor @@ -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." } ; diff --git a/basis/xml/utilities/utilities-tests.factor b/basis/xml/utilities/utilities-tests.factor index c150c7133d..7b0989611c 100644 --- a/basis/xml/utilities/utilities-tests.factor +++ b/basis/xml/utilities/utilities-tests.factor @@ -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" ] [ "bar" string>xml children>string ] unit-test [ "" ] [ "" string>xml children>string ] unit-test [ "" ] [ "" string>xml children>string ] unit-test + +XML-NS: foo http://blah.com + +[ T{ name { main "bling" } { url "http://blah.com" } } ] [ "bling" foo ] unit-test diff --git a/basis/xml/utilities/utilities.factor b/basis/xml/utilities/utilities.factor index e104142a76..60460e3f46 100644 --- a/basis/xml/utilities/utilities.factor +++ b/basis/xml/utilities/utilities.factor @@ -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 ; - -: 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 { } ; - : 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 _ ] define-memoized ; parsing diff --git a/basis/xml/xml-docs.factor b/basis/xml/xml-docs.factor index 60bc88bad6..264a71c8e9 100644 --- a/basis/xml/xml-docs.factor +++ b/basis/xml/xml-docs.factor @@ -74,10 +74,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" From 50cd0c4ccc95af22d8695d7dfe004f39279f9288 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Tue, 27 Jan 2009 13:38:13 -0600 Subject: [PATCH 2/6] Updating other vocabs for XML changes --- basis/lcs/diff2html/diff2html-tests.factor | 6 ++++ basis/xml-rpc/xml-rpc.factor | 11 ++----- basis/xml/tests/arithmetic.factor | 30 ------------------- .../space-file-decoder.factor | 14 ++------- 4 files changed, 10 insertions(+), 51 deletions(-) create mode 100644 basis/lcs/diff2html/diff2html-tests.factor delete mode 100644 basis/xml/tests/arithmetic.factor diff --git a/basis/lcs/diff2html/diff2html-tests.factor b/basis/lcs/diff2html/diff2html-tests.factor new file mode 100644 index 0000000000..d261a4659a --- /dev/null +++ b/basis/lcs/diff2html/diff2html-tests.factor @@ -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 diff --git a/basis/xml-rpc/xml-rpc.factor b/basis/xml-rpc/xml-rpc.factor index d2fd111b39..52e175ca3a 100644 --- a/basis/xml-rpc/xml-rpc.factor +++ b/basis/xml-rpc/xml-rpc.factor @@ -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 <-> XML] ; + [XML <-> XML] ; UNION: boolean t POSTPONE: f ; @@ -176,10 +176,3 @@ TAG: array xml>item : invoke-method ( params method url -- ) [ swap ] 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 ; diff --git a/basis/xml/tests/arithmetic.factor b/basis/xml/tests/arithmetic.factor deleted file mode 100644 index 98facfcac2..0000000000 --- a/basis/xml/tests/arithmetic.factor +++ /dev/null @@ -1,30 +0,0 @@ -! Copyright (C) 2005, 2006 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 ; - -PROCESS: calculate ( tag -- n ) - -: calc-2children ( tag -- n n ) - children-tags first2 [ calculate ] dip calculate ; - -TAG: number calculate - children>string string>number ; -TAG: add calculate - calc-2children + ; -TAG: minus calculate - calc-2children - ; -TAG: times calculate - calc-2children * ; -TAG: divide calculate - calc-2children / ; -TAG: neg calculate - children-tags first calculate neg ; - -: calc-arith ( string -- n ) - string>xml first-child-tag calculate ; - -[ 32 ] [ - "13-8" - calc-arith -] unit-test diff --git a/extra/4DNav/space-file-decoder/space-file-decoder.factor b/extra/4DNav/space-file-decoder/space-file-decoder.factor index 158917ca3e..8ef5c9e906 100755 --- a/extra/4DNav/space-file-decoder/space-file-decoder.factor +++ b/extra/4DNav/space-file-decoder/space-file-decoder.factor @@ -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 ; From c46f857671b46b24aa1b56e5471b4b7911bf29fe Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Tue, 27 Jan 2009 14:15:00 -0600 Subject: [PATCH 3/6] Documenting read-dtd and friends; renaming sax to each-element --- basis/xml/data/tags.txt | 2 ++ basis/xml/dispatch/authors.txt | 1 + basis/xml/dispatch/summary.txt | 1 + basis/xml/dispatch/tags.txt | 1 + basis/xml/interpolate/summary.txt | 1 + basis/xml/interpolate/tags.txt | 2 ++ basis/xml/tests/test.factor | 2 +- basis/xml/utilities/tags.txt | 1 + basis/xml/xml-docs.factor | 54 ++++++++++++++++++++----------- basis/xml/xml.factor | 27 +++++++++++----- 10 files changed, 64 insertions(+), 28 deletions(-) create mode 100644 basis/xml/data/tags.txt create mode 100644 basis/xml/dispatch/authors.txt create mode 100644 basis/xml/dispatch/summary.txt create mode 100644 basis/xml/dispatch/tags.txt create mode 100644 basis/xml/interpolate/summary.txt create mode 100644 basis/xml/interpolate/tags.txt create mode 100644 basis/xml/utilities/tags.txt diff --git a/basis/xml/data/tags.txt b/basis/xml/data/tags.txt new file mode 100644 index 0000000000..2a501370ae --- /dev/null +++ b/basis/xml/data/tags.txt @@ -0,0 +1,2 @@ +collections +assocs diff --git a/basis/xml/dispatch/authors.txt b/basis/xml/dispatch/authors.txt new file mode 100644 index 0000000000..f990dd0ed2 --- /dev/null +++ b/basis/xml/dispatch/authors.txt @@ -0,0 +1 @@ +Daniel Ehrenberg diff --git a/basis/xml/dispatch/summary.txt b/basis/xml/dispatch/summary.txt new file mode 100644 index 0000000000..6751e55e63 --- /dev/null +++ b/basis/xml/dispatch/summary.txt @@ -0,0 +1 @@ +'Generic words' that dispatch on XML tag names diff --git a/basis/xml/dispatch/tags.txt b/basis/xml/dispatch/tags.txt new file mode 100644 index 0000000000..71c0ff7282 --- /dev/null +++ b/basis/xml/dispatch/tags.txt @@ -0,0 +1 @@ +syntax diff --git a/basis/xml/interpolate/summary.txt b/basis/xml/interpolate/summary.txt new file mode 100644 index 0000000000..7c18fc8c76 --- /dev/null +++ b/basis/xml/interpolate/summary.txt @@ -0,0 +1 @@ +Syntax for XML interpolation diff --git a/basis/xml/interpolate/tags.txt b/basis/xml/interpolate/tags.txt new file mode 100644 index 0000000000..d236e9679f --- /dev/null +++ b/basis/xml/interpolate/tags.txt @@ -0,0 +1,2 @@ +syntax +enterprise diff --git a/basis/xml/tests/test.factor b/basis/xml/tests/test.factor index 99b660276c..bed729e300 100644 --- a/basis/xml/tests/test.factor +++ b/basis/xml/tests/test.factor @@ -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 diff --git a/basis/xml/utilities/tags.txt b/basis/xml/utilities/tags.txt new file mode 100644 index 0000000000..71c0ff7282 --- /dev/null +++ b/basis/xml/utilities/tags.txt @@ -0,0 +1 @@ +syntax diff --git a/basis/xml/xml-docs.factor b/basis/xml/xml-docs.factor index 264a71c8e9..26d4319b5e 100644 --- a/basis/xml/xml-docs.factor +++ b/basis/xml/xml-docs.factor @@ -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-event pull-elem } ; HELP: { $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-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-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 } diff --git a/basis/xml/xml.factor b/basis/xml/xml.factor index fdabbdc4df..b043d5771e 100644 --- a/basis/xml/xml.factor +++ b/basis/xml/xml.factor @@ -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 + + TUPLE: pull-xml scope ; : ( -- pull-xml ) [ @@ -106,6 +108,8 @@ TUPLE: pull-xml scope ; ] if text-now? set ] bind ; + + : pull-elem ( pull -- xml-elem/f ) [ init-xml-stack (pull-elem) ] with-scope ; + + +: 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 ) - read-xml ; + t string-input? + [ read-xml ] with-variable ; : string>xml-chunk ( string -- xml ) t string-input? From c581b67193ed96178d6cfa846a5b443b414849ba Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Tue, 27 Jan 2009 14:33:43 -0600 Subject: [PATCH 4/6] Code using interpolation can now compile --- .../xml/interpolate/interpolate-tests.factor | 3 ++ basis/xml/interpolate/interpolate.factor | 28 +++++++++---------- basis/xml/tests/test.factor | 2 +- 3 files changed, 18 insertions(+), 15 deletions(-) diff --git a/basis/xml/interpolate/interpolate-tests.factor b/basis/xml/interpolate/interpolate-tests.factor index 621480abb9..3067254a60 100644 --- a/basis/xml/interpolate/interpolate-tests.factor +++ b/basis/xml/interpolate/interpolate-tests.factor @@ -53,3 +53,6 @@ IN: xml.interpolate.tests [ "3" ] [ 3 [XML <-> XML] xml-chunk>string ] unit-test [ "" ] [ f [XML <-> XML] xml-chunk>string ] unit-test + +\ parse-def must-infer +[ "" interpolate-chunk ] must-infer diff --git a/basis/xml/interpolate/interpolate.factor b/basis/xml/interpolate/interpolate.factor index 9e39ba8fdc..0b3bb15456 100644 --- a/basis/xml/interpolate/interpolate.factor +++ b/basis/xml/interpolate/interpolate.factor @@ -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 @@ -48,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 ] ; diff --git a/basis/xml/tests/test.factor b/basis/xml/tests/test.factor index bed729e300..e3a7fdbc7a 100644 --- a/basis/xml/tests/test.factor +++ b/basis/xml/tests/test.factor @@ -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 From 824df4182ab5c3268f6f1deea0f9af59263da809 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Tue, 27 Jan 2009 15:10:56 -0600 Subject: [PATCH 5/6] Fixing xml.interpolate docs --- basis/xml/interpolate/interpolate-docs.factor | 18 ++++++++++-------- basis/xml/interpolate/interpolate-tests.factor | 1 + 2 files changed, 11 insertions(+), 8 deletions(-) diff --git a/basis/xml/interpolate/interpolate-docs.factor b/basis/xml/interpolate/interpolate-docs.factor index 2633ef11cb..23972ba7a4 100644 --- a/basis/xml/interpolate/interpolate-docs.factor +++ b/basis/xml/interpolate/interpolate-docs.factor @@ -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 <-> XML]" } " or where an attribute might go, as in " { $snippet "[XML /> 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 <-> XML] ] map -<-> XML> pprint-xml>string "} -{" <' +<-> XML> pprint-xml"} +{" one @@ -37,10 +38,11 @@ $nl three -'> "} } +"} } "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> pprint-xml ] "} +{" +"} } ; diff --git a/basis/xml/interpolate/interpolate-tests.factor b/basis/xml/interpolate/interpolate-tests.factor index 3067254a60..817cb453fa 100644 --- a/basis/xml/interpolate/interpolate-tests.factor +++ b/basis/xml/interpolate/interpolate-tests.factor @@ -56,3 +56,4 @@ IN: xml.interpolate.tests \ parse-def must-infer [ "" interpolate-chunk ] must-infer +[ [XML <-> /> XML] ] must-infer From c01ef3fca2dc10b57b64446d34a0ded6f139f045 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Tue, 27 Jan 2009 15:35:51 -0600 Subject: [PATCH 6/6] Fixing random docs and tests --- basis/farkup/farkup-docs.factor | 4 ++-- basis/html/components/components-docs.factor | 4 ++-- basis/html/templates/chloe/chloe-tests.factor | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/basis/farkup/farkup-docs.factor b/basis/farkup/farkup-docs.factor index 8e7270cc01..8c6b07a01c 100644 --- a/basis/farkup/farkup-docs.factor +++ b/basis/farkup/farkup-docs.factor @@ -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 } "." diff --git a/basis/html/components/components-docs.factor b/basis/html/components/components-docs.factor index d131cc3e03..39c17a4708 100644 --- a/basis/html/components/components-docs.factor +++ b/basis/html/components/components-docs.factor @@ -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." diff --git a/basis/html/templates/chloe/chloe-tests.factor b/basis/html/templates/chloe/chloe-tests.factor index 542dfa0e05..19b67f7018 100644 --- a/basis/html/templates/chloe/chloe-tests.factor +++ b/basis/html/templates/chloe/chloe-tests.factor @@ -159,7 +159,7 @@ TUPLE: person first-name last-name ; "true" "b" set-value ] unit-test -[ "ab" ] [ +[ "ab" ] [ [ "test12" test-template call-template ] run-template