#!/bin/sh # \ exec tclkit "$0" ${1+"$@"}
proc Puts {args} {}
Puts ">> start\t clock clicks"
proc DoCommit {} {
mk::file commit doc
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
proc InitDatabase {} {
global rootName fdHist
set fdHist [open ${rootName}.hist a+]
catch {puts $fdHist "\n# [GetTimeStamp]"}
package require Mk4tcl 1.1
catch {mk::file open doc wtry.dat -nocommit} ;# not in scripted doc
mk::view layout doc.scripts {name date:I size:I checked:I text:M}
mk::view layout doc.pages {name date:I contents:M who count:I
format:I page cached:I refs}
mk::view layout doc.archived {name date:I diff:M who last:I lines:I}
if ![mk::view size doc.pages] { # the core pages
set date [clock seconds]
foreach name {Home WiKit Search Help Recent History 6 7 8 9} {
mk::row append doc.pages name $name format 1 page \n date $date
}
DoCommit
}
# convert database format 0 to 1 if necessary
if {[mk::get doc.pages!0 page] == ""} {
proc -A- {id} {
return "\[[mk::get doc.pages!$id name]\]"
}
proc -P- {} {}
proc -HR- {} {return ----}
proc -UL- {text} {return " * $text\n"}
proc -OL- {text} {return " 1. $text\n"} proc -PRE- {text} {return " $text\n"}
mk::loop c doc.pages {
set page [mk::get $c contents]
if [regexp -nocase {.\.(tcl|txt)$} [mk::get $c name]] {
mk::set $c page $page format 0
} else {
set page [subst -nobackslashes -novariables $page]
mk::set $c page $page format 1
}
Puts "conv $c" ;#\n============\n$page\n========="
}
}}
proc AcquireLock {{maxAge 3600}} {
global rootName
set lockFile ${rootName}.lock
foreach try {1 2 3 4 5 6 7 8 9 10} {
if ![catch {open $lockFile {CREAT EXCL WRONLY}} fd] {
close $fd
return 1
}
after 3000
}
# if the file is older than maxAge, we grab the lock anyway
return [expr {[clock seconds] > [file mtime $lockFile] + $maxAge}]}
proc ReleaseLock {} {
global rootName
file delete ${rootName}.lock}
proc PageLookup {name} {
set n [mk::select doc.pages -count 1 name $name]
if {$n == ""} {
set n [mk::view size doc.pages]
mk::set doc.pages!$n name $name
DoCommit
}
return $n}
proc SavePage {id text who {name ""}} {
if {$name != ""} {
set type [expr {![regexp {.\.(txt|tcl)$} $name]}]
Puts "save page $id title [list $name] type $type"
mk::set doc.pages!$id name $name format $type
}
set text [string trimright $text]
append text \n
mk::set doc.pages!$id date [clock seconds] page $text who $who
AddLogEntry $id
DoCommit}
proc PageType {id} {
return [mk::get doc.pages!$id format]
}
proc AddLogEntry {id} {
global fdHist
set c doc.pages!$id
# allow failure if log file cannot be written
catch {
seek $fdHist 0 end
set pos [tell $fdHist]
mk::row append doc.archived name [mk::get $c name] \
date [mk::get $c date] \
who [mk::get $c who] last $pos
puts $fdHist ""
puts $fdHist [ExportAsTcl $id]
flush $fdHist
}}
proc GetTimeStamp {} {
clock format [clock seconds] -gmt 1 -format {%Y/%m/%d %T}}
# generate a pseudo "Set" command which can be used to restore a page
proc ExportAsTcl {id} {
array set a [mk::get doc.pages!$id]
if {$a(date) == 0 || [string length $a(page)] <= 1} {
return
}
list Set $id name $a(name) date $a(date) who $a(who) \
format $a(format) page $a(page)}
proc ExportAll {file} {
set fd [open $file w]
puts $fd "\n# [GetTimeStamp]"
puts $fd "\nReset [mk::view layout doc.pages]"
mk::loop c doc.pages {
set s [ExportAsTcl [mk::cursor position c]]
if {$s != ""} {
puts $fd "\n$s"
}
}
close $fd}
proc ImportAll {file} {
proc Reset {layout} {
global fdHist
mk::view size doc.pages 0
DoCommit
mk::view layout doc.pages $layout
DoCommit
puts $fdHist "\n# [GetTimeStamp]"
puts $fdHist "\nReset [mk::view layout doc.pages]"
}
proc Set {id args} {
eval mk::set doc.pages!$id $args
AddLogEntry $id
}
source $file
DoCommit
file rename -force $file ${file}.bak}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
proc Wiki {name args} {
if {$name == "-"} {
set name [mk::get doc.pages![lindex $args 0] name]
}
link - $name "$::env(SCRIPT_NAME)/[join $args ?]"}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
proc Expand {type str} {
set str [TextToStream $str]
Puts "<pre>TYPE $type STR '$str'</pre>"
Context_$type $str}
proc InfoProc {ref} {
set id [PageLookup $ref]
set date [mk::get doc.pages!$id date]
if {$date == 0} {
append id @ ;# enter edit mode for missing links
}
list $id [mk::get doc.pages!$id name] $date}
proc Context_HTML {str} {
puts [StreamToHTML $str $::env(SCRIPT_NAME)/ InfoProc]
}
proc Context_Edit {str} {
StreamToText $str
}
proc Context_Tk {str} {
global D
set result [StreamToTk $str InfoProc]
Puts "\nURLS:"
foreach {a b c} [lindex $result 1] {
Puts "$a $b\t$c"
set tag $a$b
$D tag bind $tag <Any-Enter> "$D tag configure $tag -foreground red"
$D tag bind $tag <Any-Leave> "$D tag configure $tag -foreground blue"
if {$a == "u" || $a == "x"} {
$D tag configure $tag -font {Times 12 underline}
}
if {$a == "g"} {
set id [PageLookup $c]
$D tag bind $tag <ButtonPress> "ShowPage $id"
}
}
return [lindex $result 0]}
proc OldRefList {str} {
proc -A- {id} {
return "\[[mk::get doc.pages!$id name]\]"
}
proc -P- {} {}
proc -HR- {} {return ----}
proc -UL- {text} {return " * $text\n"}
proc -OL- {text} {return " 1. $text\n"} proc -PRE- {text} {return " $text\n"}
subst -nobackslashes -novariables $str}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
proc ProcessCGI {} {
package require cgi 0.7
input "n=1"
suffix ""
admin_mail_addr [email protected]
#debug -on
cgi_eval {
set path ""
catch {set path $::env(PATH_INFO)}
set query ""
catch {set query $::env(QUERY_STRING)}
set cmd ""
if {![regexp {^/([0-9]+)(.?)$} $path x N cmd] || $N >= [mk::view size doc.pages]} {
set N 0
}#puts "path $path query $query N $N $::env(PATH_INFO)"
set n doc.pages!$N
set self $::env(SCRIPT_NAME)
set host $::env(REMOTE_HOST)
# not used?
set http http://$::env(SERVER_NAME)
if {$::env(SERVER_PORT) != 80} {
append http : $::env(SERVER_PORT)
}
append http $self
set name [mk::get $n name]
# set up a few standard URLs
set Refs "[mk::get $n count] [Wiki References $N!]"
set Links "[Wiki Expand $N*]"
set Edit "Edit [Wiki - $N@]"
set Home "Go to [Wiki - 0]"
set About "About [Wiki - 1]"
set Search "[Wiki Search 2]"
set date [mk::get $n date]
if {$date != 0} {
set date [clock format $date -gmt 1 -format {%d %b %Y, %R GMT}]
}
set sep " - "
set menu [italic "Updated $date [nbspace] - [nbspace] $Edit[nl]"]
append menu [font size=-1 "$Search - $Links - $Refs - $About - $Home"]
# editScript is used generate an editing form
set editScript {
puts [h2 [Wiki - $N]]
form $self/$N {
set C [mk::get $n page]
textarea C=$C rows=30 cols=72 wrap=virtual
p
submit_button "= Save "
if {$date != 0} {
puts " [nbspace] [nbspace] [nbspace] "
puts [italic "Last saved on [bold $date]"]
}
}
#parray ::env
}
# now dispatch on the type of request
switch -- $cmd {
@ { # called to generate an edit page
cgi_http_head {
cgi_content_type
pragma no-cache
}
cgi_title $name
cgi_body {
eval $editScript
}
}
! { # called to generate a page with references
cgi_title $name
h3 "RRRRRRRRRRReferences are not yet available..."
} cgi_title $name
h3 "EXXXXXXXXXXpansions are not yet available..."
}
default { # called to optionally save, and then display a page
catch {
if {[import C] != "" && $N != ""} {
SavePage $N $C $::env(REMOTE_HOST)
}
}
cgi_http_head {
cgi_content_type
pragma no-cache
}
cgi_title $name
cgi_body {
puts [h2 [Wiki - $N!]]
set C [mk::get $n page]
switch [PageType $N] {
0 {
preformatted {puts [quote_html $C]}
}
1 {
puts [Expand HTML $C]
}
}
hr noshade
puts $menu
}
}
}
}}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
proc ShowPage {{id ""}} {
global D urlSeq currMode
set urlSeq 0
set id [History $id]
set name [mk::get doc.pages!$id name]
set page [mk::get doc.pages!$id page]
wm title . $name
.n.back configure -text Back -command "ShowPage"
.n.home configure -text Home -command "ShowPage 0"
.n.edit configure -text Edit -command "EditPage"
.n.mode configure -text Search:
set currMode ""
$D configure -state normal -font {Times 12}
$D delete 1.0 end
#set cmd "$D insert end {$name} title {\n\n} body "
set cmd "$D insert end {$name} title "
switch [PageType $id] {
0 {
Puts "FIXED: <$page>"
append cmd [list \n\n$page fixed] ;# because Expand Tk inserts \n's
}
1 {
append cmd [Expand Tk $page]
Puts \n===============================$cmd
}
}
eval $cmd
Puts "EVAL: $cmd\n"
$D configure -state disabled
focus .n.enter}
proc EditPage {} {
global D currMode pageStack
set id [lindex $pageStack end]
.n.back configure -text Cancel -command "ShowPage $id" -state normal
.n.home configure -text Save -command \
"SavePage $id \[$D get 1.0 end\] local \[.n.enter get\]; ShowPage $id"
.n.edit configure -text History -command "ShowPage 5" ;# and more!!!
.n.mode configure -text "Edit Title:"
set currMode [mk::get doc.pages!$id name]
$D configure -state normal -font {Courier 10}
$D delete 1.0 end
$D insert end [mk::get doc.pages!$id page] fixed \n fixed
$D mark set insert 1.0
focus $D}
proc History {page} {
global pageStack
if {$page == ""} { # pop last page
set pageStack [lreplace $pageStack end end]
set page [lindex $pageStack end]
} else { # push specified page
if {$page != [lindex $pageStack end]} {
lappend pageStack $page
}
}
set state normal
if {[llength $pageStack] <= 1} {set state disabled}
.n.back configure -state $state
Puts "history $page: $pageStack"
return $page}
proc LoadPreferences {} {
global Prefs
array set Prefs {
}
catch { array set Prefs [mk::get doc.scripts!10 text] }}
proc SavePreferences {} {
global Prefs
# avoid commits if preferences did not change
catch {
set new [array get Prefs]
if {[catch {mk::get doc.scripts!10 text} old] || $new != $old} {
Puts $new
mk::set doc.scripts!10 text $new
DoCommit
}
}}
proc LocalInterface {} {
global D currMode pageStack
set pageStack ""
frame .n
pack .n -fill x
frame .s
pack .s -side bottom -fill x
button .n.back -width 7
button .n.home -width 7
button .n.edit -width 7
label .n.mode -width 7 -anchor e
entry .n.enter -textvariable currMode
button .n.help -width 6 -text Help -command "ShowPage 3"
pack .n.back .n.home .n.edit .n.mode -side left -padx 4 -pady 4
pack .n.enter -side left -padx 4 -expand 1 -fill x
pack .n.help -side left -padx 4 -pady 4
label .s.status
pack .s.status -side left
set S .s.status
scrollbar .scroll -command ".details yview"
text .details -yscrollcommand ".scroll set" -width 72 \
-height 20 -state disabled -wrap word -font {Times 12}
pack .scroll -side right -fill y
pack .details -expand 1 -fill both
set D .details
$D tag configure title -font {Times 18 bold} -lmargin1 3 -lmargin2 3
$D tag configure fixed -font {Courier 10} -lmargin1 3 -lmargin2 3
$D tag configure body -font {Times 12} -lmargin1 3 -lmargin2 3
$D tag configure url -foreground blue
$D tag configure ul -font {Times 12} -lmargin1 3 -lmargin2 30 -tabs 30
$D tag configure ol -font {Times 12} -lmargin1 3 -lmargin2 30 -tabs 30
$D tag configure dt -font {Times 12} -lmargin1 3 -lmargin2 30 -tabs 30
$D tag configure dl -font {Times 12} -lmargin1 30 -lmargin2 30 -tabs 30
$D tag configure i -font {Times 12 italic}
$D tag configure b -font {Times 12 bold}
$D tag configure bi -font {Times 12 bold italic}
# support for horizontal lines
$D tag configure thin -font {Times 4}
$D tag configure hr -relief sunken -borderwidth 1 -wrap none
bind $D <Configure> {%W tag configure hr -tabs %w}
ShowPage 0
#raise .}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# format codes are: # 0: old style wiki # 1: package require format1 1.0
# script numbers are: # 0: wtry.tcl # 1: cgi.tcl # 2: format1.tcl # 3: Html_library.tcl # 4: http.tcl
set rootName [file join [file dirname [info script] \
[file rootname [info script]]]
if !AcquireLock {puts "Can't lock: ${rootName}.lock"; exit 1} ;# the laziest way out
Puts ">> locked\t clock clicks"
set failed [catch {
if [catch {source format1.tcl}] {
eval [mk::get doc.scripts!2 text]
}
package require Format1
namespace import Format1::*
InitDatabase
if [file exists ${rootName}.export] {
ExportAll ${rootName}.export
}
if [file exists ${rootName}.import] {
ImportAll ${rootName}.import
}
if [info exists ::env(SCRIPT_NAME)] {
if [catch {source cgi.tcl}] {
eval [mk::get doc.scripts!1 text]
}
ProcessCGI
} else {
if {[info command winfo] == ""} {
foreach hasTk [info loaded] {
if {$hasTk == "{} Tk"} {load "" Tk; break}
}
}
package require Tk 8.0
Puts ">> Tk 8.0\t [clock clicks]"
if [catch {source Html_library.tcl}] {
eval [mk::get doc.scripts!3 text]
}
Puts ">> html_lib\t [clock clicks]"
if [catch {source http.tcl}] {
eval [mk::get doc.scripts!4 text]
}
package require http 2.0
Puts ">> http_lib\t [clock clicks]"
LoadPreferences
if [info exists Prefs(geometry)] {
after idle {
update idletasks
wm geometry . $Prefs(geometry)
}
}
LocalInterface
bind . <Destroy> {
set Prefs(geometry) [winfo geometry .]
set Quit 1
}
vwait Quit
SavePreferences
}} errMsg] set savedInfo $errorInfo
ReleaseLock
if $failed {
error $errMsg $savedInfo
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -