Eskil

    # Add a dummy if it does not exists.
    proc addBalloon {args} {}
} else {
    namespace import -force psballoon::addBalloon
}

set debug 0
set diffver "Version 2.0b1+  2003-12-09"
set thisScript [file join [pwd] [info script]]
set thisDir [file dirname $thisScript]

# Follow any link
set tmplink $thisScript
while {[file type $tmplink] == "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] ""]}]
set ::util(diffexe) diff
set ::util(diffWrapped) 0

# Experimenting with DiffUtil package
#set ::util(diffutil) [expr {![catch {package require DiffUtil}]}]
set ::util(diffutil) 0

# Figure out a place to store temporary files.
if {[info exists env(TEMP)] && [file writable $env(TEMP)]} {
    set ::diff(tmpdir) $env(TEMP)
} elseif {[info exists env(TMP)] && [file writable $env(TMP)]} {
    set ::diff(tmpdir) $env(TMP)
} elseif {[file writable /tmp]} {
    set ::diff(tmpdir) /tmp
} elseif {[file writable .]} {
    set ::diff(tmpdir) .
} elseif {[file writable ~]} {
    set ::diff(tmpdir) ~
} else {
    # Panic?
    set ::diff(tmpdir) .
}

# Locate a diff executable on windows.
proc locateDiffExe {} {


    # Build a list of possible directories.
    set dirs [list $::thisDir]
    # Are we in a starkit?
    if {[string match "*/lib/app-diff" $::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 "Diff Error" -message \
                "Could not locate any external diff executable." \

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

# This is called when an editor is needed to display a file.
# It sets up the util(editor) variable.
proc locateEditor {} {

    if {[info exists ::util(editor)]} return

    if {$::tcl_platform(platform) == "unix"} {
        set ::util(editor) emacs
    } else {
        set ::util(editor) wordpad
        foreach dir [lsort -decreasing -dictionary \
                             [glob -nocomplain c:/apps/emacs*]] {
            set em [file join $dir bin runemacs.exe]
            set em [file normalize $em]
            if {[file exists $em]} {
                set ::util(editor) $em
                break
            }
        }
    }
}

# This function is called when a toplevel is closed.

}

# Compare two lines and rate how much they resemble each other.
# This has never worked well. Some day I'll sit down, think this through,
# and come up with a better algorithm.
proc compareLines2 {line1 line2} {
    compareLines $line1 $line2 res1 res2 1
    if {$::util(diffutil)} {
        compareLinesX $line1 $line2 xres1 xres2 1
        if {$res1 != $xres1 || $res2 != $xres2} {
            tk_messageBox -title "Rate Mismatch!" \
                    -message ":$res1:\n:$res2:\n:$xres1:\n:$xres2:"
        }
    }
    # Collect identical pieces and different pieces

            return
        }
        set ::diff(filterflag) 0
    }

    if {$Pref(parse) != 0} {
        compareLines $line1 $line2 res1 res2
        if {$::util(diffutil)} {
            compareLinesX $line1 $line2 xres1 xres2
            if {$res1 != $xres1 || $res2 != $xres2} {
                tk_messageBox -title Mismatch! \
                        -message ":$res1:\n:$res2:\n:$xres1:\n:$xres2:"
            }
        }
        set dotag 0

# Process one of the change/add/delete blocks reported by diff.
# 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
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 "only diffs" is on, just display a couple of context lines.
        set limit -1
        if {$Pref(onlydiffs) == 1} {
            set limit $Pref(context)
        }
	# Consider any total limit on displayed lines.
        if {$::diff($top,limitlines)} {
            set limit [expr {$::diff($top,limitlines) - $::diff($top,mapMax)}]
            if {$limit < 0} {
                set limit 0
            }
        }
        set t 0
        while {[gets $ch2 apa] != -1} {
            insertLine $top 2 $doingLine2 $apa
            incr doingLine2
            incr ::diff($top,mapMax)
            incr t
            if {$limit >= 0 && $t >= $limit} break
        }
        set t 0
        while {[gets $ch1 apa] != -1} {
            insertLine $top 1 $doingLine1 $apa
            incr doingLine1

    while {$doingLine1 < $line1} {
        gets $ch1 apa
        gets $ch2 bepa
        if {$limit < 0 || ($t < $limit && $doingLine1 > $limit) || \
                ($line1 - $doingLine1) <= $limit} {
            insertLine $top 1 $doingLine1 $apa
            insertLine $top 2 $doingLine2 $bepa
            incr ::diff($top,mapMax)
        } elseif {$t == $limit} {
            emptyLine $top 1 0
            emptyLine $top 2 0
            incr ::diff($top,mapMax)
        }
        incr doingLine1
        incr doingLine2
        incr t
        if {$::diff($top,limitlines) && \
                ($::diff($top,mapMax) > $::diff($top,limitlines))} {
            return
        }
    }
    # This should not happen unless something is wrong...
    if {$doingLine2 != $line2} {
        $::diff($top,wDiff1) insert end \
                "**Bad alignment here!! $doingLine2 $line2**\n"

            gets $ch1 textline1
            gets $ch2 textline2
            insertMatchingLines $top $textline1 $textline2
        }
        if {$::diff(filter) != "" &&  $::diff(filterflag)} {

        } else {
            lappend ::diff($top,changes) [list $::diff($top,mapMax) $n1 \
                    change $line1 $n1 $line2 $n2]
        }
        incr ::diff($top,mapMax) $n1
    } else {
        if {$n1 != 0 && $n2 != 0 && $Pref(parse) >= 2 && \
                ($n1 * $n2 < 1000 || $Pref(parse) == 3)} {
            # Full block parsing
            set block1 {}
            for {set t 0} {$t < $n1} {incr t} {
                gets $ch1 apa
                lappend block1 $apa
            }
            set block2 {}
            for {set t 0} {$t < $n2} {incr t} {
                gets $ch2 apa
                lappend block2 $apa
            }
            set apa [insertMatchingBlocks $top $block1 $block2]

            lappend ::diff($top,changes) [list $::diff($top,mapMax) $apa \
                    change $line1 $n1 $line2 $n2]
            incr ::diff($top,mapMax) $apa
        } else {
            # No extra parsing at all.
            for {set t 0} {$t < $n1} {incr t} {
                gets $ch1 apa
                insertLine $top 1 $doingLine1 $apa $tag1
                incr doingLine1
            }
            for {set t 0} {$t < $n2} {incr t} {
                gets $ch2 apa
                insertLine $top 2 $doingLine2 $apa $tag2
                incr doingLine2
            }
            if {$n1 <= $n2} {
                for {set t $n1} {$t < $n2} {incr t} {
                    emptyLine $top 1
                }
                lappend ::diff($top,changes) [list $::diff($top,mapMax) \
                        $n2 $tag2 $line1 $n1 $line2 $n2]
                incr ::diff($top,mapMax) $n2
            } elseif {$n2 < $n1} {
                for {set t $n2} {$t < $n1} {incr t} {
                    emptyLine $top 2
                }
                lappend ::diff($top,changes) [list $::diff($top,mapMax) \
                        $n1 $tag1 $line1 $n1 $line2 $n2]
                incr ::diff($top,mapMax) $n1
            }
        }
    }
}

proc enableRedo {top} {
    $top.mf.m entryconfigure "Redo Diff" -state normal
    $top.mt.m entryconfigure "Merge"     -state normal
}

proc disableRedo {top} {
    $top.mf.m entryconfigure "Redo Diff" -state disabled
    $top.mt.m entryconfigure "Merge"     -state disabled
}

proc busyCursor {top} {
    global oldcursor oldcursor2
    if {![info exists oldcursor]} {
        set oldcursor [. cget -cursor]
        set oldcursor2 [$::diff($top,wDiff1) cget -cursor]
    }
    $top config -cursor watch
    foreach item {wLine1 wDiff1 wLine2 wDiff2} {
        if {[info exists ::diff($top,$item)]} {
            set w $::diff($top,$item)
            $w config -cursor watch
        }
    }
}

proc normalCursor {top} {
    global oldcursor oldcursor2
    $top config -cursor $oldcursor
    foreach item {wLine1 wDiff1 wLine2 wDiff2} {
        if {[info exists ::diff($top,$item)]} {
            set w $::diff($top,$item)
            $w config -cursor $oldcursor2
        }
    }
}

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

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

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

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

    set ch [open $diff($top,patchFile) r]

            set rightRE {^\+\+\+\s+(.*)$}
        }
        if {$state == "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 == "newfile" && [regexp $rightRE $line -> sub]} {
            emptyLine $top 2
            insertLine $top 2 "" $divider
            insertLine $top 2 "" $sub
            insertLine $top 2 "" $divider

    }
}

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


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

    busyCursor $top

    # Clear up everything before starting processing
    foreach item {wLine1 wDiff1 wLine2 wDiff2} {
        set w $::diff($top,$item)
        $w configure -state normal
        $w delete 1.0 end
    }
    set ::diff($top,changes) {}
    set ::diff($top,mapMax) 0
    set ::HighLightCount 0
    highLightChange $top -1
    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) "*"

        normalCursor $top
        return
    } else {
        prepareFiles $top
    }

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

                }
                d {
                    # Gap in right, new in left
                    doText $top $ch1 $ch2 $n1 0 $line1 [expr {$line2 + 1}]
                }
            }
        }
        if {$::diff($top,limitlines) && \
                ($::diff($top,mapMax) > $::diff($top,limitlines))} {
            break
        }
        bindHighlight $top
        incr ::HighLightCount

        # Get one update when the screen has been filled.
        # Show the first diff.
        if {$firstview && $::diff($top,mapMax) > 100} {
            set firstview 0
            showDiff $top 0
            update idletasks
        }
        if {0 && [incr t] >= 10} {
	    update idletasks
	    $::diff($top,wLine2) see end

#####################################
# Highlight and navigation stuff
#####################################

# Scroll windows to next/previous diff
proc findDiff {top delta} {



    showDiff $top [expr {$::diff($top,currHighLight) + $delta}]
}

# Scroll a text window to view a certain range, and possibly some
# lines before and after.
proc seeText {w si ei} {
    $w see $ei
    $w see $si
    $w see $si-5lines
    $w see $ei+5lines
    if {[llength [$w bbox $si]] == 0} {
        $w yview $si-5lines
    }
    if {[llength [$w bbox $ei]] == 0} {
        $w yview $si
    }
}

# Highlight a diff
proc highLightChange {top n} {
    if {[info exists ::diff($top,currHighLight)] && \
            $::diff($top,currHighLight) >= 0} {
        $::diff($top,wLine1) tag configure hl$::diff($top,currHighLight) \
                -background {}
        $::diff($top,wLine2) tag configure hl$::diff($top,currHighLight) \
                -background {}
    }
    set ::diff($top,currHighLight) $n
    if {$::diff($top,currHighLight) < 0} {
        set ::diff($top,currHighLight) -1
    } elseif {$::diff($top,currHighLight) >= [llength $::diff($top,changes)]} {
        set ::diff($top,currHighLight) [llength $::diff($top,changes)]
    } else {
        $::diff($top,wLine1) tag configure hl$::diff($top,currHighLight) \
                -background yellow
        $::diff($top,wLine2) tag configure hl$::diff($top,currHighLight) \
                -background yellow
    }
}

# Highlight a diff and scroll windows to it.
proc showDiff {top num} {


    highLightChange $top $num

    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 == ""} {
        set line1 end
        set line2 end
    } else {
        set line2 [expr {$line1 + [lindex $change 1]}]

        incr line1
        set line1 $line1.0
        set line2 $line2.0
    }

    foreach item {wLine1 wDiff1 wLine2 wDiff2} {
        set w $::diff($top,$item)

}

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

proc drawMap {top newh} {
    global Pref

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

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

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

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

# Get all data from the files to merge
proc collectMergeData {top} {
    global diff
    # FIXA separate merge variables per top
    global mergeSelection
    global leftMergeData rightMergeData

    set leftMergeData {}
    set rightMergeData {}

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

    if {$diff($top,mode) == "RCS" || $diff($top,mode) == "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]
    set doingLine1 1
    set doingLine2 1
    set changeNo 0
    foreach change $::diff($top,changes) {
        foreach {start length type line1 n1 line2 n2} $change break
        set data1 {}
        set data2 {}
        while {$doingLine1 < $line1} {
            gets $ch1 apa
            append data1 $apa\n
            incr doingLine1
        }

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

# Procedures for common y-scroll
# FIXA: Move these to a package

proc commonYScroll_YView {sby args} {
    global yscroll
    foreach w $yscroll($sby) {
        eval [list $w yview] $args
    }
}

    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]

    grid $l.old1 $l.old2 -sticky w -padx 4 -pady 4
    grid $l.new1 $l.new2 -sticky w -padx 4 -pady 4
    grid $l.change -     -sticky e -padx 4 -pady 4
    grid columnconfigure $l 1 -weight 1
}

proc makeRegistryWin {} {
    global thisScript

    # Locate executable for this program
    set exe [info nameofexecutable]
    if {[regexp {^(.*wish)\d+\.exe$} $exe -> pre]} {
        set alt $pre.exe
        if {[file exists $alt]} {
            set a [tk_messageBox -icon question -title "Which Wish" -message \

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

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

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

    button $top.close -text "Close" -width 10 -command [list destroy $top] \
            -default active
    pack $top.close -side bottom -pady 4

}

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

proc makeNuisance {top {str {Hi there!}}} {


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

    destroy $top.nui
    toplevel $top.nui
    wm transient $top.nui $top