[REBOL] Re: html
From: al:bri:xtra at: 8-Jan-2002 22:43
Louis wrote:
> Sounds really great, but I would like to do forms. How can I get the
version on your HDD? :>)
Hopefully, it's attached to this email. :-) Along with ML.r as it was only a
extra keyclick. Just in case, I've CC-ed a copy to your directly.
Andrew Martin
ICQ: 26227169 http://valley.150m.com/
-><-
-- 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: 5/Oct/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
]
]
Rejoins: func [Item [any-type!]][
either block? :Item [
rejoin Map Item :Rejoins
][
: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 "" Map reduce bind Map Content :Inlines 'self :Rejoins
][
Content
]
]
Tags: func [Tag [tag!] Content [string! tag! none!] /Break /Breaks][
rejoin [
either any [Break Breaks] [newline][""]
Tag
either Breaks [newline][""]
either none? Content [""] [Content]
either Breaks [newline][""]
to-tag join "/" first parse Tag none
]
]
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: 8/Jan/2002
]
make do %ML.r insert tail [
set 'HTML 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! none!]] [
if none? File [return ""]
Empty-Tag build-tag [
link rel ("stylesheet") type ("text/css") href (Encode File)
]
]
JavaScript: function [Text [file! url! string! none!]] [Tag] [
if none? Text [return ""]
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)]
Tags build-tag Tag none
]
]
Title: func [Content [string!]] [
Tags <title> Content
]
Header: func [Content [block!]] [
Tags/breaks <head> Recurse Content
]
Body: function [Attributes [block!] Content [block!]] [Tag] [
Tag: copy [body]
append Tag Attributes
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 (H)]]
Tags/Breaks build-tag Tag Recurse Content
]
Hr: join mold <hr /> newline
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" Recurse 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: function [Picture [file! url!] Alternative [string!] /Size WxH [pair!]] [Tag]
[
Tag: copy [img border (0)
src (Encode Picture)
alt (Alternative)
]
if Size [append Tag [width (WxH/x) height (WxH/y)]]
Empty-Tag build-tag Tag
]
A: function [
Reference [file! url! email! string!] Content [string! block!] /Top /Name /Blank
] [
Tag
] [
if email? Reference [
return MailTo Reference none 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! none!] Content [string! block!]] [
Tags build-tag [
a href (
rejoin [
"mailto:" eMail either none? Subject [""] [join "?subject=" Subject]
]
)
] Recurse Content
]
GetForm: func [Action [url!] Content [string! block!]] [
Tags build-tag [
form method ("GET") action (Encode Action)
] Recurse Content
]
PostForm: func [Action [url!] Content [string! block!]] [
Tags build-tag [
form method ("POST") action (Encode Action)
] Recurse Content
]
Submit: func [Label [string!]] [
build-tag [
input type ("submit") value (Label)
]
]
Reset: func [Label [string!]] [
build-tag [
input type ("reset") value (Label)
]
]
Text: func ['Name [word!] Value [string!]] [
build-tag [
input type ("text") name (mold Name) value (Value)
]
]
Password: func ['Name [word!] Value [string!]] [
build-tag [
input type ("password") name (mold Name) value (Value)
]
]
TextArea: func ['Name [word!] Size [pair!] Content [string! block!]] [
tags build-tag [
textarea name (mold Name) cols (Size/x) rows (Size/y)
] recurse Content
]
Checkbox: function ['Name [word!] /Checked] [Tag] [
Tag: copy [input type ("checkbox") name (mold Name) value ("True")]
if Checked [append Tag [checked ("checked")]]
build-tag Tag
]
Radio: function ['Name [word!] Value [string!] /Checked] [Tag] [
Tag: copy [input type ("radio") name (mold Name) value (Value)]
if Checked [append Tag [checked ("checked")]]
build-tag Tag
]
Button: func ['Name [word!] Value [string!]] [
build-tag [
input type ("button") name (mold Name) value (Value)
]
]
Hidden: func ['Name [word!] Value [string!]] [
build-tag [
input type ("hidden") name (mold Name) value (Value)
]
]
Fieldset: func [Content [string! block!]] [
tags build-tag [fieldset] recurse Content
]
Legend: func [Label [string!]] [
tags build-tag [legend] Label
]
] 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>
Sup: <sup>
Sub: <sub>
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
]
]