[REBOL] Wiki in Rebol, CGI Xitami
From: al:bri:xtra at: 3-Jun-2002 19:42
Here's my Wiki in Rebol. It runs as a CGI under Xitami's web server, and
uses text files to store each page. It uses my %eText.r and %ML.r dialects
to change plain text into HTML. Links are expressed like:
?"Andrew Martin"
which links to the file %"Andrew Martin.txt".
It's not bullet proof, though.
Andrew Martin
ICQ: 26227169 http://valley.150m.com/
-><-
-- Attached file included as plaintext by Listar --
-- File: Wiki.r
#! C:\Rebol\View\rebol.exe -cs
[
Rebol [
Name: 'Wiki
Title: "Wiki"
File: %Wiki.r
Author: "Andrew Martin"
eMail: [Al--Bri--xtra--co--nz]
Date: 3/June/2002
]
Directory: %../../Wiki/
Host: %/cgi-bin/
Action: join Host Rebol/script/header/File
Forbidden: {\/:*?"<>|} ; A Wiki name cannot contain any of these characters.
Permitted: exclude Printable charset Forbidden
content-type text/html
Bug: function [String [string!]] [Title] [
Title: "Wiki Bug!"
print ML compose/deep [
html [
head [
title (Title)
]
body [
h1 (Title)
p (String)
p [
"system/options/cgi/query-string: "
(mold system/options/cgi/query-string)
]
p ["Time: " (now)]
]
]
]
]
Index: has [Title Files Links] [
Files: sort read Directory
Title: "Index"
print ML compose/deep [
html [
head [
title (Title)
]
body [
h1 (Title)
p "Pages: "
(
Links: make block! 4 * length? Files
foreach File Files [
if %.txt = find/last File %. [
File: filename File
append Links compose/deep [
li [
a/href (
rejoin [Action #"?" replace/all copy File #" " " "]
) (File)
]
]
]
]
compose/deep [
ul [(Links)]
]
)
hr
p ["As of: " (now)]
]
]
]
]
if none? Query_String: system/options/cgi/query-string [ ; Might be a POST instead?
Post: make string! 2 + Length: to-integer system/options/cgi/content-length
read-io system/ports/input Post Length
if empty? Post [
Index
quit
]
Post: decode-cgi Post
if all [
parse Post [
set-word! string!
set-word! string!
end
]
Post: make object! Post
parse/all Post/File [some Permitted end]
] [
File: to-file Post/File
if exists? Backup: rejoin [Directory filename File %.bak] [
delete Backup
]
if exists? New_File: join Directory File [
rename New_File Backup
]
Text: Post/Text
write New_File Text
Title: filename File
print ML compose/deep [
html [
head [
title (rejoin [{Thanks for editing: "} Title {"!}])
]
body [
H1 "Thank you!"
p [
"Thank you for editing "
a/href (rejoin [Action #"?" Title]) (Title) "."
]
p "Your careful attention to detail is much appreciated."
p ["PS Be sure to " b "Refresh" " or " b "Reload" " your old pages."]
]
]
]
quit
]
Bug reform [mold Post]
quit
]
View: function [Title [string!] File [file!]] [Heading] [
Heading: Title
print ML compose/deep [
html [
head [
title (Heading)
]
body [
(eText/Wiki/Base read Directory/:File rejoin [Action #"?"])
hr
(now)
form/method/action "GET" (Action) [
input/type/name/value "hidden" (first Edit_Rule) (Title)
input/type/value "submit" "Edit"
]
]
]
]
]
Verb: :View
Edit_Rule: ["*Edit" #"=" (Verb: :Edit)]
Edit: function [Title [string!] File [file!] /New] [Heading] [
Heading: rejoin [either New ["New: "] ["Edit: "] Title]
print ML compose/deep [
html [
head [
title (Heading)
]
body [
h1 (Heading)
form/method/action "POST" (Action) [
input/type/name/value "hidden" "File" (File)
textarea/name/rows/cols/wrap/style "Text" 20 80 "virtual" "width:100%;" (
either New [
rejoin [
Title newline
head insert/dup copy "" #"*" length? Title newline
]
] [
read Directory/:File
]
)
br
input/type/value "submit" "Save"
]
]
]
]
]
if parse/all Query_String [
opt [Edit_Rule]
copy Title some Permitted
end
] [
Title: dehex replace/all Title #"+" #" "
File: join to-file Title %.txt
either exists? Directory/:File [
Verb Title File
] [
Edit/New Title File
]
quit
]
Index
]
-- 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]
Date: 2/June/2002
Comments: {
ML generates XML-like markup language from words, paths and blocks.
ML can generate HTML, XHTML, WML and SVG markup.
}
]
ML!: make object! [
; Note: Entity replacement should have all ready been done by caller.
set 'ML function [Dialect [block!]] [String Values_Rule Values Value Tag] [
String: make string! 20000
Values_Rule: [
; Caution! The none! value below is replaced in the 'parse rule below!
none [
set Value any-type! (
Tag: next next Tag
if word? Value [Value: form Value]
insert Tag Value
Value: none
)
]
]
Values: make block! 10
parse Dialect [
any [
set Value tag! (append String Value)
| set Tag [path! | word!] (
Tag: to-block get 'Tag
Values_Rule/1: -1 + length? Tag ; Replace none! value above.
) Values_Rule opt [
set Value [
block! | string! | url! | file! | integer!
| money! | time! | date! | issue! | tag!
| tuple! | tag! | email! | pair! | decimal!
| logic! | char!
]
]
(
Tag: head Tag
repend String either none? Value [
[join build-tag Tag " /"]
] [
[
either block? Value [newline] [""]
build-tag Tag
either block? Value [ML Value] [Value]
to-tag join "/" first Tag
]
]
Values_Rule/1: none
)
| set Value any-type! (append String Value)
]
end
]
String
]
]
]
-- 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: 3/June/2002
Needs: [%"Common Parse Values.r"]
]
make object! [
Link_Base: none
Link_Wiki: false
Space: charset [#" " #"^-"]
Separator: charset [#"." #"!" #" " #"," #"?" #";" #":"]
Empty: [any Space newline]
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 Temporary][
NonMark: exclude Graphic charset to string! Mark
compose/deep [
Temporary: (Mark) copy Text [some (NonMark) any [opt #" " some (NonMark)]]
(Mark)
(to-paren reduce ['Plain HtmlDialect])
(to-paren [After: Temporary])
Before:
]
]
Link: make object! [
Word: [Alpha any [AlphaDigit | #"-"] opt {'s} opt #"/"]
Text: Link: URL: none
URL_Mail: func [URL [string!]] [
URL: first load/next URL
if email? URL [URL: join "mailto:" URL]
URL
]
ImageAnchor: func [Text [string!] URL [string!]][
URL: URL_Mail URL
Plain either any [
found? find/last URL %.jpg
found? find/last URL %.gif
found? find/last URL %.png
][
['img/src URL Text]
][
['a/href URL Text]
]
]
Rule: [
[
After: [
#"^"" copy Text to #"^"" skip
#" " [
#"%" #"^"" copy Link to #"^"" skip (
insert replace/all Link " " " " #"%"
)
| copy Link URI
]
#" " copy URL URI
](
Plain [
'a/href URL_Mail URL reduce [
'img/src first load/next Link Text
]
]
) Before:
]
| [
After: [
{"} copy Text to {" } {" } [
#"%" #"^"" copy Link to #"^"" skip (
insert replace/all Link " " " " #"%"
)
| copy Link URI
]
] (ImageAnchor Text Link) Before:
]
| After: copy Link URI (ImageAnchor copy Link Link) Before:
| [
After: [
{?"} copy Link to {"} skip
| "?" copy Link Word
](
Text: replace/all copy Link " " " "
Link: rejoin [
Link_Base
to-file replace/all Link " " " "
either Link_Wiki [""] [
either #"/" = last Link [%index.html][%.html]
]
]
Plain ['a/href Link Text]
) Before:
]
]
]
DoubleQuote: make object! [
Mark: #"^""
NonMark: exclude Graphic charset to-string Mark
Rule: [
After: Mark copy Text [NonMark any [NonMark | #" "]] Mark (
Plain [rejoin ["“" Text "”"]]
) Before:
]
]
SingleQuote: make object! [
Mark: #"'"
Div: none
NonMark: exclude Graphic charset to-string Mark
Rule: [
After: #" " Mark copy Text [NonMark some [NonMark | #" "]]
Mark copy Div Separator(
Plain [rejoin [#" " "‘" Text "’" Div]]
) Before:
]
]
Superscript: make object! [
Rule: [
After: #"^^" copy Text [some Alpha | Digits] (
Plain ['sup reduce ['small Text]]
) Before:
]
]
Single: func [Mark [string! char!] Replacement [string!]][
compose [After: (Mark) (to-paren compose [Plain (Replacement)]) Before:]
]
Rules: compose [
(Link/Rule)
| (DoubleQuote/Rule)
| (SingleQuote/Rule)
| (Superscript/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 { +- } { ± })
| (Single { * } { × })
| (Single {-:} {÷})
;| (Single { / } { ÷ }) ; Slash is often used as a divider or alternative.
| (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
]
]
Literal-Rules: compose [
(Single {&} "&")
| (Single {<} "<")
| (Single {>} ">")
| skip
]
Literal: func [String [string!]][
Block: make block! 10
Before: String
After: none
parse/case/all String [some Literal-Rules (Plain None) end]
either empty? Block [
String
][
Block
]
]
]
Inline: get in Inline! 'Dialect
Literal: get in Inline! 'Literal
Line: Heading: Block: Previous: none
Text-Line: [Graphic any Printable]
Text: [copy Line Text-Line empty]
H: [
opt Empty
Text
[
some "*" (Heading: 'h1)
| some "=" (Heading: 'h2)
| some "-" (Heading: 'h3)
| some "~" (Heading: 'h4)
| some "_" (Heading: 'h5)
| some "." (Heading: 'h6)
] empty (repend Block [Heading Inline Line])
]
IP: [Text (repend Block ['p/class "Initial" 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] empty (
if not empty? Lines [
append Lines <br />
]
append Lines Inline Line
)
](
repend Block ['div/align "center" Lines]
Lines: make block! 10
)
]
]
Table: make object! [
Type: 'th
Mark: #"|"
NonBar: exclude Printable charset to-string Mark
Cells: make block! 10
BarCell: [Align copy Line any NonBar any [#" " | tab]]
TabCell: [Align copy Line any Printable]
Append-Cell: does [
repend Cells [
make path! reduce [Type 'align] Align!/Type
either none? Line [""][Inline trim Line]
]
]
Row: [
[
opt [some [Mark some #"-"] opt Mark empty]
some [Mark BarCell (Append-Cell)] opt Mark empty
]
| TabCell (Append-Cell) some [tab TabCell (Append-Cell)] empty
]
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 string! 100
Rule: [
opt Empty
some [
2 tab copy Line some [Printable | tab] empty (
append Quotes rejoin [trim/tail Line newline]
)
] (
repend Block ['blockquote reduce ['pre Literal detab Quotes]]
clear Quotes
)
]
]
BlockQuote: make object! [
Center: no
NonQuote: exclude Graphic charset {"}
Lines: make block! 10
Common: function [L [string! block!]] [bq] [
bq: [
'i reduce [
'blockquote either string? L [inline L] [L]
]
]
repend Block either Center [
[
'div/align "center" reduce bq
]
] [
bq
]
Center: no
]
Rule: [
[
opt [#" " (Center: true)] (Lines: make block! 10)
#"^"" copy Line [some [NonQuote | { "} | {" } | { }]] #"^"" empty (
Common Line
)
]
| [
opt [#" " (Center: true)] (Lines: make block! 10)
#"^"" copy Line [some [NonQuote | { "} | {" } | { }]] empty (
repend Lines [Line <br />]
)
any [
opt #" " copy Line [some [NonQuote | { "} | {" } | { }]] empty (
repend Lines [Line <br />]
)
]
opt #" " copy Lin
