Eskil

#                               Regular screen updates during processing.
#                               Added CVS support.
#
#-----------------------------------------------
# the next line restarts using wish \
exec wish "$0" "$@"

set debug 1
set diffver "Version 1.8b  000508"
set tmpcnt 0
set tmpfiles {}
set thisscript [file join [pwd] [info script]]
set thisdir [file dirname $thisscript]

if {$tcl_platform(platform) == "windows"} {
    cd $thisdir
    package require dde
}

# Support for FreeWrap. If diff.exe is wrapped, copy it so we can use it.
set diffexe diff
if {[info exists _freewrap_contents] && [file exists diff.exe]} {
    set inch [open diff.exe r]
    if {[info exists env(TEMP)]} {
        set diffexe [file join $env(TEMP) diff.exe]
    } elseif {[info exists env(TMP)]} {
        set diffexe [file join $env(TMP) diff.exe]
    } else {
        set diffexe [file join c:/ diff.exe]
    }
    set outch [open $diffexe w]
    fconfigure $inch -translation binary
    fconfigure $outch -translation binary
    puts -nonewline $outch [read $inch]
    close $inch
    close $outch
    set debug 0
}

proc cleanupAndExit {} {
    if {$::diffexe != "diff"} {
        file delete $::diffexe
    }
    cleartmp
    exit
}

proc myform {lineNo text} {
    return [format "%3d: %s\n" $lineNo $text]
}

proc myforml {lineNo} {
    return [format "%3d: \n" $lineNo]

    }
}

#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

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

        compareMidString $mid1 $mid2 mid1 mid2 $test
        set res1 [eval lreplace \$res1 1 1 $mid1]
        set res2 [eval lreplace \$res2 1 1 $mid2]
    }
}

#Count how many characters are common between two lines
proc compareLines2 {line1 line2} {
    compareLines $line1 $line2 res1 res2 1

    #Add lengths of every other element
    set sumsame 0
    set sumdiff1 0
    set sumdiff2 0
    foreach {same diff} $res1 {
        incr sumsame [string length $same]

    set result {}
    set scores {}
    foreach line1 $block1 {
        set bestscore -100000
        set bestline 0
        set i 0
        foreach line2 $block2 {  
            set x [compareLines2 $line1 $line2]
            if {$x > $bestscore} {
                set bestscore $x
                set bestline $i
            }
            incr i
        }
        lappend result $bestline

    set scores {}
    set j 0
    foreach line1 $block1 {
        set bestscore -100000
        set bestline 0
        set i 0
        foreach line2 $block2 {  
            set x [compareLines2 $line1 $line2]
            if {$x > $bestscore} {
                set bestscore $x
                set bestline $i
            }
            incr i
        }
        set result($j) $bestline

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

    if {$Pref(parse) != 0} {
        compareLines $line1 $line2 res1 res2
        set dotag 0
        set n [maxabs [llength $res1] [llength $res2]]
        .ft1.tl insert end [myforml $doingLine1] change
        .ft2.tl insert end [myforml $doingLine2] change
        set new1 new1
        set new2 new2
        set change change

proc prepareRCS {} {
    global leftFile rightFile RCSFile leftLabel rightLabel Pref RCSmode

    set revs {}
    set opts {}
    set Pref(old_dopt) $Pref(dopt)

    set nextIsRev 0
    foreach opt $Pref(dopt) {
        if {$nextIsRev} {
            lappend revs $opt
            set nextIsRev 0
        } elseif {[string equal "-r" $opt]} {
            set nextIsRev 1
        } elseif {[string match "-r*" $opt]} {
            lappend revs [string range $opt 2 end]
        } else {
            lappend opts $opt
        }
    }

    switch [llength $revs] {

            set r [lindex $revs 0]
            set leftFile [tmpfile]
            set rightLabel $RCSFile
            set rightFile $RCSFile

            if {$RCSmode == 2} {
                set leftLabel "$RCSFile (CVS $r)"
                catch {exec cvs update -p -r $r [file nativename $RCSFile] > $leftFile}
            } else {
                set leftLabel "$RCSFile (RCS $r)"
                catch {exec co -p$r [file nativename $RCSFile] > $leftFile}
            }
        }
        default {
            set r1 [lindex $revs 0]
            set r2 [lindex $revs 1]
            set leftFile [tmpfile]
            set rightFile [tmpfile]
            
            if {$RCSmode == 2} {
                set leftLabel "$RCSFile (CVS $r1)"
                set rightLabel "$RCSFile (CVS $r2)"
                catch {exec cvs update -p -r $r1 [file nativename $RCSFile] > $leftFile}
                catch {exec cvs update -p -r $r2 [file nativename $RCSFile] > $rightFile}
            } else {
                set leftLabel "$RCSFile (RCS $r1)"
                set rightLabel "$RCSFile (RCS $r2)"
                catch {exec co -p$r1 [file nativename $RCSFile] > $leftFile}
                catch {exec co -p$r2 [file nativename $RCSFile] > $rightFile}
            }
        }

    update idletasks

    if {$RCSmode} {
        prepareRCS
    }

    set differr [catch {eval exec $::diffexe $Pref(dopt) $Pref(ignore) \
            \$leftFile \$rightFile} diffres]
    
    set apa [split $diffres "\n"]
    set result {}
    foreach i $apa {
        if {[string match {[0-9]*} $i]} {
            lappend result $i
        }

proc printDiffs {} {
    busyCursor
    update idletasks
    set tmpFile [file nativename ~/tcldiff.enscript]
    set tmpFile2 [file nativename ~/tcldifftmp.ps]
    set tmpFile3 [file nativename ~/tcldiff.ps]


    set lines1 {}
    set lines2 {}

    set tdump1 [.ft1.tt dump -tag -text 1.0 end]
    set tdump2 [.ft2.tt dump -tag -text 1.0 end]

            }
        } elseif {$w2 > $w1} {
            for {set t $w1} {$t < $w2} {incr t} {
                lappend wraplines1 ""
            }
        }
    }

    set ch [open $tmpFile "w"]

    set len1 [llength $wraplines1]
    set len2 [llength $wraplines2]

    set i1 0
    set i2 0

}

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

    wm protocol . WM_DELETE_WINDOW cleanupAndExit

    frame .f
    grid .f - - - -row 0 -sticky news

    menubutton .mf -text File -underline 0 -menu .mf.m
    menu .mf.m
    if {$debug == 1} {
        .mf.m add command -label "Redo Diff" -underline 5 -command doDiff

    if {$tcl_platform(platform) == "unix"} {
        .mf.m add command -label "RCSDiff" -underline 0 -command openRCS
        .mf.m add command -label "CVSDiff" -underline 0 -command openCVS
        .mf.m add separator
        .mf.m add command -label "Print" -underline 0 -command printDiffs
    }
    .mf.m add separator
    .mf.m add command -label "Quit" -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
    .mo.m add checkbutton -label "Diffs only" -variable Pref(onlydiffs)

            openRight
        }
    }
}

proc saveOptions {} {
    global Pref

    set ch [open "~/.diffrc" w]

    foreach i [array names Pref] {

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

proc getOptions {} {
    global Pref