Eskil

2015-11-22
 Allow plugins to define command line options.

2015-11-20
 Rebuilt command line option handling.

2015-11-19
 Added binary plugin.

2015-11-17

##Eskil Plugin : Compare comma separated value (CSV) files
## Option -csvignore : A list of columns to ignore
## Option -csvkey    : A list of columns to sort on before comparison
## Flag   -csvheader : First line is a header line defining names of columns

# Example file for a plugin.
# A plugin's first line must start exactly like this one.
# The text after : is the summary you can get at the command line

# A plugin may declare command line options that should be allowed through
# to ::argv

# This plugin compares CSV files with some preprocessing available
# Example usage:
# eskil -plugin csv -csvignore "head3 head5" -csvkey head2 -sep , \
#       examples/dir*/csv1.txt

# A plugin must define this procedure to do the job.
# side: left or right
# chi:  An input channel for reading the original file.
# cho:  An output channel for writing the processed file.
proc PreProcess {side chi cho} {
    # Look for parameters in command line
    set opts(-sep) ","
    set opts(-csvignore) ""
    set opts(-csvkey) ""
    set opts(-csvheader) 0
    foreach opt {-sep -csvignore -csvkey} {
        set i [lsearch -exact $::argv $opt]
        if {$i >= 0} {
            incr i

        }
        set opts($opt) [lindex $::argv $i]
    }

    set opts(-sep) [subst -nocommands -novariables $opts(-sep)]
    set i [lsearch -exact $::argv "-csvheader"]
    if {$i >= 0} {
        set opts(-csvheader) 1
    }

    # Also allow options via info
    foreach {opt val} $::Info {
        set opts($opt) $val
    }
    # If any column is given by name, assume the file starts with
    # a header line of column names
    foreach col [concat $opts(-csvignore) $opts(-csvkey)] {
        if {![string is integer $col]} {
            set opts(-csvheader) 1
        }
    }
    if {$opts(-csvheader)} {
        set nameLine [gets $chi]
        # Keep it first in file
        puts $cho $nameLine
        set nameList [split $nameLine $opts(-sep)]
    }

    set icol {}
    foreach col $opts(-csvignore) {
        if {[string is integer $col]} {
            lappend icol $col
        } else {
            set i [lsearch $nameList $col]
            if {$i < 0} {
                return -code error "CSV Plugin Error: No such heading '$col'"
            }
            lappend icol $i
        }
    }
    set icol [lsort -integer $icol]

    set kcol {}
    foreach col $opts(-csvkey) {
        if {[string is integer $col]} {
            lappend kcol $col
        } else {
            set i [lsearch $nameList $col]
            if {$i < 0} {
                return -code error "CSV Plugin Error: No such heading '$col'"
            }

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

# Do initalisations for needed packages and globals.
# This is not run until needed to speed up command line error reporting.
proc Init {} {
    if {[info exists ::eskil(initHasRun)]} {
        return
    }
    set ::eskil(initHasRun) 1
    package require Tk 8.4
    catch {package require textSearch}
    package require wcb
    package require snit
    package require tablelist_tile

    if {[catch {package require psballoon}]} {

    package require pdf4tcl
    if {[llength [pdf4tcl::getPaperSize $arg]] != 2} {
        puts "Argument $opt must be a valid paper size"
        puts "Valid paper sizes:"
        puts [join [lsort -dictionary [pdf4tcl::getPaperSizeList]] \n]
        exit
    }
}
proc optValidatePlugin {opt arg} {
    # We must start up completely to check a plugin
    Init
    set src [LocatePlugin $arg]
    if {$src eq ""} {
        puts "Bad plugin: $arg"
        printPlugins
        exit
    }
    # Look for declarations of command line options
    set ch [open $src r]
    while {[gets $ch line] >= 0} {
        # Only look until empty line
        if {[string trim $line] eq ""} break
        if {[regexp {^\#\# Option\s+(\S+)} $line -> name]} {
            addOpt $name
        }
        if {[regexp {^\#\# Flag\s+(\S+)} $line -> name]} {
            addFlags $name
        }
    }
    close $ch
}
# Option database setup
proc initOpts {} {
    set ::eskil(opts) {}
    set ::eskil(defoptinfo) {
        flag 0
        given 0

proc addPrefOpt {name elem {validator ""}} {
    dict set ::eskil(opts) $name ""
    dict set ::eskil(opts,info) $name $::eskil(defoptinfo)
    dict set ::eskil(opts,info) $name type Pref
    dict set ::eskil(opts,info) $name "elem" $elem
    dict set ::eskil(opts,info) $name "validator" $validator
}
# Add a vaildator command to an Opt
proc addValidator {name cmd} {
    dict set ::eskil(opts,info) $name validator $cmd
}
# Add a filter command prefix to an Opt
proc addFilter {name cmd} {
    dict set ::eskil(opts,info) $name filter $cmd
}
# Add a sideeffect to an Opt
##nagelfar syntax addSideEffect x c
proc addSideEffect {name script} {

    addFlags -browse -nodiff
    addFlags -server -cvs -svn -debug
    addFlags -foreach -close
    addFlags -nonewline -nonewline+ -nocdiff
    addFlags -pluginlist -pluginallow
    # Options that take values
    addOpt   -plugin
    addValidator -plugin optValidatePlugin
    addOpt   -plugininfo
    addOpt   -plugindump
    # These options affect Pref
    addPrefOpt -pivot             pivot             optValidatePositive
    addPrefOpt -context           context           optValidateNatural
    addPrefOpt -printHeaderSize   printHeaderSize   optValidatePositive
    addPrefOpt -printCharsPerLine printCharsPerLine optValidatePositive

    if {$plugindump ne ""} {
        printPlugin $plugindump
        exit
    }
    if {$plugin ne ""} {
        set pinterp [createPluginInterp $plugin $plugininfo $pluginallow pinfo]
        if {$pinterp eq ""} {
            # This should not happen since the validator should handle it
            puts "Bad plugin: $plugin"
            printPlugins
            exit
        }
        set opts(plugin) $pinterp
        set opts(pluginname) $plugin
        set opts(plugininfo) $plugininfo

proc printPlugins {} {
    set plugins [listPlugins]
    if {[llength $plugins] == 0} {
        puts "No plugins found."
        return
    }
    set w 0
    foreach {plugin info} $plugins {
        if {[string length $plugin] > $w} {
            set w [string length $plugin]
        }
    }
    incr w 2
    puts "Available plugins:"
    foreach {plugin info} $plugins {
        set descr [dict get $info descr]
        puts "Plugin [format %-*s $w \"$plugin\"] : $descr"
    }
}

proc preparePlugin {top} {
    disallowEdit $top
    set allow [dict get $::eskil($top,pluginpinfo) allow]
    # Pass ::argv to plugin