#!/bin/sh
#---------------------------------------------------------- -*- tcl -*-
#
# Eskil, a Graphical frontend to diff
#
# Copyright (c) 1998-2015, Peter Spjuth (peter.spjuth@gmail.com)
#
# Usage
# Do 'eskil' for interactive mode
# Do 'eskil --help' for command line usage
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; see the file COPYING. If not, write to
# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
#
#----------------------------------------------------------------------
# the next line restarts using tclsh \
exec tclsh "$0" "$@"
package require Tcl 8.6-
# 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
namespace import tcl::mathop::+
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.6-
catch {package require textSearch}
package require wcb
package require snit
package require tablelist_tile
package require psmenu
package require psdebug
namespace import ::_PsDebug::*
if {[catch {package require psballoon}]} {
# Add a dummy if it does not exist.
proc addBalloon {args} {}
} else {
namespace import -force psballoon::addBalloon
}
if {[file exists $::eskil(thisDir)/../version.txt]} {
set ch [open $::eskil(thisDir)/../version.txt]
set ::eskil(diffver) [string trim [read $ch 100]]
close $ch
}
# Get all other source files
InitReSource
# Diff functionality is in the DiffUtil package.
package require DiffUtil 0.4
# Help DiffUtil to find a diff executable, if needed
catch {DiffUtil::LocateDiffExe $::eskil(thisScript)}
# Create font for PDF
if {$::Pref(printFont) eq ""} {
set fontfile $::eskil(thisDir)/embedfont.ttf
} else {
set fontfile $::Pref(printFont)
}
# Allow fallback to PDF-builtin Courier
if {$fontfile eq "Courier"} {
set ::eskil(printFont) Courier
} else {
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 cp1252
set ::eskil(printFont) EskilFont
}
# Figure out a place to store temporary files.
locateTmp ::eskil(tmpdir)
if {$::tcl_platform(platform) eq "windows"} {
# Locate CVS if it is in c:/bin
if {[auto_execok cvs] eq "" && [file exists "c:/bin/cvs.exe"]} {
set ::env(PATH) "$::env(PATH);c:\\bin"
auto_reset
}
}
defaultGuiOptions
if {0 && [bind all <Alt-KeyPress>] eq ""} {
bind all <Alt-KeyPress> [bind Menubutton <Alt-KeyPress>]
#after 500 "tk_messageBox -message Miffo"
}
wm withdraw .
if {[catch {package require Ttk}]} {
if {[catch {package require tile}]} {
if {[info exists ::eskil_testsuite]} {
return
} else {
puts "Themed Tk not found"
exit
}
}
}
# Provide a ttk-friendly toplevel, fixing background and menubar
if {[info commands ttk::toplevel] eq ""} {
proc ttk::toplevel {W args} {
tk::toplevel $W {*}$args
place [ttk::frame $W.tilebg] -border outside \
-x 0 -y 0 -relwidth 1 -relheight 1
return $W
}
}
::snit::widgetadaptor ttk::entryX {
delegate method * to hull
delegate option * to hull
constructor {args} {
installhull using ttk::entry
$self configurelist $args
# Make sure textvariable is initialised
set varName [from args -textvariable ""]
if {$varName ne ""} {
upvar \#0 $varName var
if { ! [info exists var]} {
set var ""
}
}
}
# Circumvent a bug in ttk::entry that "xview end" does not work.
# Fixed 2013-06-05, bug 3613750. 8.5.16 and 8.6.2.
method xview {args} {
if {[llength $args] == 1} {
set ix [lindex $args 0]
$hull xview [$hull index $ix]
} else {
$hull xview {*}$args
}
}
}
interp alias {} toplevel {} ttk::toplevel
# Use demo images from Tablelist
set dir $::eskil(thisDir)/../lib/tablelist/demos
if {[catch {
set ::img(clsd) [image create photo -file [file join $dir clsdFolder.gif]]
set ::img(open) [image create photo -file [file join $dir openFolder.gif]]
set ::img(file) [image create photo -file [file join $dir file.gif]]
}]} then {
set ::img(clsd) ""
set ::img(open) ""
set ::img(file) ""
}
# Local images
set dir $::eskil(thisDir)/images
set ::img(link) [image create photo -file [file join $dir link.gif]]
set ::img(left) [image create photo -file [file join $dir arrow_left.gif]]
set ::img(right) [image create photo -file [file join $dir arrow_right.gif]]
set ::img(browse) [image create photo -file [file join $dir folderopen1.gif]]
set ::img(up) [image create photo -file [file join $dir arrow_up.gif]]
# Create a double up arrow
set ih [image height $::img(up)]
set iw [image width $::img(up)]
set ::img(upup) [image create photo -height $ih -width [expr {2 * $iw}]]
$::img(upup) copy $::img(up) -to 0 0 [expr {2 * $iw - 1}] [expr {$ih - 1}]
EskilThemeInit
}
# Load sources needed early, during command line handling
proc InitSourceEarly {{srcdir {}}} {
if {$srcdir eq ""} {
set srcdir $::eskil(thisDir)
}
source $srcdir/preprocess.tcl
}
proc InitReSource {{srcdir {}}} {
if {$srcdir eq ""} {
set srcdir $::eskil(thisDir)
}
InitSourceEarly $srcdir
# Get all other source files
source $srcdir/eskil.tcl
source $srcdir/clip.tcl
source $srcdir/compare.tcl
source $srcdir/map.tcl
source $srcdir/merge.tcl
source $srcdir/registry.tcl
source $srcdir/dirdiff.tcl
source $srcdir/fourway.tcl
source $srcdir/help.tcl
source $srcdir/plugin.tcl
source $srcdir/printobj.tcl
source $srcdir/print.tcl
source $srcdir/rev.tcl
# Only load vcsvfs if vfs is present
if { ! [catch {package require vfs}]} {
source $srcdir/vcsvfs.tcl
}
}
# Debug function to be able to reread the source even when wrapped in a kit.
proc EskilRereadSource {} {
set this $::eskil(thisScript)
# FIXA: Better detection of starkit?
# Maybe look at ::starkit::topdir ?
#if {[info exists ::starkit::topdir]} {
# puts "Topdir: $::starkit::topdir"
#}
# Are we in a Starkit?
if {[regexp {^(.*eskil)((?:\.[^/]+)?)(/src/.*)$} $this -> \
pre ext post]} {
if {$ext ne ".vfs"} {
# If the unpacked vfs directory is available, read from that
# instead.
set src $pre.vfs$post
if {[file readable $src]} {
set this $src
}
}
}
puts "Resourcing $this"
uplevel \#0 [list source $this]
# Get all other source files
InitReSource [file dirname $this]
}
# Initialize Ttk style settings
proc EskilThemeInit {} {
# Import the 'default' theme border element.
catch { ttk::style element create plain.border from default }
catch { ttk::style element create plain.padding from default }
catch { ttk::style element create plain.label from default }
# Create a new style using the imported element.
ttk::style layout My.Toolbutton {
My.Toolbutton.plain.border -sticky nswe -children {
My.Toolbutton.padding -sticky nswe -children {
My.Toolbutton.label -sticky nswe
}
}
}
# Configure our new style.
ttk::style configure My.Toolbutton {*}[ttk::style configure Toolbutton] \
-padding {1 1}
ttk::style map My.Toolbutton {*}[ttk::style map Toolbutton] \
-relief {disabled flat selected sunken pressed sunken active raised}
# Re-do if the user changes theme.
if {[lsearch -exact [bind . <<ThemeChanged>>] EskilThemeInit] == -1} {
bind . <<ThemeChanged>> +EskilThemeInit
}
}
proc defaultGuiOptions {} {
# Turn off tearoff on all systems
option add *Menu.tearOff 0
if {[tk windowingsystem]=="x11"} {
# Menubar looks out of place on linux. This adjusts the background
# Which is enough to make it reasonable.
set bg [ttk::style configure . -background]
set sbg [ttk::style configure . -selectbackground]
option add *Menubutton.background $bg
option add *Menu.background $bg
option add *Menu.activeBackground $sbg
option add *Listbox.background $bg
option add *Listbox.selectBackground $sbg
option add *Text.background white
option add *Text.selectBackground $sbg
#option add *Scrollbar.takeFocus 0
#option add *highlightThickness 0
}
}
#####################################
# Startup stuff
#####################################
proc printUsage {} {
set usageStr {Usage: eskil [options] [files...]
[options] See below.
[files...] Files to be compared
%v%
If no files are given, the program is started anyway and you can select
files from within. If only one file is given, the program looks for version
control of the file, and if found, runs in version control mode.
If directories are given, Eskil starts in directory diff.
To list all options matching a prefix, run 'eskil --query prefix'.
In tcsh use this line to get option completion:
complete eskil 'C/-/`eskil --query -`/'
Options:}
set versionStr ""
if {[file exists $::eskil(thisDir)/../version.txt]} {
set ch [open $::eskil(thisDir)/../version.txt]
set versionStr [string trim [read $ch 100]]
close $ch
set versionStr "$versionStr\n"
}
set usageStr [string map [list "%v%" $versionStr] $usageStr]
puts $usageStr
# Dump option info
foreach name [lsort -dictionary [dict keys $::eskil(opts,info)]] {
set outName $name
if { ! [dict exists $::eskil(opts,info) $name flag]} {
puts "Internal Error: BOHOHOHO $name"
break
}
if { ! [dict get $::eskil(opts,info) $name flag]} {
set valueName v
# Detect a reference in short description
set short [dict get $::eskil(opts,info) $name shortdescr]
if {[regexp {<(.*?)>} $short -> var] } {
set valueName $var
}
append outName " <$valueName>"
}
# Line up shorter ones
if {[string length $outName] < 12} {
set outName [format %-12s $outName]
}
set outName "$outName : "
set indent [string length $outName]
set len [expr {80 - $indent}]
set d [dict get $::eskil(opts,info) $name shortdescr]
if {$d eq "_"} continue
while {$d ne ""} {
if {[string length $d] <= $len} {
set chunk $d
set d ""
} else {
set ci $len
while {[string index $d $ci] ne " " && $ci > 40} {
incr ci -1
}
set chunk [string range $d 0 $ci-1]
set d [string trim [string range $d $ci end]]
}
puts "$outName$chunk"
set outName [format %*s $indent ""]
}
}
# Dump any plugin that has options defined
foreach {plugin _} $::eskil(opts,src) {
puts ""
printPlugin $plugin 1
}
}
#####################################
# Option/flag handling helpers
#####################################
# Validators
proc optValidatePdfColor {opt arg} {
set fail 0
if { ! [string is list $arg] || [llength $arg] != 3} {
set fail 1
} else {
foreach val $arg {
if { ! [string is double -strict $val] || $val < 0.0 || $val > 1.0} {
set fail 1
}
}
}
if {$fail} {
puts "Argument $opt must be a list of RBG values from 0.0 to 1.0"
exit
}
}
proc optValidatePositive {opt arg} {
if { ! [string is double -strict $arg] || $arg <= 0} {
puts "Argument $opt must be a positive number"
exit
}
}
proc optValidateNatural {opt arg} {
if { ! [string is integer -strict $arg] || $arg < 0} {
puts "Argument $opt must be a natural number"
exit
}
}
proc optValidatePaper {opt arg} {
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 res [LocatePlugin $arg]
set src [dict get $res file]
if {$src eq ""} {
puts "Bad plugin: $arg"
printPlugins
exit
}
# Look for declarations of command line options
foreach {name flag doc} [dict get $res opts] {
if {$flag} {
addFlags $name
} else {
addOpt $name
}
docFlag $name "Plugin $arg : $doc"
addSource $name $arg
}
# Special:
# If a -plugin is given and plugininfo and pluginallow is not
# balanced, extend them.
set n [llength [dict get $::eskil(opts) -plugin]]
# Validator is called after this -plugin was added.
incr n -1
while {[llength [dict get $::eskil(opts) -plugininfo]] < $n} {
dict lappend ::eskil(opts) -plugininfo ""
}
while {[llength [dict get $::eskil(opts) -pluginallow]] < $n} {
dict lappend ::eskil(opts) -pluginallow 0
}
}
# Option database setup
proc initOpts {} {
set ::eskil(opts) {}
set ::eskil(opts,info) {}
set ::eskil(opts,src) {}
set ::eskil(defoptinfo) {
flag 0
given 0
multi 0
type ""
validator ""
filter ""
sideeffect ""
shortdescr ""
longdescr ""
source ""
}
}
# 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 $::eskil(defoptinfo)
dict set ::eskil(opts,info) $name flag 1
}
}
# Add a command line flag that do not take a value, but can be given multiple
proc addMultFlags {args} {
foreach name $args {
dict set ::eskil(opts) $name {}
dict set ::eskil(opts,info) $name $::eskil(defoptinfo)
dict set ::eskil(opts,info) $name flag 1
dict set ::eskil(opts,info) $name multi 1
}
}
# Document a flag or option
proc docFlag {name short {long {}}} {
dict set ::eskil(opts,info) $name shortdescr $short
dict set ::eskil(opts,info) $name longdescr $long
}
# Flag that affects Pref
proc addPrefFlag {name elem {value 1}} {
dict set ::eskil(opts) $name 0
dict set ::eskil(opts,info) $name $::eskil(defoptinfo)
dict set ::eskil(opts,info) $name flag 1
dict set ::eskil(opts,info) $name type Pref
dict set ::eskil(opts,info) $name "elem" $elem
dict set ::eskil(opts,info) $name "value" $value
}
# Flag that affects local opts
proc addOptsFlag {name elem {value 1}} {
dict set ::eskil(opts) $name 0
dict set ::eskil(opts,info) $name $::eskil(defoptinfo)
dict set ::eskil(opts,info) $name flag 1
dict set ::eskil(opts,info) $name type Opts
dict set ::eskil(opts,info) $name "elem" $elem
dict set ::eskil(opts,info) $name "value" $value
}
# 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 $::eskil(defoptinfo)
}
# Add a command line option that takes a value and stores in Pref
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 command line option that takes multiple values and stores in Pref
proc addPrefMultOpt {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
dict set ::eskil(opts,info) $name multi 1
}
# 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 source reference to an Opt
proc addSource {name src} {
# Remember them if needed for -help
dict set ::eskil(opts,src) $src 1
# This points to the plugin the Opt belongs to.
dict set ::eskil(opts,info) $name source $src
}
# Add a sideeffect to an Opt
##nagelfar syntax addSideEffect x c
proc addSideEffect {name script} {
dict set ::eskil(opts,info) $name sideeffect $script
}
# Add a command line option that takes a value and stores in local opts
proc addOptsOpt {name elem {validator ""}} {
dict set ::eskil(opts) $name ""
dict set ::eskil(opts,info) $name $::eskil(defoptinfo)
dict set ::eskil(opts,info) $name type Opts
dict set ::eskil(opts,info) $name "elem" $elem
dict set ::eskil(opts,info) $name "validator" $validator
}
# Add a command line option that takes multiple values
proc addMultOpt {name} {
dict set ::eskil(opts) $name {}
dict set ::eskil(opts,info) $name $::eskil(defoptinfo)
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
}
# If it is a flag, the value can come from the settings
if {[dict exists $::eskil(opts,info) $arg value]} {
set val [dict get $::eskil(opts,info) $arg value]
}
# Any validator?
set cmd [dict get $::eskil(opts,info) $arg validator]
if {$cmd ne ""} {
# The validator will exit if it fails
$cmd $arg $val
}
# Any filter?
set cmd [dict get $::eskil(opts,info) $arg filter]
if {$cmd ne ""} {
set val [{*}$cmd $val]
}
# Any side effect?
set cmd [dict get $::eskil(opts,info) $arg sideeffect]
if {$cmd ne ""} {
uplevel 1 $cmd
}
set type [dict get $::eskil(opts,info) $arg type]
switch $type {
Pref {
if {[dict get $::eskil(opts,info) $arg multi]} {
lappend ::Pref([dict get $::eskil(opts,info) $arg elem]) $val
} else {
set ::Pref([dict get $::eskil(opts,info) $arg elem]) $val
}
}
Opts {
# Does not support multi yet
upvar 1 opts _xx
set _xx([dict get $::eskil(opts,info) $arg elem]) $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]} {
if {[string length $arg] <= 2 && [string match *M* $arg]} {
puts "Ignoring argument: $arg"
} else {
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 --help -help
addPrefFlag -w ignore -w
addPrefFlag -b ignore -b
addPrefFlag -noignore ignore " "
docFlag -w "Ignore all spaces"
docFlag -b "Ignore space changes (default)"
docFlag -noignore "Don't ignore any whitespace"
addPrefFlag -noparse parse 0
addPrefFlag -line parse 1
addPrefFlag -smallblock parse 2
addPrefFlag -block parse 3
docFlag -noparse "No block analysis"
docFlag -line "Line based block analysis"
docFlag -smallblock "Do block analysis on small blocks (default)"
docFlag -block "Full block analysis. This can be slow if there are large change blocks"
addPrefFlag -char lineparsewords 0
addPrefFlag -word lineparsewords 1
docFlag -char "Character based change view (default)"
docFlag -word "Word based change view"
addPrefFlag -i nocase
addPrefFlag -nocase nocase
docFlag -i "Ignore case changes"
docFlag -nocase "Ignore case changes"
addPrefFlag -nodigit nodigit
docFlag -nodigit "Ignore digit changes"
addPrefFlag -nokeyword dir,ignorekey
docFlag -nokeyword "In directory diff, ignore \$ Keywords: \$"
addPrefFlag -noempty noempty
docFlag -noempty "Ignore empty lines initially for matching"
addPrefFlag -fine finegrainchunks
docFlag -fine "Use fine grained chunks. Useful for merging"
addOptsFlag -table view table
docFlag -table "Run in table mode"
addOptsFlag -conflict mode conflict
docFlag -conflict "Treat file as a merge conflict file and enter merge mode"
# Conflict implies foreach
addSideEffect -conflict {
optSet -foreach 1
}
addFlags -dir -clip -fourway -patch -review -
docFlag -dir "Start in directory diff mode. Ignores other args"
docFlag -clip "Start in clip diff mode. Ignores other args"
docFlag -fourway "Start in fourway diff mode. Ignores other args"
docFlag -patch "View patch file"
docFlag - "Read patch file from standard input, to allow pipes"
docFlag -review "View revision control tree as a patch"
addSideEffect -review {
optSet -noignore 1
}
addFlags -browse -nodiff
docFlag -browse "Bring up file dialog for missing files after starting"
docFlag -nodiff "Do not run diff after startup"
addFlags -server -cvs -svn -debug
docFlag -server "Set up Eskil to be controllable from the outside"
docFlag -cvs "Detect CVS first, if multiple version systems are used"
docFlag -svn "Detect SVN first, if multiple version systems are used"
docFlag -debug "Start in debug mode"
addFlags -foreach -close
docFlag -foreach "Open one diff window per file listed"
docFlag -close "Close any window with no changes"
addFlags -nonewline -nonewline+ -nocdiff
docFlag -nonewline "Try to ignore newline changes"
docFlag -nonewline+ "Try to ignore newline changes, and don't display"
docFlag -nocdiff "Disable C version of DiffUtil. For debug"
addFlags -pluginlist
addMultFlags -pluginallow
docFlag -pluginlist "List known plugins"
docFlag -pluginallow "Allow full access privilege for plugin"
# Options that take values
addMultOpt -plugin
docFlag -plugin "Preprocess files using plugin"
addValidator -plugin optValidatePlugin
addMultOpt -plugininfo
docFlag -plugininfo "Pass info to plugin (plugin specific)"
addOpt -plugindump
docFlag -plugindump "Dump plugin source to stdout"
# These options affect Pref
addPrefOpt -pivot pivot optValidatePositive
docFlag -pivot "Pivot setting for diff algorithm (10)"
addPrefOpt -context context optValidateNatural
docFlag -context "Show only differences, with <n> lines of context"
addPrefOpt -printHeaderSize printHeaderSize optValidatePositive
addPrefOpt -printLineSpace printLineSpace optValidatePositive
addPrefOpt -printCharsPerLine printCharsPerLine optValidatePositive
addPrefOpt -printPaper printPaper optValidatePaper
addPrefOpt -printColorChange printColorChange optValidatePdfColor
addPrefOpt -printColorOld printColorOld optValidatePdfColor
addPrefOpt -printColorNew printColorNew optValidatePdfColor
addPrefOpt -printFont printFont
docFlag -printHeaderSize "Font size for page header (10)"
docFlag -printLineSpace "Line spacing (1.0)"
docFlag -printCharsPerLine "Adapt font size for this line length and wrap (80)"
docFlag -printPaper "Select paper size (a4)"
docFlag -printColorChange "Color for change (1.0 0.7 0.7)"
docFlag -printColorOld "Color for old text (0.7 1.0 0.7)"
docFlag -printColorNew "Color for new text (0.8 0.8 1.0)"
docFlag -printFont "Select font to use in PDF, afm or ttf. If <fontfile> is given as \"Courier\", PDF built in font is used"
addPrefMultOpt -excludedir dir,exdirs
docFlag -excludedir "Exclude from directory diff"
addPrefMultOpt -excludefile dir,exfiles
docFlag -excludefile "Exclude from directory diff"
addPrefMultOpt -includedir dir,incdirs
docFlag -includedir "Include in directory diff"
addPrefMultOpt -includefile dir,incfiles
docFlag -includefile "Include in directory diff"
# These affect Pref but via special processing later
addMultOpt -prefix
docFlag -prefix "Care mainly about words starting with <str>"
addMultOpt -subst
docFlag -subst "The <pair> is a list of Left+Right, used for subst preprocessing"
addMultOpt -preprocess
addMultOpt -preprocessleft
addMultOpt -preprocessright
docFlag -preprocess "The <pair> is a list of RE+Subst applied to each line before compare"
docFlag -preprocessleft "Use <pair> only on left side"
docFlag -preprocessright "Use <pair> only on right side"
# These affect opts
addOptsOpt -limit limitlines
docFlag -limit "Do not process more than <lines> lines"
addOptsFlag -gz gz
docFlag -gz "Uncompress input files with gunzip"
addOptsOpt -maxwidth maxwidth
docFlag -maxwidth "Limit column width in table mode"
addOptsOpt -o mergeFile
docFlag -o "Specify merge result output <file>"
addFilter -o [list file join [pwd]]
addOptsOpt -a ancestorFile
docFlag -a "Give ancestor <file> for three way merge"
addFilter -a [list file join [pwd]]
# Default is no ignore on three-way merge
addSideEffect -a { set ::Pref(ignore) " " }
addOptsOpt -sep separatorview
docFlag -sep "See char <c> as separator between columns in files"
addOptsOpt -print printFile
docFlag -print "Generate PDF and exit"
addOptsOpt -printpdf printFile ;# Old option
docFlag -printpdf "_"
addSideEffect -print { set opts(printFileCmd) 1 }
addSideEffect -printpdf { set opts(printFileCmd) 1 }
addMultOpt -r
docFlag -r "Version info for version control mode"
# 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]
# Remove "-" from allOpts
set i [lsearch -exact $allOpts "-"]
set allOpts [lreplace $allOpts $i $i]
if {[lsearch -exact $allOpts $arg] < 0} {
set match [lsearch -glob -all -inline $allOpts $arg*]
} else {
set match [list $arg]
}
puts [lsort -dictionary $match]
exit
}
# Local opts array that some flags puts their info in.
array set opts {}
# 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
}
# 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
}
# Any help flag given just prints and exits
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 pluginL [optGet -plugin]
set plugininfoL [optGet -plugininfo]
set plugindump [optGet -plugindump]
set pluginlist [optGet -pluginlist]
set pluginallowL [optGet -pluginallow]
set noautodiff [optGet -nodiff]
set nocdiff [optGet -nocdiff]
set dodir [optGet -dir]
set doclip [optGet -clip]
set dofourway [optGet -fourway]
set dopatch [optGet -patch]
set doreview [optGet -review]
set autobrowse [optGet -browse]
set foreachOpt [optGet -foreach]
set preferedRev "GIT"
if {[optGet -svn]} {
set preferedRev "SVN"
} elseif {[optGet -cvs]} {
set preferedRev "CVS"
}
# 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 -prefix arg]} {
foreach apa $arg {
set RE [string map [list % $apa] {^.*?\m(%\w+).*$}]
if {$::Pref(nocase)} {
set RE "(?i)$RE"
}
addPreprocess prefix $RE {\1} ""
}
}
if {[optIsGiven -subst arg]} {
# FIXA: better validity check
foreach apa $arg {
foreach {left right} $apa {
if {$::Pref(nocase)} {
set left "(?i)$left"
set right "(?i)$right"
}
addPreprocess subst $left $right Subst
}
}
}
if {[optIsGiven -preprocess arg]} {
# FIXA: better validity check
foreach apa $arg {
foreach {RE sub} $apa {
addPreprocess cmdline $RE $sub ""
}
}
}
if {[optIsGiven -preprocessleft arg]} {
# FIXA: better validity check
foreach apa $arg {
foreach {RE sub} $apa {
addPreprocess cmdline $RE $sub "left"
}
}
}
if {[optIsGiven -preprocessright arg]} {
# FIXA: better validity check
foreach apa $arg {
foreach {RE sub} $apa {
addPreprocess cmdline $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
}
if {$pluginlist} {
printPlugins
exit
}
if {$plugindump ne ""} {
printPlugin $plugindump
exit
}
set t 0
foreach plugin $pluginL {
set plugininfo [lindex $plugininfoL $t]
set pluginallow [lindex $pluginallowL $t]
# If pluginallow list is too short
if {$pluginallow eq ""} { set pluginallow 0 }
incr t
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,$t) $pinterp
set opts(pluginname,$t) $plugin
set opts(pluginallow,$t) $pluginallow
set opts(plugininfo,$t) $plugininfo
set opts(pluginpinfo,$t) $pinfo
}
# Store the command line given opts
set ::eskil(defaultopts) [array get opts]
# Do we start in clip diff mode?
if {$doclip} {
return [makeClipDiffWin]
}
# Do we start in fourway diff mode?
if {$dofourway} {
return [makeFourWayWin]
}
# Figure out if we start in a diff or dirdiff window.
set len [llength $files]
if {$len == 0 && $dodir} {
set dirdiff(leftDir) ""
set dirdiff(rightDir) ""
return [makeDirDiffWin $noautodiff]
}
if { ! $doreview && $len == 1} {
set fullname [lindex $files 0]
if {[FileIsDirectory $fullname 1]} {
set dirdiff(leftDir) $fullname
set dirdiff(rightDir) $dirdiff(leftDir)
return [makeDirDiffWin $noautodiff]
}
} elseif { ! $doreview && $len >= 2} {
set fullname1 [lindex $files 0]
set fullname2 [lindex $files 1]
if {[FileIsDirectory $fullname1 1] && [FileIsDirectory $fullname2 1]} {
set dirdiff(leftDir) $fullname1
set dirdiff(rightDir) $fullname2
return [makeDirDiffWin $noautodiff]
}
}
# 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
if {$doreview} {
set rev [detectRevSystem "" $preferedRev]
set ::eskil($top,modetype) $rev
set ::eskil($top,mode) "patch"
set ::eskil($top,patchFile) ""
set ::eskil($top,patchData) ""
set ::eskil($top,reviewFiles) $files
set ::Pref(toolbar) 1
after idle [list doDiff $top]
return $top
}
if {$len == 1 || $foreachOpt} {
set ReturnAfterLoop 0
set first 1
foreach file $files {
if {$first} {
set first 0
} else {
# Create new window for other files
set top [makeDiffWin $top]
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
}
set fullname $file
set fulldir [file dirname $fullname]
if {$::eskil($top,mode) eq "conflict"} {
startConflictDiff $top $fullname
after idle [list doDiff $top]
set ReturnAfterLoop 1
continue
}
if { ! $dopatch} {
# Check for revision control
set rev [detectRevSystem $fullname $preferedRev]
if {$rev ne ""} {
startRevMode $top $rev $fullname
if {$noautodiff} {
enableRedo $top
} else {
after idle [list doDiff $top]
}
set ReturnAfterLoop 1
continue
}
}
# No revision control. Is it a patch file?
set ::eskil($top,leftDir) $fulldir
set ::eskil($top,leftFile) $fullname
set ::eskil($top,leftLabel) $fullname
set ::eskil($top,leftOK) 1
if {$dopatch || \
[regexp {\.(diff|patch)$} $fullname] || \
$fullname eq "-"} {
set ::eskil($top,mode) "patch"
set ::eskil($top,patchFile) $fullname
set ::eskil($top,patchData) ""
set autobrowse 0
if {$noautodiff} {
enableRedo $top
} else {
after idle [list doDiff $top]
}
set ReturnAfterLoop 1
continue
}
}
if {$ReturnAfterLoop} {return $top}
} elseif {$len >= 2} {
if {$len % 2 != 0} {
puts "I see $len files. It must an even number."
exit
}
set first 1
foreach {file1 file2} $files {
if {$first} {
set first 0
} else {
# Create new window for other files
set top [makeDiffWin $top]
update
}
set fullname [file join [pwd] $file1]
set fulldir [file dirname $fullname]
set ::eskil($top,leftDir) $fulldir
set ::eskil($top,leftFile) $fullname
set ::eskil($top,leftLabel) $fullname
set ::eskil($top,leftOK) 1
set fullname [file join [pwd] $file2]
set fulldir [file dirname $fullname]
set ::eskil($top,rightDir) $fulldir
set ::eskil($top,rightFile) $fullname
set ::eskil($top,rightLabel) $fullname
set ::eskil($top,rightOK) 1
if {$noautodiff} {
enableRedo $top
} else {
after idle [list doDiff $top]
}
}
}
if {$autobrowse && (!$::eskil($top,leftOK) || !$::eskil($top,rightOK))} {
if { ! $::eskil($top,leftOK) && !$::eskil($top,rightOK)} {
openBoth $top 0
} elseif { ! $::eskil($top,leftOK)} {
openLeft $top
} elseif { ! $::eskil($top,rightOK)} {
openRight $top
}
# If we cancel the second file and detect CVS, ask about it.
# TBD: Extend this to all VCS:s?
if {$::eskil($top,leftOK) && !$::eskil($top,rightOK) && \
[llength [glob -nocomplain [file join $fulldir CVS]]]} {
if {[tk_messageBox -title Diff -icon question \
-message "Do CVS diff?" -type yesno] eq "yes"} {
set fullname $::eskil($top,leftFile)
set ::eskil($top,leftOK) 0
startRevMode $top "CVS" $fullname
after idle [list doDiff $top]
}
}
}
return $top
}
# Save options to file ~/.eskilrc
proc saveOptions {top} {
# Is this a diff win or some other win?
if {[info exists ::widgets($top,wDiff1)]} {
# Check if the window size has changed
set w $::widgets($top,wDiff1)
if {[winfo reqwidth $w] != [winfo width $w] || \
[winfo reqheight $w] != [winfo height $w]} {
set dx [expr {[winfo width $w] - [winfo reqwidth $w]}]
set dy [expr {[winfo height $w] - [winfo reqheight $w]}]
set cx [font measure myfont 0]
set cy [font metrics myfont -linespace]
set neww [expr {[$w cget -width] + $dx / $cx}]
set newh [expr {[$w cget -height] + $dy / $cy}]
if {$neww != $::Pref(linewidth) || $newh != $::Pref(lines)} {
set msg "Should I save the current window\
size with the preferences?\nCurrent: $neww x $newh Old:\
$::Pref(linewidth) x $::Pref(lines)"
set apa [tk_messageBox -title "Save Preferences" \
-icon question -type yesno -message $msg]
if {$apa == "yes"} {
set ::Pref(linewidth) $neww
set ::Pref(lines) $newh
}
}
}
}
set rcfile "~/.eskilrc"
if {[catch {set ch [open $rcfile "w"]} err]} {
tk_messageBox -icon error -title "File error" -message \
"Error when trying to save preferences:\n$err"
return
}
foreach i [array names ::Pref] {
set value $::Pref($i)
# Special handling for preprocess
if {$i eq "preprocessn"} {
set value [getPreprocessSave]
}
# Skip unchanged options.
if {[info exists ::DefaultPref($i)]} {
if {$::DefaultPref($i) eq $value} {
continue
}
puts $ch "# $i default : $::DefaultPref($i)"
}
puts $ch [list set "::Pref($i)" $value]
}
close $ch
tk_messageBox -icon info -title "Saved" -message \
"Preferences saved to:\n[file nativename $rcfile]"
}
proc getOptions {} {
if {$::tcl_platform(os) eq "Darwin"} {
set ::DefaultPref(fontsize) 10
} else {
set ::DefaultPref(fontsize) 8
}
# Maybe base default font on TkFixedFont ?
set ::DefaultPref(fontfamily) Courier
set ::DefaultPref(ignore) "-b"
set ::DefaultPref(nocase) 0
set ::DefaultPref(noempty) 0
set ::DefaultPref(pivot) 10
set ::DefaultPref(nodigit) 0
set ::DefaultPref(parse) 2
set ::DefaultPref(lineparsewords) 0
set ::DefaultPref(colorequal) ""
set ::DefaultPref(colorchange) red
set ::DefaultPref(colornew1) darkgreen
set ::DefaultPref(colornew2) blue
set ::DefaultPref(bgequal) ""
set ::DefaultPref(bgchange) \#ffe0e0
set ::DefaultPref(bgnew1) \#a0ffa0
set ::DefaultPref(bgnew2) \#e0e0ff
set ::DefaultPref(context) -1
set ::DefaultPref(finegrainchunks) 0
set ::DefaultPref(marklast) 1
set ::DefaultPref(linewidth) 80
set ::DefaultPref(lines) 60
set ::DefaultPref(editor) "" ;# Not settable in GUI yet
set ::DefaultPref(preprocessn) {}
set ::DefaultPref(toolbar) 0
set ::DefaultPref(wideMap) 0 ;# Not settable in GUI yet
set ::DefaultPref(askOverwrite) 0 ;# Not settable in GUI yet
# Print options
set ::DefaultPref(printHeaderSize) 10
set ::DefaultPref(printLineSpace) 1.0
set ::DefaultPref(printCharsPerLine) 80
set ::DefaultPref(printPaper) a4
set ::DefaultPref(printColorChange) "1.0 0.7 0.7"
set ::DefaultPref(printColorNew1) "0.7 1.0 0.7"
set ::DefaultPref(printColorNew2) "0.8 0.8 1.0"
set ::DefaultPref(printFont) "" ;# Not settable in GUI yet (-printFont)
# Directory diff options
set ::DefaultPref(dir,comparelevel) 1
set ::DefaultPref(dir,ignorekey) 0
set ::DefaultPref(dir,incfiles) ""
set ::DefaultPref(dir,exfiles) "*.o"
set ::DefaultPref(dir,incdirs) ""
set ::DefaultPref(dir,exdirs) "RCS CVS .git .svn .hg"
set ::DefaultPref(dir,onlyrev) 0
set ::DefaultPref(dir,nice) 1
# Start with default preferences, before loading setup file
array set ::Pref [array get ::DefaultPref]
# Handle old option
set ::Pref(preprocess) {}
# TODO: implement filter option fully
set ::eskil(filter) ""
if { ! [info exists ::eskil_testsuite] && [file exists "~/.eskilrc"]} {
safeLoad "~/.eskilrc" ::Pref
}
if {$::Pref(editor) ne ""} {
set ::util(editor) $::Pref(editor)
}
# If the user's file has this old option, translate it to the new
if {$::Pref(preprocess) ne ""} {
lappend ::Pref(preprocessn) "old"
lappend ::Pref(preprocessn) \
[dict create preprocess $::Pref(preprocess) \
active 1 save 1]
}
array unset ::Pref preprocess
# 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
set ::eskil(plugins) {}
# Version string is loaded from version.txt later
set ::eskil(diffver) "Version Unknown"
set ::eskil(thisScript) [file join [pwd] [info script]]
set ::eskil(thisDir) [file dirname $::eskil(thisScript)]
# Follow any link
set tmplink $::eskil(thisScript)
while {[file type $tmplink] eq "link"} {
set tmplink [file readlink $tmplink]
set tmplink [file normalize [file join $::eskil(thisDir) $tmplink]]
set ::eskil(thisDir) [file dirname $tmplink]
}
set libDir [file join $::eskil(thisDir) .. lib]
if { ! [file isdirectory $libDir]} {
# Try the local file from devel
set libDir [file join $::eskil(thisDir) .. eskil.vfs lib]
}
::tcl::tm::path add $libDir
package require pstools
namespace import -force pstools::*
getOptions
if { ! [info exists ::eskil_testsuite]} {
InitSourceEarly
parseCommandLine
}
}