Eskil

2014-11-16
 First working plugin in dirdiff.

2014-11-13
 Undid all dirdiff refactoring from August. Bad idea...

2014-11-12
 Bumped revision to 2.6.7

2014-11-12

#----------------------------------------------------------------------
# Make file for Eskil
#----------------------------------------------------------------------

VERSION = 2671

# Path to the TclKits used for creating StarPacks.
TCLKIT = /home/peter/tclkit/v85
TCLKIT_LINUX   = $(TCLKIT)/tclkit-linux
TCLKIT_SOLARIS = $(TCLKIT)/tclkit-solaris-sparc
TCLKIT_WIN     = $(TCLKIT)/tclkit-win32.upx.exe

        file stat $file1 stat1
        file stat $file2 stat2
    }
    # If contents is not checked, same size is enough to be equal
    if {$stat1(size) == $stat2(size) && $::Pref(dir,comparelevel) == 0} {
        return 1
    }
    set anyPlugin [expr {$::eskil(.dirdiff,plugin) ne ""}]
    set ignorekey $::Pref(dir,ignorekey)
    # Different size is enough when doing binary compare
    if {$stat1(size) != $stat2(size) && $::Pref(dir,comparelevel) == 2 \
        && !$ignorekey && !$anyPlugin} {
        return 0
    }
    # Same size and time is always considered equal
    if {$stat1(size) == $stat2(size) && $stat1(mtime) == $stat2(mtime)} {
	return 1
    }
    # Don't check further if contents should not be checked
    if {$::Pref(dir,comparelevel) == 0} {
        return 0
    }
    # Don't check further if any is a directory
    if {$isdir1 || $isdir2} {
        # Consider dirs equal until we implement something recursive
	return 1
    }

    switch $::Pref(dir,comparelevel) {
        2 -
        1 { # Check contents internally
            set bufsz 65536
            set eq 2 ;# 2 = equal this far, 1 = equal, 0 = not equal
            set ch1 [open $file1 r]
            set ch2 [open $file2 r]
            if {$::Pref(dir,comparelevel) == 2} {
                fconfigure $ch1 -translation binary
                fconfigure $ch2 -translation binary
            }
            # Allow a plugin to do its thing
            if {$anyPlugin} {
                #puts "PLUGIN!"
                $::eskil(.dirdiff,plugin) eval \
                        [list array set ::Pref [array get ::Pref]]
                interp share {} $ch1 $::eskil(.dirdiff,plugin)
                interp share {} $ch2 $::eskil(.dirdiff,plugin)
                set info1 [dict create name $file1 size $stat1(size)]
                set info2 [dict create name $file2 size $stat2(size)]
                set eq [$::eskil(.dirdiff,plugin) eval \
                                [list FileCompare $ch1 $ch2 $info1 $info2]]
                $::eskil(.dirdiff,plugin) invokehidden close $ch1
                $::eskil(.dirdiff,plugin) invokehidden close $ch2
            }

            if {$ignorekey} {
                # Assume that all keywords are in the first block
                set f1 [read $ch1 $bufsz]
                set f2 [read $ch2 $bufsz]
                regsub -all {\$\w+:[^\$]*\$} $f1 {} f1
                regsub -all {\$\w+:[^\$]*\$} $f2 {} f2
                # Compensate for any change in length
                if {[string length $f1] < [string length $f2]} {
                    append f1 [read $ch1 [expr {[string length $f2] - [string length $f1]}]]
                }
                if {[string length $f2] < [string length $f1]} {
                    append f2 [read $ch2 [expr {[string length $f1] - [string length $f2]}]]
                }
                if {![string equal $f1 $f2]} {
                    set eq 0
                }
            }
            while {$eq == 2 && ![eof $ch1] && ![eof $ch2]} {
                set f1 [read $ch1 $bufsz]
                set f2 [read $ch2 $bufsz]
                if {![string equal $f1 $f2]} {
                    set eq 0
                }
            }
            if {$eq == 2 && (![eof $ch1] || ![eof $ch2])} {
                set eq 0
            }
            close $ch1
            close $ch2
        }
    }
    return [expr {$eq != 0}]
}

# Returns the contents of a directory as a sorted list of full file paths.
proc DirContents {dir} {
    if {$::tcl_platform(platform) eq "windows"} {
        # .-files are not treated specially on windows. * is enough to get all
        set files [glob -directory $dir -nocomplain *]

        $win.m.mo.mc add radiobutton -variable ::Pref(dir,comparelevel) -value 1 \
                -label "Normal compare"
        $win.m.mo.mc add radiobutton -variable ::Pref(dir,comparelevel) -value 2 \
                -label "Exact compare"
        $win.m.mo.mc add checkbutton -variable ::Pref(dir,ignorekey) \
                -label "Ignore \$Keyword:\$"

        $win.m.mo add command -label "Plugins..." -underline 1 \
                -command [list EditPrefPlugins $win 1]
        $win.m.mo add cascade -label "Nice" -menu $win.m.mo.mn
        menu $win.m.mo.mn
        $win.m.mo.mn add radiobutton -variable [myvar nice] -value 1 \
                -command [mymethod DoNice] -label 1
        $win.m.mo.mn add radiobutton -variable [myvar nice] -value 50 \
                -command [mymethod DoNice] -label 50
        $win.m.mo.mn add radiobutton -variable [myvar nice] -value 100 \

    }
    if {![info exists ::dirdiff(leftDir)]} {
        set ::dirdiff(leftDir) ""
    }
    if {![info exists ::dirdiff(rightDir)]} {
        set ::dirdiff(rightDir) ""
    }
    set ::eskil(.dirdiff,plugin) ""
    foreach {item val} [array get opts] {
        set ::eskil(.dirdiff,$item) $val
    }

    # Experiment to support -r for directory diff
    # Currently only Fossil/SVN is supported
    if {[info exists opts(doptrev1)] && $opts(doptrev1) ne ""} {
        set fullname $::dirdiff(leftDir)
        set type [detectRevSystem $fullname]
        # Is this a revision system with dirdiff support?
        if {[info commands eskil::rev::${type}::mount] ne ""} {
            set revs [list $opts(doptrev1)]
            if {[info exists opts(doptrev2)] && $opts(doptrev2) ne ""} {

# 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

set ::eskil(debug) 0
set ::eskil(diffver) "Version 2.6.7+ 2014-11-16"
set ::eskil(thisScript) [file join [pwd] [info script]]

namespace import tcl::mathop::+
namespace import tcl::mathop::-
namespace import tcl::mathop::*
namespace import tcl::mathop::/

    }
    unset -nocomplain \
            ::eskil($top,leftFileBak) ::eskil($top,rightFileBak) \
            ::eskil($top,leftFileDiff) ::eskil($top,rightFileDiff)
}

# GUI for plugin selection
proc EditPrefPlugins {top {dirdiff 0}} {
    set w $top.prefplugin

    # Create window
    destroy $w
    toplevel $w -padx 3 -pady 3
    ttk::frame $w._bg
    place $w._bg -x 0 -y 0 -relwidth 1.0 -relheight 1.0 -border outside

        set ::eskil($top,plugininfo) ""
    }
    set ::eskil($top,edit,pluginname) $::eskil($top,pluginname) 
    set ::eskil($top,edit,plugininfo) $::eskil($top,plugininfo)
    set t 0
    foreach {plugin info} $plugins {
        set descr [dict get $info descr]
        if {$dirdiff && ![dict get $info dir]} continue
        ttk::radiobutton $w.rb$t -variable ::eskil($top,edit,pluginname) -value $plugin -text $plugin
        ttk::label $w.l$t -text $descr -anchor "w"
        grid $w.rb$t $w.l$t -sticky we -padx 3 -pady 3
        incr t
    }
    ttk::radiobutton $w.rb$t -variable ::eskil($top,edit,pluginname) -value "" -text "No Plugin"
    grid $w.rb$t -sticky we -padx 3 -pady 3