##+##########################################################################
 #
 # Wiki History Diff.tcl -- diffs back versions of the tcl Wiki pages
 # by Keith Vetter
 #
 # Revisions:
 # KPV Mar 11, 2003 - initial revision
 # KPV Nov 07, 2003 - some touch up work
 # KPV Nov 10, 2003 - added JCW's undocumented way of fetching latest version
 # KPV Jan 23, 2004 - added Recents window showing Wiki page 4
 # KPV Jun 12, 2007 - updated to use new history format
 #

 package require Tk
 package require http
 set S(tkhtml) [expr {! [catch {package require Tkhtml 2}]}]

 set S(diffprog) tkdiff                          ;# Examdiff.exe works well too
 set S(title) "Wiki History Diff"
 set S(bg) "#9977cc"
 set S(pnum) "xx"                                ;# Page we want to compare
 set S(pnum2) ""                                 ;# Entry widget version of pnum
 set S(busy) 0
 set S(font) {courier 8}
 if {$tcl_platform(machine) == "Power Macintosh"} {
    set S(font) {courier 10}
 }

 # Stupid temp directory
 set S(tmp) [pwd]
 if {[file isdirectory "c:/temp"]} { set S(tmp) "c:/temp"}
 if {[file isdirectory "/tmp"]} { set S(tmp) "/tmp"}
 catch {set S(tmp) $env(TRASH_FOLDER)}           ;# Macintosh(?)
 catch {set S(tmp) $env(TMPDIR)}
 catch {set S(tmp) $env(TMP)}
 catch {set S(tmp) $env(TEMP)}

 proc INFO {msg} {puts [set ::S(msg) $msg]}
 proc DoDisplay {} {
    global S

    wm title . "Wiki History Diff"
    wm protocol . WM_DELETE_WINDOW {Cleanup 1}
    wm geom . +10+10
    frame .bottom
    pack .bottom -side bottom -fill x

    button .recent -text "Show Recent Changes" -command Recents
    if {! $S(tkhtml)} { .recent config -state disabled}
    label .msg -textvariable S(msg)
    button .about -text About -command About
    pack .recent -in .bottom -side left -padx .1i
    pack .about -in .bottom -side right -padx .1i
    pack .msg -in .bottom -side bottom -fill x

    option add *Label.background $S(bg)
    option add *Label.foreground white
    option add *Button.background $S(bg)
    option add *Button.activeBackground $S(bg)
    option add *Button.foreground white
    option add *Button.activeForeground white

    frame .top -bg $S(bg) -relief groove -bd 2
    frame .topl -bg $S(bg)
    button .topl.wiki -text "Wiki Page " -command DoWikiPage -relief flat
    entry .topl.ewiki -textvariable S(pnum2) -relief sunken -width 6
    bind .topl.ewiki <Key-Return> [list .topl.wiki invoke]
    label .top.title -textvariable S(title) -fg magenta
    trace variable S(pnum2) w tracer

    set font [font actual [.top.title cget -font]]
    .top.title config -font "$font -weight bold -size 18"

    frame .topr -bg $S(bg)
    label .topr.l0 -text "Version "
    label .topr.e0 -textvar S(left) -width 5 -relief sunken
    label .topr.v -text " vs. "
    label .topr.l1 -text "Version "
    label .topr.e1 -textvar S(right) -width 5 -relief sunken
    label .topr.= -text " => "
    button .topr.diff -text "Run $S(diffprog)" -command RunTKDiff -bd 5

    pack .top -side top -fill x
    pack .topr -in .top -side right
    pack .topl -in .top -side left
    pack .top.title -side top -expand 1
    eval pack [winfo child .topl] -side left
    eval pack [winfo child .topr] -side left
    pack config .topl.wiki -padx {.1i .05i}
    pack config .topr.diff -padx {0 .1i}

    pack [frame .mid -bd 4 -relief ridge] -side top -fill both -expand 1
    foreach w {0 1} side {left right} {
        listbox .l$w -exportselection 0 -width 63 -activestyle none -bd 0 \
            -font {courier 8} -yscrollcommand [list .sb$w set] -height 20
        bind .l$w <<ListboxSelect>> [list ListboxSelect %W $side]
        bind .l$w <1> [list focus %W]
        scrollbar .sb$w -orient v -command [list .l$w yview]
    }
    grid .l0 .sb0 .l1 .sb1 -in .mid -sticky news
    grid rowconfigure .mid 0 -weight 1
    grid columnconfigure .mid {0 2} -weight 1
    option clear
    bind all <Key-F2> {console show}
    bind all <Control-w> exit
    MouseWheelBind
    focus .topl.ewiki
 }
 proc ListboxSelect {W side} {
    global S

    set row [$W curselection]
    set data [$W get $row]
    set S($side) [lindex [split [string trimleft $data] " "] 0]
 }
 proc tracer {var1 var2 op} {
    global S

    if {$S(pnum2) == $S(pnum)} {
        .topl.ewiki config -bg [lindex [.topl.ewiki config -bg] 3]
        .topl.wiki config -relief flat
    } else {
        .topl.ewiki config -bg red
        .topl.wiki config -relief raised
    }
 }
 proc GetVersionInfo {} {
    global S

    .l0 delete 0 end
    .l1 delete 0 end
    set S(left) [set S(right) ""]
    update

    set url "https://wiki.tcl-lang.org/_history/$S(pnum)"
    set token [::http::geturl $url]
    set data [::http::data $token] ; list
    ::http::cleanup $token

    set S(title) "No Wiki History"
    regexp -line {Change history of.*?>(.*?)</a>} $data => S(title)
    set S(title) "\"$S(title)\""

    foreach line [split $data "\n"] {
        if {! [string match "<tr><td*" $line]} continue
        regsub -all {</*?a.*?>} $line {} line
        set matches [regexp -all -inline {<td.*?>(.*?)</td>} $line]
        foreach {. vnum . vwhen . vwho} $matches break
        set txt [format " %3s   %-20s  %s" $vnum $vwho $vwhen]
        .l0 insert end $txt
        .l1 insert end $txt
    }

    .l0 selection clear 0 end
    .l0 selection set 1
    .l0 selection anchor 1
    event generate .l0 <<ListboxSelect>>
    .l1 selection clear 0 end
    .l1 selection set 0
    .l1 selection anchor 0
    event generate .l1 <<ListboxSelect>>
 }
 proc GetRevision {pnum ver} {
    set fname [file join $::S(tmp) "wiki.$pnum.$ver"]
    set fout [open $fname "w"]

    # https://wiki.tcl-lang.org/_revision/606.txt?V=156
    set url "https://wiki.tcl-lang.org/_revision/${pnum}.txt?V=$ver"
    set token [::http::geturl $url -channel $fout]
    puts $fout ""       ; # added by lv to handle missing newline
    close $fout
    ::http::cleanup $token

    return $fname
 }
 proc RunTKDiff {} {
    global S

    Cleanup
    if {$S(left) eq "" || $S(left) eq ""} return
    set f1 [GetRevision $S(pnum) $S(left)]
    set f2 [GetRevision $S(pnum) $S(right)]

    exec $S(diffprog) $f1 $f2 &
    set ::TMPFILES($f1) 1
    set ::TMPFILES($f2) 1
    after 2000                                  ;# Pause to let tkdiff start
 }
 proc DoWikiPage {} {
    global S

    set S(busy) 1
    while {1} {
        after 10 Cleanup
        .topl.ewiki icursor end
        if {! [string is integer -strict $S(pnum2)]} break
        if {$S(pnum) == $S(pnum2)} break
        set S(pnum) $S(pnum2)
        GetVersionInfo
        set S(pnum2) $S(pnum2)
    }
    set S(busy) 0
 }
 proc Cleanup {{exit 0}} {
    global TMPFILES

    foreach fname [array names TMPFILES] {
        set n [catch {file delete $fname}]
        if {! $n} { unset TMPFILES($fname) }
    }
    if {$exit} exit
 }
 proc About {} {
    set msg "WikiDiff\nby Keith Vetter\nMarch 2003\n\n"
    append msg "Compares back revisions of a\nTcl'ers Wiki "
    append msg "page using tkdiff."
    tk_messageBox -title "About" -message $msg
 }
 proc Recents {} {
    if {! $::S(tkhtml)} return
    destroy .r
    toplevel .r
    wm title .r "WIKI Recent Changes"
    wm transient .r .
    wm geom .r +10+470

    scrollbar .r.v -o v -command {.r.h yv}
    html .r.h -yscrollcommand {.r.v set} -background white -height 500
    bind .r.h.x <1> [list Click 1 %x %y]
    bind .r.h.x <Double-Button-1> [list Click 2 %x %y]
    bind .r.h.x <Button-3> [list 3Click %x %y]
    #bind .r.h <MouseWheel> [bind Text <MouseWheel>]

    pack .r.v -side right -fill y
    pack .r.h -side left -fill both -expand 1
    FillRecents
 }
 proc FillRecents {} {
    .r.h clear
    .r.h parse "<html><body><p>Downloading Recent Changes...</body></html>"
    #update idletask
    update

    set url "https://wiki.tcl-lang.org/4"
    set url "https://wiki.tcl-lang.org/4"
    set n [catch {
        set token [::http::geturl $url]
    }]
    if {$n} {                                   ;# Error
        .r.h clear
        .r.h parse "<html><body><p>Error loading Recent Changes</body></html>"
        return
    }

    set data [::http::data $token] ; list
    ::http::cleanup $token

    .r.h clear
    .r.h config -base $url
    .r.h parse $data
    set ::data $data
    focus .r.h
 }
 proc Click {cnt x y} {
    if {$::S(busy)} return
    set href [.r.h href $x $y]
    set ::href $href
    if {$href == ""} return
    if {$href == "{https://wiki.tcl-lang.org/4!}"} {
        if {$cnt == 2} FillRecents
        return
    }
    set ::href $href
    set n [regexp {/(\d+)\}?$} $href => pnum]
    if {! $n} return

    set ::S(pnum2) $pnum
    if {$cnt == 2} {
        .topl.wiki invoke
    }
 }
 proc 3Click {x y} {
    set href [.r.h href $x $y]
    if {$href == ""} return

    set n [catch {eval exec [auto_execok start] $href &} err]
 }
 proc MouseWheelBind {} {
    # Taken from tip #171

    # Remove existing class MouseWheel bindings
    set mw_classes [list Text Listbox Table TreeCtrl]
    foreach class $mw_classes { bind $class <MouseWheel> {} }
    if {[tk windowingsystem] eq "x11"} {
        foreach class $mw_classes {
            bind $class <4> {}
            bind $class <5> {}
        }
    }
    proc ::tk::MouseWheel {wFired D X Y {dir y}} {
        # do not double-fire in case the class already has a binding
        if {[bind [winfo class $wFired] <MouseWheel>] ne ""} { return }
        # obtain the window the mouse is over
        set w [winfo containing $X $Y]
        # if we are outside the app, try and scroll the focus widget
        if {![winfo exists $w]} { catch {set w [focus]} }
        if {[winfo exists $w]} {
            # scrollbars have different call conventions
            if {[winfo class $w] eq "Scrollbar"} {
                catch {tk::ScrollByUnits $w \
                           [string index [$w cget -orient] 0] \
                           [expr {-($D/30)}]}
            } else {
                catch {$w ${dir}view scroll [expr {- ($D / 120) * 4}] units}
            }
        }
    }
    bind all <MouseWheel> [list ::tk::MouseWheel %W %D %X %Y]
    bind all <Shift-MouseWheel> [list ::tk::MouseWheel %W %D %X %Y x]
    if {[tk windowingsystem] eq "x11"} {
        # Support for mousewheels on Linux/Unix commonly comes through
        # mapping the wheel to the extended buttons.
        bind all <4> [list ::tk::MouseWheel %W 120 %X %Y]
        bind all <5> [list ::tk::MouseWheel %W -120 %X %Y]
    }
 }
 DoDisplay
 set S(pnum2) [lindex $argv 0]
 .l0 insert end "Enter the number of a Wiki page to run diff on"
 Recents
 return