Eskil

proc Fsort {l} {
    lsort -dictionary $l
}

# Compare two files or dirs
# Return true if equal
proc CompareFiles {file1 file2} {
    global Pref
    if {[catch {file lstat $file1 stat1}]} {
        return 0
    }
    if {[catch {file lstat $file2 stat2}]} {
        return 0
    }

        if {$l1 eq $l2} {
            return 1
        }
        file stat $file1 stat1
        file stat $file2 stat2
    }
    # If contents is not checked, same size is enough to be equal
    if {$stat1(size) == $stat2(size) && $Pref(dir,comparelevel) == 0} {
        return 1
    }
    set ignorekey $Pref(dir,ignorekey)
    # Different size is enough when doing binary compare
    if {$stat1(size) != $stat2(size) && $Pref(dir,comparelevel) == 2 \
        && !$ignorekey} {
        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(dir,comparelevel) == 0} {
        return 0
    }
    # Don't check further if any is a directory
    if {$isdir1 || $isdir2} {
        # Consider dirs equal until we implement something recursive
	return 1
    }

    switch $Pref(dir,comparelevel) {
        2 -
        1 { # Check contents internally
            set bufsz 65536
            set eq 1
            set ch1 [open $file1 r]
            set ch2 [open $file2 r]
            if {$Pref(dir,comparelevel) == 2} {
                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]

        }
    }
    return $eq
}

# Returns the contents of a directory as a sorted list of full file paths.
proc DirContents {dir} {
    global Pref
    if {$::tcl_platform(platform) eq "windows"} {
        # .-files are not treated specially on windows. * is enough to get all
        set files [glob -directory $dir -nocomplain *]
    } else {
        set files [glob -directory $dir -nocomplain * {.[a-zA-Z]*}]
    }

    if {$Pref(dir,onlyrev)} {
        # FIXA: move to rev and make general for other systems
        set entries [file join $dir CVS Entries]
        if {[file exists $entries]} {
            set ch [open $entries r]
            set data [read $ch]
            close $ch
            foreach line [split $data \n] {

    set files2 {}
    foreach file $files {
        set full $file
        set tail [file tail $file]
        # Apply filters
        if {[FileIsDirectory $full]} {
            if {[llength $Pref(dir,incdirs)] == 0} {
                set allowed 1
            } else {
                set allowed 0
                foreach pat $Pref(dir,incdirs) {
                    if {[string match $pat $tail]} {
                        set allowed 1
                        break
                    }
                }
            }
            if {$allowed} {
                foreach pat $Pref(dir,exdirs) {
                    if {[string match $pat $tail]} {
                        set allowed 0
                        break
                    }
                }
            }
            if {!$allowed} continue
        } else {
            if {[llength $Pref(dir,incfiles)] == 0} {
                set allowed 1
            } else {
                set allowed 0
                foreach pat $Pref(dir,incfiles) {
                    if {[string match $pat $tail]} {
                        set allowed 1
                        break
                    }
                }
            }
            if {$allowed} {
                foreach pat $Pref(dir,exfiles) {
                    if {[string match $pat $tail]} {
                        set allowed 0
                        break
                    }
                }
            }
            if {!$allowed} continue

proc EditFile {file} {
    locateEditor ::util(editor)
    exec $::util(editor) $file &
}

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

    set newdir $dir
    while {$newdir != "." && ![FileIsDirectory $newdir]} {
        set newdir [file dirname $newdir]
    }
    set newdir [tk_chooseDirectory -initialdir $newdir -title "Select Directory"]

        } else {
            $tree collapseall
        }
    }

    # Copy a file from one directory to the other
    method CopyFile {node from} {
        global dirdiff Pref

        set lf [$tree rowattrib $node leftfull]
        set rf [$tree rowattrib $node rightfull]
        set parent [$tree parent $node]
        set lp [$tree rowattrib $parent leftfull]
        set rp [$tree rowattrib $parent rightfull]

        if {$rf eq ""} {
            $w.bl configure -state disabled
        }
    }

    # Compare two directories.
    method CompareDirs {dir1 dir2 node} {
        global Pref
        if {$dir1 eq ""} {
            set files1 {}
        } else {
            set files1 [DirContents $dir1]
        }
        if {$dir2 eq ""} {
            set files2 {}

        $win.m add cascade -menu $win.m.mo -label "Preferences" -underline 0
        menu $win.m.mo
        $win.m.mo add command -label "Prefs..." -command makeDirDiffPrefWin
        $win.m.mo add cascade -label "Check" -menu $win.m.mo.mc

        menu $win.m.mo.mc
        $win.m.mo.mc add radiobutton -variable Pref(dir,comparelevel) -value 0 \
                -label "Do not check contents"
        $win.m.mo.mc add radiobutton -variable Pref(dir,comparelevel) -value 1 \
                -label "Normal compare"
        $win.m.mo.mc add radiobutton -variable Pref(dir,comparelevel) -value 2 \
                -label "Exact compare"
        $win.m.mo.mc add checkbutton -variable Pref(dir,ignorekey) \
                -label "Ignore \$Keyword:\$"

        $win.m.mo add cascade -label "Nice" -menu $win.m.mo.mn
        menu $win.m.mo.mn
        $win.m.mo.mn add radiobutton -variable [myvar nice] -value 1 \
                -command [mymethod DoNice] -label 1
        $win.m.mo.mn add radiobutton -variable [myvar nice] -value 50 \

        
        ttk::button $win.bu -image $::img(upup) -command [mymethod UpDir] \
                -underline 0
        addBalloon $win.bu "Up in both."
        bind $win <Alt-u> "$win.bu invoke"
        
        #catch {font delete myfont}
        #font create myfont -family $Pref(fontfamily) -size $Pref(fontsize)

        ttk::entryX $win.e1 -textvariable dirdiff(leftDir) -width 30
        ttk::button $win.bu1 -image $::img(up) -command [mymethod UpDir 1]
        addBalloon $win.bu1 "Up in left."
        ttk::button $win.bb1 -image $::img(browse) \
                -command "[list BrowseDir dirdiff(leftDir) $win.e1]
                          [mymethod DoDirCompare]"

    method DoNice {} {
        $tree nice $nice
    }

    # Go up one level in directory hierarchy.
    # 0 = both
    method UpDir {{n 0}} {
        global dirdiff Pref
        switch $n {
            0 {
                set dirdiff(leftDir) [file dirname $dirdiff(leftDir)]
                set dirdiff(rightDir) [file dirname $dirdiff(rightDir)]
                $win.e1 xview end
                $win.e2 xview end
            }

            set ::TmpPref($item) $::Pref($item)
        }
    }

    wm title $top "Eskil Directory Preferences"

    set check [ttk::labelframe $top.check -text "Check" -padding 3]
    ttk::radiobutton $check.rb1 -variable TmpPref(dir,comparelevel) -value 0 \
            -text "Do not check contents"
    ttk::radiobutton $check.rb2 -variable TmpPref(dir,comparelevel) -value 1 \
            -text "Normal compare"
    ttk::radiobutton $check.rb3 -variable TmpPref(dir,comparelevel) -value 2 \
            -text "Exact compare"
    grid $check.rb1 -sticky w -padx 3 -pady 3
    grid $check.rb2 -sticky w -padx 3 -pady 3
    grid $check.rb3 -sticky w -padx 3 -pady 3
    grid columnconfigure $check {0 1 2} -uniform a -weight 1

    set opts [ttk::labelframe $top.opts -text "Options" -padding 3]
    ttk::checkbutton $opts.cb1 -variable TmpPref(dir,ignorekey) \
            -text "Ignore \$Keyword:\$"
    pack {*}[winfo children $opts] -side top -anchor w 

    set filter [ttk::labelframe $top.filter -text "Filter" -padding 3]
    ttk::label $filter.l1 -text "Include Files" -anchor w
    ttk::entryX $filter.e1 -width 20 -textvariable TmpPref(dir,incfiles)
    ttk::label $filter.l2 -text "Exclude Files" -anchor w
    ttk::entryX $filter.e2 -width 20 -textvariable TmpPref(dir,exfiles)
    ttk::label $filter.l3 -text "Include Dirs" -anchor w
    ttk::entryX $filter.e3 -width 20 -textvariable TmpPref(dir,incdirs)
    ttk::label $filter.l4 -text "Exclude Dirs" -anchor w
    ttk::entryX $filter.e4 -width 20 -textvariable TmpPref(dir,exdirs)
    ttk::checkbutton $filter.cb1 -text "Only revision controlled" \
            -variable TmpPref(dir,onlyrev)
    grid $filter.l1 $filter.e1 -sticky we -padx 3 -pady 3
    grid $filter.l2 $filter.e2 -sticky we -padx 3 -pady 3
    grid $filter.l3 $filter.e3 -sticky we -padx 3 -pady 3
    grid $filter.l4 $filter.e4 -sticky we -padx 3 -pady 3
    grid $filter.cb1 - -sticky w -padx 3 -pady 3
    grid columnconfigure $filter 1 -weight 1

    }
    $::widgets($top,wDiff$n) insert end "\n" padding
}

# Insert one line in each text widget.
# Mark them as changed, and optionally parse them.
proc insertMatchingLines {top line1 line2} {
    global doingLine1 doingLine2 Pref

    # FIXA: fully implement filter
    if {$::eskil(filter) != ""} {
        if {[regexp $::eskil(filter) $line1]} {
            insertLine $top 1 $doingLine1 $line1
            insertLine $top 2 $doingLine2 $line2
            incr doingLine1
            incr doingLine2
            set ::eskil(filterflag) 1
            return
        }
        set ::eskil(filterflag) 0
    }

    if {$Pref(parse) != 0} {
        set opts $Pref(ignore)
        if {$Pref(nocase)} {lappend opts -nocase}
        if {$Pref(lineparsewords)} {lappend opts -words}
        set res [DiffUtil::diffStrings {*}$opts $line1 $line2]
        set dotag 0
        set n [expr {[llength $res] / 2}]
        $::widgets($top,wLine1) insert end [myFormL $doingLine1] \
                "hl$::HighLightCount change"
        $::widgets($top,wLine2) insert end [myFormL $doingLine2] \
                "hl$::HighLightCount change"
        set new1 "new1"
        set new2 "new2"
        set change "change"
        foreach {i1 i2} $res {
            incr n -1
            if {$dotag} {
                if {$n == 1 && $Pref(marklast)} {
                    lappend new1 last
                    lappend new2 last
                    lappend change last
                }
                if {$i1 eq ""} {
                    $::widgets($top,wDiff2) insert end $i2 $new2
                } elseif {$i2 eq ""} {

        addChange $top $n1 $tag1 $line1 $n1 $line2 $n2
        nextHighlight $top
    }
}

# Insert two blocks of lines in the compare windows.
proc insertMatchingBlocks {top block1 block2 line1 line2 details} {
    global doingLine1 doingLine2 Pref

    set n1 [llength $block1]
    set n2 [llength $block2]

    set large [expr {$n1 * $n2 > 1000}]

    if {$n1 == 0 || $n2 == 0 || $Pref(parse) < 2 || \
            ($large && $Pref(parse) < 3)} {
        # No extra parsing at all.
        insertMatchingBlocksNoParse $top $block1 $block2 $line1 $line2 $details
        return
    }

    # A large block may take time.  Give a small warning.
    if {$large} {

#  ch1 is a file channel for the left file
#  ch2 is a file channel for the right file
#  n1/n2 is the number of lines involved
#  line1/line2 says on what lines this block starts
# If n1/n2 are both 0, it means that this is the last lines to be displayed.
#  In that case line1/line2, if non-zero says the last line to display.
proc doText {top ch1 ch2 n1 n2 line1 line2} {
    global doingLine1 doingLine2 Pref

    if {$n1 == 0 && $n2 == 0} {
        # All blocks have been processed. Continue until end of file.
        # If "show all" is not on, just display a couple of context lines.
        set limit -1
        if {$Pref(context) >= 0} {
            set limit $Pref(context)
        }
        # Consider any total limit on displayed lines.
        if {$::eskil($top,limitlines)} {
            set limit [expr {$::eskil($top,limitlines) - $::eskil($top,mapMax)}]
            if {$limit < 0} {
                set limit 0
            }

    if {$n1 == 0} {set tag2 new2} else {set tag2 change}
    if {$n2 == 0} {set tag1 new1} else {set tag1 change}

    # Display all equal lines before next diff, or skip if context is set.
    # If context is on, only skip a section if the blank
    # line replaces at least 3 lines.
    set limit -1
    if {$Pref(context) == 0} {
        set limit 0
    } elseif {$Pref(context) > 0 && \
            ($line1 - $doingLine1 > (2 * $Pref(context) + 2))} {
        set limit $Pref(context)
    }
    if {$doingLine1 == 1} {
        set allowStartFill 0
    } else {
        set allowStartFill 1
    }
    set t 0

                "**Bad alignment here!! $doingLine2 $line2**\n"
        $::widgets($top,wLine1) insert end "\n"
        $::widgets($top,wLine2) insert end "\n"
    }

    # Process the block

    if {$n1 == $n2 && ($n1 == 1 || $Pref(parse) < 2)} {
        # Never do block parsing for one line blocks.
        # If block parsing is turned off, only do line parsing for
        # blocks of equal size.
        for {set t 0} {$t < $n1} {incr t} {
            gets $ch1 textline1
            gets $ch2 textline2
            insertMatchingLines $top $textline1 $textline2

    } else {
        set ::eskil($top,mergetranslation) lf
    }
}

# Read a conflict file and extract the two versions.
proc prepareConflict {top} {
    global Pref

    disallowEdit $top
    set ::eskil($top,leftFile) [tmpFile]
    set ::eskil($top,rightFile) [tmpFile]

    set ch1 [open $::eskil($top,leftFile) w]
    set ch2 [open $::eskil($top,rightFile) w]
    set ch [open $::eskil($top,conflictFile) r]

    set ::eskil($top,leftLabel) $leftName
    set ::eskil($top,rightLabel) $rightName
    update idletasks
}

# Clean up after a conflict diff.
proc cleanupConflict {top} {
    global Pref

    clearTmp $::eskil($top,rightFile) $::eskil($top,leftFile)
    set ::eskil($top,rightFile) $::eskil($top,conflictFile)
    set ::eskil($top,leftFile) $::eskil($top,conflictFile)
}

# Display one chunk from a patch file
proc displayOnePatch {top leftLines rightLines leftLine rightLine} {

        set rblock {}
    }
    mapNoChange $top 0
}

# Read a patch file and display it
proc displayPatch {top} {
    global Pref

    set ::eskil($top,leftLabel) "Patch $::eskil($top,patchFile): old"
    set ::eskil($top,rightLabel) "Patch $::eskil($top,patchFile): new"
    update idletasks

    if {$::eskil($top,patchFile) eq ""} {
        if {$::eskil($top,patchData) eq ""} {
            set data [getFullPatch $top]

    } else {
        return "$tail2 vs $tail1"
    }
}

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

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

    } else {
        prepareFiles $top
    }

    wm title $top "Eskil: [TitleTail $top]"

    # Run diff and parse the result.
    set opts $Pref(ignore)
    if {$Pref(nocase)} {lappend opts -nocase}
    if {$Pref(noempty)} {lappend opts -noempty}
    if {$Pref(pivot) > 0} {lappend opts -pivot $Pref(pivot)}
    if {[info exists ::eskil($top,aligns)] && \
            [llength $::eskil($top,aligns)] > 0} {
        lappend opts -align $::eskil($top,aligns)
    }
    set range {}
    if {[info exists ::eskil($top,range)] && \
            [llength $::eskil($top,range)] == 4} {
        set range $::eskil($top,range)
        lappend opts -range $range
    }
    foreach {RE sub side} $Pref(preprocess) {
        lappend opts -regsub$side [list $RE $sub]
    }
    # Apply nodigit after preprocess
    if {$Pref(nodigit)} {lappend opts -nodigit}

    # If a special file for diffing is present, use it.
    if {[info exists ::eskil($top,leftFileDiff)]} {
        set dFile1 $::eskil($top,leftFileDiff)
    } else {
        set dFile1 $::eskil($top,leftFile)
    }

    if {[doOpenAncestor $top]} {
        # Redo diff with ancestor
        doDiff $top
    }
}

proc openConflict {top} {
    global Pref
    if {[doOpenRight $top]} {
        startConflictDiff $top $::eskil($top,rightFile)
        set ::eskil($top,mergeFile) ""
        doDiff $top
    }
}

proc openPatch {top} {
    global Pref
    if {[doOpenLeft $top]} {
        set ::eskil($top,mode) "patch"
        set Pref(ignore) " "
        set Pref(nocase) 0
        set Pref(noempty) 0
        set ::eskil($top,patchFile) $::eskil($top,leftFile)
        set ::eskil($top,patchData) ""
        doDiff $top
    }
}

# Get data from clipboard and display as a patch.

}

#########
# Zooming
#########

proc zoomRow {w X Y x y} {
    global Pref
    set top [winfo toplevel $w]
    # Get the row that was clicked
    set index [$w index @$x,$y]
    set row [lindex [split $index "."] 0]

    # Check if it is selected
    if {[lsearch [$w tag names $index] sel] >= 0} {

    wm withdraw $top.balloon
    wm overrideredirect $top.balloon 1

    set wid 0
    foreach x {1 2} {
        text $top.balloon.t$x -relief flat -font $font -background \#ffffcc \
            -foreground black -padx 2 -pady 0 -height 1 -wrap word
        $top.balloon.t$x tag configure new1 -foreground $Pref(colornew1) \
                -background $Pref(bgnew1)
        $top.balloon.t$x tag configure change -foreground $Pref(colorchange) \
                -background $Pref(bgchange)
        $top.balloon.t$x tag configure new2 -foreground $Pref(colornew2) \
                -background $Pref(bgnew2)
        $top.balloon.t$x tag configure equal -foreground $Pref(colorequal) \
                -background $Pref(bgequal)
        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]

proc unzoomRow {w} {
    set top [winfo toplevel $w]
    destroy $top.balloon
}

# Reconfigure font
proc chFont {} {
    global Pref

    font configure myfont -size $Pref(fontsize) -family $Pref(fontfamily)
}

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

    foreach top $::eskil(diffWindows) {
        if {$top eq ".clipdiff"} continue
        if {$top != ".dirdiff"} {
            foreach item {wLine1 wDiff1 wLine2 wDiff2} {
                if {![info exists ::widgets($top,$item)]} continue
                set w $::widgets($top,$item)

                $w tag configure equal -foreground $Pref(colorequal) \
                        -background $Pref(bgequal)
                $w tag configure new1 -foreground $Pref(colornew1) \
                        -background $Pref(bgnew1)
                $w tag configure change -foreground $Pref(colorchange) \
                        -background $Pref(bgchange)
                $w tag configure new2 -foreground $Pref(colornew2) \
                        -background $Pref(bgnew2)
            }
            continue
        }

#        $dirdiff(wLeft) tag configure new1 -foreground $Pref(colornew1) \
#                -background $Pref(bgnew1)
#        $dirdiff(wLeft) tag configure change -foreground $Pref(colorchange) \
#                -background $Pref(bgchange)
#        $dirdiff(wLeft) tag configure changed -foreground $Pref(colorchange)
#        $dirdiff(wLeft) tag configure invalid -background #a9a9a9
#        $dirdiff(wRight) tag configure new2 -foreground $Pref(colornew2) \
#                -background $Pref(bgnew2)
#        $dirdiff(wRight) tag configure change -foreground $Pref(colorchange) \
#                -background $Pref(bgchange)
#        $dirdiff(wRight) tag configure changed -foreground $Pref(colorchange)
#        $dirdiff(wRight) tag configure invalid -background #a9a9a9

    }
}

# Scroll text windows
proc scrollText {top n what} {
    # Do not scroll if focus is in a text window.
    # This is for scroll bindings in the toplevel.

    $dMenu add command -label "_stats" -command {parray _stats}
    $dMenu add command -label "Nuisance" -command [list makeNuisance \
        $top "It looks like you are trying out the debug menu."]
}

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

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

    $top.m.mo add separator
    $top.m.mo add command -label "Save default" \
            -command [list saveOptions $top]

    menu $top.m.mo.f
    $top.m.mo.f add command -label "Select..." -command makeFontWin \
            -underline 0
    $top.m.mo.f add radiobutton -label 6 -variable Pref(fontsize) -value 6 \
            -command chFont
    $top.m.mo.f add radiobutton -label 7 -variable Pref(fontsize) -value 7 \
            -command chFont
    $top.m.mo.f add radiobutton -label 8 -variable Pref(fontsize) -value 8 \
            -command chFont
    $top.m.mo.f add radiobutton -label 9 -variable Pref(fontsize) -value 9 \
            -command chFont
    $top.m.mo.f add radiobutton -label 10 -variable Pref(fontsize) -value 10 \
            -command chFont

    menu $top.m.mo.i
    $top.m.mo.i add radiobutton -label "No spaces" \
            -variable Pref(ignore) -value " "
    $top.m.mo.i add radiobutton -label "Space changes (-b)" \
            -variable Pref(ignore) -value "-b"
    $top.m.mo.i add radiobutton -label "All spaces (-w)" \
            -variable Pref(ignore) -value "-w"
    $top.m.mo.i add separator
    $top.m.mo.i add checkbutton -label "Case (-i)" \
            -variable Pref(nocase)
    $top.m.mo.i add checkbutton -label "Empty" \
            -variable Pref(noempty)
    $top.m.mo.i add checkbutton -label "Digits" \
            -variable Pref(nodigit)

    menu $top.m.mo.p
    $top.m.mo.p add radiobutton -label "Nothing" -variable Pref(parse) -value 0
    $top.m.mo.p add radiobutton -label "Lines" -variable Pref(parse) -value 1
    $top.m.mo.p add radiobutton -label "Blocks (small)" -variable Pref(parse) \
            -value 2
    $top.m.mo.p add radiobutton -label "Blocks" -variable Pref(parse) -value 3
    $top.m.mo.p add separator
    $top.m.mo.p add radiobutton -label "Characters" \
            -variable Pref(lineparsewords) -value "0"
    $top.m.mo.p add radiobutton -label "Words" \
            -variable Pref(lineparsewords) -value "1"
    $top.m.mo.p add separator
    $top.m.mo.p add checkbutton -label "Fine chunks" -variable Pref(finegrainchunks)
    $top.m.mo.p add separator
    $top.m.mo.p add checkbutton -label "Mark last" -variable Pref(marklast)

    menu $top.m.mo.c
    $top.m.mo.c add radiobutton -label "Show all lines" \
            -variable ::Pref(context) -value -1
    $top.m.mo.c add radiobutton -label "Show only diffs" \
            -variable ::Pref(context) -value 0
    $top.m.mo.c add separator

            -underline 0
    bind $top <Alt-n> [list findDiff $top 1]
    bind $top <Alt-p> [list findDiff $top -1]
    bind $top <Alt-c> [list revCommit $top]
    bind $top <Alt-l> [list revLog $top]

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

    fileLabel $top.l1 -textvariable ::eskil($top,leftLabel)
    fileLabel $top.l2 -textvariable ::eskil($top,rightLabel)

    ttk::frame $top.ft1 -borderwidth 2 -relief sunken
    text $top.ft1.tl -height $Pref(lines) -width 5 -wrap none \
            -font myfont -borderwidth 0 -padx 0 -highlightthickness 0 \
            -takefocus 0
    text $top.ft1.tt -height $Pref(lines) -width $Pref(linewidth) -wrap none \
            -xscrollcommand [list $top.sbx1 set] \
            -font myfont -borderwidth 0 -padx 1 \
            -highlightthickness 0
    $top.ft1.tt configure -tabstyle wordprocessor
    tk::frame $top.ft1.f -width 2 -height 2 -background lightgray
    pack $top.ft1.tl -side left -fill y
    pack $top.ft1.f -side left -fill y
    pack $top.ft1.tt -side right -fill both -expand 1
    scrollbar $top.sby -orient vertical
    scrollbar $top.sbx1 -orient horizontal -command [list $top.ft1.tt xview]
    set ::widgets($top,wLine1) $top.ft1.tl
    set ::widgets($top,wDiff1) $top.ft1.tt

    ttk::frame $top.ft2 -borderwidth 2 -relief sunken
    text $top.ft2.tl -height $Pref(lines) -width 5 -wrap none \
            -font myfont -borderwidth 0 -padx 0 -highlightthickness 0 \
            -takefocus 0
    text $top.ft2.tt -height $Pref(lines) -width $Pref(linewidth) -wrap none \
            -xscrollcommand [list $top.sbx2 set] \
            -font myfont -borderwidth 0 -padx 1 \
            -highlightthickness 0
    $top.ft2.tt configure -tabstyle wordprocessor
    tk::frame $top.ft2.f -width 2 -height 2 -background lightgray
    pack $top.ft2.tl -side left -fill y
    pack $top.ft2.f -side left -fill y

    initDiffData $top
    resetEdit $top
    return $top
}

proc ValidateNewColors {} {
    global TmpPref
    foreach item {colorchange bgchange colornew1 bgnew1
        colornew2 bgnew2 colorequal bgequal} {
        if {![info exists TmpPref($item)]} continue
        set col $TmpPref($item)
        if {$col eq ""} continue
        if {[catch {winfo rgb . $col}]} {
            # FIXA: Error message
            # Just restore for now
            set TmpPref($item) $::Pref($item)
        }
    }
}

# Set new preferences.
proc applyPref {} {
    global Pref TmpPref

    ValidateNewColors
    array set Pref [array get TmpPref]
    applyColor
}

# Update test color fields.
proc testColor {} {
    global TmpPref


    ValidateNewColors
    .pr.fc.t1 tag configure change -foreground $TmpPref(colorchange) \
            -background $TmpPref(bgchange)
    .pr.fc.t2 tag configure new1 -foreground $TmpPref(colornew1) \
            -background $TmpPref(bgnew1)
    .pr.fc.t3 tag configure new2 -foreground $TmpPref(colornew2) \
            -background $TmpPref(bgnew2)
    .pr.fc.t4 tag configure equal -foreground $TmpPref(colorequal) \
            -background $TmpPref(bgequal)
}

# Color dialog.
proc selColor {name} {
    global TmpPref

    set old $TmpPref($name)
    if {$old eq ""} {
        set t [tk_chooseColor -parent .pr]
    } else {
        set t [tk_chooseColor -parent .pr -initialcolor $old]
    }
    if {$t != ""} {
        set TmpPref($name) $t
    }
}

# Create a window for changing preferences.
# Currently only colors are changed in this dialog.
proc makePrefWin {} {
    global Pref TmpPref

    array set TmpPref [array get Pref]

    destroy .pr

    toplevel .pr
    wm title .pr "Eskil Preferences"

    ttk::frame .pr.fc -borderwidth 1 -relief solid
    ttk::label .pr.fc.l1 -text "Colours" -anchor w
    ttk::label .pr.fc.l2 -text "Text" -anchor w
    ttk::label .pr.fc.l3 -text "Background" -anchor w

    ttk::entryX .pr.fc.e1 -textvariable "TmpPref(colorchange)" -width 10
    ttk::entryX .pr.fc.e2 -textvariable "TmpPref(colornew1)" -width 10
    ttk::entryX .pr.fc.e3 -textvariable "TmpPref(colornew2)" -width 10
    ttk::entryX .pr.fc.e4 -textvariable "TmpPref(colorequal)" -width 10

    ttk::button .pr.fc.b1 -text "Sel" -command "selColor colorchange"
    ttk::button .pr.fc.b2 -text "Sel" -command "selColor colornew1"
    ttk::button .pr.fc.b3 -text "Sel" -command "selColor colornew2"
    ttk::button .pr.fc.b4 -text "Sel" -command "selColor colorequal"

    ttk::entryX .pr.fc.e5 -textvariable "TmpPref(bgchange)" -width 10
    ttk::entryX .pr.fc.e6 -textvariable "TmpPref(bgnew1)" -width 10
    ttk::entryX .pr.fc.e7 -textvariable "TmpPref(bgnew2)" -width 10
    ttk::entryX .pr.fc.e8 -textvariable "TmpPref(bgequal)" -width 10

    ttk::button .pr.fc.b5 -text "Sel" -command "selColor bgchange"
    ttk::button .pr.fc.b6 -text "Sel" -command "selColor bgnew1"
    ttk::button .pr.fc.b7 -text "Sel" -command "selColor bgnew2"
    ttk::button .pr.fc.b8 -text "Sel" -command "selColor bgequal"

    text .pr.fc.t1 -width 12 -height 1 -font myfont -takefocus 0
    text .pr.fc.t2 -width 12 -height 1 -font myfont -takefocus 0
    text .pr.fc.t3 -width 12 -height 1 -font myfont -takefocus 0
    text .pr.fc.t4 -width 12 -height 1 -font myfont -takefocus 0
    .pr.fc.t1 tag configure change -foreground $TmpPref(colorchange) \
            -background $TmpPref(bgchange)
    .pr.fc.t2 tag configure new1 -foreground $TmpPref(colornew1) \
            -background $TmpPref(bgnew1)
    .pr.fc.t3 tag configure new2 -foreground $TmpPref(colornew2) \
            -background $TmpPref(bgnew2)
    .pr.fc.t4 tag configure equal -foreground $TmpPref(colorequal) \
            -background $TmpPref(bgequal)
    .pr.fc.t1 insert end "Changed text" change
    .pr.fc.t2 insert end "Deleted text" new1
    .pr.fc.t3 insert end "Added text" new2
    .pr.fc.t4 insert end "Equal text" equal

    .pr.fc.t1 configure -state disabled
    .pr.fc.t2 configure -state disabled

    pack .pr.fc -side top -fill x
    pack .pr.b1 .pr.b2 .pr.b3 -side left -expand 1 -fill x -anchor s \
            -padx 2 -pady 2
}

# Change font preference
proc applyFont {lb} {
    global Pref TmpPref

    set Pref(fontsize) $TmpPref(fontsize)

    set i [lindex [$lb curselection] 0]
    set Pref(fontfamily) [$lb get $i]

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

proc UpdateFontBox {lb} {
    $lb delete 0 end
    foreach {f fixed} $::FontCache {
        if {$fixed || !$::eskil(fixedfont)} {
            $lb insert end $f
            if {[string equal -nocase $f $::Pref(fontfamily)]} {
                $lb selection set end
                $lb see end
            }
        }
    }
}

# Font dialog
proc makeFontWin {} {
    global Pref TmpPref FontCache

    destroy .fo
    toplevel .fo -padx 3 -pady 3
    wm title .fo "Select Font"

    ttk::label .fo.ltmp -text "Searching for fonts..."
    pack .fo.ltmp -padx {10 50} -pady {10 50}
    update

    catch {font delete tmpfont}
    font create tmpfont

    array set TmpPref [array get Pref]
    ttk::labelframe .fo.lf -text "Family" -padding 3
    set lb [Scroll y listbox .fo.lf.lb -width 15 -height 10 \
            -exportselection no -selectmode single]
    bind $lb <<ListboxSelect>> [list exampleFont $lb]
    pack .fo.lf.lb -fill both -expand 1

    ttk::labelframe .fo.ls -text "Size" -padding 3
    spinbox .fo.ls.sp -from 1 -to 30 -increment 1 -width 3 -state readonly \
            -textvariable TmpPref(fontsize) -command [list exampleFont $lb]
    pack .fo.ls.sp -fill both -expand 1

    ttk::label .fo.le -text "Example\n0Ooi1Il" -anchor w -font tmpfont \
            -width 1 -justify left
    if {![info exists ::eskil(fixedfont)]} {set ::eskil(fixedfont) 1}
    ttk::checkbutton .fo.cb -text "Fixed" -variable ::eskil(fixedfont) \
            -command [list UpdateFontBox $lb]

# Go through all command line arguments and start the appropriate
# diff window.
# Returns the created toplevel.
# This can be used as an entry point if embedding eskil.
# In that case fill in ::eskil(argv) and ::eskil(argc) before calling.
proc parseCommandLine {} {
    global dirdiff Pref

    set ::eskil(autoclose) 0
    set ::eskil(ignorenewline) 0

    if {$::eskil(argc) == 0} {
        Init
        return [makeDiffWin]

            } elseif {$nextArg eq "printFile"} {
                set opts(printFile) [file join [pwd] $arg]
            } elseif {$nextArg eq "printHeaderSize"} {
                if {![string is double -strict $arg] || $arg <= 0} {
                    puts "Argument -printHeaderSize must be a positive number"
                    exit
                }
                set Pref(printHeaderSize) $arg
            } elseif {$nextArg eq "printCharsPerLine"} {
                if {![string is integer -strict $arg] || $arg <= 0} {
                    puts "Argument -printCharsPerLine must be a positive number"
                    exit
                }
                set Pref(printCharsPerLine) $arg
            } elseif {$nextArg eq "printPaper"} {
                package require pdf4tcl
                if {[llength [pdf4tcl::getPaperSize $arg]] != 2} {
                    puts "Argument -printPaper must be a valid paper size"
                    puts "Valid paper sizes:"
                    puts [join [lsort -dictionary [pdf4tcl::getPaperSizeList]] \n]
                    exit
                }
                set Pref(printPaper) $arg
            } elseif {$nextArg eq "printColorChange"} {
                ValidatePdfColor $arg -printColorChange
                set Pref(printColorChange) $arg
            } elseif {$nextArg eq "printColorOld"} {
                ValidatePdfColor $arg -printColorOld
                set Pref(printColorNew1) $arg
            } elseif {$nextArg eq "printColorNew"} {
                ValidatePdfColor $arg -printColorNew
                set Pref(printColorNew2) $arg
            } elseif {$nextArg eq "revision"} {
                set opts(doptrev$revNo) $arg
                incr revNo
            } elseif {$nextArg eq "limitlines"} {
                set opts(limitlines) $arg
            } elseif {$nextArg eq "context"} {
                set Pref(context) $arg
            } elseif {$nextArg eq "pivot"} {
                if {$arg >= 1} {
                    set Pref(pivot) $arg
                }
            } elseif {$nextArg eq "prefix"} {
                set RE [string map [list % $arg] {^.*?\m(%\w+).*$}]
                if {$Pref(nocase)} {
                    set RE "(?i)$RE"
                }
                lappend ::Pref(preprocess) $RE {\1} ""
            } elseif {$nextArg eq "plugin"} {
                set plugin $arg
            } elseif {$nextArg eq "plugininfo"} {
                set plugininfo $arg

            set match [lsearch -glob -all -inline $allOpts $arg*]
            if {[llength $match] == 1} {
                set arg [lindex $match 0]
            }
        }

        if {$arg eq "-w"} {
            set Pref(ignore) "-w"
        } elseif {$arg eq "--help" || $arg eq "-help"} {
            printUsage
            exit
        } elseif {$arg eq "-b"} {
            set Pref(ignore) "-b"
        } elseif {$arg eq "-noignore"} {
            set Pref(ignore) " "
        } elseif {$arg eq "-i"} {
            set Pref(nocase) 1
        } elseif {$arg eq "-nocase"} {
            set Pref(nocase) 1
        } elseif {$arg eq "-noempty"} { # FIXA: Add to documentation
            set Pref(noempty) 1
        } elseif {$arg eq "-pivot"} { # FIXA: Add to documentation
            set nextArg pivot
        } elseif {$arg eq "-nodigit"} {
            set Pref(nodigit) 1
        } elseif {$arg eq "-nokeyword"} {
            set Pref(dir,ignorekey) 1
        } elseif {$arg eq "-prefix"} {
            set nextArg prefix
        } elseif {$arg eq "-preprocess"} {
            set nextArg preprocess
        } elseif {$arg eq "-preprocessleft"} {
            set nextArg preprocessleft
        } elseif {$arg eq "-preprocessright"} {
            set nextArg preprocessright
        } elseif {$arg eq "-plugin"} {
            set nextArg "plugin"
        } elseif {$arg eq "-plugininfo"} {
            set nextArg "plugininfo"
        } elseif {$arg eq "-plugindump"} {
            set nextArg "plugindump"
        } elseif {$arg eq "-pluginlist"} {
            set pluginlist 1
        } elseif {$arg eq "-context"} {
            set nextArg context
        } 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"} { # Deprecated
            #set Pref(extralineparse) 1
        } elseif {$arg eq "-no2nd"} { # Deprecated
            #set Pref(extralineparse) 0
        } elseif {$arg eq "-limit"} {
            set nextArg limitlines
        } elseif {$arg eq "-nodiff"} {
            set noautodiff 1
        } elseif {$arg eq "-nocdiff"} {
            set nocdiff 1
        } elseif {$arg eq "-dir"} {

                tk appname Eskil
            }
        } elseif {$arg eq "-o"} {
            set nextArg mergeFile
        } elseif {$arg eq "-a"} {
            set nextArg ancestorFile
            # Default is no ignore on three-way merge
            set Pref(ignore) " "
        } elseif {$arg eq "-fine"} {
            set Pref(finegrainchunks) 1
        } elseif {$arg eq "-r"} {
            set nextArg revision
        } elseif {$arg eq "-debug"} {
            set ::eskil(debug) 1
        } elseif {$arg eq "-svn"} {
            set preferedRev "SVN"
        } elseif {$arg eq "-cvs"} {

        }
    }
    return $top
}

# Save options to file ~/.eskilrc
proc saveOptions {top} {
    global Pref

    # Check if the window size has changed
    set w $::widgets($top,wDiff1)
    if {[winfo reqwidth $w] != [winfo width $w] || \
            [winfo reqheight $w] != [winfo height $w]} {
        set dx [expr {[winfo width $w] - [winfo reqwidth $w]}]
        set dy [expr {[winfo height $w] - [winfo reqheight $w]}]
        set cx [font measure myfont 0]
        set cy [font metrics myfont -linespace]
        set neww [expr {[$w cget -width]  + $dx / $cx}]
        set newh [expr {[$w cget -height] + $dy / $cy}]
        if {$neww != $Pref(linewidth) || $newh != $Pref(lines)} {
            set apa [tk_messageBox -title "Save Preferences" -icon question \
                    -type yesno -message "Should I save the current window\
                    size with the preferences?\nCurrent: $neww x $newh  Old:\
                    $Pref(linewidth) x $Pref(lines)"]
            if {$apa == "yes"} {
                set Pref(linewidth) $neww
                set Pref(lines) $newh
            }
        }
    }

    set rcfile "~/.eskilrc"
    if {[catch {set ch [open $rcfile "w"]} err]} {
        tk_messageBox -icon error -title "File error" -message \
                "Error when trying to save preferences:\n$err"
        return
    }

    foreach i [array names Pref] {
        # Skip unchanged options.
        if {[info exists ::DefaultPref($i)]} {
            if {$::DefaultPref($i) eq $Pref($i)} {
                continue
            }
        }
        puts $ch [list set Pref($i) $Pref($i)]
    }
    close $ch

    tk_messageBox -icon info -title "Saved" -message \
            "Preferences saved to:\n[file nativename $rcfile]"
}

proc getOptions {} {
    global Pref

    set Pref(fontsize) 8
    # Maybe change to TkFixedFont in 8.5 ?
    set Pref(fontfamily) Courier
    set Pref(ignore) "-b"
    set Pref(nocase) 0
    set Pref(noempty) 0
    set Pref(pivot) 100
    set Pref(nodigit) 0
    set Pref(parse) 2
    set Pref(lineparsewords) 0
    set Pref(colorequal) ""
    set Pref(colorchange) red
    set Pref(colornew1) darkgreen
    set Pref(colornew2) blue
    set Pref(bgequal) ""
    set Pref(bgchange) \#ffe0e0
    set Pref(bgnew1) \#a0ffa0
    set Pref(bgnew2) \#e0e0ff
    set Pref(context) -1
    set Pref(finegrainchunks) 0
    set Pref(marklast) 1
    set Pref(linewidth) 80
    set Pref(lines) 60
    set Pref(editor) ""
    set Pref(preprocess) {}
    set Pref(toolbar) 0
    set Pref(wideMap) 0 ;# Not settable in GUI yet

    # Print options
    set Pref(printHeaderSize) 10
    set Pref(printCharsPerLine) 80
    set Pref(printPaper) a4
    set Pref(printColorChange) "1.0 0.7 0.7"
    set Pref(printColorNew1)   "0.7 1.0 0.7"
    set Pref(printColorNew2)   "0.8 0.8 1.0"

    # Directory diff options
    set Pref(dir,comparelevel) 1
    set Pref(dir,ignorekey) 0
    set Pref(dir,incfiles) ""
    set Pref(dir,exfiles) "*.o"
    set Pref(dir,incdirs) ""
    set Pref(dir,exdirs) "RCS CVS .git .svn .hg"
    set Pref(dir,onlyrev) 0

    # Store default preferences, to filter saved preferences
    array set ::DefaultPref [array get Pref]

    # Backward compatibilty options
    set Pref(onlydiffs) -1
    set Pref(regsub) {}

    set ::eskil(filter) ""

    if {![info exists ::eskil_testsuite] && [file exists "~/.eskilrc"]} {
        safeLoad "~/.eskilrc" Pref
    }

    if {$Pref(editor) ne ""} {
        set ::util(editor) $Pref(editor)
    }

    # If the user's file has this old option, translate it to the new
    if {$Pref(onlydiffs) == 0} {
        set Pref(context) -1
    }
    unset Pref(onlydiffs)
    if {$Pref(regsub) ne ""} {
        foreach {a b} $Pref(regsub) {
            lappend Pref(preprocess) $a $b ""
        }
    }
    unset Pref(regsub)

    # Set up reactions to some Pref settings
    if {![info exists ::widgets(toolbars)]} {
        set ::widgets(toolbars) {}
    }
    trace add variable ::Pref(toolbar) write TraceToolbar
}

            $w insert end [subst -nocommands -novariables $data] $tags
            set data ""
        }
    }
}

proc makeHelpWin {} {
    global Pref

    set doc [file join $::eskil(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 $::eskil(thisDir)/../doc/$fileName

    #focus $t
    $t configure -state disabled
}

proc makeTutorialWin {} {
    global Pref

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

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

#  Boston, MA 02111-1307, USA.
#
#----------------------------------------------------------------------
# $Revision$
#----------------------------------------------------------------------

proc createMap {top} {
    global Pref

    set w $top.c_map
    if {$Pref(wideMap)} {
        set width 20
    } else {
        set width 6
    }
    canvas $w -width $width -borderwidth 0 -selectborderwidth 0 \
            -highlightthickness 0 -height 10
    set map [image create photo map$top]

}

proc addMapLines {top n} {
    incr ::eskil($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 ::eskil($top,changes)] || \
	    [llength $::eskil($top,changes)] == 0} return

    set w [winfo width $top.c_map]
    set h [winfo height $top.c_map]
    set x2 [expr {$w - ($Pref(wideMap) ? 5 : 1)}]
    if {$x2 < 0} { set x2 0 }
    map$top configure -width $w -height $h
    incr h -1
    set y0 0
    foreach change $::eskil($top,changes) {
	lassign $change start length type
	set y1 [expr {$start * $h / $::eskil($top,mapMax) + 1}]
	if {!$y0} { set y0 $y1 } ;# Record first occurance
	if {$y1 < 1} {set y1 1}
	if {$y1 > $h} {set y1 $h}
	set y2 [expr {($start + $length) * $h / $::eskil($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
    }
    if {$Pref(wideMap)} {
        map$top put black -to $x2 $y0 $w $y2
    }
}

# Allow button 2 on map to jump to a position
proc ThumbMap  {top y} {
    incr y 15
    ::tk::ScrollButton2Down $top.sby 0 $y
}

    set ::eskil($top,leftLabel) $rev
    set ::eskil($top,leftOK) 0
    set ::Pref(toolbar) 1
}

# Prepare for revision diff. Checkout copies of the versions needed.
proc prepareRev {top} {
    global Pref

    $::widgets($top,commit) configure -state disabled
    $::widgets($top,revert) configure -state disabled
    $::widgets($top,log)    configure -state disabled

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

    set revs {}

    }
    # Make sure labels are updated before processing starts
    update idletasks
}

# Clean up after a revision diff.
proc cleanupRev {top} {
    global Pref

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

proc revCommit {top} {
    if {[$::widgets($top,commit) cget -state] eq "disabled"} return

    set type $::eskil($top,modetype)
    eskil::rev::${type}::viewLog $top $::eskil($top,RevFile) \
            $::eskil($top,RevRevs)
}

# Get a complete tree patch from this system.
proc getFullPatch {top} {
    global Pref

    $::widgets($top,commit) configure -state disabled
    $::widgets($top,revert) configure -state disabled
    $::widgets($top,log)    configure -state disabled

    set type $::eskil($top,modetype)
    set files $::eskil($top,reviewFiles)