Eskil

#!/bin/sh
#----------------------------------------------------------------------
#
#  Eskil, a Graphical frontend to diff
#
#  Copyright (c) 1998-2005, Peter Spjuth  (peter.spjuth@space.se)
#
#  Usage
#             Do 'eskil.tcl' for interactive mode
#             Do 'eskil.tcl --help' for command line usage
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,

# Stop Tk from meddling with the command line by copying it first.
set ::eskil(argv) $::argv
set ::eskil(argc) $::argc
set ::argv {}
set ::argc 0

set debug 0
set diffver "Version 2.0.7+ 2005-02-10"

# Do initalisations for needed packages and globals.
# This is not run until needed to speed up command line error reporting.
proc Init {} {
    package require Tk 8.4
    catch {package require textSearch}

    # Follow any link
    set tmplink $::thisScript
    while {[file type $tmplink] eq "link"} {
        set tmplink [file readlink $tmplink]
        set tmplink [file normalize [file join $::thisDir $tmplink]]
        set ::thisDir [file dirname $tmplink]
    }










    set ::util(diffexe) diff

    # Diff functionality is in the DiffUtil package.
    package require DiffUtil
    # Help DiffUtil to find a diff executable, if needed
    catch {DiffUtil::LocateDiffExe $::thisScript}

#    puts "Same ($sames)"
#    puts "D1   ($diffs1)"
#    puts "D2   ($diffs2)"
#    puts "S $sumsame D $sumdiff1 D $sumdiff2"
    return [expr {$sumsame - [maxAbs $sumdiff1 $sumdiff2]}]
}

# Initialise a multidimensional list with empty values
# This should use lrepeat once 8.5 is required
# The args are in the same order as indexes to lset/lindex
proc Linit {elem args} {
    for {set t [expr {[llength $args] - 1}]} {$t >= 0} {incr t -1} {
	set new {}
	for {set j [lindex $args $t]} {$j >= 1} {incr j -1} {
	    lappend new $elem

    if {$state != "none"} {
        displayOnePatch $top $leftLines $rightLines $leftLine $rightLine
    }

    close $ch
}

#####################################
# Revision control systems support
#####################################

# Figure out what revision control system a file is under
# Returns "CVS", "RCS", "CT" if detectd, or "" if none.
proc DetectRevSystem {file} {
    set dir [file dirname $file]
    # CVS
    if {[file isdirectory [file join $dir CVS]]} {
        if {[auto_execok cvs] ne ""} {
            return "CVS"
        }
        # Error?
    }
    # ClearCase
    if {[auto_execok cleartool] != ""} {
        set old [pwd]
        cd $dir
        if {![catch {exec cleartool pwv -s} view] && $view != "** NONE **"} {
            cd $old
            return "CT"
        }
        cd $old
    }
    # RCS
    if {[file isdirectory [file join $dir RCS]] || [file exists $file,v]} {
        if {[auto_execok rcs] ne ""} {
            return "RCS"
        }
        # Error?
    }
    return
}

# Initialise revision control mode
# The file name should be an absolute normalized path.
proc startRevMode {top rev file} {
    set ::diff($top,mode) "rev"
    set ::diff($top,modetype) $rev
    set ::diff($top,rightDir) [file dirname $file]
    set ::diff($top,RevFile) $file
    set ::diff($top,rightLabel) $file
    set ::diff($top,rightFile) $file
    set ::diff($top,rightOK) 1
    set ::diff($top,leftLabel) $rev
    set ::diff($top,leftOK) 0
}

# Get a CVS revision
proc getCvsRev {filename outfile {rev {}}} {
    set old ""
    set dir [file dirname $filename]
    if {$dir != "."} {
        set old [pwd]
        set outfile [file join [pwd] $outfile]
        cd $dir
        set filename [file tail $filename]
    }

    set cmd [list exec cvs -z3 update -p]
    if {$rev != ""} {
        lappend cmd -r $rev
    }
    lappend cmd [file nativename $filename] > $outfile
    if {[catch {eval $cmd} res]} {
        if {![string match "*Checking out*" $res]} {
            tk_messageBox -icon error -title "CVS error" -message $res
        }
    }

    if {$old != ""} {
        cd $old
    }
}

# Get an RCS revision
proc getRcsRev {filename outfile {rev {}}} {
    catch {exec co -p$rev [file nativename $filename] \
            > $outfile}
}

# Get a ClearCase revision
proc getCtRev {filename outfile rev} {
    set filerev [file nativename $filename@@$rev]
    if {[catch {exec cleartool get -to $outfile $filerev} msg]} {
        tk_messageBox -icon error -title "Cleartool error" -message $msg
        return
    }
}

# Figure out ClearCase revision from arguments
proc ParseCtRevs {filename stream rev} {
    # A negative version number is offset from latest.
    set offset 0
    set tail [file tail $rev]
    if {[string is integer -strict $tail] && $tail < 0} {
        set offset $tail
        set rev [file dirname $rev]
    }
    # If the argument is of the form "name/rev", look for a fitting one
    if {![string is integer $rev] && [regexp {^[^/.]+(/\d+)?$} $rev]} {
        if {[catch {exec cleartool lshistory -short $filename} allrevs]} {#
            tk_messageBox -icon error -title "Cleartool error" \
                    -message $allrevs
            return
        }
        set allrevs [split $allrevs \n]

        set i [lsearch -glob $allrevs "*$rev" ]
        if {$i >= 0} {
            set rev [lindex [split [lindex $allrevs $i] "@"] end]
        }
    }
    set rev [file normalize [file join $stream $rev]]
    # If we don't have a version number, try to find the latest
    if {![string is integer [file tail $rev]]} {
        if {![info exists allrevs]} {
            if {[catch {exec cleartool lshistory -short $filename} allrevs]} {#
                tk_messageBox -icon error -title "Cleartool error" \
                        -message $allrevs
                return
            }
            set allrevs [split $allrevs \n]
        }
        set apa [lsearch -regexp -all -inline $allrevs "$rev/\\d+\$"]
        set apa [lindex [lsort -dictionary $apa] end]
        if {$apa ne ""} {
            set rev [lindex [split $apa "@"] end]
        }
    }
    set tail [file tail $rev]
    if {[string is integer -strict $tail] && $offset < 0} {
        set path [file dirname $rev]
        set tail [expr {$tail + $offset}]
        if {$tail < 0} {set tail 0}
        set rev [file join $path $tail]
    }
        
    return $rev
}

# Get the last two elements in a file path
proc GetLastTwoPath {path} {
    set last [file tail $path]
    set penultimate [file tail [file dirname $path]]
    if {$penultimate eq "."} {
        return $last
    } else {
        return [file join $penultimate $last]
    }
}

# Prepare for RCS/CVS/CT diff. Checkout copies of the versions needed.
proc prepareRev {top} {
    global Pref

    set type $::diff($top,modetype)

    if {$type eq "CT"} {
        # Figure out stream and current version
        if {[catch {exec cleartool ls $::diff($top,RevFile)} info]} {
            tk_messageBox -icon error -title "Cleartool error" -message $info
            return
        }
        set currV {}
        if {![regexp {@@(\S+)\s+from (\S+)\s+Rule} $info -> dummy currV]} {
            regexp {@@(\S+)} $info -> currV
        }
        set stream [file dirname $currV]
        set latest [file tail $currV]
    }

    set revs {}

    # Search for revision options
    if {$::diff($top,doptrev1) != ""} {
        lappend revs $::diff($top,doptrev1)
    }
    if {$::diff($top,doptrev2) != ""} {
        lappend revs $::diff($top,doptrev2)
    }

    if {$type eq "CT"} {
        set revs2 {}
        set revlabels {}
        foreach rev $revs {
            set rev [ParseCtRevs $::diff($top,RevFile) $stream $rev]
            lappend revs2 $rev
            lappend revlabels [GetLastTwoPath $rev]
        }
        set revs $revs2
    } else {
        set revlabels $revs
    }

    if {[llength $revs] < 2} {
        # Compare local file with specified version.
        disallowEdit $top 1
        if {[llength $revs] == 0} {
            set r ""
            if {$type eq "CT"} {
                set r [file join $stream $latest]
            }
            set tag "($type)"
        } else {
            set r [lindex $revs 0]
            set tag "($type [lindex $revlabels 0])"
        }
        set ::diff($top,leftFile) [tmpFile]
        set ::diff($top,leftLabel) "$::diff($top,RevFile) $tag"
        set ::diff($top,rightLabel) $::diff($top,RevFile)
        set ::diff($top,rightFile) $::diff($top,RevFile)

        if {$type eq "CVS"} {
            getCvsRev $::diff($top,RevFile) $::diff($top,leftFile) $r
        } elseif {$type eq "RCS"} {
            getRcsRev $::diff($top,RevFile) $::diff($top,leftFile) $r
        } else {
            getCtRev $::diff($top,RevFile) $::diff($top,leftFile) $r
        }
    } else {
        # Compare the two specified versions.
        disallowEdit $top
        set r1 [lindex $revs 0]
        set r2 [lindex $revs 1]
        set ::diff($top,leftFile)  [tmpFile]
        set ::diff($top,rightFile) [tmpFile]

        set ::diff($top,leftLabel) \
                "$::diff($top,RevFile) ($type [lindex $revlabels 0])"
        set ::diff($top,rightLabel) \
                "$::diff($top,RevFile) ($type [lindex $revlabels 1])"
        if {$type eq "CVS"} {
            getCvsRev $::diff($top,RevFile) $::diff($top,leftFile) $r1
            getCvsRev $::diff($top,RevFile) $::diff($top,rightFile) $r2
        } elseif {$type eq "RCS"} {
            getRcsRev $::diff($top,RevFile) $::diff($top,leftFile) $r1
            getRcsRev $::diff($top,RevFile) $::diff($top,rightFile) $r2
        } else {
            getCtRev $::diff($top,RevFile) $::diff($top,leftFile) $r1
            getCtRev $::diff($top,RevFile) $::diff($top,rightFile) $r2
        }
    }
    # Make sure labels are updated before processing starts
    update idletasks
}

# Clean up after a RCS/CVS/CT diff.
proc cleanupRev {top} {
    global Pref

    clearTmp $::diff($top,rightFile) $::diff($top,leftFile)
    set ::diff($top,rightFile) $::diff($top,RevFile)
    set ::diff($top,leftFile) $::diff($top,RevFile)
}

#####################################
# Main diff
#####################################

# Prepare for a diff by creating needed temporary files
proc prepareFiles {top} {
    set ::diff($top,cleanup) ""

        set ::diff($top,patchFile) $::diff($top,leftFile)
        doDiff $top
    }
}

proc openRev {top} {
    if {[doOpenRight $top]} {
        set rev [DetectRevSystem $::diff($top,rightFile)]
        if {$rev eq ""} {
            tk_messageBox -icon error -title "Eskil Error" -message \
                    "Could not figure out which revison control system\
                    \"$::diff($top,rightFile)\" is under." -type ok
            return
        }
        startRevMode $top $rev $::diff($top,rightFile)
        doDiff $top
    }
}

proc openBoth {top forget} {
    if {[doOpenLeft $top]} {
        if {[doOpenRight $top $forget]} {
            set ::diff($top,mode) ""
            doDiff $top
        }
    }
}

#####################################
# Map stuff
#####################################

proc clearMap {top} {
    set ::diff($top,changes) {}
    set ::diff($top,mapMax) 0
    drawMap $top -1
}

proc addChange {top n tag line1 n1 line2 n2} {
    if {$tag ne ""} {
        lappend ::diff($top,changes) [list $::diff($top,mapMax) $n \
                $tag $line1 $n1 $line2 $n2]
    }
    incr ::diff($top,mapMax) $n
}

proc addMapLines {top n} {
    incr ::diff($top,mapMax) $n
}

proc drawMap {top newh} {
    global Pref

    set oldh [map$top cget -height]
    if {$oldh == $newh} return

    map$top blank
    if {![info exists ::diff($top,changes)] || \
            [llength $::diff($top,changes)] == 0} return

    set w [winfo width $top.c]
    set h [winfo height $top.c]
    set x2 [expr {$w - 1}]
    map$top configure -width $w -height $h
    incr h -1
    foreach change $::diff($top,changes) {
        foreach {start length type dum1 dum2 dum3 dum4} $change break
        set y1 [expr {$start * $h / $::diff($top,mapMax) + 1}]
        if {$y1 < 1} {set y1 1}
        if {$y1 > $h} {set y1 $h}
        set y2 [expr {($start + $length) * $h / $::diff($top,mapMax) + 1}]
        if {$y2 < 1} {set y2 1}
        if {$y2 <= $y1} {set y2 [expr {$y1 + 1}]}
        if {$y2 > $h} {set y2 $h}
        incr y2
        map$top put $Pref(color$type) -to 1 $y1 $x2 $y2
    }
}

######################################
# Merge stuff
#####################################

# Get all data from the files to merge
proc collectMergeData {top} {
    global diff

    grid columnconfigure $w 0 -weight 1
    grid rowconfigure $w 1 -weight 1

    collectMergeData $top
    fillMergeWindow $top
}

#####################################
# Printing stuff
#####################################

# Format a line number for printing
# It will always be 5 chars wide.
proc formatLineno {lineno gray} {
    if {[string is integer -strict $lineno]} {
        set res [format "%3d: " $lineno]
    } else {
        set res [format "%-5s" $lineno]
        set gray 0.9
    }
    if {[string length $res] > 5} {
        set res [string range $res end-5 end-1]
    }
    if {$gray eq "1.0"} {
        return $res
    } else {
        return "\0bggray\{$gray\}$res\0bggray\{1.0\}"
    }
}

# Process the line numbers from the line number widget into a list
# of "linestarters"
proc processLineno {w} {
    set tdump [$w dump -tag -text 1.0 end]
    set gray 1.0
    set line ""
    set lines {}
    foreach {key value index} $tdump {
        if {$key eq "tagon"} {
            if {$value eq "change"} {
                set gray $::grayLevel1
            } elseif {[string match "new*" $value]} {
                set gray $::grayLevel2
            }
        } elseif {$key eq "tagoff"} {
            if {$value eq "change" || [string match "new*" $value]} {
                set gray 1.0
            }
        } elseif {$key eq "text"} {
            append line $value
            if {[string index $value end] eq "\n"} {
                set line [string trim [string trim $line] :]
                if {$line eq ""} {
                    lappend lines ""
                } else {
                    lappend lines [formatLineno $line $gray]
                }
                set line ""
            }
        }
    }
    return $lines
}

# Handle wrapping of a too long line for printing
# The indentation of the wrapped line is 5 chars, same as a line number.
proc lineWrap {gray} {
    if {$gray eq "1.0"} {
        return "\n     "
    } else {
        return "\0bggray\{1.0\}\n     \0bggray\{$gray\}"
    }
}

# Prepare a text block for printing
proc fixTextBlock {text index} {
    # Remove any form feed
    if {[regsub -all "\f" $text {} apa]} {
        set text $apa
    }
    regexp {\d+\.(\d+)} $index -> index

    # Expand tabs to 8 chars
    while 1 {
        set i [string first \t $text]
        if {$i eq -1} break
        set n [expr {(- $i - $index - 1) % 8 + 1}]
        set text [string replace $text $i $i [format %${n}s ""]]
    }
    return $text
}

# Main print function
proc printDiffs {top {quiet 0}} {
    busyCursor $top
    update idletasks
    set tmpFile [file nativename ~/eskil.enscript]
    if {$::diff($top,printFile) != ""} {
        set tmpFile2 [file nativename $::diff($top,printFile)]
    } else {
        set tmpFile2 [file nativename ~/eskil.ps]
    }

    set lines1 {}
    set lines2 {}
    if {$::wideLines} {
        set wraplength 100
        set linesPerPage 74
    } else {
        set wraplength 85
        set linesPerPage 66
    }

    set tdump1 [$::widgets($top,wDiff1) dump -tag -text 1.0 end]
    set tdump2 [$::widgets($top,wDiff2) dump -tag -text 1.0 end]
    set lineNo1 [processLineno $::widgets($top,wLine1)]
    set lineNo2 [processLineno $::widgets($top,wLine2)]

    foreach tdump [list $tdump1 $tdump2] \
            lineName {lines1 lines2} wrapName {wrap1 wrap2} \
            lineNo [list $lineNo1 $lineNo2] {
        ##nagelfar variable lineName varName
        ##nagelfar variable wrapName varName
        set lines {}
        set wraps {}
        set line [lindex $lineNo 0]
        set newline 0
        set gray 1.0
        set chars 0
        set wrapc 0
        foreach {key value index} $tdump {
            if {$key != "tagoff" && $newline == 1} {
                lappend lines $line
                lappend wraps $wrapc
                set newline 0
                set line [lindex $lineNo [llength $lines]]
                append line "\0bggray\{$gray\}"
                set chars 0
                set wrapc 0
            }
            switch $key {
                text {
                    set value [fixTextBlock $value $index]
                    if {[string index $value end] eq "\n"} {
                        set newline 1
                        set value [string trimright $value "\n"]
                    }
                    set len [string length $value]
                    while {$chars + $len > $wraplength} {
                        set wrap [expr {$wraplength - $chars}]
                        set val1 [string range $value 0 [expr {$wrap - 1}]]
                        set value [string range $value $wrap end]
                        append line $val1
                        append line [lineWrap $gray]
                        set chars 5
                        incr wrapc
                        set len [string length $value]
                    }
                    append line $value
                    incr chars $len
                }
                tagon {
                    if {$value eq "change"} {
                        set gray $::grayLevel1
                        append line "\0bggray\{$gray\}"
                    } elseif {$value != "last"} {
                        set gray $::grayLevel2
                        append line "\0bggray\{$gray\}"
                    }
                }
                tagoff {
                    if {$value != "last"} {
                        append line "\0bggray\{1.0\}"
                        set gray 1.0
                    }
                }
            }
        }
        set $lineName $lines
        set $wrapName $wraps
    }

    set wraplines1 {}
    set wraplines2 {}

    foreach l1 $lines1 l2 $lines2 w1 $wrap1 w2 $wrap2 {
        if {$w1 > 0} {
            set apa [split $l1 "\n"]
            set wraplines1 [concat $wraplines1 $apa]
        } else {
            lappend wraplines1 $l1
        }
        if {$w2 > 0} {
            set apa [split $l2 "\n"]
            set wraplines2 [concat $wraplines2 $apa]
        } else {
            lappend wraplines2 $l2
        }
        if {$w1 > $w2} {
            for {set t $w2} {$t < $w1} {incr t} {
                lappend wraplines2 ""
            }
        } elseif {$w2 > $w1} {
            for {set t $w1} {$t < $w2} {incr t} {
                lappend wraplines1 ""
            }
        }
    }

    set ch [open $tmpFile "w"]

    set len1 [llength $wraplines1]
    set len2 [llength $wraplines2]

    set i1 0
    set i2 0

    while {$i1 < $len1 && $i2 < $len2} {
        for {set i 0} {$i < $linesPerPage && $i1 < $len1} {incr i ; incr i1} {
            puts $ch [lindex $wraplines1 $i1]
        }
        if {$i < $linesPerPage} {puts -nonewline $ch "\f"}
        for {set i 0} {$i < $linesPerPage && $i2 < $len2} {incr i ; incr i2} {
            puts $ch [lindex $wraplines2 $i2]
        }
        if {$i < $linesPerPage} {puts -nonewline $ch "\f"}
    }

    close $ch

    if {$::tcl_platform(platform) eq "windows" &&\
            ![info exists ::env(ENSCRIPT_LIBRARY)]} {
        set ::env(ENSCRIPT_LIBRARY) [pwd]
    }
    set enscriptCmd [list enscript -2jcre -L $linesPerPage -M A4]
    if {$::wideLines} {
        lappend enscriptCmd  -f Courier6
    }
    if {![regexp {^(.*)( \(.*?\))$} $::diff($top,leftLabel) -> lfile lrest]} {
        set lfile $::diff($top,leftLabel)
        set lrest ""
    }
    set lfile [file tail $lfile]$lrest
    if {![regexp {^(.*)( \(.*?\))$} $::diff($top,rightLabel) -> rfile rrest]} {
        set rfile $::diff($top,rightLabel)
        set rrest ""
    }
    set rfile [file tail $rfile]$rrest

    lappend enscriptCmd "--header=$lfile|Page \$% of \$=|$rfile"
    if {$::prettyPrint != ""} {
        lappend enscriptCmd -E$::prettyPrint
    }
    lappend enscriptCmd -p $tmpFile2 $tmpFile

    if {[catch {eval exec $enscriptCmd} result]} {
        if {[string index $result 0] != "\["} {
            tk_messageBox -message "Enscript error: $result"
            return
        }
    }

    normalCursor $top
    if {!$quiet} {
        destroy .dp
        toplevel .dp
        wm title .dp "Eskil Print"
        button .dp.b -text "Close" -command {destroy .dp}
        label .dp.l -anchor w -justify left -text "The following files have\
                been created:\n\n$tmpFile\nInput file to enscript.\
                \n\n$tmpFile2\nCreated with\
                '[lrange $enscriptCmd 0 end-3] \\\n             \
                [lrange $enscriptCmd end-2 end]'" \
                -font "Courier 8"
        pack .dp.b -side bottom
        pack .dp.l -side "top"
    }
}

# Create a print dialog.
proc doPrint {top {quiet 0}} {
    if {![info exists ::grayLevel1]} {
        set ::grayLevel1 0.6
        set ::grayLevel2 0.8
        set ::wideLines 0
    }
    if {$quiet} {
        printDiffs $top 1
        return
    }

    destroy .pr
    toplevel .pr
    wm title .pr "Print diffs"

    label .pr.l1 -justify left -anchor w \
            -text "The print function is just on an\
            experimental level. It will use 'enscript' to write a postcript\
            file \"eskil.ps\" in your home directory."
    label .pr.l2 -justify left -anchor w \
            -text "Below you can adjust the gray scale\
            levels that are used on the background to mark changes.\
            The first value is used for changed text. The second for\
            new/deleted text."
    .pr.l1 configure -wraplength 400
    .pr.l2 configure -wraplength 400

    scale .pr.s1 -orient horizontal -resolution 0.1 -showvalue 1 -from 0.0 \
            -to 1.0 -variable grayLevel1
    scale .pr.s2 -orient horizontal -resolution 0.1 -showvalue 1 -from 0.0 \
            -to 1.0 -variable grayLevel2
    frame .pr.f
    radiobutton .pr.r1 -text "No Syntax" -variable prettyPrint -value ""
    radiobutton .pr.r2 -text "VHDL" -variable prettyPrint -value "vhdl"
    radiobutton .pr.r3 -text "Tcl"  -variable prettyPrint -value "tcl"
    radiobutton .pr.r4 -text "C"    -variable prettyPrint -value "c"

    frame .pr.fs
    radiobutton .pr.fs.r1 -text "80 char" -variable wideLines -value 0
    radiobutton .pr.fs.r2 -text "95 char" -variable wideLines -value 1
    pack .pr.fs.r1 .pr.fs.r2 -side left -padx 10

    button .pr.b1 -text "Print to File" -padx 5\
            -command "destroy .pr; update; printDiffs $top"
    button .pr.b2 -text "Cancel" -padx 5 \
            -command {destroy .pr}

    grid .pr.l1 - - -sticky we
    grid .pr.l2 - - -sticky we
    grid .pr.s1 - - -sticky we
    grid .pr.s2 - - -sticky we
    grid .pr.f  - - -sticky we
    grid .pr.fs - - -sticky we
    grid .pr.b1 x .pr.b2 -sticky we -padx 5 -pady 5
    grid columnconfigure .pr {0 2} -uniform a
    grid columnconfigure .pr 1 -weight 1
    pack .pr.r1 .pr.r2 .pr.r3 .pr.r4 -in .pr.f -side left -fill x -expand 1

}

#####################################
# GUI stuff
#####################################

# A little helper to make a scrolled window
# It returns the name of the scrolled window

    label $top.le -textvariable ::widgets($top,eqLabel) -width 1
    addBalloon $top.le "* means external diff is running.\n= means files do\
            not differ.\n! means a large block is being processed.\nBlank\
            means files differ."
    label $top.ls -width 1 -pady 0 -padx 0 \
            -textvariable ::widgets($top,isearchLabel)
    addBalloon $top.ls "Incremental search indicator"
    canvas $top.c -width 6 -bd 0 -selectborderwidth 0 -highlightthickness 0


    applyColor
    foreach w [list $top.ft1.tt $top.ft2.tt] {
        # The last change in a row is underlined
        $w tag configure last -underline 1
        # Each file in a patch view starts with a block of this type
        $w tag configure patch -background gray
        # Make sure selection is visible
        $w tag raise sel
        bind $w <ButtonPress-3> "zoomRow %W %X %Y %x %y"
        bind $w <ButtonRelease-3> "unzoomRow %W"
    }
    foreach w [list $top.ft1.tl $top.ft2.tl] {
        $w tag configure align -underline 1
        bind $w <ButtonPress-3> "rowPopup %W %X %Y %x %y"
    }

    grid $top.l1   $top.le -        $top.l2   -row 1 -sticky news
    grid $top.ft1  $top.c  $top.sby $top.ft2  -row 2 -sticky news
    grid $top.sbx1 $top.ls -        $top.sbx2 -row 3 -sticky news
    grid columnconfigure $top {0 3} -weight 1
    grid rowconfigure $top 2 -weight 1
    grid $top.c -pady [expr {[$top.sby cget -width] + 2}]
    grid $top.ls -sticky ""

    image create photo map$top
    $top.c create image 0 0 -anchor nw -image map$top
    bind $top.c <Destroy> [list image delete map$top]
    bind $top.c <Configure> [list drawMap $top %h]

    bind $top <Key-Up>    [list scrollText $top -1 u]
    bind $top <Key-Down>  [list scrollText $top  1 u]
    bind $top <Key-Prior> [list scrollText $top -1 p]
    bind $top <Key-Next>  [list scrollText $top  1 p]
    bind $top <Key-Escape> [list focus $top]
    if {$debug == 0} {
        bind $top <Key> "backDoor %A"

    trace add variable ::diff($top,prefregexa) write \
            [list EditPrefRegsubUpdate $top]
    trace add variable ::diff($top,prefregexa2) write \
            [list EditPrefRegsubUpdate $top]
    EditPrefRegsubUpdate $top
}

#####################################
# Registry section
#####################################

proc makeRegistryFrame {w label key newvalue} {
    set old {}
    catch {set old [registry get $key {}]}

    set l [labelframe $w -text $label -padx 4 -pady 4]

    label $l.key1 -text "Key:"
    label $l.key2 -text $key
    label $l.old1 -text "Old value:"
    label $l.old2 -text $old
    label $l.new1 -text "New value:"
    label $l.new2 -text $newvalue

    button $l.change -text "Change" -width 10 -command \
            "[list registry set $key {} $newvalue] ; \
             [list $l.change configure -state disabled]"
    button $l.delete -text "Delete" -width 10 -command \
            "[list registry delete $key] ; \
             [list $l.delete configure -state disabled]"
    if {[string equal $newvalue $old]} {
        $l.change configure -state disabled
    }
    if {[string equal "" $old]} {
        $l.delete configure -state disabled
    }
    grid $l.key1 $l.key2 -     -sticky "w" -padx 4 -pady 4
    grid $l.old1 $l.old2 -     -sticky "w" -padx 4 -pady 4
    grid $l.new1 $l.new2 -     -sticky "w" -padx 4 -pady 4
    grid $l.delete - $l.change -sticky "w" -padx 4 -pady 4
    grid $l.change -sticky "e"
    grid columnconfigure $l 2 -weight 1
}

proc makeRegistryWin {} {
    global thisScript

    # Locate executable for this program
    set exe [info nameofexecutable]
    if {[regexp {^(.*wish)\d+\.exe$} $exe -> pre]} {
        set alt $pre.exe
        if {[file exists $alt]} {
            set a [tk_messageBox -icon question -title "Which Wish" -message \
                    "Would you prefer to use the executable\n\
                    \"$alt\"\ninstead of\n\
                    \"$exe\"\nin the registry settings?" -type yesno]
            if {$a eq "yes"} {
                set exe $alt
            }
        }
    }

    set top .reg
    destroy $top
    toplevel $top
    wm title $top "Register Eskil"

    # Registry keys

    #set keyg {HKEY_CLASSES_ROOT\Folder\shell\Grep\command}
    set keydd {HKEY_CLASSES_ROOT\Folder\shell\Diff\command}
    set keyd {HKEY_CLASSES_ROOT\*\shell\Diff\command}
    set keyc {HKEY_CLASSES_ROOT\*\shell\DiffC\command}
    set keye {HKEY_CLASSES_ROOT\*\shell\Emacs\command}

    # Are we in a starkit?
    if {[info exists ::starkit::topdir]} {
        # In a starpack ?
        set exe [file normalize $exe]
        if {[string equal [file normalize $::starkit::topdir] $exe]} {
            set myexe [list $exe]
        } else {
            set myexe [list $exe $::starkit::topdir]
        }
    } else {
        if {[regexp {wish\d+\.exe} $exe]} {
            set exe [file join [file dirname $exe] wish.exe]
            if {[file exists $exe]} {
                set myexe [list $exe]
            }
        }
        set myexe [list $exe $thisScript]
    }

    set valbase {}
    foreach item $myexe {
        lappend valbase \"[file nativename $item]\"
    }
    set valbase [join $valbase]

    set new "$valbase -browse \"%1\""
    makeRegistryFrame $top.d "Diff" $keyd $new

    set new "$valbase -o \"%1\" -conflict \"%1\""
    makeRegistryFrame $top.c "Diff Conflict" $keyc $new

    set new "$valbase \"%1\""
    makeRegistryFrame $top.dd "Directory Diff" $keydd $new

    pack $top.d $top.c $top.dd -side "top" -fill x -padx 4 -pady 4

    locateEditor ::util(editor)
    if {[string match "*runemacs.exe" $::util(editor)]} {
        # Set up emacs
        set newkey "\"[file nativename $::util(editor)]\" \"%1\""
        makeRegistryFrame $top.e "Emacs" $keye $newkey
        pack $top.e -side "top" -fill x -padx 4 -pady 4
    }

    button $top.close -text "Close" -width 10 -command [list destroy $top] \
            -default active
    pack $top.close -side bottom -pady 4
    bind $top <Key-Return> [list destroy $top]
    bind $top <Key-Escape> [list destroy $top]
}

#####################################
# Directory diff section
#####################################

# Compare file names
proc FStrCmp {s1 s2} {
    # On Unix filenames are case sensitive
    if {$::tcl_platform(platform) eq "unix"} {
	return [string compare $s1 $s2]
    }
    string compare -nocase $s1 $s2
}

# Sort file names
proc Fsort {l} {
    if {$::tcl_platform(platform) eq "unix"} {
	return [lsort $l]
    }
    # Case insensitive on windows
    lsort -dictionary $l
}

# Compare two files
proc compareFiles {file1 file2} {
    global Pref
    if {[catch {file stat $file1 stat1}]} {
        return 0
    }
    if {[catch {file stat $file2 stat2}]} {
        return 0
    }

    # Same type?
    if {[file isdirectory $file1] != [file isdirectory $file2]} {
	return 0
    }
    # If contents is not checked, same size is enough to be equal
    if {$stat1(size) == $stat2(size) && $Pref(comparelevel) == 0} {
        return 1
    }
    # Different size is enough when doing binary compare
    if {$stat1(size) != $stat2(size) && $Pref(comparelevel) eq "1b"} {
        return 0
    }
    # Same size and time is always considered equal
    if {$stat1(size) == $stat2(size) && $stat1(mtime) == $stat2(mtime)} {
	return 1
    }
    # Don't check further if contents should not be checked
    if {$Pref(comparelevel) == 0} {
        return 0
    }
    # Don't check further if any is a directory
    if {[file isdirectory $file1] || [file isdirectory $file2]} {
	return 0
    }

    set ignorekey $Pref(dir,ignorekey)
    switch $Pref(comparelevel) {
        1b -
        1 { # Check contents internally
            set bufsz 65536
            set eq 1
            set ch1 [open $file1 r]
            set ch2 [open $file2 r]
            if {$Pref(comparelevel) eq "1b"} {
                fconfigure $ch1 -translation binary
                fconfigure $ch2 -translation binary
            }
            if {$ignorekey} {
                # Assume that all keywords are in the first block
                set f1 [read $ch1 $bufsz]
                set f2 [read $ch2 $bufsz]
                regsub -all {\$\w+:[^\$]*\$} $f1 {} f1
                regsub -all {\$\w+:[^\$]*\$} $f2 {} f2
                # Compensate for any change in length
                if {[string length $f1] < [string length $f2]} {
                    append f1 [read $ch1 [expr {[string length $f2] - [string length $f1]}]]
                }
                if {[string length $f2] < [string length $f1]} {
                    append f2 [read $ch2 [expr {[string length $f1] - [string length $f2]}]]
                }
                if {![string equal $f1 $f2]} {
                    set eq 0
                }
            }
            while {$eq && ![eof $ch1] && ![eof $ch2]} {
                set f1 [read $ch1 $bufsz]
                set f2 [read $ch2 $bufsz]
                if {![string equal $f1 $f2]} {
                    set eq 0
                }
            }
            if {![eof $ch1] || ![eof $ch2]} {
                set eq 0
            }
            close $ch1
            close $ch2
        }
        2 { # Simple external diff
            set eq [expr {![catch {exec $::util(diffexe) $file1 $file2}]}]
        }
        3 { # Ignore space
            set eq [expr {![catch {exec $::util(diffexe) -w $file1 $file2}]}]
        }
        4 { # Ignore case
            set eq [expr {![catch {exec $::util(diffexe) -i $file1 $file2}]}]
        }
    }
    return $eq
}

# Display two files in the directory windows and set up info for
# interacting with them.
# diff: Do they differ.
# level: Depth in a recursive run.
# The values in infoFiles are:
# 1 = noLeft, 2 = noRight, 4 = left is dir, 8 = right is dir, 16 = diff
proc listFiles {df1 df2 diff level} {
    global dirdiff Pref

    # Optionally do not list directories.
    if {$Pref(nodir)} {
        if {$df1 != "" && [file isdirectory $df1] && \
                $df2 != "" && [file isdirectory $df2] } {
            return
        }
    }

    lappend dirdiff(leftFiles) $df1
    lappend dirdiff(rightFiles) $df2
    set info [expr {$diff? 16 : 0}]
    if {$df1 eq ""} {
        incr info 1
    }
    if {$df2 eq ""} {
        incr info 2
    }
    if {$df1 != ""} {
	set f1 [file split $df1]
	set i [expr {[llength $f1] - $level - 1}]
	set f1 [eval file join [lrange $f1 $i end]]
    }
    if {$df2 != ""} {
	set f2 [file split $df2]
	set i [expr {[llength $f2] - $level - 1}]
	set f2 [eval file join [lrange $f2 $i end]]
    }

    if {[file isdirectory $df1]} {
	append f1 /
        incr info 4
    }
    if {[file isdirectory $df2]} {
	append f2 /
        incr info 8
    }

    set maptag [expr {$diff ? "change" : ""}]
    if {$df1 eq ""} {
	set tag2 new2
        set maptag new2
    } elseif {!$diff} {
	set tag2 ""
    } else {
        if {$info & 8} {
            set tag2 changed
            set maptag ""
        } else {
            set tag2 change
        }
    }

    if {$df2 eq ""} {
	set tag1 new1
        set maptag new1
    } elseif {!$diff} {
	set tag1 ""
    } else {
        if {$info & 4} {
            set tag1 changed
            set maptag ""
        } else {
            set tag1 change
        }
    }
    addChange .dirdiff 1 $maptag 0 0 0 0

    if {$df2 eq ""} {
	$dirdiff(wRight) insert end \n
    } else {
        if {[catch {set size [file size $df2]}]} {
            set size -1
            set mtime 0
            lappend tag2 invalid
        } else {
            set mtime [file mtime $df2]
        }
	$dirdiff(wRight) insert end [format "%-30s %8d %16s\n" \
                $f2 $size \
		[clock format $mtime -format "%Y-%m-%d %H:%M"]] \
		$tag2
    }
    if {$df1 eq ""} {
	$dirdiff(wLeft) insert end \n
    } else {
        if {[catch {set size [file size $df1]}]} {
            set size -1
            set mtime 0
            lappend tag1 invalid
        } else {
            set mtime [file mtime $df1]
        }
	$dirdiff(wLeft) insert end [format "%-30s %8d %16s\n" \
                $f1 $size \
		[clock format $mtime -format "%Y-%m-%d %H:%M"]] \
		$tag1
    }
    lappend dirdiff(infoFiles) $info
}

# Compare two directories.
proc compareDirs {dir1 dir2 {level 0}} {
    global Pref
    set olddir [pwd]
    cd $dir1
    set files1 [Fsort [glob -nocomplain * {.[a-zA-Z]*}]]
    cd $dir2
    set files2 [Fsort [glob -nocomplain * {.[a-zA-Z]*}]]
    cd $olddir

    set len1 [llength $files1]
    set len2 [llength $files2]

    set p1 0
    set p2 0
    while 1 {
	if {$p1 < $len1 && $p2 < $len2} {
	    set f1 [lindex $files1 $p1]
	    set df1 [file join $dir1 $f1]
	    set f2 [lindex $files2 $p2]
	    set df2 [file join $dir2 $f2]
            set apa [FStrCmp $f1 $f2]
            if {$apa == 0} {
                set apa [expr {- [file isdirectory $df1] \
                               + [file isdirectory $df2]}]
            }
	    switch -- $apa {
		0 {
		    set diff [expr {![compareFiles $df1 $df2]}]
		    if {$diff || !$Pref(dir,onlydiffs)} {
			listFiles $df1 $df2 $diff $level
		    }
		    if {[file isdirectory $df1] && [file isdirectory $df2] && \
			    $Pref(recursive) && [file tail $df1] != "CVS"} {
			compareDirs $df1 $df2 [expr {$level + 1}]
		    }
		    incr p1
		    incr p2
		}
		-1 {
		    listFiles $df1 "" 0 $level
		    incr p1
		}
		1 {
		    listFiles "" $df2 0 $level
		    incr p2
		}
	    }
	} elseif {$p1 < $len1 && $p2 >= $len2} {
	    set f1 [lindex $files1 $p1]
	    listFiles [file join $dir1 $f1] "" 0 $level
	    incr p1
	} elseif {$p1 >= $len1 && $p2 < $len2} {
	    set f2 [lindex $files2 $p2]
	    listFiles "" [file join $dir2 $f2] 0 $level
	    incr p2
	} else {
	    break
	}
    }
}

# Run the directory comparison
proc doCompare {} {
    global dirdiff
    if {![file isdirectory $dirdiff(leftDir)]} return
    if {![file isdirectory $dirdiff(rightDir)]} return
    set dirdiff(leftFiles)  {}
    set dirdiff(rightFiles) {}
    set dirdiff(infoFiles)  {}
    set dirdiff(leftMark)   ""
    set dirdiff(rightMark)  ""

    set tail1 [file tail $dirdiff(leftDir)]
    set tail2 [file tail $dirdiff(rightDir)]
    if {$tail1 eq $tail2} {
        wm title .dirdiff "Eskil Dir: $tail1"
    } else {
        wm title .dirdiff "Eskil Dir: $tail1 vs $tail2"
    }

    $dirdiff(wLeft) delete 1.0 end
    $dirdiff(wRight) delete 1.0 end
    set top .dirdiff
    busyCursor $top
    clearMap $top
    update idletasks
    compareDirs $dirdiff(leftDir) $dirdiff(rightDir)
    normalCursor .dirdiff
    drawMap $top -1
}

# Pick a directory for compare
proc browseDir {dirVar entryW} {
    global Pref
    upvar "#0" $dirVar dir

    set newdir $dir
    while {$newdir != "." && ![file isdirectory $newdir]} {
        set newdir [file dirname $newdir]
    }
    set newdir [tk_chooseDirectory -initialdir $newdir -title "Select Directory"]
    if {$newdir != ""} {
        set dir $newdir
        $entryW xview end
    }
    if {$Pref(autocompare)} doCompare
}

# This is called when double clicking on a file in
# the directory compare window
proc selectFile {w x y} {
    global dirdiff Pref

    set row [expr {int([$w index @$x,$y]) - 1}]
    set lf [lindex $dirdiff(leftFiles) $row]
    set rf [lindex $dirdiff(rightFiles) $row]
    set i [lindex $dirdiff(infoFiles) $row]
    if {($i & 12) == 12} { # Both are dirs
        set dirdiff(leftDir) $lf
        set dirdiff(rightDir) $rf
        if {$Pref(autocompare)} doCompare
    } elseif {$i & 4} { # Left is dir
        set dirdiff(leftDir) $lf
        if {$Pref(autocompare)} doCompare
    } elseif {$i & 8} { # Right is dir
        set dirdiff(rightDir) $rf
        if {$Pref(autocompare)} doCompare
    } elseif {($i & 3) == 0} { # Both exists
        # Open a diff window for them
        newDiff $lf $rf
    }
}

# Bring up a context menu on a file.
proc rightClick {w x y X Y} {
    global dirdiff Pref

    set row [expr {int([$w index @$x,$y]) - 1}]
    set lf [lindex $dirdiff(leftFiles) $row]
    set rf [lindex $dirdiff(rightFiles) $row]
    set i [lindex $dirdiff(infoFiles) $row]

    set m .dirdiff.m
    destroy $m
    menu $m
    if {($i & 12) == 12} { # Both are dirs
        $m add command -label "Compare Directories" -command "
            [list set dirdiff(leftDir) $lf]
            [list set dirdiff(rightDir) $rf]
            [list if \$Pref(autocompare) "after idle doCompare"]
        "
    }
    if {$i & 4 && $w eq $dirdiff(wLeft)} { # Left is dir
        $m add command -label "Step down left directory" -command "
            [list set dirdiff(leftDir) $lf]
            [list if \$Pref(autocompare) "after idle doCompare"]
        "
    }
    if {$i & 8 && $w eq $dirdiff(wRight)} { # Right is dir
        $m add command -label "Step down right directory" -command "
            [list set dirdiff(rightDir) $rf]
            [list if \$Pref(autocompare) "after idle doCompare"]
        "
    }
    if {($i & 12) == 0 && ($i & 3) == 0} { # Neither is dir, Both exists
        $m add command -label "Compare Files" -command [list \
                newDiff $lf $rf]
    }
    if {$w eq $dirdiff(wLeft) && ($i & 13) == 0} {
        $m add command -label "Copy File" \
                -command [list copyFile $row right]
        $m add command -label "Edit File" \
                -command [list editFile $row left]
        $m add command -label "Mark File" \
                -command [list set ::dirdiff(leftMark) $lf]
	if {$::dirdiff(rightMark) != ""} {
	    $m add command -label "Compare with $::dirdiff(rightMark)" \
		    -command [list newDiff $lf $::dirdiff(rightMark)]
	}
    }
    if {$w eq $dirdiff(wRight) && ($i & 14) == 0} {
        $m add command -label "Copy File" \
                -command [list copyFile $row left]
        $m add command -label "Edit File" \
                -command [list editFile $row right]
        $m add command -label "Mark File" \
                -command [list set ::dirdiff(rightMark) $rf]
	if {$::dirdiff(leftMark) != ""} {
	    $m add command -label "Compare with $::dirdiff(leftMark)" \
		    -command [list newDiff $::dirdiff(leftMark) $rf]
	}
    }

    tk_popup $m $X $Y
}

# Copy a file from one directory to the other
proc copyFile {row to} {
    global dirdiff Pref

    if {$to eq "left"} {
        set src [lindex $dirdiff(rightFiles) $row]
        set n [expr {[string length $dirdiff(rightDir)] + 1}]
        set dst [file join $dirdiff(leftDir) [string range $src $n end]]
    } elseif {$to eq "right"} {
        set src [lindex $dirdiff(leftFiles) $row]
        set n [expr {[string length $dirdiff(leftDir)] + 1}]
        set dst [file join $dirdiff(rightDir) [string range $src $n end]]
    } else {
        error "Bad to argument to copyFile: $to"
    }

    if {[file exists $dst]} {
        if {[tk_messageBox -icon question -title "Overwrite file?" -message \
                "Copy\n$src\noverwriting\n$dst ?" -type yesno] eq "yes"} {
            file copy -force $src $dst
        }
    } else {
        if {[tk_messageBox -icon question -title "Copy file?" -message \
                "Copy\n$src\nto\n$dst ?" -type yesno] eq "yes"} {
            file copy $src $dst
        }
    }
}

# Bring up an editor to display a file.
proc editFile {row from} {
    global dirdiff Pref

    if {$from eq "left"} {
        set src [file join $dirdiff(leftDir) [lindex $dirdiff(leftFiles) $row]]
    } elseif {$from eq "right"} {
        set src [file join $dirdiff(rightDir) [lindex $dirdiff(rightFiles) $row]]
    } else {
        error "Bad from argument to editFile: $from"
    }

    locateEditor ::util(editor)
    exec $::util(editor) $src &
}

# Go up one level in directory hierarchy.
# 0 = both
proc upDir {{n 0}} {
    global dirdiff Pref
    switch $n {
        0 {
            set dirdiff(leftDir) [file dirname $dirdiff(leftDir)]
            set dirdiff(rightDir) [file dirname $dirdiff(rightDir)]
            if {$Pref(autocompare)} doCompare
        }
        1 {
            set dirdiff(leftDir) [file dirname $dirdiff(leftDir)]
            if {$Pref(autocompare)} doCompare
        }
        2 {
            set dirdiff(rightDir) [file dirname $dirdiff(rightDir)]
            if {$Pref(autocompare)} doCompare
        }
    }
}

# Create directory diff window.
proc makeDirDiffWin {{redraw 0}} {
    global Pref dirdiff

    set top .dirdiff
    if {[winfo exists $top] && [winfo toplevel $top] eq $top} {
        if {$redraw} {
            eval destroy [winfo children $top]
        } else {
            raise $top
            focus -force $top
            return
        }
    } else {
        destroy $top
        toplevel $top
        lappend ::diff(diffWindows) $top
    }

    wm title $top "Eskil Dir"
    wm protocol $top WM_DELETE_WINDOW [list cleanupAndExit $top]

    frame $top.fm
    frame $top.fe1
    frame $top.fe2

    menubutton $top.mf -menu $top.mf.m -text "File" -underline 0
    menu $top.mf.m
    $top.mf.m add command -label "Close" -underline 0 \
            -command [list cleanupAndExit $top]
    $top.mf.m add separator
    $top.mf.m add command -label "Quit" -underline 0 \
            -command [list cleanupAndExit all]

    menubutton $top.mo -menu $top.mo.m -text "Preferences" -underline 0
    menu $top.mo.m
    $top.mo.m add checkbutton -variable Pref(recursive) -label "Recursive"
    $top.mo.m add cascade -label "Check" -menu $top.mo.mc
    $top.mo.m add checkbutton -variable Pref(dir,onlydiffs) -label "Diffs Only"
    $top.mo.m add checkbutton -variable Pref(nodir)    -label "No Directory"
    $top.mo.m add checkbutton -variable Pref(autocompare) -label "Auto Compare"

    menu $top.mo.mc
    $top.mo.mc add radiobutton -variable Pref(comparelevel) -value 0 \
            -label "Do not check contents"
    $top.mo.mc add radiobutton -variable Pref(comparelevel) -value 1 \
            -label "Internal compare"
    $top.mo.mc add radiobutton -variable Pref(comparelevel) -value 1b \
            -label "Internal compare (bin)"
    $top.mo.mc add radiobutton -variable Pref(comparelevel) -value 2 \
            -label "Use Diff"
    $top.mo.mc add radiobutton -variable Pref(comparelevel) -value 3 \
            -label "Diff, ignore blanks"
    $top.mo.mc add radiobutton -variable Pref(comparelevel) -value 4 \
            -label "Diff, ignore case"
    $top.mo.mc add checkbutton -variable Pref(dir,ignorekey) \
            -label "Ignore \$Keyword:\$"

    menubutton $top.mt -text "Tools" -underline 0 -menu $top.mt.m
    menu $top.mt.m
    $top.mt.m add command -label "New Diff Window" -underline 0 \
            -command makeDiffWin
    $top.mt.m add command -label "Clip Diff" -underline 0 \
            -command makeClipDiffWin
    if {$::tcl_platform(platform) eq "windows"} {
        if {![catch {package require registry}]} {
            $top.mt.m add separator
            $top.mt.m add command -label "Setup Registry" -underline 6 \
                    -command makeRegistryWin
        }
    }

    menubutton $top.mh -text "Help" -underline 0 -menu $top.mh.m
    menu $top.mh.m
    #$top.mh.m add command -label "Help" -command makeHelpWin -underline 0
    $top.mh.m add command -label "Tutorial" -command makeTutorialWin \
            -underline 0
    $top.mh.m add command -label "About" -command makeAboutWin -underline 0

    pack $top.mf $top.mo $top.mt $top.mh -in $top.fm -side left -anchor n

    if {$::debug} {
        menubutton $top.md -text "Debug" -menu $top.md.m -underline 0
        menu $top.md.m
        if {$::tcl_platform(platform) eq "windows"} {
            $top.md.m add checkbutton -label "Console" -variable consolestate \
                    -onvalue show -offvalue hide -command {console $consolestate}
            $top.md.m add separator
        }
        $top.md.m add command -label "Reread Source" -underline 0 \
                -command {EskilRereadSource}
        $top.md.m add separator
        $top.md.m add command -label "Redraw Window" -command {makeDirDiffWin 1}
        pack $top.md -in $top.fm -side left -padx 20 -anchor n
    }

    button $top.bu -text "Up Both" -command upDir -underline 0 -padx 10
    bind $top <Alt-u> "$top.bu invoke"
    button $top.bc -text "Compare" -command doCompare -underline 0 -padx 10
    bind $top <Alt-c> "$top.bc invoke"
    pack $top.bc $top.bu -in $top.fm -side right
    pack $top.bu -padx 6

    catch {font delete myfont}
    font create myfont -family $Pref(fontfamily) -size $Pref(fontsize)

    entry $top.e1 -textvariable dirdiff(leftDir)
    button $top.bu1 -text "Up" -padx 10 -command {upDir 1}
    button $top.bb1 -text "Browse"  -padx 10 \
            -command [list browseDir dirdiff(leftDir) $top.e1]
    $top.e1 xview end
    entry $top.e2 -textvariable dirdiff(rightDir)
    button $top.bu2 -text "Up" -padx 10 -command {upDir 2}
    button $top.bb2 -text "Browse" -padx 10 \
            -command [list browseDir dirdiff(rightDir) $top.e2]
    $top.e2 xview end
    bind $top.e1 <Return> doCompare
    bind $top.e2 <Return> doCompare

    pack $top.bb1 $top.bu1 -in $top.fe1 -side right -pady 1
    pack $top.bu1 -padx 6
    pack $top.e1 -in $top.fe1 -side left -fill x -expand 1
    pack $top.bb2 $top.bu2 -in $top.fe2 -side right -pady 1
    pack $top.bu2 -padx 6
    pack $top.e2 -in $top.fe2 -side left -fill x -expand 1

    text $top.t1 -height 40 -width 60 -wrap none -font myfont \
	    -xscrollcommand "$top.sbx1 set" -takefocus 0
    scrollbar $top.sby -orient vertical
    scrollbar $top.sbx1 -orient horizontal -command "$top.t1 xview"
    text $top.t2 -height 40 -width 60 -wrap none -font myfont \
	    -xscrollcommand "$top.sbx2 set" -takefocus 0
    scrollbar $top.sbx2 -orient horizontal -command "$top.t2 xview"
    commonYScroll $top.sby $top.t1 $top.t2
    canvas $top.c -width 6 -bd 0 -selectborderwidth 0 -highlightthickness 0

    image create photo map$top
    $top.c create image 0 0 -anchor nw -image map$top
    bind $top.c <Destroy> [list image delete map$top]
    bind $top.c <Configure> [list drawMap $top %h]

    bind $top.t1 <Double-Button-1> "after idle selectFile $top.t1 %x %y"
    bind $top.t2 <Double-Button-1> "after idle selectFile $top.t2 %x %y"
    bind $top.t1 <Button-3> "rightClick $top.t1 %x %y %X %Y"
    bind $top.t2 <Button-3> "rightClick $top.t2 %x %y %X %Y"

    set dirdiff(wLeft)  $top.t1
    set dirdiff(wRight) $top.t2
    set dirdiff(wY) $top.sby
    # Interact better with diff by setting these
    set ::widgets($top,wDiff1) $top.t1
    set ::widgets($top,wDiff2) $top.t2

    applyColor

    grid $top.fm   - - -   -     -sticky we
    grid $top.fe1  x  x    $top.fe2  -sticky we
    grid $top.t1   $top.c $top.sby $top.t2   -sticky news
    grid $top.sbx1 x  x    $top.sbx2 -sticky we

    grid $top.c -pady [expr {[$top.sby cget -width] + 2}]

    grid rowconfigure    $top  2    -weight 1
    grid columnconfigure $top {0 3} -weight 1
}


#####################################
# Clip diff section
#####################################

# Remove things pasted that can disturb
proc ClipClean {data} {
    string map [list \r \n] $data
}

proc doClipDiff {} {
    set f1 [tmpFile]
    set f2 [tmpFile]

    set ch [open $f1 w]
    set data [string trimright [$::diff(wClip1) get 1.0 end] \n]
    set data [ClipClean $data]
    puts $ch $data
    close $ch
    set ch [open $f2 w]
    set data [string trimright [$::diff(wClip2) get 1.0 end] \n]
    set data [ClipClean $data]
    puts $ch $data
    close $ch

    newDiff $f1 $f2
}

proc makeClipDiffWin {} {
    set top .clipdiff
    if {[winfo exists $top] && [winfo toplevel $top] eq $top} {
        raise $top
        focus -force $top
        return
    }
    destroy $top
    toplevel $top
    lappend ::diff(diffWindows) $top

    wm title $top "Clip Diff"
    wm protocol $top WM_DELETE_WINDOW "cleanupAndExit $top"
    set t1 [Scroll both \
            text $top.t1 -width 60 -height 35 -font myfont]
    set t2 [Scroll both \
            text $top.t2 -width 60 -height 35 -font myfont]

    set ::diff(wClip1) $t1
    set ::diff(wClip2) $t2

    bind $t1 <Control-o> [list focus $t2]
    bind $t2 <Control-o> [list focus $t1]

    frame $top.f
    menubutton $top.f.mf -menu $top.f.mf.m -text "File" -underline 0
    menu $top.f.mf.m
    $top.f.mf.m add command -label "Close" -underline 0 \
            -command [list cleanupAndExit $top]
    $top.f.mf.m add separator
    $top.f.mf.m add command -label "Quit" -underline 0 \
            -command [list cleanupAndExit all]

    button $top.f.b -text "Diff" -command doClipDiff -underline 0 -width 8
    bind $top <Alt-d> [list $top.f.b invoke]
    button $top.f.b2 -text "Left Clear" -command "$t1 delete 1.0 end" \
            -underline 0
    bind $top <Alt-l> "[list $top.f.b2 invoke] ; [list focus $t1]"

    button $top.f.b3 -text "Right Clear" -command "$t2 delete 1.0 end" \
            -underline 0
    bind $top <Alt-r> "[list $top.f.b3 invoke] ; [list focus $t2]"
    button $top.f.b4 -text "Left Clear&Paste" -command \
            "$t1 delete 1.0 end ; event generate $t1 <<Paste>>"
    button $top.f.b5 -text "Right Clear&Paste" -command \
            "$t2 delete 1.0 end ; event generate $t2 <<Paste>>"

    foreach w [list $top.f.b2 $top.f.b4 $top.f.b $top.f.b3 $top.f.b5] {
        raise $w
    }
    grid $top.f.mf $top.f.b2 $top.f.b4 x $top.f.b x $top.f.b3 $top.f.b5 x \
            -padx 4 -pady 2 -sticky "w"
    grid $top.f.mf -sticky nw -pady 0 -padx 0
    grid columnconfigure $top.f {0 3 5 8} -weight 1
    grid columnconfigure $top.f 8 -minsize [winfo reqwidth $top.f.mf]

    grid $top.f    -       -sticky we
    grid $top.t1   $top.t2 -sticky news
    grid $top.t2 -padx {2 0}
    grid rowconfigure    $top 1     -weight 1
    grid columnconfigure $top {0 1} -weight 1
}

#####################################
# Help and startup functions
#####################################

proc makeNuisance {top {str {Hi there!}}} {
    if {[lsearch [image names] nuisance] < 0} {
        set file [file join $::thisDir .. Nuisance.gif]
        if {![file exists $file]} return
        image create photo nuisance -file $file
    }

    destroy $top.nui
    toplevel $top.nui
    wm transient $top.nui $top
    wm geometry $top.nui +400+400
    wm title $top.nui ""
    label $top.nui.l -image nuisance
    pack $top.nui.l
    wm protocol $top.nui WM_DELETE_WINDOW [list destroy $top.nui2 $top.nui]
    update

    destroy $top.nui2
    toplevel $top.nui2 -bg yellow
    wm transient $top.nui2 $top.nui
    wm overrideredirect $top.nui2 1
    wm title $top.nui2 ""
    label $top.nui2.l -text "$str\nDo you want help?" -justify left -bg yellow
    button $top.nui2.b -text "No, get out of my face!" \
            -command [list destroy $top.nui2 $top.nui] -bg yellow
    pack $top.nui2.l $top.nui2.b -side "top" -fill x
    wm geometry $top.nui2 +[expr {405 + [winfo width $top.nui]}]+400
}

proc makeAboutWin {} {
    global diffver

    set w [helpWin .ab "About Eskil"]

    text $w.t -width 45 -height 11 -wrap none -relief flat \
            -bg [$w cget -bg]
    pack $w.t -side top -expand y -fill both

    $w.t insert end "A graphical frontend to diff\n\n"
    $w.t insert end "$diffver\n\n"
    $w.t insert end "Made by Peter Spjuth\n"
    $w.t insert end "E-Mail: peter.spjuth@space.se\n"
    $w.t insert end "\nURL: http://spjuth.pointclark.net/Eskil.html\n"
    $w.t insert end "\nTcl version: [info patchlevel]\n"

    set du [package provide DiffUtil]
    if {[info procs DiffUtil::LocateDiffExe] ne ""} {
        append du " (tcl)"
    } else {
        append du " (c)"
    }
    $w.t insert end "DiffUtil version: $du\n"
    $w.t insert end "\nCredits:\n"
    $w.t insert end "Ideas for scrollbar map and merge function\n"
    $w.t insert end "taken from TkDiff"

    set last [lindex [split [$w.t index end] "."] 0]
    $w.t configure -height $last
    $w.t configure -state disabled
}

# Insert a text file into a text widget.
# Any XML-style tags in the file are used as tags in the text window.
proc insertTaggedText {w file} {
    set ch [open $file r]
    set data [read $ch]
    close $ch

    set tags {}
    while {$data != ""} {
        if {[regexp {^([^<]*)<(/?)([^>]+)>(.*)$} $data -> pre sl tag post]} {
            $w insert end [subst -nocommands -novariables $pre] $tags
            set i [lsearch $tags $tag]
            if {$sl != ""} {
                # Remove tag
                if {$i >= 0} {
                    set tags [lreplace $tags $i $i]
                }
            } else {
                # Add tag
                lappend tags $tag
            }
            set data $post
        } else {
            $w insert end [subst -nocommands -novariables $data] $tags
            set data ""
        }
    }
}

proc makeHelpWin {} {
    global Pref

    set doc [file join $::thisDir .. doc/eskil.txt]
    if {![file exists $doc]} return

    set w [helpWin .he "Eskil Help"]
    set t [Scroll y text $w.t -width 85 -height 35]
    pack $w.t -side top -expand 1 -fill both

    configureDocWin $t

    # Set up tags for change marks
    $t tag configure new1 -foreground $Pref(colornew1) \
            -background $Pref(bgnew1)
    $t tag configure new2 -foreground $Pref(colornew2) \
            -background $Pref(bgnew2)
    $t tag configure change -foreground $Pref(colorchange) \
            -background $Pref(bgchange)
    $t tag configure ul -underline 1

    set width [font measure [$t cget -font] [string repeat x 20]]
    $t configure -tabs [list $width [expr {$width * 3/2}] [expr {$width * 2}]]

    set width [font measure docFontP [string repeat x 36]]
    $t tag configure example -tabs [list $width] -wrap none

    insertTaggedText $t $doc
    $t configure -state disabled
}

proc createDocFonts {} {
    if {[catch {font create docFont -family Helvetica -size -16}]} return
    eval font create docFontB [font configure docFont] -weight bold

    set h [font metrics docFont -linespace]
    set t [expr {-$h + 4}]
    font create docFontP -family Courier -size $t
    for {} {$t > -20} {incr t -1} {
        font configure docFontP -size $t
        if {[font metrics docFontP -linespace] >= $h} break
    }
}

# Configure a text window as Doc viewer
proc configureDocWin {w} {
    createDocFonts
    $w configure -font docFont -wrap word
    $w tag configure ul -underline 1
    $w tag configure b -font docFontB
    $w tag configure bullet -tabs "1c" -lmargin2 "1c"
    $w tag configure pre -font docFontP

    set top [winfo toplevel $w]
    foreach event {<Key-Prior> <Key-Next>} {
        bind $top $event [string map [list "%W" $w] [bind Text $event]]
    }
}

proc makeDocWin {fileName} {
    set w [helpWin .doc "Eskil Help"]
    set t [Scroll y text $w.t -width 80 -height 25]
    pack $w.t -side top -expand 1 -fill both

    configureDocWin $t

    if {![file exists $::thisDir/../doc/$fileName]} {
        $t insert end "ERROR: Could not find doc file "
        $t insert end \"$fileName\"
        return
    }
    insertTaggedText $t $::thisDir/../doc/$fileName

    #focus $t
    $t configure -state disabled
}

proc makeTutorialWin {} {
    global Pref

    set doc [file join $::thisDir .. doc/tutorial.txt]
    if {![file exists $doc]} return

    if {[catch {cd [file join $::thisDir .. examples]}]} {
        tk_messageBox -icon error -title "Eskil Error" -message \
                "Could not locate examples directory." \
                -type ok
        return
    }
    #set ::diff(tutorial) 1

    # Start up a dirdiff in the examples directory
    set ::dirdiff(leftDir) [file join [pwd] dir1]
    set ::dirdiff(rightDir) [file join [pwd] dir2]
    makeDirDiffWin
    doCompare

    set w [helpWin .ht "Eskil Tutorial"]

    text $w.t -width 82 -height 35 -yscrollcommand "$w.sb set"
    scrollbar $w.sb -orient vert -command "$w.t yview"
    pack $w.sb -side right -fill y
    pack $w.t -side left -expand 1 -fill both

    configureDocWin $w.t

    # Move border properties to frame
    set bw [$w.t cget -borderwidth]
    set relief [$w.t cget -relief]
    $w configure -relief $relief -borderwidth $bw
    $w.t configure -borderwidth 0

    insertTaggedText $w.t $doc
    $w.t configure -state disabled
}

proc printUsage {} {
    puts {Usage: eskil [options] [file1] [file2]
  [options]              All options but the ones listed below
                         are passed to diff.
  [file1],[file2]        Files to be compared
                         If no files are given, the program is

    } elseif {$len >= 2} {
        set fullname1 [file join [pwd] [lindex $files 0]]
        set fullname2 [file join [pwd] [lindex $files 1]]
        if {[file isdirectory $fullname1] && [file isdirectory $fullname2]} {
            set dirdiff(leftDir) $fullname1
            set dirdiff(rightDir) $fullname2
            makeDirDiffWin
            after idle doCompare
            return
        }
    }

    # Ok, we have a normal diff
    makeDiffWin
    update

        if {$::diff($top,mode) eq "conflict"} {
            startConflictDiff $top $fullname
            after idle [list doDiff $top]
            return
        }
        if {!$autobrowse && !$dopatch} {
            # Check for revision control
            set rev [DetectRevSystem $fullname]
            if {$rev ne ""} {
                startRevMode $top $rev $fullname
                if {$noautodiff} {
                    enableRedo $top
                } else {
                    after idle [list doDiff $top]
                }

    # If the user's file has this old option, translate it to the new
    if {$Pref(onlydiffs) == 0} {
        set Pref(context) 0
    }
    unset Pref(onlydiffs)
}

proc defaultGuiOptions {} {
    catch {package require griffin}

    option add *Menu.tearOff 0
    option add *Button.padX 5
    if {[tk windowingsystem] eq "x11"} {
        option add *Menu.activeBorderWidth 1
        option add *Menu.borderWidth 1

        option add *Listbox.exportSelection 0
        option add *Listbox.borderWidth 1
        #option add *Listbox.highlightThickness 1
        option add *Font "Helvetica -12"
        option add *Scrollbar.highlightThickness 0
        option add *Scrollbar.takeFocus 0
    }

    if {$::tcl_platform(platform) eq "windows"} {
        option add *Panedwindow.sashRelief flat
        option add *Panedwindow.sashWidth 4
        option add *Panedwindow.sashPad 0
        #option add *Menubutton.activeBackground SystemHighlight
        #option add *Menubutton.activeForeground SystemHighlightText
        option add *Menubutton.padY 1
    }

    # Use Tahoma 8 as default on Windows, which is the system default
    # on Win2K and WinXP.
    if { [tk windowingsystem] == "win32" } {
        set ASfont "Tahoma 8"
        option add *Button.font             $ASfont widgetDefault
        option add *Checkbutton.font        $ASfont widgetDefault
        option add *Label.font              $ASfont widgetDefault
        option add *Listbox.font            $ASfont widgetDefault
        option add *Menu.font               $ASfont widgetDefault
        option add *Menubutton.font         $ASfont widgetDefault
        option add *Message.font            $ASfont widgetDefault
        option add *Radiobutton.font        $ASfont widgetDefault
        option add *Spinbox.font            $ASfont widgetDefault
    }
}

# Global code is only run the first time to be able to reread source
if {![info exists gurkmeja]} {
    set gurkmeja 1
    package require pstools
    namespace import -force pstools::*
    getOptions
    if {![info exists ::eskil_testsuite]} {
        parseCommandLine
    }
}