rebol[Title: "XML to HTML node parser"
Library: [
level: 'intermediate
platform: 'all
type: 'tool
domain: [xml html markup ]
tested-under: windows
support: none
license: none
see-also: none
]
Date: 1-Jan-2001
Name: 'QuickParser
Version: 0.0.2
File: %quickparser.r
Home: http://www.rebol.com/
Author: "daniel murrill"
Email: drebol@mindspring.com
Owner: "daniel murrill"
Rights: "Copyright (C) daniel murrill 2000"
Language: 'English
Charset: 'ANSI
Purpose: {
To parse xml, xhtml, css, and html
so you can search and update, remove,
or add to your markup quickly.
}
Comment: {
The purpose for this script is to
parse xml, xhtml, css, and html.
These xml parse functions are
concurrent with the W3C standards.
This script has been taken from a larger
portion that's used in a Rebol browser.
}
]
var: func [xmlname xmldata][
set xmlname xmldata xml: copy xmldata
]
var 'xmlblock {MadirthBalam Na ResortBalam ResortBalam qwertyNa Resort
"names" "Cabo" "Baja"
Resort Balam "24" "1968"backjump
}
cleantag: does [heads: ""
tails: ""
text: ""
node: ""
]
getnodename: func [tag]
[
cleantag
heads: to-string copy tag insert heads "<"
findtail: parse/all tag " " tails: findtail/1
tails: to-tag join "/" tails
parse/all xml
[
to heads copy nodename to ">" (heads: to-string reduce [nodename ">"])
thru ">" copy text to tails (text: to-string text)
(parse nodename
[
some [thru " " copy attname to "=" thru "=" copy attvalue to ">"
] skip
]node: to-string reduce [heads text tails]
print [heads text tails])
]
]
selectnodes: func [nodename childnode nodevalue ]
[
cleantag
getchildnodes: [] childnode: join "<" childnode text: copy nodevalue
heads: to-string reduce ["<" nodename]
tails: to-string reduce [""]
nodelist: "" clear getchildnodes
parse xml[
some [
to heads copy nodeslist thru tails
( getnode: find nodeslist nodename
gettails: find nodeslist tails
node: find/part getnode nodevalue gettails
if find nodeslist childnode [
append getchildnodes nodeslist
])]skip
]print getchildnodes
]
getnodevalue: func [txt] [
cleantag
parse/all xml
[
thru "<" copy htag to txt copy text to ""]
sethead: copy gethead
hds: parse/all sethead " " gettail: copy hds/1
heads: copy setag
tails: to-tag copy gettail insert tails "/"
parse setag
[
thru " " copy attname to "=" thru "=" copy attvalue
to ">"
]
node: to-string reduce [heads text tails]
print node)
]
]
getattribute: func [attrv]
[
parse/all xml [any
[
to "<" copy heads to attrv
copy attribute to "=" thru {="} copy attvalue
to ">" (attvalue: parse/all attvalue {"} attvalue: attvalue/1) thru ">" copy text
to ""
]
parse hds
[
thru "<" copy gettail to " " (trim/all gettail)
]
tails: to-tag copy gettail insert tails "/"
node: to-string reduce [heads text tails]
either find heads attrv [print node][print reduce [attrv {not found...}]]
]
getattvalue: func [attval]
[
parse/all xml [any
[
to "<" copy heads to attval copy attvalue
to ">" (attvalue: parse/all attvalue {"} attvalue: attvalue/1) thru ">" copy text
to ""
]
parse hds
[
thru "<" copy gettail to " " (trim/all gettail)
]
tails: to-tag copy gettail insert tails "/"
node: to-string reduce [heads text tails]
print node
]
setnode: func [newhead]
[
newhead: to-string copy newhead
insert newhead "<"
findtail: parse/all newhead " "
settail: copy findtail/1
remove settail settail/1
newtail: to-tag to-string reduce ["/" settail]
parse xml [to heads copy oldhead thru text to ""
replace childnode tails ""
parse childnode
[
to "<" copy heads to ">" (tails: parse/all heads " "
tails: form tails replace tails "<" "" copy text to tails (text: to-string text)
]
replace text heads ""
hds: parse/all heads " " gettail: to-string hds/1
gettail: remove head gettail
tails: to-tag copy gettail insert tails "/"
node: to-string reduce [heads ">" text tails]
print node)]
]
getnextsibling: func [] [
gethead: replace heads ">" ""
gethead: parse/all gethead " "
gethead: to-string gethead/1
oldnode: copy/part (find xml text) (find/last xml "" copy text to tails
]
parse heads
[
thru " " copy attributename to "=" thru "=" copy attributevalue to ">"
]
node: to-string reduce [heads text tails]
print node
]
[print reduce
[
heads "has no sibling...."
]
]
]
createnode: func [newnode]
[
tailnode: newnode
parse xml
[
to text thru text to tails thru tails objtail: to "<"
objtext: (change/part objtail reduce [newline newnode newline] :objtext)
(parse tailnode [some [thru ">" copy text to ""]
replace xml lastnode ""
append xml lastnode)
(parse newnode [thru ">" copy text to ""]
getnodename opendoc root: copy form tails size: length? root
parse xmldom/xml [to root mark: (remove/part mark size)]
set in xmldom 'xml to-string reduce [xmldom/xml this newline root]
]
]
insertBefore: func [position newnode][xmldom/getnodename position
parse xml [to "<" copy xmlhead nodehead: to heads objnewnode: (change/part nodehead
reduce [ xmlhead newnode newline] :objnewnode)]]
getnodename: func [element][xml: copy to-string xmldom/xml
if find xml element [heads: to-string copy element insert heads "<"
tails: to-string copy element
insert tails "/" tails: trim/all to-tag tails
parse xml [to heads copy node thru tails]
this: copy node print [node]]
objnode/heads: heads objnode/text: text objnode/tails: tails
]
setnode: func [newhead][
findhead: to-string copy newhead insert findhead "<"
size: length? tail findtail: parse/all findhead " "
settail: copy findtail/1 remove settail settail/1
insert settail "/" newtail: to-tag settail
parse xml [
to heads mark:(remove/part mark size
mark: insert mark findhead) :mark
]
replace xmldom/xml tails newtail
parse xml [
to mark copy node thru tails
] this: copy node
]
getnodevalue: func [value][xml: copy to-string xmldom/xml
if find xml value [parse xml [
thru "<" copy htag to value copy text thru value to ""]
sethead: copy gethead
heads: to-tag sethead
gettail: parse/all sethead " "
gettail: to-string gettail/1
tails: to-tag copy gettail
node: copy/part (find/case xml head) (find/case xml text)
print [trim/auto heads text tails]]
objnode/heads: heads objnode/text: text objnode/tails: tails
]
createnode: func [nodename][
heads: copy nodename
setail: parse/all heads " "
tails: to-string reduce [""]
heads: to-tag heads
]
createtextnode: func [nodevalue][text: copy form nodevalue
]
]
appendchild: func [data][set 'this reduce [me data tails]
]
removenode: func[][size: length? this
parse xmldom/xml [to this mark: (remove/part mark size)]
]
removetextnode: func[][size: length? text
parse xmldom/xml [to text mark: (remove/part mark size)]
]
call: func [data][set 'me reduce data
]
createobject: func [data][copy data do data ]
;Why use a xmldom? So you can work with different
;files of xml, markup,css,etc. set to different Words.
;you can get a file... var 'xmlblock load %load-some-file.r
;This coding was chosen because its very close to the
;MSXMLparser, and therefore a rebol function can clean
;it up and add this code automatically to your html page.
set 'x createobject("xmldom")
set 'xmldoc x/documentElement
tagname: x/createnode("PROPERTIES")
txt: x/createtextnode({
SIZE=300X400
BACKCOLOR=RED
NOICONS=TRUE
})
;You must set the called nodename to => this.
call(tagname)appendchild(txt) tagname: this
;You must append this new childnode to the document.
xmldoc/appendchild(tagname)
;The xmlDOM's xml is only a copy of the xmlblock's xml
;If you want changes to the xmlDOM's xml in the xmlblock,
;just do this... var 'xmlblock x/xml.
;var 'xmlblock x/xml
{Function: selectnodes
This is an E4X function: ECMAscript for xml function
It's the same as getElementsByTagName function, just shorter
to write. The selectnodes func. creates a nodelist of all nodes of
the same name with a childnode that has the requested value.
}