[REBOL] ML dialect update
From: al::bri::xtra::co::nz at: 14-Nov-2002 11:07
I've updated my ML (and Build-Tag) dialect to handle XML namespaces. The relevant files
are attached to this email.
Here's a section of my test code, so you can see what the ML dialect looks like:
probe ML probe [
<document xmlns="http://www.defaultnamespace.com" xmlns:tag="urn:someothernamespace.org:tag">
[
p [
"Here's some text in our default namespace. "
tag: [
text "Here's some text in the tag namespace."
]
" Here we are back in the default namespace."
tag: [
foo "Foo stuff"
blech: [
ngatai [
b "bold" i "italic"
]
]
bar "Bar stuff"
]
]
]
]
Note that the set-word! values are the namespace values.
Here's an example of the generated XML from the above dialect:
{
<document xmlns="http://www.defaultnamespace.com" xmlns:tag="urn:someothernamespace.org:tag">
<p>Here's some text in our default namespace. <tag:text>Here's some text in the tag namespace.</tag:text>
Here we are back in the default name
space.
<tag:foo>Foo stuff</tag:foo>
<blech:ngatai><blech:b>bold</blech:b><blech:i>italic</blech:i></blech:ngatai><tag:bar>Bar
stuff</tag:bar></p></document>
}
Andrew Martin
-- Attached file included as plaintext by Listar --
-- File: Build-Tag.r
Rebol [
Name: 'Build-Tag
Title: "Build-Tag"
File: %Build-Tag.r
Author: "Andrew Martin"
eMail: [Al--Bri--xtra--co--nz]
Web: http://valley.150m.com
Date: 14/November/2002
Version: 1.2.0
Purpose: {
Build-Tag is a replacement Build-Tag that handles XML attributes.
An earlier version of Build-tag is incorporated into latest Rebol/Core. :)
}
Category: [util 1]
]
Build-Tag: function [
"Generates a tag from a composed block."
Values [block!] "Block of parens to evaluate and other data."
] [
Tag Value_Rule XML? Name Attribute Value
] [
Tag: make string! 7 * length? Values
Value_Rule: [
set Value issue! (Value: mold Value)
| set value file! (Value: replace/all copy Value #" " " ")
| set Value any-type!
]
XML?: false
parse compose Values [
[
set Name ['?xml (XML?: true) | word! | url! | string!] (append Tag Name)
any [
set Attribute [word! | url! | string!] Value_Rule (
repend Tag [#" " Attribute {="} Value {"}]
)
| Value_Rule (repend Tag [#" " Value])
]
end (if XML? [append Tag #"?"])
]
| [set Name refinement! to end (Tag: mold Name)]
]
to tag! Tag
]
-- Attached file included as plaintext by Listar --
-- File: ML.r
Rebol [
Name: 'ML
Title: "ML"
File: %ML.r
Author: "Andrew Martin"
eMail: [Al--Bri--xtra--co--nz]
Web: http://valley.150m.com
Date: 14/November/2002
Version: 1.6.0
Needs: [%Build-Tag.r %Push.r %Pop.r]
Purpose: {
ML generates HTML, XHTML, XML, WML and SVG markup
from Rebol words, paths, tags and blocks.
}
Category: [util 5]
]
make object! [
Stack: make block! 10
push Stack ""
set 'ML function [
{ML generates HTML, XHTML, XML, WML and SVG markup
from Rebol words, paths, tags and blocks.}
Dialect [block!]
] [String Values_Rule Values Value Tag NameSpace] [
String: make string! 40000
Values_Rule: [
; Caution! The 'none word below is replaced in the 'parse rule below!
none [
set Value any-type! (
Tag: next next Tag
insert Tag Value
Value: none
)
]
; Caution! The 'opt word below is replaced in the 'parse rule below!
opt [
set Value [
decimal! | file! | block! | string! | char!
| money! | time! | issue! | tuple! | date!
| email! | pair! | logic! | integer! | url!
]
]
]
Values: make block! 10
parse Dialect [
any [
[
set Tag tag! (
Values_Rule/1: 0 ; Replace 'none word in 'Values_Rule above.
Values_Rule/3: either any [ ; Replace 'opt word...
#"/" = last Tag ; empty tag.
#"?" = first Tag ; XML tag.
#"!" = first Tag ; DOCTYPE tag.
] [0] [1]
)
| set Tag [path! | word!] (
Tag: to-block get 'Tag
Values_Rule/1: -1 + length? Tag ; Replace 'none word in 'Values_Rule above.
Values_Rule/3: 'opt ; Replace 'opt word...
)
] (Value: none) Values_Rule (
Tag: head Tag
repend String either none? Value [
if not tag? Tag [
Tag: Build-Tag Tag
]
if all [
#"/" <> last Tag
#"?" <> first Tag
#"!" <> first Tag
] [
append Tag " /"
]
[Tag newline]
] [
[
either all [block? Value empty? String] [newline] [""]
either tag? Tag [Tag] [Build-Tag head change Tag join first Stack first Tag]
either block? Value [ML Value] [Value]
to-tag join #"/" first either tag? Tag [to-block Tag] [Tag]
]
]
Values_Rule/1: none
)
| set NameSpace set-word! set Value block! (
push Stack probe mold :NameSpace
insert tail String ML Value
pop Stack
)
| none! ; Ignore 'none values.
| set Value any-type! (append String Value)
]
end
]
String
]
]
-- Attached file included as plaintext by Listar --
-- File: Push.r
Rebol [
Name: 'Push
Title: "Push"
File: %Push.r
Author: "Andrew Martin"
eMail: [Al--Bri--xtra--co--nz]
Web: http://valley.150m.com
Date: 3/July/2002
Version: 1.0.0
Purpose: {Inserts a value into a series and returns the series head.}
Category: [util 5]
]
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
]
]
-- Attached file included as plaintext by Listar --
-- File: Pop.r
Rebol [
Name: 'Pop
Title: "Pop"
File: %Pop.r
Author: "Andrew Martin"
eMail: [Al--Bri--xtra--co--nz]
Web: http://valley.150m.com
Date: 3/July/2002
Version: 1.0.0
Purpose: {Returns the first value in a series and removes it from the series.}
Category: [util 5]
]
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
]
