Eskil

set debug 1
set diffver "Version 2.0b3+ 2004-01-20"
set thisScript [file join [pwd] [info script]]
set thisDir [file dirname $thisScript]

# 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]
}
unset tmplink

set ::util(cvsExists) [expr {![string equal [auto_execok cvs] ""]}]

    # Are we in a starkit?
    if {[string match "*/lib/app-eskil" $::thisDir]} {
        lappend dirs [file dirname [file dirname [file dirname $::thisDir]]]
        # And for a starpack
        lappend dirs [file dirname [info nameofexecutable]]
    }
    lappend dirs c:/bin

    foreach dir $dirs {
        set try [file join $dir diff.exe]
        if {[file exists $try]} {
            set ::util(diffexe) $try
            return
        }
    }

    if {[string equal [auto_execok diff] ""]} {
        tk_messageBox -icon error -title "Eskil Error" -message \
                "Could not locate any external diff executable." \
                -type ok
        exit
    }
}

if {$tcl_platform(platform) eq "windows"} {
    locateDiffExe
    # Locate CVS if it is in c:/bin
    if {!$::util(cvsExists) && [file exists "c:/bin/cvs.exe"]} {
        set env(PATH) "$env(PATH);c:\\bin"
        auto_reset
        set ::util(cvsExists) [expr {![string equal [auto_execok cvs] ""]}]
    }

        if {$top != "all"} {
            set i [lsearch $::diff(diffWindows) $top]
            if {$i >= 0} {
                set ::diff(diffWindows) [lreplace $::diff(diffWindows) $i $i]
            }
            destroy $top
            array unset ::diff $top,*

            # Any windows remaining?
            if {[llength $::diff(diffWindows)] > 0} {
                set cont 1
            }
        }
    } errMsg]} {
        tk_messageBox -icon error -title "Eskil Error" -message \

                }
            }
            if {$Pref(lineparsewords) != 0 && $test == 0} {
                set newt $t
                if {($t > 0 && [string index $s1 [expr {$t - 1}]] != " ") || \
                    ($i > 0 && [string index $s2 [expr {$i - 1}]] != " ")} {
                    for {} {$newt < $p1} {incr newt} {
                        if {[string index $s1 $newt] eq " "} break
                    }
                }

                set newp1 [expr {$p1 - 1}]
                if {($p1 < $len1 && [string index $s1 $p1] != " ") || \
                    ($p2 < $len2 && [string index $s2 $p2] != " ")} {
                    for {} {$newp1 > $newt} {incr newp1 -1} {
                        if {[string index $s1 $newp1] eq " "} break
                    }
                }
                incr newp1

                if {$newp1 - $newt > $minlen} {
                    set foundlen [expr {$newp1 - $newt}]
                    set found1 $newt

    set len2 [string length $apa2]
    set len [expr {$len1 < $len2 ? $len1 : $len2}]
    for {set t 0; set s 0; set flag 0} {$t < $len} {incr t} {
        if {[set c [string index $apa1 $t]] != [string index $apa2 $t]} {
            incr flag 2
            break
        }
        if {$c eq " "} {
            set s $t
            set flag 1
        }
    }

    if {$Pref(lineparsewords) == 0 || $test != 0} {
        incr leftp1 $t

    set s2 $t2
    set flag 0
    for {} {$t1 >= $leftp1 && $t2 >= $leftp2} {incr t1 -1; incr t2 -1} {
        if {[set c [string index $mid1 $t1]] != [string index $mid2 $t2]} {
            incr flag 2
            break
        }
        if {$c eq " "} {
            set s1 $t1
            set s2 $t2
            set flag 1
        }
    }
    if {$Pref(lineparsewords) == 1 && $test == 0} {
        if {$flag >= 2} {

            incr n -1
            if {$dotag} {
                if {$n == 1 && $Pref(marklast)} {
                    lappend new1 last
                    lappend new2 last
                    lappend change last
                }
                if {$i1 eq ""} {
                    $::diff($top,wDiff2) insert end $i2 $new2
                } elseif {$i2 eq ""} {
                    $::diff($top,wDiff1) insert end $i1 $new1
                } else {
                    $::diff($top,wDiff1) insert end $i1 $change
                    $::diff($top,wDiff2) insert end $i2 $change
                }
                set dotag 0
            } else {

    global doingLine1 doingLine2

    set apa [compareBlocks $block1 $block2]

    set t1 0
    set t2 0
    foreach c $apa {
        if {$c eq "c"} {
            set textline1 [lindex $block1 $t1]
            set textline2 [lindex $block2 $t2]
            insertMatchingLines $top $textline1 $textline2
            incr t1
            incr t2

        } elseif {$c eq "C"} {
	    # This is two lines that the block matching considered
	    # too different to use line parsing on them.
	    # Marked the whole line as deleted/inserted
            set textline1 [lindex $block1 $t1]
            set textline2 [lindex $block2 $t2]
            $::diff($top,wLine1) insert end [myFormL $doingLine1] \
                    "hl$::HighLightCount change"
            $::diff($top,wDiff1) insert end "$textline1\n" new1
            $::diff($top,wLine2) insert end [myFormL $doingLine2] \
                    "hl$::HighLightCount change"
            $::diff($top,wDiff2) insert end "$textline2\n" new2
            incr doingLine1
            incr doingLine2
            incr t1
            incr t2

        } elseif {$c eq "d"} {
            set bepa [lindex $block1 $t1]
            $::diff($top,wLine1) insert end [myFormL $doingLine1] \
                    "hl$::HighLightCount change"
            $::diff($top,wDiff1) insert end "$bepa\n" new1
            emptyLine $top 2
            incr doingLine1
            incr t1

        } elseif {$c eq "a"} {
            set bepa [lindex $block2 $t2]
            $::diff($top,wLine2) insert end [myFormL $doingLine2] \
                    "hl$::HighLightCount change"
            $::diff($top,wDiff2) insert end "$bepa\n" new2
            emptyLine $top 1
            incr doingLine2
            incr t2

    set rightName ""
    set leftName ""
    while {[gets $ch line] != -1} {
        if {[string match <<<<<<* $line]} {
            set state right
            regexp {<*\s*(.*)} $line -> rightName
            set start2 $rightLine
        } elseif {[string match ======* $line] && $state eq "right"} {
            set state left
            set end2 [expr {$rightLine - 1}]
            set start1 $leftLine
        } elseif {[string match >>>>>>* $line] && $state eq "left"} {
            set state both
            regexp {>*\s*(.*)} $line -> leftName
            set end1 [expr {$leftLine - 1}]
            lappend diff($top,conflictDiff) $start1,${end1}c$start2,$end2
        } elseif {$state eq "both"} {
            puts $ch1 $line
            puts $ch2 $line
            incr leftLine
            incr rightLine
        } elseif {$state eq "left"} {
            puts $ch1 $line
            incr leftLine
        } else {
            puts $ch2 $line
            incr rightLine
        }
    }
    close $ch
    close $ch1
    close $ch2

    if {$leftName eq "" && $rightName eq ""} {
        set leftName "No Conflict: [file tail $diff($top,conflictFile)]"
        set rightName $leftName
    }
    set diff($top,leftLabel) $leftName
    set diff($top,rightLabel) $rightName
    update idletasks
}

            }
            set leftLines {}
            set rightLines {}
            set state none
            continue
        }
        # Detect the first line in a -c style diff
        if {$state eq "none" && [regexp {^\*\*\*} $line]} {
            set state newfile
            set style c
            set leftRE {^\*\*\*\s+(.*)$}
            set rightRE {^---\s+(.*)$}
        }
        # Detect the first line in a -u style diff
        if {$state eq "none" && [regexp {^---} $line]} {
            set state newfile
            set style u
            set leftRE {^---\s+(.*)$}
            set rightRE {^\+\+\+\s+(.*)$}
        }
        if {$state eq "newfile" && [regexp $leftRE $line -> sub]} {
            emptyLine $top 1
            insertLine $top 1 "" $divider
            insertLine $top 1 "" $sub
            insertLine $top 1 "" $divider
            lappend ::diff($top,changes) [list $::diff($top,mapMax) 4 \
                    change 0 0 0 0]
            incr ::diff($top,mapMax) 4
            continue
        }
        if {$state eq "newfile" && [regexp $rightRE $line -> sub]} {
            emptyLine $top 2
            insertLine $top 2 "" $divider
            insertLine $top 2 "" $sub
            insertLine $top 2 "" $divider
            continue
        }
        # A new section in a -u style diff
        if {[regexp {^@@\s+-(\d+),\d+\s+\+(\d+),} $line -> sub1 sub2]} {
            if {$state eq "both"} {
                displayOnePatch $top $leftLines $rightLines \
                        $leftLine $rightLine
            }
            set state both
            set leftLine $sub1
            set rightLine $sub2
            set leftLines {}
            set rightLines {}
            continue
        }
        # A new section in a -c style diff
        if {[regexp {^\*\*\*\*\*} $line]} {
            if {$state eq "right"} {
                displayOnePatch $top $leftLines $rightLines $leftLine $rightLine
            }
            set leftLines {}
            set rightLines {}
            set state left
            continue
        }
        # We are in the left part of a -c style diff
        if {$state eq "left"} {
            if {[regexp {^\*\*\*\s*(\d*)} $line -> sub]} {
                if {$sub != ""} {
                    set leftLine $sub
                }
                continue
            }
            if {[regexp {^---\s*(\d*)} $line -> sub]} {

            lappend leftLines [list $leftLine \
                    [string trim [string range $line 0 1]] \
                    [string range $line 2 end]]
            incr leftLine
            continue
        }
        # We are in the right part of a -c style diff
        if {$state eq "right"} {
            if {![regexp {^[\s!+-]} $line]} continue
            lappend rightLines [list $rightLine \
                    [string trim [string range $line 0 1]] \
                    [string range $line 2 end]]
            incr rightLine
            continue
        }
        # We are in a -u style diff
        if {$state eq "both"} {
            if {![regexp {^[\s+-]} $line]} continue
            set sig [string trim [string index $line 0]]
            set str [string range $line 1 end]
            if {$sig eq ""} {
                lappend leftLines [list $leftLine "" $str]
                lappend rightLines [list $leftLine "" $str]
                incr leftLine
                incr rightLine
            } elseif {$sig eq "-"} {
                lappend leftLines [list $leftLine "-" $str]
                incr leftLine
            } else {
                lappend rightLines [list $leftLine "+" $str]
                incr rightLine
            }
            continue

    switch [llength $revs] {
        0 {
            # Compare local file with latest version.
            set diff($top,leftFile) [tmpFile]
            set diff($top,rightLabel) $diff($top,RCSFile)
            set diff($top,rightFile) $diff($top,RCSFile)

            if {$diff($top,mode) eq "CVS"} {
                set diff($top,leftLabel) "$diff($top,RCSFile) (CVS)"
                execCvsUpdate $diff($top,RCSFile) $diff($top,leftFile)
            } else {
                set diff($top,leftLabel) "$diff($top,RCSFile) (RCS)"
                catch {exec co -p [file nativename $diff($top,RCSFile)] \
                        > $diff($top,leftFile)}
            }
        }
        1 {
            # Compare local file with specified version.
            set r [lindex $revs 0]
            set diff($top,leftFile) [tmpFile]
            set diff($top,rightLabel) $diff($top,RCSFile)
            set diff($top,rightFile) $diff($top,RCSFile)

            if {$diff($top,mode) eq "CVS"} {
                set diff($top,leftLabel) "$diff($top,RCSFile) (CVS $r)"
                execCvsUpdate $diff($top,RCSFile) $diff($top,leftFile) -r $r
            } else {
                set diff($top,leftLabel) "$diff($top,RCSFile) (RCS $r)"
                catch {exec co -p$r [file nativename $diff($top,RCSFile)] \
                        > $diff($top,leftFile)}
            }
        }
        default {
            # Compare the two specified versions.
            set r1 [lindex $revs 0]
            set r2 [lindex $revs 1]
            set diff($top,leftFile) [tmpFile]
            set diff($top,rightFile) [tmpFile]

            if {$diff($top,mode) eq "CVS"} {
                set diff($top,leftLabel) "$diff($top,RCSFile) (CVS $r1)"
                set diff($top,rightLabel) "$diff($top,RCSFile) (CVS $r2)"
                execCvsUpdate $diff($top,RCSFile) $diff($top,leftFile) -r $r1
                execCvsUpdate $diff($top,RCSFile) $diff($top,rightFile) -r $r2
            } else {
                set diff($top,leftLabel) "$diff($top,RCSFile) (RCS $r1)"
                set diff($top,rightLabel) "$diff($top,RCSFile) (RCS $r2)"

    # Compare local file with latest version.
    set diff($top,leftFile) [tmpFile]
    set diff($top,rightLabel) $diff($top,RCSFile)
    set diff($top,rightFile) $diff($top,RCSFile)

    set diff($top,leftLabel) "$diff($top,RCSFile) (CT)"
    if {[catch {exec cleartool pwv -s} view] || $view eq "** NONE **"} {
        puts "MIFFFO"
        return
    }

    if {[catch {exec cleartool get -to $diff($top,leftFile) [file nativename $diff($top,RCSFile)@@/main/$view/LATEST]} msg]} {
        puts "Cleartool error: $msg"
        return
    }
}

# Prepare for a diff by creating needed temporary files
proc prepareFiles {top} {
    set ::diff($top,cleanup) ""
    if {$::diff($top,mode) eq "RCS" || $::diff($top,mode) eq "CVS"} {
        prepareRCS $top
        set ::diff($top,cleanup) "RCS"
    } elseif {$::diff($top,mode) eq "CT"} {
        prepareClearCase $top
        set ::diff($top,cleanup) "CT"
    } elseif {[string match "conflict*" $::diff($top,mode)]} {
        prepareConflict $top
        set ::diff($top,cleanup) "conflict"
    } elseif {[lindex [file system $::diff($top,leftFile)] 0] ne "native" || \
            [lindex [file system $::diff($top,rightFile)] 0] ne "native"} {

}

# Main diff function.
proc doDiff {top} {
    global diff Pref
    global doingLine1 doingLine2

    if {$diff($top,mode) eq "" && ($diff($top,leftOK) == 0 || $diff($top,rightOK) == 0)} {
        disableRedo $top
        return
    } else {
        enableRedo $top
    }

    busyCursor $top

    drawMap $top -1
    # Display a star during diff execution, to know when the internal
    # processing starts, and when the label is "valid".
    set ::diff($top,eqLabel) "*"

    update idletasks

    if {$diff($top,mode) eq "patch"} {
        displayPatch $top
        drawMap $top -1
        foreach item {wLine1 wLine2} {
            set w $::diff($top,$item)
            $w configure -state disabled
        }
        update idletasks

            lappend result $i
        }
    }

    # In conflict mode we can use the diff information collected when
    # parsing the conflict file. This makes sure the blocks in the conflict
    # file become change-blocks during merge.
    if {$diff($top,mode) eq "conflictPure"} {
        set result $diff($top,conflictDiff)
    }

    if {[llength $result] == 0} {
        if {$differr == 1} {
            $::diff($top,wDiff1) insert end $diffres
            normalCursor $top

    # Update the equal label immediately for better feedback
    update idletasks

    set firstview 1

    set ch1 [open $diff($top,leftFile)]
    set ch2 [open $diff($top,rightFile)]
    if {$::tcl_platform(platform) eq "windows" && $Pref(crlf)} {
        fconfigure $ch1 -translation crlf
        fconfigure $ch2 -translation crlf
    }
    set doingLine1 1
    set doingLine2 1
    set t 0
    foreach i $result {

    set change [lindex $::diff($top,changes) $::diff($top,currHighLight)]
    set line1 [lindex $change 0]

    if {$::diff($top,currHighLight) < 0} {
        set line1 1.0
        set line2 1.0
    } elseif {$line1 eq ""} {
        set line1 end
        set line2 end
    } else {
        set line2 [expr {$line1 + [lindex $change 1]}]
        incr line1
        set line1 $line1.0
        set line2 $line2.0

# A wrapper for tk_getOpenFile
proc myOpenFile {args} {
    # When in tutorial mode, make sure the Tcl file dialog is used
    # to be able to access the files in a starkit.
    if {[info exists ::diff(tutorial)] && $::diff(tutorial)} {
        # Only do this if tk_getOpenFile is not a proc.
        if {[info procs tk_getOpenFile] eq ""} {
            # If there is any problem, call the real one
            if {![catch {set res [eval ::tk::dialog::file:: open $args]}]} {
                return $res
            }
        }
    }
    return [eval tk_getOpenFile $args]

    set leftMergeData {}
    set rightMergeData {}

    if {![info exists ::diff($top,changes)]} {
        set ::diff($top,changes) {}
    }

    if {$diff($top,mode) eq "RCS" || $diff($top,mode) eq "CVS"} {
        prepareRCS $top
    } elseif {[string match "conflict*" $diff($top,mode)]} {
        prepareConflict $top
    }

    set ch1 [open $diff($top,leftFile) r]
    set ch2 [open $diff($top,rightFile) r]

    }
    lappend leftMergeData $data1
    lappend rightMergeData $data2

    close $ch1
    close $ch2

    if {$diff($top,mode) eq "RCS" || $diff($top,mode) eq "CVS"} {
        cleanupRCS $top
    } elseif {[string match "conflict*" $diff($top,mode)]} {
        cleanupConflict $top
    }
}

# Fill up the merge window with the initial version of merged files.

# Save the merge result.
proc saveMerge {top} {
    global diff

    set w $top.merge.t

    if {$diff($top,mergeFile) eq ""} {
        if {[info exists diff($top,rightDir)]} {
            set initDir $diff($top,rightDir)
        } elseif {[info exists diff($top,leftDir)]} {
            set initDir $diff($top,leftDir)
        } else {
            set initDir [pwd]
        }

        set apa [tk_getSaveFile -title "Save merge file" -initialdir $initDir]
        if {$apa eq ""} return
        set diff($top,mergeFile) $apa
    }

    set ch [open $diff($top,mergeFile) "w"]
    puts -nonewline $ch [$w get 1.0 end-1char]
    close $ch
    tk_messageBox -parent $top.merge -icon info -type ok -title "Diff" \

# Format a line number for printing
proc formatLineno {lineno gray} {
    set res [format "%3d: " $lineno]
    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
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

                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 > 84} {
                        set wrap [expr {84 - $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\}"
                    }
                }

            puts $ch [lindex $wraplines2 $i2]
        }
        if {$i < 66} {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]
    if {![regexp {^(.*)( \(.*?\))$} $::diff($top,leftLabel) -> lfile lrest]} {
        set lfile $::diff($top,leftLabel)
        set lrest ""

}

proc hlSeparate {top n hl} {
    set ::diff($top,separate$n) $hl
    set wd $::diff($top,wDiff$n)
    set wl $::diff($top,wLine$n)

    if {$hl eq ""} {
        set range [$wd tag ranges sel]
    } else {
        set range [$wl tag ranges hl$::diff($top,separate$n)]
    }
    set text [eval $wd get $range]
    set ::diff($top,separatetext$n) $text

                -background $Pref(bgchange)
        $top.balloon.t$x tag configure new2 -foreground $Pref(colornew2) \
                -background $Pref(bgnew2)
        pack $top.balloon.t$x -side "top" -padx 1 -pady 1 -fill both -expand 1

        set tags {}
        foreach {key value index} $data($x) {
            if {$key eq "tagon"} {
                lappend tags $value
                set tags [lsort -unique $tags]
            } elseif {$key eq "tagoff"} {
                set i [lsearch $tags $value]
                if {$i >= 0} {
                    set tags [lreplace $tags $i $i]
                }
            } else {
                $top.balloon.t$x insert end $value $tags
            }

}

# Change color settings
proc applyColor {} {
    global diff dirdiff Pref

    foreach top $diff(diffWindows) {
        if {$top eq ".clipdiff"} continue
        if {$top != ".dirdiff"} {
            foreach item {wLine1 wDiff1 wLine2 wDiff2} {
                set w $diff($top,$item)

                $w tag configure new1 -foreground $Pref(colornew1) \
                        -background $Pref(bgnew1)
                $w tag configure change -foreground $Pref(colorchange) \

    update
    doDiff $top
}

# Build the main window
proc makeDiffWin {{top {}}} {
    global Pref tcl_platform debug

    if {$top != "" && [winfo exists $top] && [winfo toplevel $top] eq $top} {
        # Reuse the old window
        eval destroy [winfo children $top]
    } else {
        # Locate a free toplevel name
        if {[info exists ::diff(topDiffCnt)]} {
            set t $::diff(topDiffCnt)
        } else {

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

    frame $top.f
    grid $top.f -row 0 -columnspan 4 -sticky news

    if {$tcl_platform(platform) eq "windows"} {
        #frame $top.f.line -height 1 -bg SystemButtonHighlight
        #pack $top.f.line -side bottom -fill x
    }

    menubutton $top.mf -text "File" -underline 0 -menu $top.mf.m
    menu $top.mf.m
    $top.mf.m add command -label "Redo Diff" -underline 5 \

            -command [list openLeft $top]
    $top.mf.m add command -label "Open Right File..." \
            -command [list openRight $top]
    $top.mf.m add command -label "Open Conflict File..." \
            -command [list openConflict $top]
    $top.mf.m add command -label "Open Patch File..." \
            -command [list openPatch $top]
    if {$tcl_platform(platform) eq "unix"} {
        $top.mf.m add command -label "RCSDiff..." -underline 0 \
                -command [list openRCS $top]
    }
    if {$::util(cvsExists)} {
        $top.mf.m add command -label "CVSDiff..." -underline 1 \
                -command [list openCVS $top]
    }

    menubutton $top.mo -text "Options" -underline 0 -menu $top.mo.m
    menu $top.mo.m
    $top.mo.m add cascade -label "Font" -underline 0 -menu $top.mo.mf
    $top.mo.m add cascade -label "Ignore" -underline 0 -menu $top.mo.mi
    $top.mo.m add cascade -label "Parse" -underline 0 -menu $top.mo.mp
    $top.mo.m add command -label "Colours..." -underline 0 -command makePrefWin
    $top.mo.m add checkbutton -label "Diffs only" -variable Pref(onlydiffs)
    if {$tcl_platform(platform) eq "windows"} {
        $top.mo.m add checkbutton -label "Force crlf translation" \
                -variable Pref(crlf)
    }
    $top.mo.m add separator
    $top.mo.m add command -label "Save default" -command saveOptions

    menu $top.mo.mf

            -command makeDirDiffWin
    $top.mt.m add command -label "Clip Diff" -underline 0 \
            -command makeClipDiffWin
    $top.mt.m add command -label "Merge" -underline 0 \
            -command [list makeMergeWin $top] -state disabled
    $top.mt.m add command -label "Align" -command [list runAlign $top] \
            -state disabled
    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
        }
    }

    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]

    pack $top.mf $top.mo $top.ms $top.mt -in $top.f -side left -anchor n
    pack $top.mh -in $top.f -side left -anchor n
    pack $top.bfn -in $top.f -side right -padx {3 6}
    pack $top.bfp $top.er2 $top.lr2 $top.er1 $top.lr1 $top.eo $top.lo \
            -in $top.f -side right -padx 3
    if {$debug == 1} {
        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 radiobutton -label "Context 2" \
                -variable ::Pref(context) -value 2

    chFont
}

# Update example font
proc exampleFont {lb} {
    global TmpPref
    set i [lindex [$lb curselection] 0]
    if {$i eq ""} return
    set TmpPref(fontfamily) [$lb get $i]

    font configure tmpfont -family $TmpPref(fontfamily)
    if {[string is integer -strict $TmpPref(fontsize)]} {
        font configure tmpfont -size $TmpPref(fontsize)
    }
}

    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 {

#####################################
# 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

	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

    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
            }
            while {![eof $ch1] && ![eof $ch2]} {
                set f1 [read $ch1 $bufsz]
                set f2 [read $ch2 $bufsz]
                if {![string equal $f1 $f2]} {

            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]]
    }

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

    if {$df1 eq ""} {
	set tag2 new2
    } elseif {!$diff} {
	set tag2 ""
    } else {
        if {$info & 8} {
            set tag2 changed
        } else {
            set tag2 change
        }
    }

    if {$df2 eq ""} {
	set tag1 new1
    } elseif {!$diff} {
	set tag1 ""
    } else {
        if {$info & 4} {
            set tag1 changed
        } else {
            set tag1 change
        }
    }

    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 {

            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]

    busyCursor .dirdiff
    update idletasks
    compareDirs $dirdiff(leftDir) $dirdiff(rightDir)
    normalCursor .dirdiff
}

# 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 see 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]

            [list set dirdiff(rightDir) $rf]
            [list if \$Pref(autocompare) "after idle doCompare"]
        "
    } elseif {($i & 3) == 0} { # 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]
    }
    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]
    }

    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
        }

            -label "Diff, ignore case"
    $top.mo.mc add radiobutton -variable Pref(comparelevel) -value 5 \
            -label "Diff, ignore RCS"
    pack $top.mf $top.mo -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 {source $thisScript}
        $top.md.m add separator

    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]
    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]
    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

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

    newDiff $f1 $f2
}

proc makeClipDiffWin {} {
    global diff

    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

            -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>>"

    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 -wrap word -yscrollcommand "$w.sb set"\
            -font "Courier 10"
    scrollbar $w.sb -orient vert -command "$w.t yview"
    pack $w.sb -side right -fill y

    global diff dirdiff Pref
    global argv argc tcl_platform

    if {$argc == 0} {
        makeDiffWin
        return
    }

    set noautodiff 0
    set autobrowse 0
    set dodir 0
    set doclip 0
    set files ""
    set nextArg ""
    set revNo 1
    foreach arg $argv {
        if {$nextArg != ""} {
            if {$nextArg eq "mergeFile"} {
                set opts(mergeFile) [file join [pwd] $arg]
            } elseif {$nextArg eq "printFile"} {
                set opts(printFile) [file join [pwd] $arg]
            } elseif {$nextArg eq "revision"} {
                set opts(doptrev$revNo) $arg
                incr revNo
            } elseif {$nextArg eq "limitlines"} {
                set opts(limitlines) $arg
            }
            set nextArg ""
            continue
        }
        if {$arg eq "-w"} {
            set Pref(ignore) "-w"
        } elseif {$arg eq "--help"} {
            printUsage
            exit
        } elseif {$arg eq "-b"} {
            set Pref(ignore) "-b"
        } elseif {$arg eq "-noignore"} {
            set Pref(ignore) " "
        } elseif {$arg eq "-noparse"} {
            set Pref(parse) 0
        } elseif {$arg eq "-line"} {
            set Pref(parse) 1
        } elseif {$arg eq "-smallblock"} {
            set Pref(parse) 2
        } elseif {$arg eq "-block"} {
            set Pref(parse) 3
        } elseif {$arg eq "-char"} {
            set Pref(lineparsewords) 0
        } elseif {$arg eq "-word"} {
            set Pref(lineparsewords) 1
        } elseif {$arg eq "-2nd"} {
            set Pref(extralineparse) 1
        } elseif {$arg eq "-no2nd"} {
            set Pref(extralineparse) 0
        } elseif {$arg eq "-limit"} {
            set nextArg limitlines
        } elseif {$arg eq "-nodiff"} {
            set noautodiff 1
        } elseif {$arg eq "-dir"} {
            set dodir 1
        } elseif {$arg eq "-clip"} {
            set doclip 1
        } elseif {$arg eq "-browse"} {
            set autobrowse 1
        } elseif {$arg eq "-conflict"} {
            set opts(mode) "conflict"
            set Pref(ignore) " "
        } elseif {$arg eq "-print"} {
            set nextArg printFile
        } elseif {$arg eq "-server"} {
            if {$tcl_platform(platform) eq "windows"} {
                catch {
                    package require dde
                    dde servername Eskil
                }
            } else {
                tk appname Eskil
            }
        } elseif {$arg eq "-o"} {
            set nextArg mergeFile
        } elseif {$arg eq "-r"} {
            set nextArg revision
        } elseif {[string range $arg 0 1] eq "-r"} {
            set opts(doptrev$revNo) [string range $arg 2 end]
            incr revNo
        } elseif {[string range $arg 0 0] eq "-"} {
            append opts(dopt) " $arg"
        } else {
            set apa [file normalize [file join [pwd] $arg]]
            if {![file exists $apa]} {
                puts "Ignoring argument: $arg"
            } else {
                lappend files $apa
            }
        }
    }

    # Do we start in clip diff mode?
    if {$doclip} {
        makeClipDiffWin
        return
    }

    # Figure out if we start in a diff or dirdiff window.
    set len [llength $files]

    if {$len == 0 && $dodir} {
        set dirdiff(leftDir) [pwd]
        set dirdiff(rightDir) [pwd]
        makeDirDiffWin
        return
    }
    if {$len == 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
    set top [lindex $::diff(diffWindows) end]
    # Copy the previously collected options
    foreach {item val} [array get opts] {
        set diff($top,$item) $val
    }

    if {$len == 1} {
        set fullname [file join [pwd] [lindex $files 0]]
        set fulldir [file dirname $fullname]
        if {$diff($top,mode) eq "conflict"} {
            set diff($top,conflictFile) $fullname
            set diff($top,rightDir) $fulldir
            set diff($top,rightOK) 1
            set diff($top,rightLabel) $fullname
            set diff($top,leftLabel) $fullname
            after idle [list doDiff $top]
            return

                set diff($top,leftLabel) "RCS"
                if {$noautodiff} {
                    enableRedo $top
                } else {
                    after idle [list doDiff $top]
                }
                return
            }
            # CVS
            if {[llength [glob -nocomplain [file join $fulldir CVS]]]} {
                set diff($top,mode) "CVS"
                set diff($top,rightDir) $fulldir
                set diff($top,RCSFile) $fullname
                set diff($top,rightLabel) $fullname
                set diff($top,rightFile) $fullname

            openRight $top
        }
        # If we cancel the second file and detect CVS, ask about it.
        if {$diff($top,leftOK) && !$diff($top,rightOK) && \
                [llength [glob -nocomplain [file join $fulldir CVS]]]} {

            if {[tk_messageBox -title Diff -icon question \
                    -message "Do CVS diff?" -type yesno] eq "yes"} {
                set fulldir $diff($top,leftDir)
                set fullname $diff($top,leftFile)
                set diff($top,leftOK) 0
                set diff($top,mode) "CVS"
                set diff($top,rightDir) $fulldir
                set diff($top,RCSFile) $fullname
                set diff($top,rightLabel) $fullname

    }
}

proc defaultGuiOptions {} {
    catch {package require griffin}

    option add *Menu.tearOff 0
    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
    }
}

if {![info exists gurkmeja]} {
    set gurkmeja 1
    defaultGuiOptions
    if {0 && [bind all <Alt-KeyPress>] eq ""} {
        bind all <Alt-KeyPress> [bind Menubutton <Alt-KeyPress>]
        #after 500 "tk_messageBox -message Miffo"
    }
    getOptions
    wm withdraw .
    parseCommandLine
}