Eskil

2011-04-28
 Code cleanup to get clean Nagelfar run

2011-04-28
 Added three-way merge. Cmd line options -a and -fine.

2011-04-24
 Added basic GUI for plugin selection.

2011-04-22

TKDND      = /home/peter/src/packages/tkdnd/lib/tkdnd1.0

# Tools
NAGELFAR    = nagelfar

all: setup

SRCFILES = src/eskil.tcl src/clip.tcl src/dirdiff.tcl src/help.tcl src/map.tcl \
	   src/print.tcl src/registry.tcl src/rev.tcl \
	   src/compare.tcl src/merge.tcl src/printobj.tcl src/plugin.tcl

#----------------------------------------------------------------
# Setup symbolic links from the VFS to the real files
#----------------------------------------------------------------

eskil.vfs/src/eskil.tcl:

#----------------------------------------------------------------
# Testing
#----------------------------------------------------------------

spell:
	@cat doc/*.txt | ispell -d british -l | sort -u

NAGELFARFLAGS = -s syntaxdb86.tcl -filter "*Non constant definition*" -quiet

# Create a common "header" file for all source files.
eskil_h.syntax: $(SRCFILES) src/eskil.syntax
	@echo Creating syntax header file...
	@$(NAGELFAR) $(NAGELFARFLAGS) -header eskil_h.syntax $(SRCFILES)

check: eskil_h.syntax
	@echo Checking...
	@for i in $(SRCFILES); do $(NAGELFAR)  $(NAGELFARFLAGS) eskil_h.syntax $$i ; done

test:
	@./tests/all.tcl

#----------------------------------------------------------------
# Coverage
#----------------------------------------------------------------

                set dst $lf
            } elseif {$lp ne ""} {
                set dst [file join $lp [file tail $src]]
            } else {
                return
            }
        } else {
            error "Bad from argument to CopyFile: $from"
        }

        if {[file exists $dst]} {
            if {[tk_messageBox -icon question -title "Overwrite file?" -message \
                    "Copy\n$src\noverwriting\n$dst ?" -type yesno] eq "yes"} {
                file copy -force $src $dst
                # FIXA: update file info in tree too

            -command "ApplyDirDiffPref ; destroy $top"
    ttk::button $fb.ap -width 10 -text "Apply" -command ApplyDirDiffPref
    ttk::button $fb.ca -width 10 -text "Cancel" -command "destroy $top"
    grid $fb.ok $fb.ap $fb.ca -padx 3 -pady 3
    grid columnconfigure $fb {0 1 2} -uniform a -weight 1

    pack $fb -side bottom -fill x
    pack $check $opts $filter -side "top" -fill x
}

# Experimental...
#preprocess filter pa namnen sa man kan jamfora bibliotek
#med andrade namn.
proc makeRegSubWin {} {
    set top .ddregsub

##nagelfar syntax textSearch::searchMenu x
##nagelfar syntax textSearch::enableSearch x x*
##nagelfar syntax DiffUtil::LocateDiffExe x
###nagelfar syntax DiffUtil::diffStrings o* x x
##nagelfar syntax dde s x
##nagelfar syntax dnd s x*
##nagelfar syntax safeLoad x n
##nagelfar syntax helpWin x x
##nagelfar syntax commonYScroll x x*
##nagelfar syntax locateEditor n
##nagelfar syntax locateTmp n
##nagelfar syntax wcb::cancel 0
##nagelfar syntax wcb::callback 4
##nagelfar syntax vfs::mk4::Mount r 2
##nagelfar syntax vfs::unmount 1
###nagelfar syntax ttk::entryX x p*
##nagelfar syntax ::tk::GetSelection x x
##nagelfar syntax ::tk::ScrollButton2Down x x x
##nagelfar syntax console x
##nagelfar syntax registry x x x
##nagelfar syntax pdf4tcl::getPaperSize x
##nagelfar syntax pdf4tcl::getPaperSizeList
##nagelfar syntax twapi::get_foreground_window
##nagelfar syntax twapi::get_window_coordinates x
##nagelfar syntax twapi::get_window_at_location x x
##nagelfar syntax twapi::set_focus x
##nagelfar syntax twapi::send_keys x
##nagelfar syntax twapi::get_window_coordinates x

# Operators
##nagelfar syntax + x*
##nagelfar syntax - x x*
##nagelfar syntax * x*
##nagelfar syntax / x x*

# This is the generic definitions needed for Snit.

##nagelfar syntax _stdclass_snit s x*
##nagelfar subcmd _stdclass_snit destroy configurelist configure
##nagelfar syntax _stdclass_snit\ destroy 0
##nagelfar syntax _stdclass_snit\ configurelist x
##nagelfar syntax _stdclass_snit\ configure x*

##nagelfar syntax snit::type do=_stdclass_snit cn
##nagelfar syntax snit::type::method dm
##nagelfar syntax snit::type::constructor cv
##nagelfar syntax snit::type::destructor cl
##nagelfar syntax snit::type::option x p*
##nagelfar syntax snit::type::component x
##nagelfar syntax snit::type::delegate x*
##nagelfar syntax snit::type::install s x*

##nagelfar syntax snit::widgetadaptor do=_stdclass_snit cn
##nagelfar syntax snit::widgetadaptor::method dm
##nagelfar syntax snit::widgetadaptor::constructor cv
##nagelfar syntax snit::widgetadaptor::destructor cl
##nagelfar syntax snit::widgetadaptor::delegate x*
##nagelfar syntax snit::widgetadaptor::installhull x*
##nagelfar syntax snit::widgetadaptor::from l x*
##nagelfar syntax snit::widgetadaptor::component x
##nagelfar syntax snit::widgetadaptor::install s x*
##nagelfar syntax snit::widgetadaptor::option x p*

##nagelfar syntax snit::widget do=_stdclass_snit cn
##nagelfar syntax snit::widget::method dm
##nagelfar syntax snit::widget::constructor cv
##nagelfar syntax snit::widget::destructor cl
##nagelfar syntax snit::widget::delegate x*
##nagelfar syntax snit::widget::installhull x*
##nagelfar syntax snit::widget::from l x*
##nagelfar syntax snit::widget::hulltype x
##nagelfar syntax snit::widget::widgetclass x
##nagelfar syntax snit::widget::myvar l
##nagelfar syntax snit::widget::mymethod x x*
##nagelfar return snit::widget::myvar varName
##nagelfar syntax snit::widget::component x
##nagelfar syntax snit::widget::install s x*
##nagelfar syntax snit::widget::option x p*

# This is the annotation needed for this object definition

##nagelfar syntax eskilprint dc=_obj,eskilprint p*
##nagelfar option eskilprint -file -cpl -cpln -headsize -headleft -headright -headnpages -margin -paper
##nagelfar return eskilprint _obj,eskilprint
##nagelfar subcmd+ _obj,eskilprint text newLine

##nagelfar implicitvar snit::type::eskilprint self\ _obj,eskilprint width height pdf hoy fontsize linesize nlines ox1 ox2 oy page options

# This is the annotation needed for this object definition

##nagelfar syntax DirDiff dc=_obj,DirDiff p*
###nagelfar option DirDiff
##nagelfar return DirDiff _obj,DirDiff
##nagelfar subcmd+ _obj,DirDiff text newLine

##nagelfar implicitvar snit::widget::DirDiff self\ _obj,DirDiff statusVar hull win self tree

# This is the annotation needed for this object definition

##nagelfar syntax DirCompareTree dc=_obj,DirCompareTree p*
##nagelfar option DirCompareTree -leftdirvariable -rightdirvariable -statusvar
##nagelfar return DirCompareTree _obj,DirCompareTree
##nagelfar subcmd+ _obj,DirCompareTree text newLine

##nagelfar implicitvar snit::widget::DirCompareTree self\ _obj,DirCompareTree hull win self tree hsb vsb options AfterId PauseBgProcessing IdleQueue IdleQueueArr leftMark rightMark leftDir rightDir

# This is the annotation needed for this object definition

##nagelfar syntax ttk::entryX dc=_obj,ttk::entryX p*
##nagelfar option ttk::entryX -width -textvariable -style
##nagelfar return ttk::entryX _obj,ttk::entryX
##nagelfar subcmd+ _obj,ttk::entryX text newLine

##nagelfar implicitvar snit::widgetadaptor::ttk::entryX self\ _obj,ttk::entryX hull win self  options

# Do initalisations for needed packages and globals.
# This is not run until needed to speed up command line error reporting.
proc Init {} {
    package require Tk 8.4
    catch {package require textSearch}
    package require wcb
    package require snit

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

    # Do not scroll if focus is in a text window.
    # This is for scroll bindings in the toplevel.
    if {[winfo class [focus]] != "Text"} {
        $::widgets($top,wDiff1) yview scroll $n $what
    }
}









# Emulate a label that:
# 1 : Displays the right part of the text if there isn't enough room
# 2 : Justfify text to the left if there is enough room.
# 3 : Does not try to allocate space according to its contents
proc fileLabel {w args} {
    ttk::entryX $w -style TLabel
    $w configure {*}$args

        } elseif {$arg eq "-nokeyword"} {
            set Pref(dir,ignorekey) 1
        } elseif {$arg eq "-prefix"} {
            set nextArg prefix
        } elseif {$arg eq "-preprocess"} {
            set nextArg preprocess
        } elseif {$arg eq "-plugin"} {
            set nextArg "plugin"
        } elseif {$arg eq "-plugininfo"} {
            set nextArg "plugininfo"
        } elseif {$arg eq "-plugindump"} {
            set nextArg "plugindump"
        } elseif {$arg eq "-pluginlist"} {
            set pluginlist 1
        } elseif {$arg eq "-context"} {
            set nextArg context
        } elseif {$arg eq "-noparse"} {
            set Pref(parse) 0
        } elseif {$arg eq "-line"} {

    }
    unset Pref(onlydiffs)

    # Set up reactions to some Pref settings
    if {![info exists ::widgets(toolbars)]} {
        set ::widgets(toolbars) {}
    }

    trace add variable ::Pref(toolbar) write TraceToolbar
}

proc TraceToolbar {args} {
    # FIXA: Handle destroyed windows ?
    foreach __ $::widgets(toolbars) {
        if {$::Pref(toolbar)} {
            grid configure $__
        } else {
            grid remove $__
        }
    }

}

# Global code is only run the first time to be able to reread source
if {![info exists ::eskil(gurkmeja)]} {
    set ::eskil(gurkmeja) 1

    package require pstools
    namespace import -force pstools::*
    getOptions
    if {![info exists ::eskil_testsuite]} {
        parseCommandLine
    }
}

        set ::diff($top,plugininfo) ""
    }
    set ::diff($top,edit,pluginname) $::diff($top,pluginname) 
    set ::diff($top,edit,plugininfo) $::diff($top,plugininfo)
    set t 0
    foreach {plugin descr} $plugins {
        ttk::radiobutton $w.rb$t -variable ::diff($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 ::diff($top,edit,pluginname) -value "" -text "No Plugin"
    grid $w.rb$t -sticky we -padx 3 -pady 3

    ttk::label $w.li -text "Info" -anchor "w"
    ttk::entry $w.ei -textvariable ::diff($top,edit,plugininfo)
    grid $w.li $w.ei -sticky we -padx 3 -pady 3

    ttk::frame $w.fb -padding 3
    ttk::button $w.fb.b1 -text "Ok"     -command [list EditPrefPluginsOk $top $w]
    ttk::button $w.fb.b2 -text "Cancel" -command [list destroy $w]
    set ::widgets($top,prefPluginsOk) $w.fb.b1

    if {$revs == ""} { set revs -1 }
    foreach rev $revs {
        if {[string is digit $rev]} {
            lappend result $rev
        } else {
            if {[catch {exec csh -c "icmp4 files $filename"} res]} {
                tk_messageBox -icon error \
                        -message "Failed p4 files filename: $rev"
                exit
            }
            regexp {\#(\d+)} [file tail $res] -> res
            if {$rev != ""} { incr res $rev }
            lappend result $res
        }
    }