Eskil

#   Usage
#             Do 'diff.tcl' for interactive mode
#             Do 'diff.tcl -h' for command line usage
#
#   Author    Peter Spjuth  980612
#
#   Revised   Date     Remark
#             
#
#     1.0     980612   New Version.
#     1.1     980807   Parsing of change blocks added
#                      Options menu and variables changed
#                      Command line options added
#     1.2     980818   Improved yscroll
#                      Added map next to y-scrollbar
#     1.3     980921   Added Prev Diff button

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

set debug 1
set diffver "Version 1.9.4b  2002-05-14"
set debug 0
set diffver "Version 1.9.5  2002-08-09"
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
set ::diff(diffutil) [expr {![catch {package require DiffUtil}]}]
set ::diff(diffutil) 0

if {[info exists env(TEMP)]} {
    set ::diff(tmpdir) $env(TEMP)
} elseif {[info exists env(TMP)]} {
    set ::diff(tmpdir) $env(TMP)
} else {
    if {$tcl_platform(platform) == "windows"} {

        catch {file delete $f}
    }
    set ::tmpfiles {}
}

# 2nd stage line parsing
# Recursively look for common substrings in strings s1 and s2
# The strings are known to not have anything in common at start or end.
# The return value is, for each string, a list where the second, fourth etc.
# element is equal between the strings.
# This is sort of a Longest Common Subsequence algorithm but with
# a preference for long consecutive substrings, and it does not look
# for really small substrings.
##syntax compareMidString x x n n x?
proc compareMidString {s1 s2 res1Name res2Name {test 0}} {
    global Pref
    upvar $res1Name res1
    upvar $res2Name res2

    set len1 [string length $s1]

        compareMidString $right1 $right2 right1 right2 $test

        set res1 [concat $left1 [list $mid1] $right1]
        set res2 [concat $left2 [list $mid2] $right2]
    }
}

# Experiment using DiffUtil
proc compareLinesX {line1 line2 res1Name res2Name {test 0}} {
    global Pref
    upvar $res1Name res1
    upvar $res2Name res2

    set args "$Pref(ignore)\
            [expr {($Pref(lineparsewords) && !$test) ? "-word" : ""}]"
    eval DiffUtil::compareLines $args \$line1 \$line2 res1 res2
}

# Compare two lines to find inequalities to highlight.
# The return value is, for each line, a list where the first, third etc.
# element is equal between the lines. The second, fourth etc. will be
# highlighted.
##syntax compareLines x x n n x?
proc compareLines {line1 line2 res1Name res2Name {test 0}} {
    global Pref
    upvar $res1Name res1
    upvar $res2Name res2

    # This processes the lines from both ends first.
    # A typical line has few changes thus this gets rid of most
    # equalities. The middle part is then optionally parsed further.

    if {$Pref(ignore) != " "} {
        # Skip white space in both ends

        set apa1 [string trimleft $line1]
        set leftp1 [expr {[string length $line1] - [string length $apa1]}]
        set mid1 [string trimright $line1]

        set right2 [string range $line2 [expr {$t2 + 1}] end]
        set mid2 [string range $line2 $leftp2 $t2]
        set left2 [string range $line2 0 [expr {$leftp2 - 1}]]
        set res2 [list $left2 $mid2 $right2]

        if {$Pref(extralineparse) != 0 && $mid1 != "" && $mid2 != ""} {
            compareMidString $mid1 $mid2 mid1 mid2 $test

            # Replace middle element in res* with list elements from mid*
            #set res1 [eval lreplace \$res1 1 1 $mid1]
            #set res2 [eval lreplace \$res2 1 1 $mid2]
            # This makes use of pure-list optimisation in eval
            set res1 [eval [linsert $mid1 0 lreplace $res1 1 1]]
            set res2 [eval [linsert $mid2 0 lreplace $res2 1 1]]
        }

        insert 1 $doingLine1 $line1 change
        insert 2 $doingLine2 $line2 change
    }
    incr doingLine1
    incr doingLine2
}

# Insert two blocks of lines in the compare windows.
# Returns number of lines used to display the blocks
proc insertMatchingBlocks {block1 block2} {
    global doingLine1 doingLine2

    set apa [compareBlocks $block1 $block2]

    set t1 0
    set t2 0
    foreach c $apa {
        if {$c == "c"} {
            set textline1 [lindex $block1 $t1]
            set textline2 [lindex $block2 $t2]
            insertMatchingLines $textline1 $textline2
            incr t1
            incr t2
        }
        if {$c == "C"} {
	    # This is two lines that the block matching considered
	    # too different to use line parsing on them.
	    # Marked the whole line as deleted/inserted
            set textline1 [lindex $block1 $t1]
            set textline2 [lindex $block2 $t2]
            .ft1.tl insert end [myforml $doingLine1] \
                    "hl$::HighLightCount change"
            .ft1.tt insert end "$textline1\n" new1
            .ft2.tl insert end [myforml $doingLine2] \
                    "hl$::HighLightCount change"

    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(limitlines)} {
            set limit [expr {$::diff(limitlines) - $mapMax}]
            if {$limit < 0} {
                set limit 0
            }
        }
        set t 0

            incr doingLine1
            incr t
            if {$limit >= 0 && $t >= $limit} break
        }
        return
    }

    # Is this a change block, a delete block or a insert block?
    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
    # If only diff is on, only skip a section if the blank
    # line replaces at least 3 lines.
    set limit -1

        incr doingLine1
        incr doingLine2
        incr t
        if {$::diff(limitlines) && $mapMax > $::diff(limitlines)} {
            return
        }
    }
    # This should not happen unless something is wrong...
    if {$doingLine2 != $line2} {
        .ft1.tt insert end "**Bad alignment here!! $doingLine2 $line2**\n"
        .ft2.tt insert end "**Bad alignment here!! $doingLine2 $line2**\n"
        .ft1.tl insert end "\n"
        .ft2.tl insert end "\n"
    }

        set differr [catch {eval DiffUtil::diffFiles $Pref(ignore) \
                \$diff(leftFile) \$diff(rightFile)} diffres]
    } else {
        set differr [catch {eval exec \$::diff(diffexe) \
                $Pref(dopt) $Pref(ignore) \
                \$diff(leftFile) \$diff(rightFile)} diffres]
    }

    set apa [split $diffres "\n"]
    set result {}
    foreach i $apa {
        if {[string match {[0-9]*} $i]} {
            lappend result $i
        }
    }

                }
            }
        }
        if {$::diff(limitlines) && $::mapMax > $::diff(limitlines)} {
            break
        }
        if {[incr t] >= 10} {
            update idletasks
            .ft2.tl see end
            update idletasks
	    update idletasks
	    .ft2.tl see end
	    update idletasks
            set t 0
        }
        bindHighlight
        incr ::HighLightCount
    }

    dotext $ch1 $ch2 0 0 0 0

    # Make sure all text widgets have the same number of lines.
    # The common y scroll doesn't work well if not.

# Highlight a diff and scroll windows to it.
proc showDiff {num} {
    global CurrentHighLight changesList

    highLightChange $num

    set line1 [lindex $changesList [expr {$CurrentHighLight * 7}]]
    

    if {$CurrentHighLight < 0} {
        set line1 1.0
        set line2 1.0
    } elseif {$line1 == ""} {
        set line1 end
        set line2 end
    } else {

    global leftMergeData rightMergeData

    set w .merge.t
    # Delete current string
    $w delete merges$no mergee$no

    set mergeSelection($no) $new
    

    set i [expr {$no * 2 + 1}]
    set diffLeft [lindex $leftMergeData $i]
    set diffRight [lindex $rightMergeData $i]

    if {$mergeSelection($no) == 12} {
        $w insert merges$no $diffLeft$diffRight merge$no
    } elseif {$mergeSelection($no) == 21} {

    button $w.f.bl -text "All L" -command {selectMergeAll 1}
    button $w.f.br -text "All R" -command {selectMergeAll 2}

    button $w.f.b1 -text "Prev" -command {nextMerge -1}
    button $w.f.b2 -text "Next" -command {nextMerge 1}
    bind $w <Key-Down> {focus .merge ; nextMerge 1}
    bind $w <Key-Up>   {focus .merge ; nextMerge -1}
    bind $w <Shift-Key-Down> {focus .merge ; nextMerge 10}
    bind $w <Shift-Key-Up>   {focus .merge ; nextMerge -10}

    button $w.f.bs -text "Save" -command saveMerge
    button $w.f.bq -text "Close" -command closeMerge
    wm protocol $w WM_CLOSE_WINDOW closeMerge

    grid $w.f.rb1 $w.f.rb2 $w.f.rb3 $w.f.rb4 x $w.f.b1 $w.f.b2 x \
            $w.f.bl $w.f.br x x x $w.f.bs $w.f.bq

    # This shouldn't happen
    if {$isearchW != ""} {
        endIncrementalSearch
    }

    set isearchW $w
    

    # Setup all bindings for incremental search
    bind ISearch <Control-Key-s> "textSearch::isearchAgain %W ; break"
    bind ISearch <Key-Delete>    "textSearch::isearchBack %W ; break"
    bind ISearch <Key-BackSpace> "textSearch::isearchBack %W ; break"
    bind ISearch <Key>           "textSearch::isearchKey %W %A %s %K"
    bind ISearch <Key-Escape>    "textSearch::endIncrementalSearch ; break"
    bind ISearch <Control-Key-g> "textSearch::endIncrementalSearch ; break"
    bind ISearch <FocusOut>      "textSearch::endIncrementalSearch"
    

    # Initialise variables
    set ::textSearch::isearchString ""
    set ::textSearch::isearchHistory {}
    set ::textSearch::isearchIndex [$w index insert]
    set ::textSearch::statusLabel "i"
}

        endIncrementalSearch
        return
    }
    if {[llength $::textSearch::isearchHistory] < 2} {
        bell
        return
    }
    

    set str [lindex $::textSearch::isearchHistory end]
    set found [lindex $::textSearch::isearchHistory end-1]
    set ::textSearch::isearchHistory \
            [lrange $::textSearch::isearchHistory 0 end-2]
    

    isearchShow $w $found $str
}

# End an incremental search
proc textSearch::endIncrementalSearch {} {

    set ::textSearch::isearchW ""
    set ::textSearch::statusLabel ""

    # Remove all bindings from ISearch
    foreach b [bind ISearch] {
        bind ISearch $b ""
    }
    

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

# Dialog functions from "Practical Programming in Tcl And Tk" by Welch.
proc textSearch::DialogCreate {top title args} {
    variable dialog
    if {[winfo exists $top]} {

        wm title $top $title
        return 1
    }
}

proc textSearch::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} {

# Ask for a search string
proc textSearch::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\
                -variable ::textSearch::searchCase
        

        button $f.ok     -text OK     -width 7 \
                -command {set ::textSearch::prompt(ok) 1}
        button $f.cancel -text Cancel -width 7 \
                -command {set ::textSearch::prompt(ok) 0}

        grid $f.msg   - - -sticky w
        grid $f.entry - - -sticky we

        return
    }

    $searchWin see $searchPos
    $searchWin tag remove sel 1.0 end
    $searchWin tag add sel $searchPos "$searchPos + $cnt chars"
    set searchIndex $searchPos
}      
}

# Search again
proc textSearch::searchNext {} {
    variable searchString
    variable searchWin
    variable searchCase
    variable searchIndex

    if {$searchString == ""} return

    if {$searchCase} {
        set searchPos [$searchWin search -count cnt \
                $searchString "$searchIndex + 1 chars"]
    } else {
        set searchPos [$searchWin search -count cnt -nocase \
                $searchString "$searchIndex + 1 chars"]
    }
    

    if {$searchPos == "" || $searchPos == $searchIndex} {
        tk_messageBox -message "String not found!" -type ok -title Search
        return
    }

    $searchWin see $searchPos
    $searchWin tag remove sel 1.0 end

        set searchPos [$searchWin search -count cnt -backwards \
                $searchString "$searchIndex - 1 chars"]
    } else {
        set searchPos [$searchWin search -count cnt -backwards \
                -nocase \
                $searchString "$searchIndex - 1 chars"]
    }
    

    if {$searchPos == "" || $searchPos == $searchIndex} {
        tk_messageBox -message "String not found!" -type ok -title Search
        return
    }

    $searchWin see $searchPos
    $searchWin tag remove sel 1.0 end

        pack .dp.b -side bottom
        pack .dp.l -side top
    }
}

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

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

}

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

proc hlSelect {hl} {
    highLightChange $hl
}

proc hlSeparate {n hl} {
    set ::diff(separate$n) $hl

    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
        close $ch
        set ch [open $f2 w]
        puts $ch $text2
        close $ch

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

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

proc hlPopup {n hl X Y} {
    destroy .lpm
    menu .lpm -tearoff 0
    .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]

    tk_popup .lpm $X $Y

    return -code break
}

proc bindHighlight {} {
    set tag hl$::HighLightCount
    foreach n {1 2} {
        .ft$n.tl tag bind $tag <ButtonPress-3> \
                "hlPopup $n $::HighLightCount %X %Y"
        .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]

    # 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]
    set wx $X
    set wy [expr {$Y + 4}]

    destroy .balloon
    toplevel .balloon -bg black
    wm withdraw .balloon
    wm overrideredirect .balloon 1
    

    set wid 0
    foreach x {1 2} {
        text .balloon.t$x -relief flat -font $font -bg #ffffaa -fg black \
                -padx 2 -pady 0 -height 1 -wrap word
        .balloon.t$x tag configure new1 -foreground $Pref(colornew1) \
                -background $Pref(bgnew1)
        .balloon.t$x tag configure change -foreground $Pref(colorchange) \
                -background $Pref(bgchange)
        .balloon.t$x tag configure new2 -foreground $Pref(colornew2) \
                -background $Pref(bgnew2)
        pack .balloon.t$x -side top -padx 1 -pady 1 -fill both -expand 1
        

        set data [set data$x]
        set tags {}
        foreach {key value index} $data {
            if {$key == "tagon"} {
                lappend tags $value
                set tags [lsort -unique $tags]
            } elseif {$key == "tagoff"} {
                set i [lsearch $tags $value]
                if {$i >= 0} {
                    set tags [lreplace $tags $i $i]
                }
            } else {
                .balloon.t$x insert end $value $tags
            }
        }
        set text [.balloon.t$x get 1.0 1.end]
        regsub -all "\t" $text "        " text
        .balloon.t$x configure -width [string length $text]
    }
    

    # Let geometry requests propagate
    update idletasks

    # Is the balloon within the diff window?
    set wid [winfo reqwidth .balloon]
    if {$wid + $wx > [winfo rootx .] + [winfo width .]} {
        # No.
        # Center on diff window
        set wx [expr {([winfo width .] - $wid) / 2 + [winfo rootx .]}]
        if {$wx < 0} {set wx 0}
        # Is the balloon not within the screen?
        if {$wx + $wid > [winfo screenwidth .]} {
            # Center in screen
            set wx [expr {([winfo screenwidth .] - $wid) / 2}]
            if {$wx < 0} {set wx 0}
        }
    }
            

    # Does the balloon fit within the screen?
    if {$wid > [winfo screenwidth .]} {
        # How many rows does it take?
        set rows [expr {ceil(double($wid) / [winfo screenwidth .])}]
        # Add rows and fill screen width
        .balloon.t1 configure -height $rows
        .balloon.t2 configure -height $rows

    .mo.mp add radiobutton -label "Words" -variable Pref(lineparsewords) \
            -value "1"
    .mo.mp add separator
    .mo.mp add checkbutton -label "Use 2nd stage" \
            -variable Pref(extralineparse)
    .mo.mp add checkbutton -label "Mark last" -variable Pref(marklast)

    menubutton .ms -text Search -underline 0 -menu .ms.m 
    menubutton .ms -text Search -underline 0 -menu .ms.m
    menu .ms.m
    textSearch::searchMenu .ms.m

    menubutton .mh -text Help -underline 0 -menu .mh.m
    menu .mh.m
    .mh.m add command -label "Help" -command makeHelpWin
    .mh.m add command -label "About" -command makeAboutWin

    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 .ft1.tl .ft2.tt .ft2.tl} {
    foreach w {.ft1.tt .ft2.tt} {
        bind $w <ButtonPress-3> "zoomRow %W %X %Y %x %y"
        bind $w <ButtonRelease-3> "unzoomRow"
    }

    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

    wm transient .nui .
    wm geometry .nui +400+400
    wm title .nui ""
    label .nui.l -image nuisance
    pack .nui.l
    wm protocol .nui WM_DELETE_WINDOW {destroy .nui2 .nui}
    update
    

    destroy .nui2
    toplevel .nui2 -bg yellow
    wm transient .nui2 .nui
    wm overrideredirect .nui2 1
    wm title .nui2 ""
    label .nui2.l -text "$str\nDo you want help?" -justify left -bg yellow
    button .nui2.b -text "No, get out of my face!" -command {destroy .nui2 .nui} -bg yellow

             Mark last  : Last change of a line is underlined
  Colours  : Choose highlight colours.
  Diffs only : Only differing lines will be displayed.
  Force crlf translation : (Windows only) Use crlf mode when reading files.
  Save default: Save current option settings in ~/.diffrc

Diff Options Field: Any text written here will be passed to diff.
                    In RCS/CVS mode, any -r options will be used to select
                    versions.
                    In RCS/CVS mode, any -r options will be used internally
                    to select versions.

Prev Diff Button: Scrolls to the previous differing block, or to the top
                  if there are no more diffs.
Next Diff Button: Scrolls to the next differing block, or to the bottom
                  if there are no more diffs.

Equal sign: Above the vertical scrollbar, a "=" will appear if the files
            are equal.
            are equal. While the external diff executes a "*" is shown
            and is replaced with "=" or "" before the files are displayed
            to give that information early.

} "" {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.

Ctrl-s starts incremental search. Incremental search is stopped by Escape
  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
been moved.

} "" {Merge Window (Appears in conflict mode)} ul {

You can, for each difference, select which version you want to appear
in the output file. The buttons "LR", "L", "R" and "RL" select the
lines from the left file, right file or both files.
"Prev" and "Next" buttons moves between differences.
"All L" and "All R" buttons select "L" or "R" for all differences.
"Pure" ...
"Save" saves the merge result to a file.

On the keyboard, Up and Down keys means the same as "Prev" and "Next".
Left and Right keys selects "L" and "R".

When saved it is the contents of the text widget that is saved which
means you can hand edit there if you are careful. E.g. you can't use
cursor keys, but you can type text, delete text and copy/paste with
mouse assistance.

} "" {Examples of effects of parse options.} ul {

Below are two example files, and five different results when using
different options with those files.

Left file:                       Right file:

  -noignore   : Don't ignore any whitespace.
  -b          : Ignore space changes. Default.
  -w          : Ignore all spaces.

  -conflict   : Treat file as a merge conflict file and enter merge
                mode.
  -o <file>   : Specify merge result output file. 
  -o <file>   : Specify merge result output file.

  -browse     : Automatically bring up file dialog after starting.
  -server     : Set up diff to be controllable from the outside.

  -print <file> : Generate postscript and exit.

  -limit <lines> : Do not process more than <lines> lines.

                set diff(patchFile) $fullname
                set autobrowse 0
                if {$noautodiff} {
                    enableRedo
                } else {
                    after idle doDiff
                }
            }   
            }
        }
    } elseif {$len >= 2} {
        set fullname [file join [pwd] [lindex $files 0]]
        set fulldir [file dirname $fullname]
        set diff(leftDir) $fulldir
        set diff(leftFile) $fullname
        set diff(leftLabel) $fullname

    set Pref(dopt) ""
    set Pref(parse) 2
    set Pref(lineparsewords) "0"
    set Pref(extralineparse) 1
    set Pref(colorchange) red
    set Pref(colornew1) darkgreen
    set Pref(colornew2) blue
    set Pref(bgchange) gray
    set Pref(bgnew1) gray
    set Pref(bgnew2) gray
    set Pref(bgchange) #ffe0e0
    set Pref(bgnew1) #a0ffa0
    set Pref(bgnew2) #e0e0ff
    set Pref(onlydiffs) 0
    set Pref(context) 2
    set Pref(crlf) 0
    set Pref(marklast) 1

    if {[file exists "~/.diffrc"]} {
        source "~/.diffrc"