[REBOL] Re: XML examples?
From: greggirwin:starband at: 21-Sep-2001 13:35
Jason,
Here is a large message that Andrew posted not too long ago. Hopefully he
won't mind my re-posting it for you.
--Gregg
<snip>
And here's an example of it's use (along with some eText):
eText: do %/C/Rebol/Dialect/eText.r
HTML: do %/C/Rebol/Dialect/HTML.r
HTML/BgColor: #FFFFFC
HTML/Text: #000000
HTML/Link: #CC0000
HTML/VLink: #330099
HTML/ALink: #FF3300
HTML/Background: %Jade.jpg
Page: make object! [
Margin: 180
Width: 480
]
Leaf: function [File [file!]][Title Dialect][
Title: to-string copy/part File find File %.txt
Dialect: eText/Dialect read File
write replace File %.txt %.html HTML/Dialect compose/Deep [
Header [
Title (Title)
]
Body [
Table [
Tr [
Td/Width " " (Page/Margin)
Td/Width [(Dialect)] (Page/Width)
Td " "
]
]
]
]
]
Andrew Martin
ICQ: 26227169 http://zen.scripterz.org
-><-
----- Original Message -----
From: <[raven--swipnet--se]>
To: <[ally-list--rebol--com]>
Sent: Friday, September 14, 2001 7:56 AM
Subject: [ALLY] Re: XML and REBOL
> > Does anyone have any XML related rebol scripts to show off?
> >
> >I've got a WML, HTML and XHTML dialect that generates those markup
> >languages
> >from Rebol values. That way, I don't have to worry about ending tags, and
I
> >can generate HTML, etc from Rebol scripts or eText.
> >
> >Andrew Martin
> >ICQ: 26227169 http://zen.scripterz.org
>
> Can I have a look? I don't suppose you have them on your homepage -
> I could not find anything related there.
>
> kind regards
> Andreas
>
> -------------------------------------------------
> WebMail från Everyday http://www.everyday.com
> -------------------------------------------------
>
> --
> To unsubscribe from this list, please send an email to
> [ally-request--rebol--com] with "unsubscribe" in the
> subject, without the quotes.
>
-- Attached file included as plaintext by Listar --
-- File: ML.r
[
Rebol [
Name: 'ML
Title: "ML Dialect"
File: %ML.r
Author: "Andrew Martin"
eMail:
[Al--Bri--xtra--co--nz]
Date: 3/September/2001
]
make object! [
Empty-Tag: func [Tag [tag!]][
rejoin ["" join Tag " /" newline]
]
Encode: func [Value [any-type!]][
either any [
url? Value
issue? Value
][
mold Value
][
join "" Value
]
]
Replacements: make block! 0
Inline: func [Value [string!]][
foreach [Search Replacement] Replacements [
replace/all Value Search Replacement
]
Value
]
Inlines: func [Item [any-type!]][
either string? :Item [
Inline Item
][
:Item
]
]
Map: function [Block [block!] Function [function!]][Mapped][
Mapped: make block! length? Block
foreach Item Block [
insert/only tail Mapped Function :Item
]
Mapped
]
Recurse: func [Content [block! string! tag!]][
either block? Content [
join "" reduce bind Map Content :Inlines 'self
][
Content
]
]
Tags: func [Tag [tag!] Content [string! tag!] /Break /Breaks][
rejoin [
either any [Break Breaks] [newline][""]
Tag
either Breaks [newline][""]
Content
either Breaks [newline][""]
to-tag join "/" first parse Tag none
;either Breaks [newline][""]
]
]
Dialect: func [Content [block!]][
Recurse Content
]
Comment: func [Ignored [block! string! tag!]][
rejoin [<!--> mold Ignored "--"]
]
Br: join mold <br/> newline
P: function [Content [string! block!] /Left /Center /Right][Tag][
Tag: copy [p]
if Left [append Tag [align ("left")]]
if Center [append Tag [align ("center")]]
if Right [append Tag [align ("right")]]
Tags/Break build-tag Tag Recurse Content
]
]
]
-- Attached file included as plaintext by Listar --
-- File: HTML.r
[
Rebol [
Name: 'HTML
Title: "HTML Dialect"
File: %"HTML.r"
Author: "Andrew Martin"
eMail:
[Al--Bri--xtra--co--nz]
Date: 11/September/2001
]
make do %ML.r insert tail [
BgColor: #FFFFFC
Text: "black"
Link: #CC0000
VLink: "blue"
ALink: "orange"
Background: none
Dialect: func [Content [block!]][
Tags <html> Recurse Content
]
Refresh: func [Delay [time!] File [url! file!]][
Empty-Tag build-tag [
meta http-equiv ("refresh") content (
rejoin [
mold Delay/second "; URL=" Encode File
]
)
]
]
StyleSheet: func [File [file! url!]][
Empty-Tag build-tag [
link rel ("stylesheet") type ("text/css") href (Encode File)
]
]
JavaScript: function [Text [file! url! string!]][Tag][
Tag: copy [script type ("text/javascript") language ("JavaScript")]
either string? Text [
Tags/Break build-tag Tag rejoin [
"<!-- " newline
Text newline
"//-->"
]
][
append Tag [src (Encode Text)]
Empty-Tag build-tag Tag
]
]
Title: func [Content [string!]][
Tags <title> Content
]
Header: func [Content [block!]][
Tags/breaks <head> Recurse Content
]
Body: function [Content [block!] /onLoad onLoadScript [string!]][Tag][
Tag: copy [
body bgcolor (Encode BgColor)
text (Encode Text)
link (Encode Link)
vlink (Encode VLink)
alink (Encode ALink)
]
if not none? Background [
append Tag [background (Encode Background)]
]
if onLoad [
append Tag [onload (onLoadScript)]
]
Tags/breaks build-tag Tag Recurse Content
]
Td: function [Content [string! block!] /Left /Center /Right /Width N
[integer! string!]][Tag][
Tag: copy [td]
if Left [append Tag [align ("left")]]
if Center [append Tag [align ("center")]]
if Right [append Tag [align ("right")]]
if Width [append Tag [width (N)]]
Tags build-tag Tag Recurse Content
]
Th: function [Content [string! block!] /Left /Center /Right][Tag][
Tag: copy [th]
if Left [append Tag [align ("left")]]
if Center [append Tag [align ("center")]]
if Right [append Tag [align ("right")]]
Tags build-tag Tag Recurse Content
]
Tr: func [Content [string! block!]][
Tags/Breaks <tr> Recurse Content
]
Table: function [
Content [string! block!]
/Width W [integer! string!]
/Height H [integer! string!]
][Tag][
Tag: copy [table]
if Width [append Tag [width (w)]]
if Height [append Tag [height (w)]]
Tags/Breaks build-tag Tag Recurse Content
]
Hr: <br />
Div: function [Class [string!] Content [string! block!] /Center][Tag][
Tag: copy [div class (Class)]
if Center [append Tag [align ("center")]]
Tags/Breaks build-tag Tag Recurse Content
]
Center: func [Content [string! block!]][
Div/Center "Center" Content
]
BlockQuote: func [Content [string! block!]][
Tags/Breaks <blockquote> Recurse Content
]
Address: func [Content [string! block!]][
Tags/Breaks <address> Recurse Content
]
IP: function [Content [string! block!] /Left /Center /Right][Tag][
Tag: copy [p class ("Initial")]
if Left [append Tag [align ("left")]]
if Center [append Tag [align ("center")]]
if Right [append Tag [align ("right")]]
Tags/Break build-tag Tag Recurse Content
]
UL: func [Content [block!]][
Tags/Breaks <ul> Recurse Content
]
OL: func [Content [block!]][
Tags/Breaks <ol> Recurse Content
]
Image: func [Picture [file! url!] WxH [pair!] Alternative [string!]][
Empty-Tag build-tag [
img border (0)
src (Encode Picture)
width (WxH/x) height (WxH/y)
alt (Alternative)
]
]
A: function [
Reference [file! url! email! string!] Content [string! block!] /Top /Name
/Blank
][
Tag
][
if email? Reference [
return MailTo Reference "" Content
]
Tag: copy [a]
if any [Top Blank] [
append Tag [target (either Top ["_top"]["_blank"])]
]
append Tag either Name [
Reference: replace/all copy Reference " " "_"
[name (Encode Reference)]
][
[href (Encode Reference)]
]
Tags build-tag Tag Recurse Content
]
MailTo: func [eMail [email!] Subject [string!] Content [string! block!]][
Tags build-tag [a href (rejoin ["mailto:" eMail "?subject=" Subject])]
Recurse Content
]
] use [Block] [
Block: make block! 10
foreach [Word Tag] [
U: <u>
B: <b>
I: <i>
Ins: <ins>
Del: <del>
Big: <big>
Em: <em>
Small: <small>
Strong: <strong>
Pre: <pre>
H1: <h1>
H2: <h2>
H3: <h3>
H4: <h4>
H5: <h5>
H6: <h6>
Tt: <tt>
Q: <q>
Dt: <dt>
Dd: <dd>
Dl: <dl>
NoBreak: <nobr>
Li: <li>
][
append Block compose/deep [
(:Word) func [Content [string! block!]][
Tags (Tag) Recurse Content
]
]
]
Block
]
]
-- Attached file included as plaintext by Listar --
-- File: eText.r
[
Rebol [
Name: 'eText
Title: "eText"
File: %eText.r
Author: "Andrew Martin"
eMail:
[Al--Bri--xtra--co--nz]
Date: 13/September/2001
]
make object! [
Space: charset [#" " #"^-"]
Br: Empty: [any Space newline]
Graphic: charset [#"^(21)" - #"^(7E)"]
Printable: charset [#"^(20)" - #"^(7E)"]
URI: do %URI.r
Inline!: make object! [
Text: Block: Before: After: none
Plain: function [Value [block! string! tag! none!]][String][
String: copy/part Before After
if not empty? String [
append Block String
]
if not none? Value [
repend Block Value
]
]
Pair: function [Mark [char!] HtmlDialect [block!]][NonMark][
NonMark: exclude Graphic charset to string! Mark
compose/deep [
After: (Mark) copy Text [some (NonMark) any [some #" " some (NonMark)]]
(Mark)
(to-paren reduce ['Plain HtmlDialect])
Before:
]
]
Link: make object! [
LinkRef: URI/Link
Word: compose/deep [(URI/Alpha) some [(URI/Alphanumeric) | #"-"] opt
{'s}]
Files: Text: Link: none
Rule: [
[
After: [
{"} copy Text to {" } {" }
| copy Text Word
] copy Link LinkRef (
Plain ['A first load/next Link Text]
) Before:
]
| [
After: [
{?"} copy Link to {"} skip
| "?" copy Link Word
](
Text: replace/all copy Link " " " "
if none? Files [Files: read %.]
if found? find Files to-file join Link #"/" [
append Link #"/"
]
Link: rejoin [
to-file replace/all Link " " " "
either #"/" = last Link [%Index.html][%.html]
]
Plain ['A Link Text]
) Before:
]
]
]
Single: func [Mark [string! char!] Replacement [string!]][
compose [After: (Mark) (to-paren compose [Plain (Replacement)]) Before:]
]
Rules: compose [
(Link/Rule)
| (Pair #"_" ['U Text])
| (Pair #"~" ['I Text])
;| (Pair #"+" ['Ins Text])
;| (Pair #"-" ['Del Text]) ; Need a better choice for 'Del, not hyphen.
| (Pair #"*" ['B Text])
| (Single newline "<br/>")
| (Single {---} "—")
| (Single {--} "–")
| (Single {&} "&")
| (Single {<} "<")
| (Single {>} ">")
| (Single {(c)} "©") | (Single {(C)} "©")
| (Single {(r)} "®") | (Single {(R)} "®")
| (Single {(tm)} "™") | (Single {(TM)} "™")
| (Single {-tm} "™") | (Single {-TM} "™")
| (Single {A^^`} {À}) | (Single {a^^`} {à})
| (Single {A^^'} {Á}) | (Single {a^^'} {Á})
| (Single {A^^~} {Ã}) | (Single {a^^~} {ã})
| (Single {A^^"} {Ä}) | (Single {a^^"} {ä})
| (Single {A^^*} {Å}) | (Single {a^^*} {å})
| (Single {A^^E} {Æ}) | (Single {a^^e} {æ})
| (Single {,C} {Ç}) | (Single {,c} {&ccdel;})
| (Single {E^^`} {È}) | (Single {e^^`} {è})
| (Single {E^^'} {É}) | (Single {e^^'} {é})
| (Single {E^^"} {Ë}) | (Single {e^^"} {ë})
| (Single {I^^`} {Ì}) | (Single {i^^`} {ì})
| (Single {I^^'} {Í}) | (Single {i^^'} {í})
| (Single {I^^"} {Ï}) | (Single {i^^"} {ï})
| (Single {D^^-} {Ð}) | (Single {d^^-} {ð})
| (Single {N^^~} {Ñ}) | (Single {n^^~} {ñ})
| (Single {O^^`} {Ò}) | (Single {o^^`} {ò})
| (Single {O^^'} {Ó}) | (Single {o^^'} {ó})
| (Single {O^^~} {Õ}) | (Single {o^^~} {õ})
| (Single {O^^"} {Ö}) | (Single {o^^"} {ö})
| (Single {O^^/} {Ø}) | (Single {o^^/} {ø})
| (Single {O^^E} {Œ}) | (Single {o^^e} {œ})
| (Single {U^^`} {Ù}) | (Single {u^^`} {ù})
| (Single {U^^'} {Ú}) | (Single {u^^'} {ú})
| (Single {U^^"} {Ü}) | (Single {u^^"} {ü})
| (Single {Y^^'} {Ý}) | (Single {y^^'} {ý})
| (Single {Y^^"} {Ÿ}) | (Single {y^^"} {ÿ})
| (Single {S^^z} {ß})
| (Single {P|} {Þ}) | (Single {p|} {þ})
| (Single {~!} {¡}) | (Single {~?} {¿})
| (Single {c^^/} {¢}) | (Single {L^^-} {£})
| (Single {Y^^-} {&Yen;})
| (Single {o^^$} {¤})
| (Single {||} {¦})
| (Single {<<} {«}) | (Single {>>} {»})
| (Single {-,} {¬})
| (Single {^^-} {¯}) | (Single {^^o} {°}) | (Single {^^o-}
{º})
; { 1/4 } { ¼ } { 1/2 } { ½ } { 3/4 } { ¾ }
| (Single {''} {´})
| (Single {^^/u} {µ})
| (Single {P^^!} {¶})
| (Single {sO} {§})
| (Single {^^.} {·})
| (Single {,,} {¸})
| (Single {...} {…})
;{ +- } {±}
;{ * } {×}
| (Single {-:} {÷})
; { / } { ÷ } ; Slash is often used as a divider or alternative
marker.
| (Single {A^^} {Â}) | (Single {a^^} {â})
| (Single {E^^} {Ê}) | (Single {e^^} {ê})
| (Single {I^^} {Î}) | (Single {i^^} {î})
| (Single {O^^} {Ô}) | (Single {o^^} {ô})
| (Single {U^^} {Û}) | (Single {u^^} {û})
;{ pi } {π}
| (Single {sqrt} {√}) ; {<font face="symbol">Ö</font>}
| skip
]
Dialect: func [String [string!]][
Block: make block! 10
Before: String
After: none
parse/case/all String [some Rules (Plain None) end]
either empty? Block [
String
][
Block
]
]
]
Inline: get in Inline! 'Dialect
Line: Heading: Block: Previous: none
Text-Line: [Graphic any Printable]
Text: [copy Line Text-Line newline]
H: [
opt Empty
Text
[
some "*" (Heading: 'H1)
| some "=" (Heading: 'H2)
| some "-" (Heading: 'H3)
| some "~" (Heading: 'H4)
| some "_" (Heading: 'H5)
| some "." (Heading: 'H6)
] newline (repend Block [Heading Line])
]
IP: [Text (repend Block ['IP Inline Line])]
P: [[Empty | tab] Text (repend Block ['P Inline Line])]
Align!: make object! [
Type: 'Left
Rule: [#" " (Type: 'Center) | tab (Type: 'Right) | none (Type: 'Left)]
]
Align: Align!/Rule
Center: make object! [
Lines: make block! 10
Rule: [
some [
#" " copy Line [Graphic any Printable] newline (
if not empty? Lines [
append Lines 'Br
]
append Lines Inline Line
)
](
repend Block ['Center Lines]
Lines: make block! 10
)
]
]
Table: make object! [
Type: 'TH
Mark: #"|"
NonBar: exclude Printable charset to-string Mark
Cells: make block! 10
BarCell: [Mark Align copy Line some NonBar]
TabCell: [copy Line some Printable (trim Line)]
Append-Cell: does [
repend Cells [make path! reduce [Type Align!/Type] Inline Line]
]
Row: [
[
[
opt [some [Mark some #"-"] opt Mark newline]
some [BarCell (Append-Cell)]
opt Mark
]
| Align TabCell (Append-Cell) some [
tab Align TabCell (Append-Cell)
]
] newline
]
Rows: make block! 10
Rule: [
opt Empty
(
Type: 'TH
Rows: make block! 10
Cells: make block! 10
)
some [
Row (
repend Rows ['TR Cells]
Type: 'TD
Cells: make block! 10
)
](
repend Block ['Table Rows]
)
]
]
Quote: make object! [
Quotes: make block! 1
Tabbed-Text: charset [#"^(20)" - #"^(7E)" #"^-"]
Rule: [
some [
tab tab copy Line [some Tabbed-Text newline]
(append/only Quotes Inline Line)
](
repend Block ['BlockQuote 'Pre rejoin Quotes]
Quotes: make block! 10
)
]
]
BlockQuote: make object! [
Lines: make block! 1
NonQuoteText: exclude charset [#"^(20)" - #"^(7E)"] charset {"}
NonQuoteLine: [
copy Line some NonQuoteText
]
Rule: [
{"} copy Line some NonQuoteText {"} newline (
repend Block ['BlockQuote inline Line]
)
| [
{"} copy Line some NonQuoteText newline (
append Lines append inline Line 'Br
)
any [
Empty (append Lines 'Br)
| copy Line some NonQuoteText newline (
append Lines append inline Line 'Br
)
]
copy Line so
