#!/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 -DL- {label text} {return "   $label:   $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 -DL- {label text} {return "   $label:   $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 jcw@equi4.com
    #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..."
            }

            * { # called to generate a page with references
                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
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -