#!../../rebol -cs
REBOL [
Title: "REBOL Email Discussion Web Pages"
Author: ["Carl Sassenrath"]
Version: 1.2.0
Date: 15-Jun-2004 ;10-Aug-2003
; Tabspace is 4
]
print "Content-Type: text/html^/"
;-- Revision History ---------------------------------------------------------
;
; 10-Jul-2003 1.0.1 carl-rebol.com {Released source code.}
; 10-Jul-2003 1.0.3 carl-rebol.com {Minor cleanup.}
; 10-Jul-2003 1.1.0 carl-rebol.com {Simple threads added.}
;
;-----------------------------------------------------------------------------
; If we're on the devel system, set switch for rapid development:
test: system/version/4 = 3
dir-out: pick [%web/ %~apache/html/maillist/] test
; Master index file name:
index-file: dir-out/index.html
; Source output file:
source-file: dir-out/lister.html
; Target directory for storing message HTML files:
msg-dir-ref: %msgs/
msg-dir: dir-out/:msg-dir-ref
if not exists? msg-dir [make-dir/deep msg-dir]
;-- Message Database ---------------------------------------------------------
; Message block format:
; * Each record is a block of: [id from subject date content]
; * Order is older to newer
; * DB currently selects only current month (to be changed)
; * Date field is currently a string (but should be REBOL date/time)
either test [
; Just use some test messages:
msgs: [
[10001 carl-rebol.com "Example Message" "3 Jul 2005" "Content here"]
[10002 luke-rebol.com "Another Message" "4 Jul 2005" "Happy Iday"]
]
][
; Read and parse the database for current month:
; (Note: the DB is huge text file right now, but REBOL parses
; it very fast, so we're being a bit lazy, but it needs to be
; optimized someday.)
do %load-msgs.r
]
;-- Message HTML Formatters --------------------------------------------------
margin: 100 ; max width of lines
html: make string! 100000
emit: func [data] [repend html data]
ws: charset " ^-^/"
wrap-text: func [str /local start end] [
; Wrap long lines
end: start: str
while [
end: find end ws
][
any [
if end/1 = newline [start: end: next end]
if (offset? start end) > margin [start: change end newline]
end: next end
]
]
head str
]
encode-html: func [
; Translate only the most common HTML tags and escapes.
; (If you think others are needed, add them. But remember
; that this code runs at N-squared speed, so take it easy.)
code
][
replacements: [
"&" "&" "<" "<" ">" ">"
"<rebol list address>" "<rebol list address>"
"<carl>" "<carl>"
"-" "-"
]
if foreach [from to] replacements [
if find code from [break/return false]
true
][return code]
foreach [from to] replacements [replace/all code from to]
wrap-text code ; return result
]
emit-message-page: func [
; Generate a message as a very simple HTML web page.
msg ; message block: [id from subject date content]
/local linkage
id1 ; first msg #
id2 ; last msg #
thr
tm0
tm1
tm2
][
clear html
; Deal with head and tail of list:
id: msg/1
id1: first first msgs ; first msg
id2: first last msgs ; last msg
if id1 = id [id1: none]
if id2 = id [id2: none]
if thr: select threads trim-subject msg/3 [
tm0: first thr
thr: find thr id
if not head? thr [tm1: first back thr] ; prior
if not tail? next thr [tm2: first next thr] ; next
]
; Generate linkage: Older | Index | Newer links:
linkage: reduce [
either tm1 [
rejoin [{<A HREF=} tm1 {.html><Back</A>}]
][{<FONT COLOR=silver><Back</FONT>}]
rejoin [{ <A HREF=} tm0 {.html>Thread</A> }]
either tm2 [
rejoin [{<A HREF=} tm2 {.html>Next></A>}]
][{<FONT COLOR=silver>Next></FONT>}]
"<br>"
either id1 [
rejoin [{<A HREF=} id - 1 {.html><Back</A>}]
][{<FONT COLOR=silver><Back</FONT>}]
" " <A HREF="../index.html"> "Index" </A> " "
either id2 [
rejoin [{<A HREF=} id + 1 {.html>Next></A>}]
][{<FONT COLOR=silver>Next></FONT>}]
]
emit [
<HTML><HEAD>
<TITLE> "REBOL List - " msg/3 </TITLE>
<style type="text/css"> trim/auto {
BODY, P, TD {Font-Family: "Arial"; Font-Size: 10pt}
:link, :visited {Text-Decoration: none}
h1 {font-size: 14pt; Font-Weight: bold;}
h2 {font-size: 12pt; color: #2030a0; Font-Weight: bold; width: 100%;
border-bottom: 1px solid #c09060;}
}
</STYLE>
</HEAD>
newline
<BODY BGCOLOR="WHITE">
newline
<a href="http://www.rebol.net"><img src="/graphics/reb-bare.jpg" border=0 alt="REBOL.net"></a>
newline
<H1> encode-html msg/3 </H1>
<BLOCKQUOTE><B>
msg/2 <BR> msg/4 <BR> "#" id <br> linkage
</B></BLOCKQUOTE>
<HR>
<PRE>
encode-html msg/5
</PRE><HR><BR><B>
linkage
</B><P>
<A HREF="http://www.rebol.com"><FONT COLOR="gray">
"REBOL.com" </FONT></A>
</BODY></HTML>
]
write join msg-dir [id ".html"] html
]
emit-index-line: func [
; Generate a message line in the master index:
msg ; message block (see above)
][
emit [
pick [<TR><TR BGCOLOR="#E0E8E0">] odd? msg/1
<TD WIDTH="10" NOWRAP ALIGN="right"><FONT COLOR="GRAY"> msg/1 </FONT></TD>
<TD><B> {<A HREF="} msg-dir-ref msg/1 {.html">} msg/3 </A></B></TD>
<TD NOWRAP> msg/2 </TD>
<TD NOWRAP> msg/4 </TD>
</TR>
newline
]
]
dat: now
dat: dat - dat/zone
dat: reform [dat/date dat/time "GMT"]
emit-index-page: func [
; Generate the master message index page:
; Messages are listed in reverse order.
msgs ; block of messages
][
clear html
emit [
<HTML><HEAD>
<TITLE> "REBOL Email List Index" </TITLE>
<style type="text/css"> trim/auto {
BODY, P, TD {Font-Family: "Arial"; Font-Size: 10pt}
:link, :visited {Text-Decoration: none}
h1 {font-size: 14pt; Font-Weight: bold;}
h2 {font-size: 12pt; color: #2030a0; Font-Weight: bold; width: 100%;
border-bottom: 1px solid #c09060;}
}
</STYLE>
</HEAD>
newline
<BODY BGCOLOR="WHITE">
newline
<a href="http://www.rebol.net"><img src="/graphics/reb-bare.jpg" border=0 alt="REBOL.net"></a>
newline
<H1> "REBOL Email List Index" </H1>
<B>"Updated " dat </B>
<BR>
trim/auto {
You may need refresh/reload this page to see changes.<BR>
To learn more about this list:
<A HREF="http://www.rebol.com/discussion.html">go here</A>.
}
<P><HR>
newline
<TABLE WIDTH="100%" BORDER="0" CELLPADDING="4" CELLSPACING="0">
newline
]
foreach msg head reverse msgs [emit-index-line msg]
emit [
</TABLE><HR><P>
newline
<FONT SIZE="1">
<A HREF="http://www.rebol.com">
<B>"REBOL.com"</B></A><BR>
<A HREF="lister.html">"Lister Source Code "
system/script/header/version</A>
</FONT>
</BODY></HTML>
]
write index-file html
; Write out current source code:
clear html
emit [
<HTML><HEAD>
<TITLE> "REBOL List Source Code" </TITLE>
</HEAD>
<BODY BGCOLOR="WHITE"><PRE>
detab/size encode-html read/with %lister.r CRLF 4
</PRE>
</BODY></HTML>
]
write source-file html
]
;-- Main Program -------------------------------------------------------------
trim-subject: func [sub /local new] [
parse sub [
any ["re:" | "fwd:" | "[rebol]"] new: | none
]
copy any [new sub]
]
threads: any [attempt [load %threads.r] copy []]
foreach msg msgs [
thr: select threads sub: trim-subject msg/3
either thr [
if not find thr msg/1 [append thr msg/1]
][
;print ["added" sub]
insert threads reduce [sub reduce [msg/1]]
]
]
save %threads.r threads
foreach msg msgs [
emit-message-page msg first first msgs first last msgs
]
emit-index-page msgs
either test [
browse index-file
print "done" halt
][
print now ;read index-file
]
quit