[REBOL] Re: Rebol & XML
From: AJMartin:orcon at: 6-Aug-2003 18:00
Here's my load-XML function. Note that it doesn't get the values the right
way around. I've got something wrong in the commented out section of the
code. Any one figure out what I'm doing wrong?
Load-XML: function [
[catch] "Loads XML as a Rebol compatible block of values."
XML [string! file!] "The XML string or file."
] [Content Stack Attribute Value Attribute_Value^ Text^ Declaration^ Name
Text Element^] [
Content: make block! 10
Stack: make block! 10
Attribute_Value^: [
WS* copy Attribute [some Alpha opt [#":" some Alpha]] {="} copy Value to
#"^"" skip (
insert tail Content reduce [
to issue! Attribute
Value
]
)
]
Text^: complement charset #"<"
Declaration^: [
"<?xml" (Name: 'xml) any Attribute_Value^ WS? "?>" (
Content: reduce [Name Content]
)
]
Element^: [
"<!--" thru "-->" | #"<" (
;push/only Stack reduce [Name Content]
;Content: make block! 6
) copy Name some Alpha any [Attribute_Value^] WS? [
"/>" | #">" (push Stack Name) [
some [
copy Text some Text^ (
if not empty? trim Text [
insert tail Content reduce [to word! Name Text]
]
)
| Element^
]
] "</" (Name: pop Stack) Name WS? #">"
] (
;insert tail last first Stack reduce [Name Content]
;set [Name Content] pop Stack
)
]
if file? XML [
XML: read XML
]
all [
probe parse/all/case XML [
WS? Declaration^
WS? Element^
WS? end
]
Content
]
]
Push: func [
"Inserts a value into a series and returns the series head."
Stack [series! port! bitset!] "Series at point to insert."
Value [any-type!] /Only "The value to insert."
][
head either Only [
insert/only Stack :Value
][
insert Stack :Value
]
]
Pop: function [
"Returns the first value in a series and removes it from the series."
Stack [series! port! bitset!] "Series at point to pop from."
][
Value
][
Value: pick Stack 1
remove Stack
:Value
]
Fail^: [to end skip] ; A rule that always fails.
Succeed^: [] ; A rule that always succeeds.
Octet: charset [#"^(00)" - #"^(FF)"]
Digit: charset "0123456789"
Digits: [some Digit]
Upper: charset [#"A" - #"Z"]
Lower: charset [#"a" - #"z"]
Alpha: union Upper Lower
Alphas: [some Alpha]
AlphaDigit: union Alpha Digit
AlphaDigits: [some AlphaDigit]
Control: charset [#"^(00)" - #"^(1F)" #"^(7F)"]
Hex: union Digit charset [#"A" - #"F" #"a" - #"f"]
HT: #"^-"
SP: #" "
LWS: charset reduce [SP HT #"^(A0)"]
LWS*: [some LWS]
LWS?: [any LWS]
LF: #"^(0A)"
WS: charset reduce [SP HT newline CR LF]
WS*: [some WS]
WS?: [any WS]
Graphic: charset [
#"^(21)" - #"^(7E)"
#"^(80)"
#"^(82)" - #"^(8C)"
#"^(8E)"
#"^(91)" - #"^(9C)"
#"^(9E)" - #"^(9F)"
#"^(A1)" - #"^(FF)"
]
Printable: union Graphic charset reduce [SP #"^(A0)"]
Integer^: Digits
Decimal^: [Digits #"." Digits]
Money^: [#"$" Digits #"." 2 Digit]
; A Windows file name cannot contain any of these characters:
Forbidden: charset {\/:*?"<>|}
Line_End: [newline | end]
Blank_Line: [LWS? newline]
Blank_Lines: [any Blank_Line]
make object! [
Zone: [[#"+" | #"-"] 1 2 Digit #":" 2 Digit]
set 'Time^ [1 2 Digit #":" 1 2 Digit opt [#":" 1 2 Digit]]
Long-Months: remove map Rebol/locale/Months func [Month [string!]] [
reduce ['| copy Month]
]
Short-Months: remove map Rebol/locale/Months func [Month [string!]] [
reduce ['| copy/part Month 3]
]
Month: [1 2 Digit | Long-Months | Short-Months]
Separator: charset "/-"
Day: [1 2 Digit]
set 'Date^ [
[
[Day Separator Month Separator [4 Digit | 2 Digit]]
| [4 Digit Separator Month Separator Day]
]
opt [#"/" [Time^ opt Zone]]
]
]
make object! [
Permitted: exclude Printable Forbidden
Filename: [some Permitted]
Folder: [Filename #"/"]
Relative_Path: [some Folder]
Absolute_Path: [#"/" any Relative_Path]
set 'File^ [
[Absolute_Path opt Filename]
| [Relative_Path opt Filename]
| Filename
]
]
make object! [
Permitted: exclude Printable Forbidden
Drive^: [Alpha #":"]
Filename^: [some Permitted]
Folder^: [Filename^ #"\"]
Relative_Path^: [some Folder^]
Absolute_Path^: [#"\" any Relative_Path^]
set 'Local_File^ [Drive^ Absolute_Path^ opt Filename^]
]
Andrew J Martin
ICQ: 26227169
http://www.rebol.it/Valley/
http://valley.orcon.net.nz/
http://Valley.150m.com/
