Eskil

2015-11-20
 Rebuilt command line option handling.

2015-11-19
 Added binary plugin.

2015-11-17
 Compress printed PDF.

2015-10-14

# 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.7+ 2015-11-20"
set ::eskil(thisScript) [file join [pwd] [info script]]

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

        set ext [file extension $fontfile]
        if {$ext eq ".afm"} {
            pdf4tcl::loadBaseType1Font EskilBase $fontfile \
                    [file rootname $fontfile].pfb
        } else {
            pdf4tcl::loadBaseTrueTypeFont EskilBase $fontfile 1
        }

        pdf4tcl::createFont EskilBase EskilFont cp1251
        set ::eskil(printFont) EskilFont
    }

    # Figure out a place to store temporary files.
    locateTmp ::eskil(tmpdir)

    if {$::tcl_platform(platform) eq "windows"} {

        set words [split $text $RE]
        set id [$::widgets($top,wTable) insert end $words]
        if {$tag ne "equal"} {
            set col 0
            foreach w $words {
                if {$n == 1} {
                    # TBD TABLE, r is faked here for now
                    dict set ::eskil($top,tablechanges) $id,$col w1 $w
                    dict set ::eskil($top,tablechanges) $id,$col w2 ""
                    dict set ::eskil($top,tablechanges) $id,$col r  "0 0 1 1"
                } else {
                    dict set ::eskil($top,tablechanges) $id,$col w1 ""
                    dict set ::eskil($top,tablechanges) $id,$col w2 $w
                    dict set ::eskil($top,tablechanges) $id,$col r  "0 0 1 1"
                }
                incr col
            }
        }
        return

        # Lap 2, collect cell changes once we have the row id
        set col -1
        foreach w1 $words1 w2 $words2 r $rs {
            incr col
            # Equal? Skip
            if {[llength $r] <= 2} continue
            dict set ::eskil($top,tablechanges) $id,$col "w1" $w1
            dict set ::eskil($top,tablechanges) $id,$col "w2" $w2
            dict set ::eskil($top,tablechanges) $id,$col "r"  $r
        }

        incr doingLine1
        incr doingLine2
        return

    if {$::eskil($top,view) eq "table"} {
        # Look for table header line
        set i [lindex $diffres 0]
        lassign $i line1 n1 line2 n2
        if {$line1 == 1 || $line2 == 1} {
            # Hide header line of widget TBD TABLE
            #$::widgets($top,wTable) configure
            # Set up columns??
            $::widgets($top,wTable) configure \
                    -columns "0 Table 0 without 0 header 0 not 0 implemented 0 yet"
        } else {
            # First lines are equal, treat them as header
            # Consume table header line
            gets $ch1 line1
            incr doingLine1
            gets $ch2 line
            incr doingLine2
            if {$::eskil($top,separator) eq ""} {
                # Autodetect separator
                # Any tab?
                if {[regsub -all "\t" $line1 "\t" _] >= 2} {
                    set ::eskil($top,separator) "\t"
                } elseif {[regsub -all "," $line1 "," _] >= 2} {
                    set ::eskil($top,separator) ","
                }
            }
            set headings [split $line1 $::eskil($top,separator)]
            set columns {}
            foreach heading $headings {
                lappend columns 0 $heading
            }
            $::widgets($top,wTable) configure -columns $columns

        $body tag configure new2 -foreground $::Pref(colornew2) \
                -background $::Pref(bgnew2)
        $body tag configure change -foreground $::Pref(colorchange) \
                -background $::Pref(bgchange)

        set bg [ttk::style configure . -background]
        set map [createMap $top $bg]

        grid $top.ft.tab $top.ft.vsb $map -sticky news
        grid $top.ft.hsb x           x    -sticky news
        grid columnconfigure $top.ft 0 -weight 1
        grid rowconfigure    $top.ft 0 -weight 1
        grid $map -pady [expr {[winfo reqwidth $top.ft.vsb] - 2}]
        set ::widgets($top,wTable) $top.ft.tab
    } else {

        }
    }
    if {$fail} {
        puts "Argument $opt must be a list of RBG values from 0.0 to 1.0"
        exit
    }
}

# Option/flag handling helpers
proc initOpts {} {
    set ::eskil(opts) {}
}
# Add a command line flag that do not take a value
proc addFlags {args} {
    foreach name $args {
        dict set ::eskil(opts) $name 0
        dict set ::eskil(opts,info) $name flag  1
        dict set ::eskil(opts,info) $name given 0
        dict set ::eskil(opts,info) $name multi 0
    }
}
# Add a command line option that takes a value
proc addOpt {name {def ""}} {
    dict set ::eskil(opts) $name $def
    dict set ::eskil(opts,info) $name flag  0
    dict set ::eskil(opts,info) $name given 0
    dict set ::eskil(opts,info) $name multi 0
}
# Add a command line option that takes multiple values
proc addMultOpt {name} {
    dict set ::eskil(opts) $name {}
    dict set ::eskil(opts,info) $name flag  0
    dict set ::eskil(opts,info) $name given 0
    dict set ::eskil(opts,info) $name multi 1
}
# List all known options
proc allOpts {{pat *}} {
    return [dict keys $::eskil(opts) $pat]
}
proc optIsFlag {arg} {
    return [dict get $::eskil(opts,info) $arg flag]
}
proc optIsGiven {arg valName} {
    upvar 1 $valName val
    set val [dict get $::eskil(opts) $arg]
    return [dict get $::eskil(opts,info) $arg given]
}
proc optSet {arg val} {
    if {[dict get $::eskil(opts,info) $arg multi]} {
        dict lappend ::eskil(opts) $arg $val
    } else {
        dict set ::eskil(opts) $arg $val
    }
    dict set ::eskil(opts,info) $arg given 1
}
proc optGet {arg} {
    return [dict get $::eskil(opts) $arg]
}

# Helper to add a file argument to list of files
proc cmdLineAddFile {filesName arg} {
    upvar 1 $filesName files
    set apa [file normalize [file join [pwd] $arg]]
    if {![file exists $apa]} {
        puts "Bad argument: $arg"
        exit
    } else {
        lappend files $apa
    }
}

# Go through all command line arguments and start the appropriate
# diff window.
# Returns the created toplevel.
# This can be used as an entry point if embedding eskil.
# In that case fill in ::eskil(argv) and ::eskil(argc) before calling.
proc parseCommandLine {} {
    global dirdiff

    set ::eskil(autoclose) 0
    set ::eskil(ignorenewline) 0
    set ::eskil(defaultopts) {}

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

    # Set up all options info
    initOpts
    addFlags -w -b -noignore
    addFlags -i -nocase -nodigit -nokeyword
    addFlags --help -help
    addFlags -noparse -line -smallblock -block
    addFlags -char -word
    addFlags -dir -clip -patch -conflict -review -table
    addFlags -browse -noempty -nodiff
    addFlags -server -fine -cvs -svn -debug
    addFlags -foreach -close
    addFlags -nonewline -nonewline+ -nocdiff
    addFlags -pluginlist -pluginallow
    # Options that take values
    addOpt   -plugin
    addOpt   -plugininfo
    addOpt   -plugindump
    # These options affect Pref
    addOpt   -pivot
    addOpt   -context
    addMultOpt -prefix
    addMultOpt -preprocess
    addMultOpt -preprocessleft
    addMultOpt -preprocessright
    addOpt   -printHeaderSize
    addOpt   -printCharsPerLine
    addOpt   -printPaper
    addOpt   -printColorChange
    addOpt   -printColorOld
    addOpt   -printColorNew
    addOpt   -printFont



    # These affect opts
    addOpt   -limit
    addOpt   -maxwidth
    addOpt   -o
    addOpt   -a
    addOpt   -sep
    addOpt   -print
    addOpt   -printpdf ;# Old option
    addMultOpt -r


    # If the first option is "--query", use it to ask about options.
    if {$::eskil(argc) == 2 && [lindex $::eskil(argv) 0] == "--query"} {
        set arg [lindex $::eskil(argv) 1]
        set allOpts [allOpts]
        if {[lsearch -exact $allOpts $arg] < 0} {
            set match [lsearch -glob -all -inline $allOpts $arg*]
        } else {
            set match [list $arg]
        }
        puts [lsort -dictionary $match]
        exit
    }

    # Go through and fill in options



    set files {}












    for {set i 0} {$i < [llength $::eskil(argv)]} {incr i} {
        set arg [lindex $::eskil(argv) $i]
        # Non-dash means not an option
        if {[string index $arg 0] ne "-"} {






            cmdLineAddFile files $arg




            continue




        }



































        if {$arg eq "-"} {

















            # Allow "-" for stdin patch processing

            lappend files "-"








            continue
        }
        # Take care of the special case of RCS style -r<rev>
        if {$arg ne "-review" && [string range $arg 0 1] eq "-r" && \
                    [string length $arg] > 2} {
            optSet -r [string range $arg 2 end]

            continue
        }
        # Handle unknowns
        if {![dict exists $::eskil(opts) $arg]} {
            # Try to see if it is an unique abbreviation of an option.

            set match [allOpts $arg*]

            if {[llength $match] == 1} {
                set arg [lindex $match 0]
            } else {
                # If not, try to put it among files
                cmdLineAddFile files $arg
                continue
            }
        }
        # Flags
        if {[optIsFlag $arg]} {
            set val 1
        } else {
            # Options with values
            incr i
            set val [lindex $::eskil(argv) $i]
        }
        optSet $arg $val
    }

    if {[optIsGiven -help arg] || [optIsGiven --help arg]} {
        printUsage
        exit
    }

    # All options have been parsed, extract them to where they need to go

    # Straight to locals
    set plugin      [optGet -plugin]
    set plugininfo  [optGet -plugininfo]
    set plugindump  [optGet -plugindump]
    set pluginlist  [optGet -pluginlist]
    set pluginallow [optGet -pluginallow]
    set noautodiff  [optGet -nodiff]
    set nocdiff     [optGet -nocdiff]
    set dodir       [optGet -dir]
    set doclip      [optGet -clip]
    set dopatch     [optGet -patch]
    set doreview    [optGet -review]
    set autobrowse  [optGet -browse]
    set foreach     [optGet -foreach]
    set preferedRev "GIT"
    if {[optGet -svn]} {
        set preferedRev "SVN"
    } elseif {[optGet -cvs]} {
        set preferedRev "CVS"
    }

    # TODO: Handle mutually exclusive options in optparsing directly?
    if {[optIsGiven -w arg]} {
        set ::Pref(ignore) "-w"
    } elseif {[optIsGiven -b arg]} {
        set ::Pref(ignore) "-b"
    } elseif {[optIsGiven -noignore arg]} {
        set ::Pref(ignore) " "


    }
    if {[optIsGiven -noparse arg]} {
        set ::Pref(parse) 0
    } elseif {[optIsGiven -line arg]} {
        set ::Pref(parse) 1
    } elseif {[optIsGiven -smallblock arg]} {
        set ::Pref(parse) 2
    } elseif {[optIsGiven -block arg]} {
        set ::Pref(parse) 3
    }
    if {[optIsGiven -char arg]} {
        set ::Pref(lineparsewords) 0
    } elseif {[optIsGiven -word arg]} {
        set ::Pref(lineparsewords) 1
    }

    # These directly correspond to Pref settings
    set apa {
        -printFont printFont
        -context   context
        -i nocase -nocase nocase
        -noempty   noempty
        -nodigit   nodigit
        -nokeyword dir,ignorekey
        -fine      finegrainchunks
    }
    foreach {opt elem} $apa {
        if {[optIsGiven $opt arg]} {
            set ::Pref($elem) $arg
        }
    }

    # These directly correspond to opts settings
    set apa {

        -limit limitlines

        -maxwidth maxwidth
    }
    foreach {opt elem} $apa {
        if {[optIsGiven $opt arg]} {
            set opts($elem) $arg
        }
    }

    # These directly correspond to ::eskil settings
    set apa {
        -nonewline  ignorenewline 1
        -nonewline+ ignorenewline 2
        -close      autoclose 1
        -debug      debug 1
    }
    foreach {opt elem val} $apa {
        if {[optIsGiven $opt arg]} {
            set ::eskil($elem) $val
        }
    }

    # Options that need individual checking/processing
    if {[optIsGiven -o arg]} {
        set opts(mergeFile) [file join [pwd] $arg]
    }
    if {[optIsGiven -a arg]} {
        set opts(ancestorFile) [file join [pwd] $arg]
        # Default is no ignore on three-way merge
        set ::Pref(ignore) " "
    }
    if {[optIsGiven -sep arg]} {
        # Handle if separator is given e.g. as '\t'
        set opts(separator) [subst -nocommands -novariables $arg]
    }
    if {[optIsGiven -print arg] || [optIsGiven -printpdf arg]} {
        set opts(printFile) [file join [pwd] $arg]
        set opts(printFileCmd) 1
    }
    if {[optIsGiven -conflict arg]} {
        set opts(mode) "conflict"
        # Conflict implies foreach
        set foreach 1
    }
    if {[optIsGiven -table arg]} {
        set opts(view) "table"
    }
    if {[optIsGiven -printHeaderSize arg]} {
        if {![string is double -strict $arg] || $arg <= 0} {
            puts "Argument -printHeaderSize must be a positive number"
            exit

        }
        set ::Pref(printHeaderSize) $arg
    }
    if {[optIsGiven -printCharsPerLine arg]} {

        if {![string is double -strict $arg] || $arg <= 0} {
            puts "Argument -printCharsPerLine must be a positive number"
            exit
        }
        set ::Pref(printCharsPerLine) $arg
    }
    if {[optIsGiven -printPaper arg]} {
        package require pdf4tcl
        if {[llength [pdf4tcl::getPaperSize $arg]] != 2} {
            puts "Argument -printPaper must be a valid paper size"
            puts "Valid paper sizes:"
            puts [join [lsort -dictionary [pdf4tcl::getPaperSizeList]] \n]
            exit
        }
        set ::Pref(printPaper) $arg
    }
    if {[optIsGiven -printColorChange arg]} {
        ValidatePdfColor $arg -printColorChange
        set ::Pref(printColorChange) $arg
    }
    if {[optIsGiven -printColorOld arg]} {
        ValidatePdfColor $arg -printColorOld
        set ::Pref(printColorNew1) $arg
    }
    if {[optIsGiven -printColorNew arg]} {
        ValidatePdfColor $arg -printColorNew
        set ::Pref(printColorNew2) $arg
    }
    if {[optIsGiven -pivot arg]} {

        if {$arg >= 1} {
            set ::Pref(pivot) $arg
        }
    }
    if {[optIsGiven -prefix arg]} {
        foreach apa $arg {
            set RE [string map [list % $apa] {^.*?\m(%\w+).*$}]
            if {$::Pref(nocase)} {
                set RE "(?i)$RE"
            }
            lappend ::Pref(preprocess) $RE {\1} ""
        }
    }
    if {[optIsGiven -preprocess arg]} {
        # FIXA: better validity check
        foreach apa $arg {
            foreach {RE sub} $apa {
                lappend ::Pref(preprocess) $RE $sub ""
            }
        }
    }
    if {[optIsGiven -preprocessleft arg]} {

        # FIXA: better validity check
        foreach apa $arg {

            foreach {RE sub} $apa {
                lappend ::Pref(preprocess) $RE $sub left
            }
        }
    }
    if {[optIsGiven -preprocessright arg]} {
        # FIXA: better validity check
        foreach apa $arg {
            foreach {RE sub} $apa {
                lappend ::Pref(preprocess) $RE $sub right
            }
        }
    }
    # Handle list of revisions
    if {[optIsGiven -r arg]} {
        set revNo 1
        foreach rev $arg {

            set opts(doptrev$revNo) $rev
            incr revNo
        }
    }
    if {[optGet -server]} {
        if {$::tcl_platform(platform) eq "windows"} {
            catch {
                package require dde
                dde servername Eskil
            }
        } else {
            package require Tk
            tk appname Eskil
        }




























    }


    # Option handling done. Lets get started.

    Init

    if {$nocdiff} {
        DisableDiffUtilC
    }

        set fullname2 [lindex $files 1]
        if {[FileIsDirectory $fullname1 1] && [FileIsDirectory $fullname2 1]} {
            set dirdiff(leftDir) $fullname1
            set dirdiff(rightDir) $fullname2
            return [makeDirDiffWin]
        }
    }

    # Ok, we have a normal diff
    set top [makeDiffWin]
    update

    # It is preferable to see the end if the rev string is too long
    $::widgets($top,rev1) xview end
    $::widgets($top,rev2) xview end