Eskil

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

package provide app-diff 1.0
package require Tk
catch {package require textSearch}
if {[catch {package require psballoon}]} {
    proc addBalloon {args} {}
} else {
    namespace import -force psballoon::addBalloon

set debug 1
set diffver "Version 1.9.7+  2003-08-07"
}

set debug 0
set diffver "Version 1.9.8  2003-08-13"
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
set ::diff(thisexe) [list [info nameofexecutable] $thisscript]

                incr mapMax $n1
            }
        }
    }
}

proc enableRedo {} {
    .mf.m entryconfigure 1 -state normal
    .mf.m entryconfigure 0 -state normal
}

proc disableRedo {} {
    .mf.m entryconfigure 1 -state disabled
    .mf.m entryconfigure 0 -state disabled
}

proc busyCursor {} {
    global oldcursor oldcursor2
    if {![info exists oldcursor]} {
        set oldcursor [. cget -cursor]
        set oldcursor2 [.ft1.tt cget -cursor]

}

# Prepare for RCS/CVS diff. Checkout copies of the versions needed.
proc prepareRCS {} {
    global diff Pref

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

    # Search for revision options
    set nextIsRev 0
    foreach opt $Pref(dopt) {
    if {$Pref(doptrev1) != ""} {
        if {$nextIsRev} {
            lappend revs $opt
        lappend revs $Pref(doptrev1)
            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
        }
    }
    if {$Pref(doptrev2) != ""} {
        lappend revs $Pref(doptrev2)
    }

    switch [llength $revs] {
        0 {
            # Compare local file with latest version.
            set diff(leftFile) [tmpfile]
            set diff(rightLabel) $diff(RCSFile)

                catch {exec co -p$r1 [file nativename $diff(RCSFile)] > $diff(leftFile)}
                catch {exec co -p$r2 [file nativename $diff(RCSFile)] > $diff(rightFile)}
            }
        }
    }
    # Make sure labels are updated before processing starts
    update idletasks
    set Pref(dopt) $opts
}

# Clean up after a RCS/CVS diff.
proc cleanupRCS {} {
    global diff Pref

    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)]} {

}

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

    option add *Menu.tearOff 0
    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
    } else {
        .mf.m add command -label "Redo Diff" -underline 5 -command doDiff \
                -state disabled
    }
    .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
    .mf.m add command -label "Open Conflict File" -command openConflict
    .mf.m add command -label "Open Patch File" -command openPatch
    .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
    .mf.m add command -label "Open Conflict File..." -command openConflict
    .mf.m add command -label "Open Patch File..." -command openPatch
    if {$tcl_platform(platform) == "unix"} {
        .mf.m add command -label "RCSDiff" -underline 0 -command openRCS
        .mf.m add command -label "RCSDiff..." -underline 0 -command openRCS
    }
    if {$::diff(cvsExists)} {
        .mf.m add command -label "CVSDiff" -underline 0 -command openCVS
        .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 command -label "Print..." -underline 0 -command doPrint
    .mf.m add separator
    .mf.m add command -label "Quit" -underline 0 -command cleanupAndExit

    menubutton .mo -text Options -underline 0 -menu .mo.m
    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 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)
    if {$tcl_platform(platform) == "windows"} {
        .mo.m add checkbutton -label "Force crlf translation" \
                -variable Pref(crlf)
    }
    .mo.m add separator
    .mo.m add command -label "Save default" -command saveOptions

    menu .mo.mf
    .mo.mf add command -label "Select" -command makeFontWin
    .mo.mf add command -label "Select..." -command makeFontWin
    .mo.mf add radiobutton -label 6 -variable Pref(fontsize) -value 6 \
            -command chFont
    .mo.mf add radiobutton -label 7 -variable Pref(fontsize) -value 7 \
            -command chFont
    .mo.mf add radiobutton -label 8 -variable Pref(fontsize) -value 8 \
            -command chFont
    .mo.mf add radiobutton -label 9 -variable Pref(fontsize) -value 9 \

            -variable Pref(extralineparse)
    .mo.mp add checkbutton -label "Mark last" -variable Pref(marklast)

    menubutton .ms -text Search -underline 0 -menu .ms.m
    menu .ms.m
    if {[info proc textSearch::searchMenu] != ""} {
        textSearch::searchMenu .ms.m
    } else {
        .ms.m add command -label "Text search not available" -state disabled
    }

    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 .lo -text "Diff Options"
    addBalloon .lo "Options passed to the external diff.\nNote\
            that options for ignoring whitespace are available in\
            the Options menu."
    entry .eo -width 6 -textvariable Pref(dopt)
    label .lr1 -text "Rev 1"
    addBalloon .lr1 "Revision number for CVS/RCS diff."
    entry .er1 -width 6 -textvariable Pref(doptrev1)
    label .lr2 -text "Rev 2"
    addBalloon .lr2 "Revision number for CVS/RCS diff."
    entry .er2 -width 6 -textvariable Pref(doptrev2)
    button .bfn -text "Next Diff" -relief raised -command {findDiff 1} \
            -underline 0
    button .bfp -text "Prev Diff" -relief raised -command {findDiff -1} \
            -underline 0
    button .bfp -text "Prev Diff" -relief raised -command {findDiff -1} \
            -underline 0 -padx 15
    button .bfn -text "Next Diff" -relief raised -command {findDiff 1} \
            -underline 0 -padx 15
    entry .eo -width 10 -textvariable Pref(dopt)
    label .lo -text "Diff Options"
    bind . <Alt-n> {findDiff 1}
    bind . <Alt-p> {findDiff -1}

    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
    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
            -font myfont -borderwidth 0 -padx 0 -highlightthickness 0 \
            -takefocus 0
    text .ft1.tt -height 40 -width 80 -wrap none -yscrollcommand my_yscroll \
            -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
            -font myfont -borderwidth 0 -padx 0 -highlightthickness 0 \
            -takefocus 0
    text .ft2.tt -height 60 -width 80 -wrap none -yscrollcommand my_yscroll \
            -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
    if {[info proc textSearch::enableSearch] != ""} {
        textSearch::enableSearch .ft1.tt -label ::diff(isearchLabel)
        textSearch::enableSearch .ft2.tt -label ::diff(isearchLabel)
    }

    label .le -textvariable ::diff(eqLabel) -width 1
    addBalloon .le "* means external diff is running.\n= means files do\
            not differ.\nBlank means files differ."
    label .ls -width 1 -pady 0 -padx 0 -textvariable ::diff(isearchLabel)
    addBalloon .ls "Incremental search indicator"
    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} {

    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}]
    grid .ls -sticky ""

    
    image create photo map
    .c create image 0 0 -anchor nw -image map
    bind .c <Configure> {drawMap %h}

    bind . <Key-Up> {scroll -1 u}
    bind . <Key-Down> {scroll 1 u}
    bind . <Key-Prior> {scroll -1 p}
    bind . <Key-Next> {scroll 1 p}
    bind . <Key-Escape> {focus .}

    pack .mf .mo .ms .mh -in .f -side left
    pack .bfn -in .f -side right -padx {3 6}
    pack .bfn .bfp .eo .lo -in .f -side right
    pack .bfp .er2 .lr2 .er1 .lr1 .eo .lo -in .f -side right -padx 3
    if {$debug == 1} {
        menubutton .md -text Debug -menu .md.m -relief ridge
        menubutton .md -text Debug -menu .md.m
        menu .md.m
        if {$tcl_platform(platform) == "windows"} {
            .md.m add checkbutton -label Console -variable consolestate \
                    -onvalue show -offvalue hide \
                    -command {console $consolestate}
            .md.m add separator
        }

    set diff(conflictFile) ""
    set diff(limitlines) 0

    if {$argc == 0} return

    set files ""
    set nextArg ""
    set revNo 1
    foreach arg $argv {
        if {$nextArg != ""} {
            if {$nextArg == "mergeFile"} {
                set diff(mergeFile) [file join [pwd] $arg]
            } elseif {$nextArg == "printFile"} {
                set diff(printFile) [file join [pwd] $arg]
            } elseif {$nextArg == "revision"} {
                set Pref(dopt) "$Pref(dopt) -r$arg"
                set Pref(doptrev$revNo) $arg
                incr revNo
            } elseif {$nextArg == "limitlines"} {
                set diff(limitlines) $arg
            }
            set nextArg ""
            continue
        }
        if {$arg == "-w"} {

            } else {
                tk appname Diff
            }
        } elseif {$arg == "-o"} {
            set nextArg mergeFile
        } elseif {$arg == "-r"} {
            set nextArg revision
        } elseif {[string range $arg 0 1] == "-r"} {
            set Pref(doptrev$revNo) [string range $arg 2 end]
            incr revNo
        } elseif {[string range $arg 0 0] == "-"} {
            set Pref(dopt) "$Pref(dopt) $arg"
        } else {
            set apa [glob -nocomplain [file join [pwd] $arg]]
            if {$apa == ""} {
                puts "Ignoring argument: $arg"
            } else {

    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"} {
        if {![string match "dopt*" $i]} {
            puts $ch [list set Pref($i) $Pref($i)]
        }
    }
    close $ch
}

proc getOptions {} {
    global Pref

    set Pref(fontsize) 9
    set Pref(fontfamily) courier
    set Pref(ignore) "-b"
    set Pref(dopt) ""
    set Pref(doptrev1) ""
    set Pref(doptrev2) ""
    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) #ffe0e0