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

Splitting off PROCESS:/TAG: into a separate vocab; new word XML-NS:

db4
Daniel Ehrenberg 2009-01-27 13:34:14 -06:00
parent b4fe2f0ad0
commit ea741a786c
9 changed files with 112 additions and 94 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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: } ;

31
basis/xml/dispatch/dispatch-tests.factor Normal file
View File

@ -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 ] [
"<math><times><add><number>1</number><number>3</number></add><neg><number>-8</number></neg></times></math>"
calc-arith
] unit-test

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

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

@ -50,3 +50,6 @@ 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

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

@ -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 , ;

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

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

@ -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"