Eskil

#!/bin/sh
#----------------------------------------------------------------------
#
#  Eskil, a Graphical frontend to diff
#
#  Copyright (c) 1998-2004, Peter Spjuth  (peter.spjuth@space.se)
#
#  Usage
#             Do 'eskil.tcl' for interactive mode
#             Do 'eskil.tcl --help' for command line usage
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; see the file COPYING.  If not, write to
#  the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
#  Boston, MA 02111-1307, USA.
#
#----------------------------------------------------------------------
# $Revision$
#----------------------------------------------------------------------
# the next line restarts using tclsh \
exec tclsh "$0" "$@"

package provide app-eskil 2.0
package require Tcl 8.4
# Stop Tk from meddling with the command line by copying it first.
set ::eskil(argv) $::argv
set ::eskil(argc) $::argc
set ::argv {}
set ::argc 0
package require Tk 8.4
catch {package require textSearch}

package require pstools
namespace import -force pstools::*

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

set debug 0
set diffver "Version 2.0.1 2004-02-10"
set thisScript [file join [pwd] [info script]]
set thisDir [file dirname $thisScript]

# Follow any link
set tmplink $thisScript
while {[file type $tmplink] eq "link"} {
    set tmplink [file readlink $tmplink]

# Save the merge result.
proc saveMerge {top} {
    global diff

    set w $top.merge.t

    if {$diff($top,mergeFile) eq ""} {
        set apa no
        if {[string match "conflict*" $diff($top,mode)]} {
            set apa [tk_messageBox -parent $top.merge -icon question \
                    -title "Save merge file" -type yesno -message \
                    "Do you want to overwrite the original conflict file?"]
        }
        if {$apa == "yes"} {
            set diff($top,mergeFile) $diff($top,conflictFile)
        } else {
            # Browse
            if {[info exists diff($top,rightDir)]} {
                set initDir $diff($top,rightDir)
            } elseif {[info exists diff($top,leftDir)]} {
                set initDir $diff($top,leftDir)
            } else {
                set initDir [pwd]
            }

            set apa [tk_getSaveFile -title "Save merge file" -initialdir $initDir \
                    -parent $top.merge]
            if {$apa eq ""} return
            set diff($top,mergeFile) $apa
        }
    }

    set ch [open $diff($top,mergeFile) "w"]
    puts -nonewline $ch [$w get 1.0 end-1char]
    close $ch
    tk_messageBox -parent $top.merge -icon info -type ok -title "Diff" \
            -message "Saved merge to file $diff($top,mergeFile)."

    set diff($top,rightOK) 1
    set diff($top,mode) ""
    wm deiconify $top
    raise $top
    update
    doDiff $top
}

# A thing to easily get to debug mode
proc backDoor {a} {
    append ::eskil(backdoor) $a
    set ::eskil(backdoor) [string range $::eskil(backdoor) end-9 end]
    if {$::eskil(backdoor) eq "PeterDebug"} {
        set ::debug 1
        catch {console show}
        set ::eskil(backdoor) ""
    }
}

# Build the main window
proc makeDiffWin {{top {}}} {
    global Pref tcl_platform debug

    if {$top != "" && [winfo exists $top] && [winfo toplevel $top] eq $top} {
        # Reuse the old window

    $top.mo.m add command -label "Colours..." -underline 0 -command makePrefWin
    $top.mo.m add checkbutton -label "Diffs only" -variable Pref(onlydiffs)
    if {$tcl_platform(platform) eq "windows"} {
        $top.mo.m add checkbutton -label "Force crlf translation" \
                -variable Pref(crlf)
    }
    $top.mo.m add separator
    $top.mo.m add command -label "Save default" \
            -command [list saveOptions $top]

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

    catch {font delete myfont}
    font create myfont -family $Pref(fontfamily) -size $Pref(fontsize)

    fileLabel $top.l1 -textvariable diff($top,leftLabel)
    fileLabel $top.l2 -textvariable diff($top,rightLabel)

    frame $top.ft1 -borderwidth 2 -relief sunken
    text $top.ft1.tl -height $Pref(lines) -width 5 -wrap none \
            -font myfont -borderwidth 0 -padx 0 -highlightthickness 0 \
            -takefocus 0
    text $top.ft1.tt -height $Pref(lines) -width $Pref(linewidth) -wrap none \
            -xscrollcommand [list $top.sbx1 set] \
            -font myfont -borderwidth 0 -padx 1 \
            -highlightthickness 0
    frame $top.ft1.f -width 2 -height 2 -bg lightgray
    pack $top.ft1.tl -side left -fill y
    pack $top.ft1.f -side left -fill y
    pack $top.ft1.tt -side right -fill both -expand 1
    scrollbar $top.sby -orient vertical
    scrollbar $top.sbx1 -orient horizontal -command [list $top.ft1.tt xview]
    set ::diff($top,wLine1) $top.ft1.tl
    set ::diff($top,wDiff1) $top.ft1.tt

    frame $top.ft2 -borderwidth 2 -relief sunken
    text $top.ft2.tl -height $Pref(lines) -width 5 -wrap none \
            -font myfont -borderwidth 0 -padx 0 -highlightthickness 0 \
            -takefocus 0
    text $top.ft2.tt -height $Pref(lines) -width $Pref(linewidth) -wrap none \
            -xscrollcommand [list $top.sbx2 set] \
            -font myfont -borderwidth 0 -padx 1 \
            -highlightthickness 0
    frame $top.ft2.f -width 2 -height 2 -bg lightgray
    pack $top.ft2.tl -side left -fill y
    pack $top.ft2.f -side left -fill y
    pack $top.ft2.tt -side right -fill both -expand 1

    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]
    if {$debug == 0} {
        bind $top <Key> "backDoor %A"
    }

    pack $top.mf $top.mo $top.ms $top.mt -in $top.f -side left -anchor n
    pack $top.mh -in $top.f -side left -anchor n
    pack $top.bfn -in $top.f -side right -padx {3 6}
    pack $top.bfp $top.er2 $top.lr2 $top.er1 $top.lr1 $top.eo $top.lo \
            -in $top.f -side right -padx 3
    if {$debug == 1} {

    label $l.old2 -text $old
    label $l.new1 -text "New value:"
    label $l.new2 -text $newvalue

    button $l.change -text "Change" -width 10 -command \
            "[list registry set $key {} $newvalue] ; \
             [list $l.change configure -state disabled]"
    button $l.delete -text "Delete" -width 10 -command \
            "[list registry delete $key] ; \
             [list $l.delete configure -state disabled]"
    if {[string equal $newvalue $old]} {
        $l.change configure -state disabled
    }
    if {[string equal "" $old]} {
        $l.delete configure -state disabled
    }
    grid $l.key1 $l.key2 -     -sticky "w" -padx 4 -pady 4
    grid $l.old1 $l.old2 -     -sticky "w" -padx 4 -pady 4
    grid $l.new1 $l.new2 -     -sticky "w" -padx 4 -pady 4
    grid $l.delete - $l.change -sticky "w" -padx 4 -pady 4
    grid $l.change -sticky "e"
    grid columnconfigure $l 2 -weight 1
}

proc makeRegistryWin {} {
    global thisScript

    # Locate executable for this program
    set exe [info nameofexecutable]

            -label "Use Diff"
    $top.mo.mc add radiobutton -variable Pref(comparelevel) -value 3 \
            -label "Diff, ignore blanks"
    $top.mo.mc add radiobutton -variable Pref(comparelevel) -value 4 \
            -label "Diff, ignore case"
    $top.mo.mc add radiobutton -variable Pref(comparelevel) -value 5 \
            -label "Diff, ignore RCS"

    menubutton $top.mt -text "Tools" -underline 0 -menu $top.mt.m
    menu $top.mt.m
    $top.mt.m add command -label "New Diff Window" -underline 0 \
            -command makeDiffWin
    $top.mt.m add command -label "Clip Diff" -underline 0 \
            -command makeClipDiffWin
    if {$::tcl_platform(platform) eq "windows"} {
        if {![catch {package require registry}]} {
            $top.mt.m add separator
            $top.mt.m add command -label "Setup Registry" -underline 6 \
                    -command makeRegistryWin
        }
    }

    pack $top.mf $top.mo $top.mt -in $top.fm -side left -anchor n

    if {$::debug} {
        menubutton $top.md -text "Debug" -menu $top.md.m -underline 0
        menu $top.md.m
        if {$::tcl_platform(platform) eq "windows"} {
            $top.md.m add checkbutton -label "Console" -variable consolestate \
                    -onvalue show -offvalue hide -command {console $consolestate}
            $top.md.m add separator

            -bg [$w cget -bg]
    pack $w.t -side top -expand y -fill both

    $w.t insert end "A Tcl/Tk frontend to diff\n\n"
    $w.t insert end "$diffver\n\n"
    $w.t insert end "Made by Peter Spjuth\n"
    $w.t insert end "E-Mail: peter.spjuth@space.se\n"
    $w.t insert end "\nURL: http://spjuth.pointclark.net/Eskil.html\n"
    $w.t insert end "\nTcl version: [info patchlevel]\n"
    $w.t insert end "\nCredits:\n"
    $w.t insert end "Ideas for scrollbar map and merge function\n"
    $w.t insert end "taken from TkDiff"

    set last [lindex [split [$w.t index end] "."] 0]
    $w.t configure -height $last

  -print <file> : Generate postscript and exit.

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

proc parseCommandLine {} {
    global diff dirdiff Pref


    if {$::eskil(argc) == 0} {
        makeDiffWin
        return
    }

    set noautodiff 0
    set autobrowse 0
    set dodir 0
    set doclip 0
    set files ""
    set nextArg ""
    set revNo 1
    foreach arg $::eskil(argv) {
        if {$nextArg != ""} {
            if {$nextArg eq "mergeFile"} {
                set opts(mergeFile) [file join [pwd] $arg]
            } elseif {$nextArg eq "printFile"} {
                set opts(printFile) [file join [pwd] $arg]
            } elseif {$nextArg eq "revision"} {
                set opts(doptrev$revNo) $arg
                incr revNo
            } elseif {$nextArg eq "limitlines"} {
                set opts(limitlines) $arg
            }
            set nextArg ""
            continue
        }
        if {$arg eq "-w"} {
            set Pref(ignore) "-w"
        } elseif {$arg eq "--help" || $arg eq "-help"} {
            printUsage
            exit
        } elseif {$arg eq "-b"} {
            set Pref(ignore) "-b"
        } elseif {$arg eq "-noignore"} {
            set Pref(ignore) " "
        } elseif {$arg eq "-noparse"} {

            set autobrowse 1
        } elseif {$arg eq "-conflict"} {
            set opts(mode) "conflict"
            set Pref(ignore) " "
        } elseif {$arg eq "-print"} {
            set nextArg printFile
        } elseif {$arg eq "-server"} {
            if {$::tcl_platform(platform) eq "windows"} {
                catch {
                    package require dde
                    dde servername Eskil
                }
            } else {
                tk appname Eskil
            }

                set diff($top,leftLabel) "CVS"
                after idle [list doDiff $top]
            }
        }
    }
}

proc saveOptions {top} {
    global Pref

    # Check if the window size has changed
    set w $::diff($top,wDiff1)
    if {[winfo reqwidth $w] != [winfo width $w] || \
            [winfo reqheight $w] != [winfo height $w]} {
        set dx [expr {[winfo width $w] - [winfo reqwidth $w]}]
        set dy [expr {[winfo height $w] - [winfo reqheight $w]}]
        set cx [font measure myfont 0]
        set cy [font metrics myfont -linespace]
        set neww [expr {[$w cget -width]  + $dx / $cx}]
        set newh [expr {[$w cget -height] + $dy / $cy}]
        if {$neww != $Pref(linewidth) || $newh != $Pref(lines)} {
            set apa [tk_messageBox -title "Save Preferences" -icon question \
                    -type yesno -message "Should I save the current window\
                    size with the preferences?\nCurrent: $neww x $newh  Old:\
                    $Pref(linewidth) x $Pref(lines)"]
            if {$apa == "yes"} {
                set Pref(linewidth) $neww
                set Pref(lines) $newh
            }
        }
    }

    set rcfile "~/.eskilrc"
    if {[catch {set ch [open $rcfile "w"]} err]} {
        tk_messageBox -icon error -title "File error" -message \
                "Error when trying to save preferences:\n$err"
        return
    }

    foreach i [array names Pref] {
        puts $ch [list set Pref($i) $Pref($i)]
    }
    close $ch

    tk_messageBox -icon info -title "Saved" -message \
            "Preferences saved to:\n[file nativename $rcfile]"
}

proc getOptions {} {
    global Pref

    set Pref(fontsize) 8
    set Pref(fontfamily) Courier
    set Pref(ignore) "-b"
    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
    set Pref(bgnew1) #a0ffa0
    set Pref(bgnew2) #e0e0ff
    set Pref(onlydiffs) 0
    set Pref(context) 2
    set Pref(crlf) 0
    set Pref(marklast) 1
    set Pref(linewidth) 80
    set Pref(lines) 60
    set Pref(editor) ""
    # Directory diff options
    set Pref(comparelevel) 1
    set Pref(recursive) 0
    set Pref(dir,onlydiffs) 0
    set Pref(nodir) 0
    set Pref(autocompare) 1

    set ::diff(filter) ""

    if {[file exists "~/.eskilrc"]} {
        safeLoad "~/.eskilrc" Pref
    }

    if {$Pref(editor) ne ""} {
        set ::util(editor) $Pref(editor)
    }
}

proc defaultGuiOptions {} {
    catch {package require griffin}

    option add *Menu.tearOff 0
    if {[tk windowingsystem] eq "x11"} {