Eskil

#     1.6     DA-PS    000131   Added scroll-keys
#                               Bug-fixes in scroll map and printing
#
#-----------------------------------------------
# the next line restarts using wish \
exec wish "$0" "$@"

set debug 1
set diffver "Version 1.7b  000426"
set tmpcnt 0
set thisscript [file join [pwd] [info script]]
set thisdir [file dirname $thisscript]

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

}

#Decide how to display change blocks
proc compareblocks {block1 block2} {
    set size1 [llength $block1]
    set size2 [llength $block2]
    
    if {$size1 * $size2 > 1000} {
        puts "Diff warning: Analyzing a large block. ($size1 $size2)"
        update idletasks
    }

    #Swap if block1 is bigger
    if {$size1 > $size2} {
        set apa $block1
        set block1 $block2
        set block2 $apa
        set size1 [llength $block1]
        set size2 [llength $block2]

}

#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

        .ft2.tt insert end "**Bad alignment here!! $doingLine2 $line2**\n"
	.ft1.tl insert end "\n"
	.ft2.tl insert end "\n"
    }

    #Process the block

    if {$n1 == $n2 && ($n1 == 1 || $Pref(parse) < 2)} {
        for {set t 0} {$t < $n1} {incr t} {
            gets $ch1 line1
            gets $ch2 line2
            insertMatchingLines $line1 $line2
        }
        lappend mapList $mapMax
        incr mapMax $n1
        lappend mapList $mapMax change
    } else {
        if {$n1 != 0 && $n2 != 0 && $Pref(parse) >= 2 && \
                ($n1 * $n2 < 1000 || $Pref(parse) == 3)} {
            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} {

    . config -cursor $oldcursor
    foreach w {.ft1.tl .ft1.tt .ft2.tl .ft2.tt} {
	$w config -cursor $oldcursor2
    }
}

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

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

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

    switch [llength $revs] {
        0 {

            set leftFile [tmpfile]
            set rightLabel $RCSFile
            set rightFile $RCSFile

            if {$RCSmode == 2} {
                set leftLabel "$RCSFile (CVS)"
                catch {exec cvs update -p [file nativename $RCSFile] > $leftFile}
            } else {
                set leftLabel "$RCSFile (RCS)"
                catch {exec co -p [file nativename $RCSFile] > $leftFile}
            }
        }
        1 {
            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 [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$r1 [file nativename $RCSFile] > $leftFile}
                catch {exec cvs update -p$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
    set Pref(dopt) $opts
}

proc cleanupRCS {} {

    update idletasks

    if {$RCSmode} {
        prepareRCS
    }

    set differr [catch {eval exec diff $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
        }

        set eqLabel " "
    }

    set ch1 [open $leftFile]
    set ch2 [open $rightFile]
    set doingLine1 1
    set doingLine2 1
    set t 0
    foreach i $result {
        if {![regexp {(.*)([acd])(.*)} $i apa l c r]} {
            .ft1.tt insert 1.0 "No regexp match for $i\n"
        } else {
            if {[regexp {([0-9]+),([0-9]+)} $l apa start stop]} {
                set n1 [expr {$stop - $start + 1}]
                set line1 $start

                } 
                d {
                    # lucka i right, new i left
                    dotext $ch1 $ch2 $n1 0 $line1 [expr {$line2 + 1}]
                }
            }
        }
        if {[incr t] >= 10} { 
            update idletasks
            .ft2.tl see end
            update idletasks
            set t 0
        }
    }

    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.
    set max 0.0
    foreach w {.ft1.tl .ft1.tt .ft2.tl .ft2.tt} {
        if {[$w index end] > $max} {
            set max [$w index end]
        }
    }
    foreach w {.ft1.tl .ft1.tt .ft2.tl .ft2.tt} {
        set d [expr {int($max - [$w index end])}]
        for {set t 0} {$t < $d} {incr t} {
            $w insert end \n
        }
    }

    close $ch1
    close $ch2

    if {$RCSmode} {
        cleanupRCS
    }

    drawMap -1
    foreach w {.ft1.tl .ft2.tl} {
	$w configure -state disabled
    }
    update idletasks
    .ft2.tl see 1.0
    normalCursor
}

# This is the entrypoint to do a diff via DDE or Send
proc remoteDiff {file1 file2} {
    global leftFile rightFile leftOK rightOK
    global leftDir rightDir leftLabel rightLabel

        set RCSmode 1
        set RCSFile $rightFile
        set leftLabel "RCS"
        set leftOK 0
        doDiff
    }
}

proc openCVS {} {
    global RCSmode leftFile rightFile leftOK RCSFile
    if {[doOpenRight]} {
        set RCSmode 2
        set RCSFile $rightFile
        set leftLabel "CVS"
        set leftOK 0
        doDiff
    }
}

proc openBoth {forget} {
    global RCSmode
    if {[doOpenLeft]} {
        if {[doOpenRight $forget]} {
            set RCSmode 0
            doDiff

    .mf.m add separator
    .mf.m add command -label "Open Both" -underline 0 -command {openBoth 0}
    .mf.m add command -label "Open Both (forget)" -command {openBoth 1}
    .mf.m add command -label "Open Left File" -command openLeft
    .mf.m add command -label "Open Right File" -command openRight
    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 exit

    menubutton .mo -text Options -underline 0 -menu .mo.m

    .mo.mi add radiobutton -label "Nothing" -variable Pref(ignore) -value " "
    .mo.mi add radiobutton -label "Space changes (-b)" -variable Pref(ignore) \
            -value "-b"
    .mo.mi add radiobutton -label "All spaces (-w)" -variable Pref(ignore) \
            -value "-w"

    menu .mo.mp
    .mo.mp add radiobutton -label "Nothing" -variable Pref(parse) -value 0
    .mo.mp add radiobutton -label "Lines" -variable Pref(parse) -value 1
    .mo.mp add radiobutton -label "Blocks (small)" -variable Pref(parse) \
            -value 2
    .mo.mp add radiobutton -label "Blocks" -variable Pref(parse) -value 3
    .mo.mp add separator
    .mo.mp add radiobutton -label "Characters" -variable Pref(lineparsewords) \
            -value "0"
    .mo.mp add radiobutton -label "Words" -variable Pref(lineparsewords) \
            -value "1"
    .mo.mp add separator
    .mo.mp add checkbutton -label "Use 2nd stage" \

        if {$arg == "-w"} {
            set Pref(ignore) "-w"
        } elseif {$arg == "-b"} {
            set Pref(ignore) "-b"
        } elseif {$arg == "-noignore"} {
            set Pref(ignore) " "
        } elseif {$arg == "-noparse"} {
            set Pref(parse) 0
        } elseif {$arg == "-line"} {
            set Pref(parse) 1
        } elseif {$arg == "-block"} {
            set Pref(parse) 3
        } elseif {$arg == "-char"} {
            set Pref(lineparsewords) 0
        } elseif {$arg == "-word"} {
            set Pref(lineparsewords) 1
        } elseif {$arg == "-2nd"} {
            set Pref(extralineparse) 1
        } elseif {$arg == "-no2nd"} {

        }
    }

    set len [llength $files]
    if {$len == 1} {
        set fullname [file join [pwd] $files]
        set fulldir [file dirname $fullname]
        if {[llength [glob -nocomplain [file join $fulldir RCS]]]} {
            set RCSmode 1
            set rightDir $fulldir
            set RCSFile $fullname
            set rightLabel $fullname
            set rightFile $fullname
            set rightOK 1
            set leftLabel "RCS"
            if {$noautodiff} {
                enableRedo
            } else {
                after idle doDiff
            }
        } elseif {[llength [glob -nocomplain [file join $fulldir CVS]]]} {
            set RCSmode 2
            set rightDir $fulldir
            set RCSFile $fullname
            set rightLabel $fullname
            set rightFile $fullname
            set rightOK 1
            set leftLabel "CVS"
            if {$noautodiff} {
                enableRedo
            } else {
                after idle doDiff
            }
        } else {
            set leftDir $fulldir
            set leftFile $fullname
            set leftLabel $fullname

            enableRedo
        } else {
            after idle doDiff
        }
    }
    if {$autobrowse && (!$leftOK || !$rightOK)} {
        if {!$leftOK && !$rightOK} {
            openBoth 0
        } elseif {!$leftOK} {
            openLeft
        } elseif {!$rightOK} {
            openRight
        }
    }
}

proc getOptions {} {
    global Pref

    set Pref(fontsize) 9
    set Pref(fontfamily) courier
    set Pref(ignore) "-b"
    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