Eskil

#!/bin/sh
#
#   diff.tcl
#
#   Purpose
#             Graphical frontend to diff
#
#   Usage
#             Do 'diff.tcl' for interactive mode
#             Do 'diff.tcl -h' for command line usage
#             Do 'diff.tcl --help' for command line usage
#
#   Author    Peter Spjuth  980612
#
#   Revised   Date     Remark
#
#     1.0     980612   New Version.
#     1.1     980807   Parsing of change blocks added

#
#-----------------------------------------------
# $Revision$
#-----------------------------------------------
# the next line restarts using wish \
exec wish "$0" "$@"

package require Tk

set debug 0
set diffver "Version 1.9.5  2002-08-09"
set debug 1
set diffver "Version 1.9.5+  2003-01-10"
set tmpcnt 0
set tmpfiles {}
set thisscript [file join [pwd] [info script]]
set thisdir [file dirname $thisscript]
set ::diff(cvsExists) [expr {![string equal [auto_execok cvs] ""]}]
set ::diff(diffexe) diff
# Experimenting with DiffUtil package

#        puts "Best for $j is $bestline : $bestscore"
        set origresult($j) $bestline
        set scores(best,$j) $bestscore
        incr bestsum $bestscore
        incr j
    }
#    puts "Bestsum: $bestsum"

    # origresult holds a mapping between blocks where each row
    # is paired with its best match. This may not be a possible
    # result since it has to be in order. 

    array set bestresult [array get origresult]
    set bestscoresum -100000

    # If the size is 1, it is automatically in order so we
    # don't need further processing.
    if {$size1 > 1} {

	# If both blocks are the same size, try first with the
    # First try the simplest match, as a base
    if {$size1 > 1 && $size1 == $size2} {
        set sum 0
        array unset result
        for {set i 0} {$i < $size1} {incr i} {
            set result($i) $i
            incr sum $scores($i,$i)
        }
#        puts "Simple map sum: $sum"
        array set bestresult [array get result]
        set bestscoresum $sum
    }
	# simple row to row match, as a base score
	if {$size1 == $size2} {
	    set sum 0
	    array unset result
	    for {set i 0} {$i < $size1} {incr i} {
		set result($i) $i
		incr sum $scores($i,$i)
	    }
#	    puts "Simple map sum: $sum"
	    array set bestresult [array get result]
	    set bestscoresum $sum
	}

    # If result is in order, no problem.
    # Otherwise, try to adjust result to make it ordered
	# If result is in order, no problem.
	# Otherwise, try to adjust result to make it ordered
    if {$size1 > 1} {
        while {1} {
	    # The outer loop restarts from the "best mapping"
            array unset result
            array set result [array get origresult]
            for {set i 0} {$i < $size1} {incr i} {
                set mark($i) 0
            }

            while {1} {
		# The inner loop tries to get the result in order
                set besti 0
                set bestscore -100000
                set order 1
                for {set i 0} {$i < $size1} {incr i} {
                    if {$mark($i) == 0} {
                        for {set j [expr {$i + 1}]} {$j < $size1} {incr j} {
                            if {$mark($j) == 0} break

                }
                for {set i [expr {$besti + 1}]} {$i < $size1} {incr i} {
                    if {$mark($i) == 0 && $result($i) <= $bestr} {
                        set mark($i) 2
                    }
                }
            }

            set prev $size2
            for {set i [expr {$size1 - 1}]} {$i >= 0} {incr i -1} {
                if {$mark($i) != 2} {
                    set prev $result($i)
                } else {
                    set high($i) [expr {$prev - 1}]
                }

                set j $result($i)
                if {[info exists scores($i,$j)]} {
#                    puts "Score: $i $j $scores($i,$j)"
                    incr scoresum $scores($i,$j)
                }
            }
#            puts "Scoresum: $scoresum ($bestscoresum)"

	    # If it was not an improvement over previous iteration, quit
            if {$scoresum > $bestscoresum} {
                array set bestresult [array get result]
                set bestscoresum $scoresum
                if {$bestscoresum >= (3 * $bestsum / 4)} {
                    break
                }
                # If the result seems too bad, try again but
                # ignore the most awkwardly placed line.
                set mostp -1
                set mosti 0
                for {set i 0} {$i < $size1} {incr i} {
                    if {$mark($i) == 1} {
                        if {abs($result($i) - $i) > $mostp} {
                            set mostp [expr {abs($result($i) - $i)}]
                            set mosti $i
                        }
                    }
                }
#                puts "Most $mosti $mostp"
                set scores(best,$mosti) 0
            if {$scoresum <= $bestscoresum} {
                break
	    }

	    array set bestresult [array get result]
	    set bestscoresum $scoresum
	    # If it is close enough to the theoretical max, take it
	    if {$bestscoresum >= (3 * $bestsum / 4)} {
		break
	    }
	    
	    # We are redoing from start, but try to improve by
	    # ignoring the most awkwardly placed line.
	    set mostp -1
	    set mosti 0
	    for {set i 0} {$i < $size1} {incr i} {
		if {$mark($i) == 1} {
		    if {abs($result($i) - $i) > $mostp} {
			set mostp [expr {abs($result($i) - $i)}]
			set mosti $i
		    }
		}
	    }
#	    puts "Most $mosti $mostp"
	    set scores(best,$mosti) 0
            } else {
                break
            }
        }
    }
        }
    }

    array set result [array get bestresult]

    array set result [array get bestresult]
    # Collect the result into diff-like codes to use as display info.

    set apa {}
    set t1 0
    set t2 0
    while {$t1 < $size1 || $t2 < $size2} {
        if {$t1 < $size1} {
            set r $result($t1)

            }
            continue
        }
        # No change block anymore. If one just ended, display it.
        if {[llength $lblock] > 0 || [llength $rblock] > 0} {
            set ::doingLine1 $lblockl
            set ::doingLine2 $rblockl
            insertMatchingBlocks $lblock $rblock
            incr ::mapMax [insertMatchingBlocks $lblock $rblock]
            set lblock {}
            set rblock {}
        }
        if {$lmode == "" && $rmode == ""} {
            insert 1 $lline $lstr
            insert 2 $rline $rstr
            incr leftc
            incr rightc
            incr ::mapMax
            continue
        }
        if {$lmode == "-"} {
            insert 1 $lline $lstr new1
            emptyline 2
            incr leftc
            incr ::mapMax
            continue
        }
        if {$rmode == "+"} {
            insert 2 $rline $rstr new2
            emptyline 1
            incr rightc
            incr ::mapMax
            continue
        }
    }
}

# Read a patch file and display it
proc displayPatch {} {
    global diff Pref
    global diff Pref changesList mapMax

    set diff(leftLabel) "Patch $diff(patchFile): old"
    set diff(rightLabel) "Patch $diff(patchFile): new"
    update idletasks

    set ch [open $diff(patchFile) r]

            set rightRE {^\+\+\+\s+(.*)$}
        }
        if {$state == "newfile" && [regexp $leftRE $line -> sub]} {
            emptyline 1
            insert 1 "" $divider
            insert 1 "" $sub
            insert 1 "" $divider
            lappend ::changesList $mapMax 4 change 0 0 0 0
            incr mapMax 4
            continue
        }
        if {$state == "newfile" && [regexp $rightRE $line -> sub]} {
            emptyline 2
            insert 2 "" $divider
            insert 2 "" $sub
            insert 2 "" $divider

        cd $dir
        set filename [file tail $filename]
    }

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

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

# Prepare for RCS/CVS diff. Checkout copies of the versions needed.

    cleartmp
    set diff(rightFile) $diff(RCSFile)
    set diff(leftFile) $diff(RCSFile)
    set Pref(dopt) $Pref(old_dopt)
    unset Pref(old_dopt)
}

# Prepare for a diff by creating needed temporary files
proc prepareFiles {} {
    if {$::diff(mode) == "RCS" || $::diff(mode) == "CVS"} {
        prepareRCS
    } elseif {[string match "conflict*" $::diff(mode)]} {
        prepareConflict
    }
}

# Clean up after a diff
proc cleanupFiles {} {
    if {$::diff(mode) == "RCS" || $::diff(mode) == "CVS"} {
        cleanupRCS
    } elseif {[string match "conflict*" $::diff(mode)]} {
        cleanupConflict
    }
}

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

        foreach w {.ft1.tl .ft2.tl} {
            $w configure -state disabled
        }
        update idletasks
        .ft2.tl see 1.0
        normalCursor
        return
    } elseif {$diff(mode) == "RCS" || $diff(mode) == "CVS"} {
        prepareRCS
    } else {
        prepareFiles
    } elseif {[string match "conflict*" $diff(mode)]} {
        prepareConflict
    }

    # Run diff and parse the result.
    if {$::diff(diffutil)} {
        set differr [catch {eval DiffUtil::diffFiles $Pref(ignore) \
                \$diff(leftFile) \$diff(rightFile)} diffres]
    } else {

        $w configure -state disabled
    }
    update idletasks
    .ft2.tl see 1.0
    normalCursor
    showDiff 0

    if {$diff(mode) == "RCS" || $diff(mode) == "CVS"} {
        cleanupRCS
    } elseif {[string match "conflict*" $diff(mode)]} {
    cleanupFiles
    if {[string match "conflict*" $diff(mode)]} {
        cleanupConflict
        if {$::diff(eqLabel) != "="} {
            after idle makeMergeWin
            makeMergeWin
        }
    }
    if {$diff(printFile) != ""} {
        after idle {doPrint 1 ; exit}
        after idle {doPrint 1 ; cleanupAndExit}
    }
}

# This is the entrypoint to do a diff via DDE or Send
proc remoteDiff {file1 file2} {
    global diff

    set rightMergeData {}
    array unset mergeSelection
}

# Create a window to display merge result.
proc makeMergeWin {} {
    set w .merge
    set geometry ""
    if {![winfo exists $w]} {
        toplevel $w
    } else {
        eval destroy [winfo children $w]
    }

    wm title $w "Merge result"

        bind ISearch $b ""
    }

    bind ISearch <Control-Key-s> "textSearch::startIncrementalSearch %W"
}

# Dialog functions from "Practical Programming in Tcl And Tk" by Welch.
namespace eval XXtextSearch {}
proc textSearch::DialogCreate {top title args} {
proc XXtextSearch::DialogCreate {top title args} {
    variable dialog
    if {[winfo exists $top]} {
        switch -- [wm state $top] {
            normal {
                # Raise a buried window
                raise $top
            }

    } else {
        eval {toplevel $top} $args
        wm title $top $title
        return 1
    }
}

proc textSearch::DialogWait {top varName {focus {}}} {
proc XXtextSearch::DialogWait {top varName {focus {}}} {
    upvar $varName var

    # Poke the variable if the user nukes the window
    bind $top <Destroy> [list set $varName $var]

    # Grab focus for the dialog
    if {[string length $focus] == 0} {
        set focus $top
    }
    set old [focus -displayof $top]
    focus $focus
    catch {tkwait visibility $top}
    catch {grab $top}

    # Wait for the dialog to complete
    tkwait variable $varName
    catch {grab release $top}
    focus $old
}

proc textSearch::DialogDismiss {top} {
proc XXtextSearch::DialogDismiss {top} {
    variable dialog
    # Save current size and position
    catch {
        # window may have been deleted
        set dialog(geo,$top) [wm geometry $top]
        wm withdraw $top
    }
}

# Ask for a search string
proc textSearch::FindDialog {string} {
proc XXtextSearch::FindDialog {string} {
    variable prompt
    set f .prompt
    if {[DialogCreate $f "Find" -borderwidth 10]} {
        message $f.msg -text $string -aspect 1000
        entry $f.entry -textvariable ::textSearch::prompt(result)

        checkbutton $f.case -text "Match Case" -anchor w\

        bind $f.entry <Key-Return> {set ::textSearch::prompt(ok) 1 ; break}
        bind $f.entry <Key-Escape> {set ::textSearch::prompt(ok) 0 ; break}
    }

    set prompt(ok) 0
    DialogWait $f ::textSearch::prompt(ok) $f.entry
    DialogDismiss $f
    if {$prompt(ok)} {
        return $prompt(result)
    } else {
        return {}
    }
}

proc textSearch::Dialog {args} {
    set arg(-parent) .
    set arg(-title) ""
    set arg(-body) {pack [button $top.b -text Ok -command "destroy $top"]}

    foreach {opt val} $args {
	set arg($opt) $val
    }

    if {$arg(-parent) == "."} {
	set arg(-parent) ""
    }
    set t 0
    set top $arg(-parent).dialog_$t
    while {[winfo exists $top]} {
	incr t
	set top $arg(-parent).dialog_$t
    }

    toplevel $top
    wm title $top $arg(-title)

    set oldfocus [focus -displayof $top]

    if {[uplevel 1 {info exists top}]} {
	set oldtop [uplevel 1 {set top}]
    }

    uplevel 1 [list set top $top]
    uplevel 1 $arg(-body)

    if {[info exists oldtop]} {
	uplevel 1 [list set top $oldtop]
    } else {
	uplevel 1 {unset top}
    }

    # Grab focus for the dialog unless the user did it in the body
    if {[winfo toplevel [focus -displayof $top]] != $top} {
	focus $top
    }
    catch {tkwait visibility $top}
    catch {grab $top}

    # Wait for the dialog to complete
    tkwait window $top
    catch {grab release $top}
    focus $oldfocus
}

proc textSearch::DismissDialog {top result} {
    variable prompt
    
    set prompt(ok) $result
    set prompt(geo) [wm geometry $top]
    destroy $top
}

# Ask for a search string
proc textSearch::FindDialog {string} {
    variable prompt

    set prompt(ok) 0

    Dialog -title Find -body {
	message $top.msg -text $string -aspect 1000
        entry $top.entry -textvariable ::textSearch::prompt(result)

        checkbutton $top.case -text "Match Case" -anchor w \
	        -variable ::textSearch::searchCase

        button $top.ok     -text OK     -width 7 -default active \
	        -command "::textSearch::DismissDialog $top 1"
        button $top.cancel -text Cancel -width 7 \
	        -command "::textSearch::DismissDialog $top 0"

        grid $top.msg   - - -sticky w  -padx 2 -pady 2
        grid $top.entry - - -sticky we -padx 2 -pady 2
        grid $top.case  - - -sticky nw  -padx 2 -pady 2
        grid $top.ok x $top.cancel -sticky we -padx 2 -pady 2
        grid columnconfigure $top {0 2} -weight 1
        grid columnconfigure $top 1 -minsize 10 -weight 2
        grid rowconfigure $top 2 -weight 1

        bind $top.entry <Key-Return> \
	        "::textSearch::DismissDialog $top 1 ; break"
        bind $top.entry <Key-Escape> \
	        "::textSearch::DismissDialog $top 0 ; break"
	focus $top.entry
	if {[info exists prompt(geo)]} {
	    wm geometry $top $prompt(geo)
	}
    }

    if {$prompt(ok)} {
        return $prompt(result)
    } else {
        return {}
    }
}

    pack .pr.r1 .pr.r2 .pr.r3 .pr.r4 -in .pr.f -side left -fill x -expand 1

}

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

proc formatAlignPattern {p} {
    set raw [binary format I $p]
    binary scan $raw B* bin
    set bin [string trimleft [string range $bin 0 end-8] 0][string range $bin end-7 end]
    set pat [string map {0 . 1 ,} $bin]
    return $pat
}

proc runAlign {} {
    if {![info exists ::diff(aligns)] || [llength $::diff(aligns)] == 0} {
        return
    }

    set pattern 0
    foreach align $::diff(aligns) {
        foreach {lline rline level} $align break
        
        set pre {}
        set post {}
        for {set t 1} {$t <= $level} {incr t} {
            lappend pre [formatAlignPattern $pattern]
            incr pattern
            lappend post [formatAlignPattern $pattern]
            incr pattern
        }

        set fix1($lline) [list [join $pre \n] [join $post \n]]
        set fix2($rline) [list [join $pre \n] [join $post \n]]
    }

    prepareFiles
    foreach n {1 2} src {leftFile rightFile} {
        set tmp [tmpfile]
        set f$n $tmp
        set cho [open $tmp w]
        set chi [open $::diff($src) r]
        set lineNo 1
        while {[gets $chi line] >= 0} {
            if {[info exists fix${n}($lineNo)]} {
                foreach {pre post} [set fix${n}($lineNo)] break
                puts $cho $pre
                puts $cho $line
                puts $cho $post
            } else {
                puts $cho $line
            }
            incr lineNo
        }
        close $cho
        close $chi
    }
    cleanupFiles

    catch {exec [info nameofexecutable] diff.tcl $f1 $f2 &}

    set ::diff(aligns) ""
}

# Mark a line as aligned.
proc markAlign {n line text} {
    set ::diff(align$n) $line
    set ::diff(aligntext$n) $text

    if {[info exists ::diff(align1)] && [info exists ::diff(align2)]} {
        set level 1
        if {![string equal $::diff(aligntext1) $::diff(aligntext2)]} {
            set apa [tk_messageBox -icon question -title "Align" -type yesno \
                    -message "Those lines are not equal.\nReally align them?"]
            if {$apa != "yes"} {
                return
            }
            set level 3
        }

        lappend ::diff(aligns) [list $::diff(align1) $::diff(align2) $level]

        unset ::diff(align1)
        unset ::diff(align2)
    }
}

# Called by popup menus over row numbers to add command for alignment.
# Returns 1 of nothing added.
proc alignMenu {m n x y} {
    # Get the row that was clicked
    set index [.ft$n.tl index @$x,$y]
    set row [lindex [split $index "."] 0]

    set data [.ft$n.tl get $row.0 $row.end]
    if {![regexp {\d+} $data line]} {
        return 1
    }
    set text [.ft$n.tt get $row.0 $row.end]

    set other [expr {$n == 1 ? 2 : 1}]
    if {![info exists ::diff(align$other)]} {
        set label "Mark line for alignment"
    } else {
        set label "Align with line $::diff(align$other) on other side"
    }

    .lpm add command -label $label -command [list markAlign $n $line $text]
    return 0
}


proc hlSelect {hl} {
    highLightChange $hl
}

proc hlSeparate {n hl} {
    set ::diff(separate$n) $hl
    if {$hl == ""} {
        set range [.ft$n.tt tag ranges sel]
    } else {
        set range [.ft$n.tl tag ranges hl$::diff(separate$n)]
    }
    set text [eval .ft$n.tt get $range]
    set ::diff(separatetext$n) $text

    if {[info exists ::diff(separate1)] && [info exists ::diff(separate2)]} {
        set tag1 hl$::diff(separate1)
        set tag2 hl$::diff(separate2)
        set range1 [.ft1.tl tag ranges $tag1]
        set range2 [.ft2.tl tag ranges $tag2]
        set text1 [eval .ft1.tt get $range1]
        set text2 [eval .ft2.tt get $range2]

        set f1 [tmpfile]
        set f2 [tmpfile]
        set ch [open $f1 w]
        puts $ch $text1
        puts $ch $::diff(separatetext1)
        close $ch
        set ch [open $f2 w]
        puts $ch $text2
        puts $ch $::diff(separatetext2)
        close $ch

        catch {exec [info nameofexecutable] diff.tcl $f1 $f2 &}

        unset ::diff(separate1)
        unset ::diff(separate2)
    }
}

proc hlPopup {n hl X Y} {
proc hlPopup {n hl X Y x y} {
    if {[info exists ::diff(nopopup)] && $::diff(nopopup)} return
    destroy .lpm
    menu .lpm -tearoff 0

    if {$hl != ""} {
    .lpm add command -label "Select" \
            -command [list hlSelect $hl]
        .lpm add command -label "Select" \
                -command [list hlSelect $hl]
    }

    set other [expr {$n == 1 ? 2 : 1}]
    if {![info exists ::diff(separate$other)]} {
        set label "Mark for Separate Diff"
    } else {
        set label "Separate Diff"
    }

    .lpm add command -label $label -command [list hlSeparate $n $hl]
    alignMenu .lpm $n $x $y

    set ::diff(nopopup) 1
    tk_popup .lpm $X $Y
    after idle {after 1 {set ::diff(nopopup) 0}}

    return -code break
    return
}

proc rowPopup {w X Y x y} {
    if {[info exists ::diff(nopopup)] && $::diff(nopopup)} return
    destroy .lpm
    menu .lpm -tearoff 0

    regexp {\d+} $w n
    if {[alignMenu .lpm $n $x $y]} {
        return
    }

    set ::diff(nopopup) 1
    tk_popup .lpm $X $Y
    after idle {after 1 {set ::diff(nopopup) 0}}
}

proc bindHighlight {} {
    set tag hl$::HighLightCount
    foreach n {1 2} {
        .ft$n.tl tag bind $tag <ButtonPress-3> \
                "hlPopup $n $::HighLightCount %X %Y"
                "hlPopup $n $::HighLightCount %X %Y %x %y ; break"
        .ft$n.tl tag bind $tag <ButtonPress-1> \
                "hlSelect $::HighLightCount"
    }
}

proc zoomRow {w X Y x y} {
    global Pref
    # 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} {
        regexp {\d+} $w n
        hlPopup $n "" $X $Y $x $y
        return
    }

    # Extract the data
    set data1 [.ft1.tt dump -tag -text $row.0 $row.end]
    set data2 [.ft2.tt dump -tag -text $row.0 $row.end]
    if {[llength $data1] == 0 && [llength $data2] == 0} return

    set font [.ft1.tt cget -font]

# Scroll text windows
proc scroll {n what} {
    if {![string match ".ft?.tt" [focus]]} {
        .ft1.tt yview scroll $n $what
    }
}

# Emulate a label that:
# 1 : Displays the right part of the text if there isn't enough room
# 2 : Justfify text to the left if there is enough room.
# 3 : Does not try to allocate space according to its contents
proc fileLabel {w args} {
    eval label $w $args
    set fg [$w cget -foreground]
    set bg [$w cget -background]
    set font [$w cget -font]
    destroy $w

    entry $w -relief flat -bd 0 -foreground $fg -background $bg -font $font
    eval $w configure $args

    $w configure -takefocus 0 -state disabled
    if {[info tclversion] >= 8.4} {
        $w configure -state readonly
    }

    set i [lsearch $args -textvariable]
    if {$i >= 0} {
	set var [lindex $args [expr {$i + 1}]]
	uplevel #0 "trace variable $var w \
		{after idle {$w xview end} ;#}"
    }
}

# Build the main window
proc makeDiffWin {} {
    global Pref tcl_platform debug
    eval destroy [winfo children .]

    wm protocol . WM_DELETE_WINDOW cleanupAndExit

    }
    if {$::diff(cvsExists)} {
        .mf.m add command -label "CVSDiff" -underline 0 -command openCVS
    }
    .mf.m add separator
    .mf.m add command -label "Print" -underline 0 -command doPrint
    .mf.m add separator
    .mf.m add command -label "Quit" -command cleanupAndExit
    .mf.m add command -label "Quit" -underline 0 -command cleanupAndExit

    menubutton .mo -text Options -underline 0 -menu .mo.m
    menu .mo.m
    .mo.m add cascade -label Font -underline 0 -menu .mo.mf
    .mo.m add cascade -label Ignore -underline 0 -menu .mo.mi
    .mo.m add cascade -label Parse -underline 0 -menu .mo.mp
    .mo.m add command -label Colours -underline 0 -command makePrefWin

    button .bfp -text "Prev Diff" -relief raised -command {findDiff -1}
    entry .eo -width 10 -textvariable Pref(dopt)
    label .lo -text "Diff Options"

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

    label .l1 -textvariable diff(leftLabel) -anchor e -width 10
    label .l2 -textvariable diff(rightLabel) -anchor e -width 10
    #label .l1 -textvariable diff(leftLabel) -anchor e -width 10
    #label .l2 -textvariable diff(rightLabel) -anchor e -width 10
    fileLabel .l1 -textvariable diff(leftLabel)
    fileLabel .l2 -textvariable diff(rightLabel)

    frame .ft1 -borderwidth 2 -relief sunken
    text .ft1.tl -height 40 -width 5 -wrap none -yscrollcommand my_yscroll \
            -font myfont -borderwidth 0 -padx 0 -highlightthickness 0
    text .ft1.tt -height 40 -width 80 -wrap none -yscrollcommand my_yscroll \
            -xscrollcommand ".sbx1 set" -font myfont -borderwidth 0 -padx 0 \
            -xscrollcommand ".sbx1 set" -font myfont -borderwidth 0 -padx 1 \
            -highlightthickness 0
    frame .ft1.f -width 2 -height 2 -bg lightgray
    pack .ft1.tl -side left -fill y
    pack .ft1.f -side left -fill y
    pack .ft1.tt -side right -fill both -expand 1
    scrollbar .sby -orient vertical -command "my_yview"
    scrollbar .sbx1 -orient horizontal -command ".ft1.tt xview"

    frame .ft2 -borderwidth 2 -relief sunken
    text .ft2.tl -height 60 -width 5 -wrap none -yscrollcommand my_yscroll \
            -font myfont -borderwidth 0 -padx 0 -highlightthickness 0
    text .ft2.tt -height 60 -width 80 -wrap none -yscrollcommand my_yscroll \
            -xscrollcommand ".sbx2 set" -font myfont -borderwidth 0 -padx 0 \
            -xscrollcommand ".sbx2 set" -font myfont -borderwidth 0 -padx 1 \
            -highlightthickness 0
    frame .ft2.f -width 2 -height 2 -bg lightgray
    pack .ft2.tl -side left -fill y
    pack .ft2.f -side left -fill y
    pack .ft2.tt -side right -fill both -expand 1
    scrollbar .sbx2 -orient horizontal -command ".ft2.tt xview"

    # Set up a tag for incremental search bindings
    textSearch::enableSearch .ft1.tt
    textSearch::enableSearch .ft2.tt

    label .le -textvariable ::diff(eqLabel) -width 1
    label .ls -textvariable ::textSearch::statusLabel -width 1 -pady 0 -padx 0
    canvas .c -width 6 -bd 0 -selectborderwidth 0 -highlightthickness 0

    applyColor
    .ft1.tt tag configure last -underline 1
    .ft2.tt tag configure last -underline 1
    foreach w {.ft1.tt .ft2.tt} {
        $w tag raise sel
        bind $w <ButtonPress-3> "zoomRow %W %X %Y %x %y"
        bind $w <ButtonRelease-3> "unzoomRow"
    }
    foreach w {.ft1.tl .ft2.tl} {
        bind $w <ButtonPress-3> "rowPopup %W %X %Y %x %y"
    }

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

        .md.m add radiobutton -label "Context 10" -variable ::Pref(context) -value 10
        .md.m add radiobutton -label "Context 20" -variable ::Pref(context) -value 20
        .md.m add separator
        .md.m add checkbutton -label Wrap -variable wrapstate -onvalue char\
                -offvalue none -command {.ft1.tt configure -wrap $wrapstate ;\
                .ft2.tt configure -wrap $wrapstate}
        .md.m add command -label "Merge" -command {makeMergeWin}
        .md.m add command -label "Stack trace" -command {bgerror Debug}
        .md.m add command -label "Align" -command {runAlign}
        .md.m add separator
        .md.m add command -label "Reread Source" -command {source $thisscript}
        .md.m add separator
        .md.m add command -label "Redraw Window" -command {makeDiffWin}
        .md.m add separator
        .md.m add command -label "Normal Cursor" -command {normalCursor}
        .md.m add separator

} "" {Bindings} ul {

Up, Down, Page Up and Page Down scrolls main windows.

Escape takes focus out of text windows.

Right mouse button "zooms" a line of text.
Right mouse button "zooms" a line of text. If the text under the cursor
is selected, a menu appears where the selected text can be used for a
separate diff.

Ctrl-s starts incremental search. Incremental search is stopped by Escape
  or Ctrl-g.
or Ctrl-g.

Ctrl-f brings up search dialog. F3 is "search again".

Left mouse click on the line number of a diff highlights it.

Right mouse click on the line number of a diff gives a menu where it can
be selected for separate diff. This can be used to check a block that has

                set diff(limitlines) $arg
            }
            set nextArg ""
            continue
        }
        if {$arg == "-w"} {
            set Pref(ignore) "-w"
        } elseif {$arg == "-h"} {
        } elseif {$arg == "--help"} {
            printUsage
            exit
        } elseif {$arg == "-b"} {
            set Pref(ignore) "-b"
        } elseif {$arg == "-noignore"} {
            set Pref(ignore) " "
        } elseif {$arg == "-noparse"} {

        }
    }
}

proc saveOptions {} {
    global Pref

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

    foreach i [array names Pref] {
        if {$i != "dopt"} {
            puts $ch [list set Pref($i) $Pref($i)]
        }
    }
    close $ch