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
#
#----------------------------------------------------------------------
# $Revision$
#----------------------------------------------------------------------
# the next line restarts using tclsh \
exec tclsh "$0" "$@"

package provide app-eskil 1.0
package require Tcl 8.4
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 1
set diffver "Version 2.0b3+ 2004-01-20"
set thisScript [file join [pwd] [info script]]
set thisDir [file dirname $thisScript]

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

set ::util(diffWrapped) 0

# Experimenting with DiffUtil package
#set ::util(diffutil) [expr {![catch {package require DiffUtil}]}]
set ::util(diffutil) 0

# Figure out a place to store temporary files.







locateTmp ::diff(tmpdir)







# Locate a diff executable on windows.
proc locateDiffExe {} {
    # Build a list of possible directories.
    set dirs [list $::thisDir]
    # Are we in a starkit?
    if {[string match "*/lib/app-eskil" $::thisDir]} {

    if {!$::util(cvsExists) && [file exists "c:/bin/cvs.exe"]} {
        set env(PATH) "$env(PATH);c:\\bin"
        auto_reset
        set ::util(cvsExists) [expr {![string equal [auto_execok cvs] ""]}]
    }
}






















# This function is called when a toplevel is closed.
# If it is the last remaining toplevel, the application quits.
# If top = "all" it means quit.
proc cleanupAndExit {top} {
    # A security thing to make sure we can exit.
    set cont 0
    if {[catch {

        set ::tmpcnt 0
    }
    set name [file join $::diff(tmpdir) "tmpd[pid]a$::tmpcnt"]
    lappend ::tmpfiles $name
    return $name
}

proc clearTmp {args} {
    if {![info exists ::tmpfiles]} {
        set ::tmpfiles {}
        return
    }
    if {[llength $args] > 0} {
        foreach f $args {
            set i [lsearch -exact $f $::tmpfiles]
            if {$i >= 0} {
                catch {file delete $f}
                set ::tmpfiles [lreplace $::tmpfiles $i $i]
            }
        }
    } else {
        foreach f $::tmpfiles {
            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.

    update idletasks
}

# Clean up after a conflict diff.
proc cleanupConflict {top} {
    global diff Pref

    clearTmp $diff($top,rightFile) $diff($top,leftFile)
    set diff($top,rightFile) $diff($top,conflictFile)
    set diff($top,leftFile) $diff($top,conflictFile)
}

# Display one chunk from a patch file
proc displayOnePatch {top leftLines rightLines leftLine rightLine} {
    emptyLine $top 1

    update idletasks
}

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

    clearTmp $diff($top,rightFile) $diff($top,leftFile)
    set diff($top,rightFile) $diff($top,RCSFile)
    set diff($top,leftFile) $diff($top,RCSFile)
}

# Prepare for ClearCase diff. Checkout copies of the versions needed.
proc prepareClearCase {top} {
    global diff Pref

    # Compare local file with latest version.
    set diff($top,leftFile) [tmpFile]
    set diff($top,rightLabel) $diff($top,RCSFile)
    set diff($top,rightFile) $diff($top,RCSFile)

    set diff($top,leftLabel) "$diff($top,RCSFile) (CT)"
    if {[catch {exec cleartool pwv -s} view] || $view == "** NONE **"} {
        puts "MIFFFO"
        return
    }

    if {[catch {exec cleartool get -to $diff($top,leftFile) [file nativename $diff($top,RCSFile)@@/main/$view/LATEST]} msg]} {
        puts "Cleartool error: $msg"
        return
    }
}

# Prepare for a diff by creating needed temporary files
proc prepareFiles {top} {
    set ::diff($top,cleanup) ""
    if {$::diff($top,mode) == "RCS" || $::diff($top,mode) == "CVS"} {
        prepareRCS $top
        set ::diff($top,cleanup) "RCS"
    } elseif {$::diff($top,mode) == "CT"} {
        prepareClearCase $top
        set ::diff($top,cleanup) "CT"
    } elseif {[string match "conflict*" $::diff($top,mode)]} {
        prepareConflict $top
        set ::diff($top,cleanup) "conflict"
    } elseif {[lindex [file system $::diff($top,leftFile)] 0] ne "native" || \
            [lindex [file system $::diff($top,rightFile)] 0] ne "native"} {
        # A special case to diff files in a virtual file system
        set ::diff($top,leftLabel)  $::diff($top,leftFile)
        set ::diff($top,rightLabel) $::diff($top,rightFile)
        set ::diff($top,leftFile)  [tmpFile]
        set ::diff($top,rightFile) [tmpFile]
        file copy -force -- $::diff($top,leftLabel)  $::diff($top,leftFile)
        file copy -force -- $::diff($top,rightLabel) $::diff($top,rightFile)
        set ::diff($top,cleanup) "virtual"
    }
}

# Clean up after a diff
proc cleanupFiles {top} {

    switch $::diff($top,cleanup) {
        "RCS" - "CT" {cleanupRCS      $top}

        "conflict"   {cleanupConflict $top}
        "virtual" {
            clearTmp $::diff($top,rightFile) $::diff($top,leftFile)
            set ::diff($top,leftFile)  $::diff($top,leftLabel)
            set ::diff($top,rightFile) $::diff($top,rightLabel)
        }
    }
}

# Main diff function.
proc doDiff {top} {
    global diff Pref
    global doingLine1 doingLine2

        seeText $w $line1 $line2
    }
}

#####################################
# File dialog stuff
#####################################

# A wrapper for tk_getOpenFile
proc myOpenFile {args} {
    # When in tutorial mode, make sure the Tcl file dialog is used
    # to be able to access the files in a starkit.
    if {[info exists ::diff(tutorial)] && $::diff(tutorial)} {
        # Only do this if tk_getOpenFile is not a proc.
        if {[info procs tk_getOpenFile] == ""} {
            # If there is any problem, call the real one
            if {![catch {set res [eval ::tk::dialog::file:: open $args]}]} {
                return $res
            }
        }
    }
    return [eval tk_getOpenFile $args]
}

proc doOpenLeft {top {forget 0}} {
    global diff

    if {!$forget && [info exists diff($top,leftDir)]} {
        set initDir $diff($top,leftDir)
    } elseif {[info exists diff($top,rightDir)]} {
        set initDir $diff($top,rightDir)
    } else {
        set initDir [pwd]
    }

    set apa [myOpenFile -title "Select left file" -initialdir $initDir \
            -parent $top]
    if {$apa != ""} {
        set diff($top,leftDir) [file dirname $apa]
        set diff($top,leftFile) $apa
        set diff($top,leftLabel) $apa
        set diff($top,leftOK) 1
        return 1

        set initDir $diff($top,rightDir)
    } elseif {[info exists diff($top,leftDir)]} {
        set initDir $diff($top,leftDir)
    } else {
        set initDir [pwd]
    }

    set apa [myOpenFile -title "Select right file" -initialdir $initDir \
            -parent $top]
    if {$apa != ""} {
        set diff($top,rightDir) [file dirname $apa]
        set diff($top,rightFile) $apa
        set diff($top,rightLabel) $apa
        set diff($top,rightOK) 1
        return 1

}

proc unzoomRow {w} {
    set top [winfo toplevel $w]
    destroy $top.balloon
}



























# Reconfigure font
proc chFont {} {
    global Pref

    font configure myfont -size $Pref(fontsize) -family $Pref(fontfamily)
}

                    -command makeRegistryWin
        }
    }

    menubutton $top.mh -text "Help" -underline 0 -menu $top.mh.m
    menu $top.mh.m
    $top.mh.m add command -label "Help" -command makeHelpWin -underline 0
    $top.mh.m add command -label "Tutorial" -command makeTutorialWin \
            -underline 0
    $top.mh.m add command -label "About" -command makeAboutWin -underline 0

    label $top.lo -text "Diff Options"
    addBalloon $top.lo "Options passed to the external diff.\nNote\
            that options for ignoring whitespace are available in\
            the Options menu."
    entry $top.eo -width 6 -textvariable diff($top,dopt)

    makeRegistryFrame $top.c "Diff Conflict" $keyc $new

    set new "$valbase \"%1\""
    makeRegistryFrame $top.dd "Directory Diff" $keydd $new

    pack $top.d $top.c $top.dd -side "top" -fill x -padx 4 -pady 4

    locateEditor ::util(editor)
    if {[string match "*runemacs.exe" $::util(editor)]} {
        # Set up emacs
        set newkey "\"[file nativename $::util(editor)]\" \"%1\""
        makeRegistryFrame $top.e "Emacs" $keye $newkey
        pack $top.e -side "top" -fill x -padx 4 -pady 4
    }

        set src [file join $dirdiff(leftDir) [lindex $dirdiff(leftFiles) $row]]
    } elseif {$from == "right"} {
        set src [file join $dirdiff(rightDir) [lindex $dirdiff(rightFiles) $row]]
    } else {
        error "Bad from argument to editFile: $from"
    }

    locateEditor ::util(editor)
    exec $::util(editor) $src &
}

# Go up one level in directory hierarchy.
# 0 = both
proc upDir {{n 0}} {
    global dirdiff Pref

    label $top.nui2.l -text "$str\nDo you want help?" -justify left -bg yellow
    button $top.nui2.b -text "No, get out of my face!" \
            -command [list destroy $top.nui2 $top.nui] -bg yellow
    pack $top.nui2.l $top.nui2.b -side "top" -fill x
    wm geometry $top.nui2 +[expr {405 + [winfo width $top.nui]}]+400
}


















proc makeAboutWin {} {
    global diffver

    set w [helpWin .ab "About Eskil"]

    text $w.t -width 45 -height 11 -wrap none -relief flat \
            -bg [$w cget -bg]

            -background $Pref(bgnew1)
    $w.t tag configure new2 -foreground $Pref(colornew2) \
            -background $Pref(bgnew2)
    $w.t tag configure change -foreground $Pref(colorchange) \
            -background $Pref(bgchange)
    $w.t tag configure ul -underline 1

    insertTaggedText $w.t $doc
    $w.t configure -state disabled
}

proc makeTutorialWin {} {
    global Pref

    set doc [file join $::thisDir doc/tutorial.txt]
    if {![file exists $doc]} return

    if {[catch {cd [file join $::thisDir examples]}]} {
        tk_messageBox -icon error -title "Eskil Error" -message \
                "Could not locate examples directory." \
                -type ok
        return
    }
    set ::diff(tutorial) 1

    set w [helpWin .ht "Eskil Tutorial"]

    text $w.t -width 82 -height 35 -wrap word -yscrollcommand "$w.sb set"\
            -font "Courier 10"
    scrollbar $w.sb -orient vert -command "$w.t yview"
    pack $w.sb -side right -fill y
    pack $w.t -side left -expand 1 -fill both

    # Move border properties to frame
    set bw [$w.t cget -borderwidth]
    set relief [$w.t cget -relief]
    $w configure -relief $relief -borderwidth $bw
    $w.t configure -borderwidth 0

    # Set up tags
    $w.t tag configure ul -underline 1

    insertTaggedText $w.t $doc
    $w.t configure -state disabled
}

proc printUsage {} {
    puts {Usage: eskil.tcl [options] [file1] [file2]
  [options]              All options but the ones listed below

    tk_messageBox -icon info -title "Saved" -message \
            "Prefrences 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(dir,onlydiffs) 0
    set Pref(nodir) 0
    set Pref(autocompare) 1

    set ::diff(filter) ""

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

proc defaultGuiOptions {} {
    catch {package require griffin}

    option add *Menu.tearOff 0
    if {[tk windowingsystem]=="x11"} {
        option add *Menu.activeBorderWidth 1
        option add *Menu.borderWidth 1       
        
        option add *Listbox.exportSelection 0
        option add *Listbox.borderWidth 1
        #option add *Listbox.highlightThickness 1
        option add *Font "Helvetica -12"
        option add *Scrollbar.highlightThickness 0
        option add *Scrollbar.takeFocus 0
    }

    if {$::tcl_platform(platform) == "windows"} {
        option add *Panedwindow.sashRelief flat