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 {

Madirth
Balam Na Resort Balam Resort
Balam qwerty Na Resort
"names" "Cabo" "Baja" Resort Balam "24" "1968"
back jump
} 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. }