Wiki in Rebol, CGI Xitami
[1/7] 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
[2/7] from: gerardcote:sympatico:ca at: 4-Jun-2002 10:59
Hello Andrew,
did you already managed for a complete Wiki setup I could test with my
browser - with you permission of course?
I also planned to do one by myself when I began to learn REBOL a couple of
months ago but you got me well before the finish line. In a tentative to
accelerate things, I also began my study by looking at the Vanilla-SBX code
from Christian Langreiter but I found it too much advanced for me - for the
moment.
In the same time as I want to be functional quickly, I am installing
something that looks like the original Wiki but to which someone added a
date and author ID stamping for each entry via the RCS package.
As you are probably aware of, this feature is for making the management of
the non desired entries an easier task, when necessary. In fact I plan to
use it as a tool to support my students during my CS teaching. This is why I
need the stamping process and I am sure you understand since I followed the
last entries in your OSCAR forum on the Yahoogroups site !!!
Do you also plan to include some date and author ID stamping too later if
and when you will be ready to do so ?
Well may be I could help you in some way - even if for now this is only for
testing and commenting purposes ...
Thank you for the code. This too will become another study matter in my
REBOL quest !
Regards,
Gerard
[3/7] from: al:bri:xtra at: 5-Jun-2002 21:53
There's another update available on my Web_Dialect list.
Gerard, let me know if this email reaches you before my earlier reply, and
I'll resend it.
Andrew Martin
ICQ: 26227169 http://valley.150m.com/
[4/7] from: al:bri:xtra at: 5-Jun-2002 15:16
> Hello Andrew,
>
> did you already managed for a complete Wiki setup I could test with my
browser - with you permission of course?
Currently, I'm still testing and refining the Wiki script, and the
supporting ML and eText dialects. There's frequent updates on my Web_Dialect
at YahooGroups list at:
[Web_Dialect-subscribe--yahoogroups--com]
[Web_Dialect--yahoogroups--com]
or by browser at:
http://groups.yahoo.com/group/Web_Dialect
You're welcome to subscribe and use the updates and make suggestions as
you wish there. I've sent an invite. Others are welcome to subscribe as
well.
> [Date and Author ID Stamping]
Currently my Wiki code doesn't have this. It uses a plain text file to store
each page, and uses a backup file to hold older versions. The script is
intended to be eventually used in a school environment, perhaps accessible
by students as well. I'm interested in your thoughts on this subject.
> [Testing]
If you could test the script as well, that would be great. That way we can
more quickly find the problems in it and then get them fixed.
Andrew Martin
ICQ: 26227169 http://valley.150m.com/
[5/7] from: gerardcote:sympatico:ca at: 5-Jun-2002 22:19
Hi Andrew,
everything is OK in your message sequencing. Thank you for your invitation
to join the Web Dialect group. I gratefully accepted your invitation and
just began to read the first 6 messages and this seems very promising. Hope
I will be not too late when coming to the 400th one or so... since I also
have to review at least as much material in four other REBOL related mailing
lists while reading and trying many of the exercices proposed in "REBOL for
Dummies".
I even admit that momentarily I had to give up my cover to cover reading of
my two other books "REBOL programmation" and "REBOL the Official guide". Add
to all this to my current readings extracts coming from the REBOL related
web and REB sites (Via View), like REBOL Forces, rebol.com, rebol.org,
reboltech and other third parties contributions (Vanilla, REBOL France,
etc...), and this is really smelling REBOL a lot here around me ...
But like every second language learning, the best start is true immersion
and for REBOL I am in the bath up to the neck for the moment ... a chance I
don't presently work at all so I can take a full time charge on alterning
REBOL learning and doing outside sports !!!
I like REBOL more and more as each new day comes to light and I hope to
begin programming real useful apps in a near future.
Thanks again for your help,
Gerard
[6/7] from: al:bri:xtra at: 6-Jun-2002 15:29
> But like every second language learning, the best start is true immersion
and for REBOL I am in the bath up to the neck for the moment ...
I'm just waiting for the shout of Eureka! :)
Andrew Martin
ICQ: 26227169 http://valley.150m.com/
[7/7] from: gscottjones:mchsi at: 6-Jun-2002 5:31
From: "Andrew Martin"
> > But like every second language learning, the best start is true
immersion
> and for REBOL I am in the bath up to the neck for the moment ...
>
> I'm just waiting for the shout of Eureka! :)
Or, Ukiah!!!
;-)
--Scott Jones