@ MS?BR
+KPFLI A>LCB Q:?C D49J? KKCI <@LM8 A06GB ?=R:> 72P EME
Index: examples/dir2/keyword
==================================================================
--- examples/dir2/keyword
+++ examples/dir2/keyword
@@ -1,2 +1,2 @@
A file with a keyword in it.
-$Revision$
+$Revision:b$
Index: examples/dir2/longline.txt
==================================================================
--- examples/dir2/longline.txt
+++ examples/dir2/longline.txt
@@ -1,5 +1,5 @@
-abcdefghijklmnop
-abcdefxhijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrs1uvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklm2opqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäö
-hej
-hopp
-abcdefghi2klmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyza4cdef
+abcdefghijklmnop
+abcdefxhijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrs1uvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklm2opqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäö
+hej
+hopp
+abcdefghi2klmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyza4cdef
ADDED examples/dir2/misc.txt
Index: examples/dir2/misc.txt
==================================================================
--- /dev/null
+++ examples/dir2/misc.txt
@@ -0,0 +1,37 @@
+Misc examples of diffs.
+A line 1 with sume line changes.
+1
+11
+111
+Surrounding line1
+One line against many others.
+Surrounding line2
+Surrounding line3
+2
+22
+222
+Bepa 2
+Gurka
+Cepa 2
+3
+33
+333
+The following is a real-life tricky case that currently do not show up well.
+ WrImmediate16 TME_TmIdCfg 0204
+ WrImmediate16 TME_VcCfgA 0FC7
+ WrImmediate32 TME_VcCfgB 00400FC1
+ WrImmediate32 TME_VcCfgC 00400FC1
+4
+44
+444
+Cepa 2
+Gurka
+5
+55
+555
+Bepa 2
+Apa 2
+Cepa 2
+6
+66
+666
ADDED htdocs/changes.wiki
Index: htdocs/changes.wiki
==================================================================
--- /dev/null
+++ htdocs/changes.wiki
@@ -0,0 +1,231 @@
+Changes
+
+Upcoming changes (not yet released):
+
+ * TBD
+
+Changes in v2.8.3 (2018-06-13):
+
+ * More features in Fourway diff.
+ * Better visibility that commit happened.
+ * Shortcuts in preprocess dialog for common patterns.
+
+Changes in v2.8.2 (2018-05-13):
+
+ * Added Fourway diff, for comparing changes.
+ * Bugfix in revision handling for Fossil.
+
+Changes in v2.8.1 (2018-01-14):
+
+ * Repaired plugins for directory diff (broken by multi plugin in 2.8.0).
+ * Added -excludedir and -excludefile options for directory diff.
+ * Handle GIT revisions better for directory diff.
+ * Support -nocase in directory diff.
+ * Directory diff no longer shortcuts for files with same size&mtime.
+ * Removed support for old RCS style -rREV command line.
+ * Corrected detected of Emacs for Registry. (Broken in 2.7.4)
+
+Changes in v2.8.0 (2017-12-05):
+
+ * Handle multiple plugins.
+ * Upgraded DiffUtil to 0.4.0 which is significantly faster for large files.
+ * Default pivot is now 10. Added GUI choise for pivot 1.
+
+Changes in v2.7.4 (2017-11-30):
+
+ * Handle multiple preprocess definitions that can be saved with preferences.
+ * Preserve line endings when saving during Edit Mode.
+ * Added -gz flag to compare compressed files.
+ * Allow multi select in table diff.
+ * Allow one side of directory diff to be protected from editing.
+ * Allow directories to be created in directory diff.
+ * When needing an editor, try VISUAL and EDITOR plus a set of common ones.
+
+Changes in v2.7.3 (2016-08-30):
+
+ * Requires Tcl 8.6
+ * GUI support for table and separator.
+
+Changes in v2.7.2 (2016-08-15):
+
+ * Corrected right side numbering when parsing patch.
+ * Word parse now consistently uses non-space as word char.
+ * New [./table.wiki | table] view, activated by -table, when comparing tables.
+ * Mercurial support for Directory Diff, Commit, Revert and Log.
+ * GIT support for negative revisions and log view.
+ * Printed PDF is now compressed.
+ * Printed PDF from patch view adds page break between files.
+ * Plugins can define command line options they accept.
+ * Plugins can read ::argv to know the given command line.
+ * New plugin for binary files
+ * New plugin for CSV files
+ * Added option -sep, to set a separator that makes input be interpreted
+ in a table like manner.
+ * New plugin for PDF files
+ * Added option -pluginallow to run plugins in a standard interpreter instead
+ of a safe one. Thus a plugin could use e.g. exec.
+ * Allow plugins to yield if Eskil is run in Tcl 8.6 or newer.
+ Added swap plugin to exemplify this.
+
+Changes in v2.7 (2015-03-09):
+
+ * Directory Diff support for GIT, Fossil and Subversion.
+ Directly browse and compare two revisions.
+ * Plugins in Directory Diff.
+ * Added option -printFont to select font for PDF generation.
+ Default font changed to a True Type font.
+ Use "-printFont Courier" to fall back on PDF built-in.
+ * Mac supported
+
+Changes in v2.6.7 (2014-11-13):
+
+ * Fixed Directory Diff that stopped working in 2.6.6
+
+Changes in v2.6.6 (2014-10-27):
+
+ * Avoid font error with balloon help.
+ * Store default prefs as comment in rc file.
+
+Changes in v2.6.5 (2014-01-24):
+
+ * Fixed error printing patch with only deleted or inserted files.
+ * Support direct print in patch mode.
+ * Detect Subversion 1.7 working copy
+
+Changes in v2.6.4 (2013-08-22):
+
+ * Include afm font for consistent PDF printing.
+ * Add .pdf to print file by default
+ * Fixed bug that marked extra changes in scroll map when displaying a patch.
+ * Avoid getting double .-files in dirdiff on Windows.
+ * Corrected display of ancestor lines in three-way merge.
+
+Changes in v2.6.3 (2012-08-21):
+
+ * Added Revert button in Revision mode
+ * Added -pivot flag to control diff algorithm. This cuts down processing time for certain large files.
+
+Changes in v2.6.2 (2012-06-18):
+
+ * Fixed bug where extra lines showed when displaying only diffs (no context).
+ * Include added files when using -review with Fossil.
+ * Improved plugin viewer and PDF print dialog.
+ * Support regsub preprocessing controlled per side.
+ * Support branches in Subversion.
+ * Support negative revisions with Fossil.
+ * Added -nocdiff command line flag for debug.
+ * Fixed a bug where alignment was not properly shown in output.
+ * Fixed out-of-stack crash.
+
+Changes in v2.6.1 (2011-11-01):
+
+ * Eskil [http://eskil.tcl.tk|re-hosted] and changed to use [http://www.fossil-scm.org|Fossil].
+ * Fixed directory diff appearance on Windows.
+ * Fixed bug where copy button in directory diff picked the wrong file.
+ * Fixed bug where plugins were not found in VFS.
+
+Changes in v2.6 (2011-10-30):
+
+ * Support commit in Git and Fossil.
+ * Support commit, list of files and revisions with -review.
+ * Added Paste Patch command.
+ * New -pluginlist option. New GUI for plugin selection.
+ * Added three-way merge.
+ * Auto-detect line endings in ancestor file to select merge output.
+ * Fully rewritten directory diff with new design.
+ * Set alignment with drag & drop.
+
+Changes in v2.5 (2011-04-01):
+
+ * Requires Tcl 8.5.
+ * Plugins: Added dump, better documentation.
+ * Dir diff: Added step down.
+ * Dir diff: Redesigned to display less.
+ * Support for Perforce and Fossil.
+ * Allow zero lines of context.
+ * Detect and display annotation in patch view.
+ * Select colors for PDF print. Command line options for PDF.
+ * Removed support for Postscript output.
+ * Support File Drop with TkDnd.
+ * Handle line endings in conflict and merge.
+
+Changes in v2.4 (2009-01-08):
+
+ * Completely redesigned directory diff.
+ * Added a log viewer in revision mode.
+ * Added color option for unchanged text.
+ * Plugins support.
+ * Support for Subversion, Mercurial and Bazaar.
+ * Support commit in Subversion.
+ * Added -review for displaying all changes in a tree.
+ * Support command line "-" to read a patch from std input.
+
+Changes in v2.3 (2007-12-05):
+
+ * Added -printpdf command line option.
+ * Fixed line numbering in PDF with big line numbers.
+ * Started on GIT support.
+ * Anything on the command line is checked for a starkit.
+ Kits are mounted and treated as directories.
+
+Changes in v2.2 (2007-04-05):
+
+ * Added experimental -nonewline command option.
+ * Added -close command option.
+ * Added experimental PDF print.
+ * Added dirdiff preferences and filters.
+ * Smarter save in merge. FR 2957
+ * Added commit button for CVS. FR 2780
+ * Bug fixes include: Kits are mounted read-only, fixed dir diff window menu,
+ improved patch file parsing.
+
+Changes in v2.1 (2006-06-02):
+
+ * Added -preprocess command line option.
+ * Added -foreach command line option.
+ * Added -context command line option.
+ * Handle starkits as directories in dir diff.
+ * Support relative -r with CVS.
+
+Changes in v2.0.7 (2004-12-14):
+
+ * Added regsub preprocessing option.
+ * Added -prefix command line option.
+ * Improved merge window.
+ * Added ignore keyword option to directory diff.
+
+Changes in v2.0.6 (2004-10-19):
+
+ * Added Ignore Digit option.
+ * Fixed bug in -r for ClearCase.
+ * Edit Mode made more robust.
+
+Changes in v2.0.5 (2004-08-20):
+
+ * Option -r can now be used with ClearCase diff.
+ * Edit Mode allows simple editing in the diff display and saving.
+
+Changes in v2.0.4 (2004-06-17):
+
+ * Added ignore case option.
+ * Improved alignment function.
+
+Changes in v2.0.3 (2004-05-26):
+
+ * Added context options for "Diffs only" mode.
+ * Rewrote how "Separate Diff" and "Align" works. The latter now only happens after a "Redo Diff".
+ * Added scroll map and some more context menu options in Directory Diff.
+
+Changes in v2.0.2 (2004-05-03):
+
+ * Fixed a bug in ClearCase support.
+ * Improved enscript usage in print command.
+ * Added "mark file" in dirdiff context menu.
+
+Changes in v2.0.1 (2004-02-10):
+
+ * Added preference for width and height.
+ * Added Tools menu to directory diff window.
+ * Made it simpler to save a conflict in the same file.
+
+First public release v2.0 (2004-01-30):
ADDED htdocs/download.html
Index: htdocs/download.html
==================================================================
--- /dev/null
+++ htdocs/download.html
@@ -0,0 +1,132 @@
+
+
+Downloads are available both as a
Starkit
+and as
Starpacks for some platforms.
+If you need a Starpack for some other platform, you can
+
generate it yourself .
+
+Eskil's application source is licensed under GPL, but the bundled packages
+included in the starkit are under the same license as Tcl.
+
+
Version 2.8.3
+
+
Version 2.8.2
+
+
Version 2.8.1
+
+
Version 2.8.0
+
+
Version 2.7.4
+
+
Version 2.7.3
+
+
Version 2.7.2
+
+
Version 2.7
+
+
Version 2.6.7
+
+
Version 2.6.6
+NOTE: Directory diff in 2.6.6 does not work. 2.6.7 has replaced it
+
+
Version 2.6.2
+
+
Version 2.6.1
+
Fossil Support
+Fossil Support
+
+Introduction
+
+Eskil can compare versions in many revision control systems including
+[http://www.fossil-scm.org | Fossil].
+
+If you specify only one file on the command line to Eskil, it will
+automatically detect if the file is under revision control and enter revision
+control mode.
+
+By default the local file is compared against the latest checked in version.
+This is for the common case when you just want to know what you have changed
+before checking in.
+
+You can use the -r option to select which versions to compare.
+The -r option works as in fossil finfo. If a revision is zero or a negative
+integer,
+the log is searched backwards for earlier versions. E.g. -1 gives the second
+to last version. The search follows the current branch from the current version.
+
+
+Examples:
+
+Compare file.txt with the latest checked in version:
+eskil file.txt
+
+Compare file.txt with the specified version:
+eskil -r rev file.txt
+
+Compare the two revisions. This does not involve the local copy of file.txt.
+eskil -r rev1 -r rev2 file.txt
+
+The -r options are also available in the GUI in the "Rev 1" and "Rev 2" fields.
+
+Directory Diff
+
+Eskil can also browse and compare Fossil revisions in the directory diff.
+It works just like for files, but give a directory on the command line.
+
+Commit support
+
+When comparing a file with the latest checked in version, Eskil can commit
+directly to Fossil.
+
+View all changes
+
+If the command line option -review is used, Eskil will generate a patch
+for the current tree and display it as in patch mode.
+
+eskil -review [files]
+
+If file names are given after -review, only the listed files are included.
+The Commit button will be enabled allowing the viewed differences to be
+committed directly from Eskil.
+
+Conflict merging
+Eskil can be used as the conflict resolution tool for Fossil by configuring
+the gmerge-command setting like this:
+
+fossil settings gmerge-command 'eskil -fine -a "%baseline" "%merge" "%original" -o "%output"' -global
+
+
+
ADDED htdocs/index.html
Index: htdocs/index.html
==================================================================
--- /dev/null
+++ htdocs/index.html
@@ -0,0 +1,45 @@
+
+
+
+
+
About Eskil
+Eskil is a graphical tool to view the differences between files and directories. It supports version management and patch files and has various preprocessing and alignment options to improve the display of tricky diffs.
+
+Pronunciation: The E is short, like in "set", the rest is like "skill".
+
+Any feedback, good or bad, can be sent to
+<peter dot spjuth at gmail dot com> or added as a Ticket .
+
+It is similar but unrelated to TkDiff .
+
+
Features
+
+
+Highlights changes within a line.
+Matches similar lines within a changed block to better show changed
+lines that are adjacent to added/removed lines.
+Recursive directory diff.
+Fossil /CVS/RCS/ClearCase/GIT/SVN/BZR/HG/Perforce diff.Conflict merge and three-way merge.
+Commit changes directly from Eskil.
+View patch, from file or clipboard.
+Print to PDF.
+"Clip diff"
+Plugins for preprocessing files.Alignment and block diff functions for tricky diffs.
+Edit and Save file from diff window.
+Starkit compare and browsing.
+
+
Screenshots
+
+
+
+A "zoom" feature for long lines.
+
Directory Diff.
+
Plugins
+
+Introduction
+
+Eskil provides a plugin system where a plugin can preprocess data
+before being compared and displayed.
+
+A plugin is a Tcl script that must follow a specific format.
+Example plugins are included in the kit.
+Dump one of the included plugins to see what it looks like.
+
+When searching for a plugin "x", files "x" and "x.tcl" will
+match. The search path is current directory, "plugins" directory,
+the directory where Eskil is installed, "plugins" directory where
+Eskil is installed, and also the internal "plugins" wrapped into Eskil.
+
+Usage
+
+The command line options for plugins are:
+ * -plugin plugin : Use plugin
+ * -plugininfo info : Pass info to plugin (plugin specific)
+ * -plugindump plugin : Dump plugin source to stdout
+ * -pluginlist : List known plugins
+ * -pluginallow : Allow full access privilege for a plugin.
+
+A plugin may further define command line options that it accepts.
+A way to see the plugin's options is to do:
+eskil -plugin <plg> -help
+
+Multiple -plugin may be given and they will be applied in the given
+order. Any -plugininfo and -pluginallow belongs to the last -plugin
+before them.
+
+General Format
+
+A plugin is a Tcl script file that must start with the verbatim sequence
+"##Eskil Plugin :". A plugin is sourced and used in its own safe
+interpreter and thus have free access to its own global space. Hookup
+points are defined by declaring specifically named procedures as specified
+below, and apart from those, a plugin can define and do whatever within
+the limits of a safe interpreter.
+
+In addition to the standard safe interpreter environment, a plugin has
+access to stdout as well. By using the command line option -pluginallow,
+the plugin is run in a standard interpreter and may e.g. do exec to utilize
+external tools.
+
+A plugin is set up with these global variables filled in:
+ * ::WhoAmI : The name of the plugin
+ * ::WhoAmIFull : The full path to the plugin source
+ * ::Info : The contents of -plugininfo parameter
+ * ::Pref : A copy if Eskil's internal preferences array.
+ * ::File(left) : The name of the left file processed
+ * ::File(right): The name of the right file processed
+ * ::argv : A copy of the command line from Eskil's invocation
+
+Additional options
+A plugin can declare command line options that should be accepted by Eskil.
+They will be passed on to the plugin through the ::argv list.
+If the initial "##Eskil" line is followed by comments formatted as below,
+it adds options. Any empty line will end parsing for such lines.
+
+A line like "## Option -" declares an option that takes a value and
+a line like "## Flag - " declares an option without value. The rest of
+the line after the option name is functionally ignored and can be used for
+comments. It is included in command line help, so the rest should preferably
+be formatted as " : Explanation" if used.
+
+File plugin
+
+To process the files being compared, the following procedure should be
+defined in the plugin file:
+
+proc PreProcess {side chi cho} {...}
+
+The arguments given to PreProcess are:
+
+ * side : left or right, indicating which file is being handled
+ * chi : An input channel for reading the original file
+ * cho : An output channel for writing the processed file
+
+A plugin may give a result that has a line-by-line correspondence to
+the original, in which case the preprocessed data is used for comparing
+while the original is used for displaying. The PreProcess procedure
+should return 0 to signify this case.
+
+If the PreProcess procedure returns 1, the processed data is used also for
+displaying.
+
+If Eskil is run with Tcl 8.6 or newer, PreProcess is run as a coroutine
+and may yield. The left and right side will then be called alternately
+until they return. This allows a plugin to take both sides into account
+for decisions if needed.
+
+Directory plugin
+
+To be used for file comparison in a directory diff, the following procedure
+should be defined in the plugin file:
+
+proc FileCompare {ch1 ch2 info1 info2} {...}
+
+The arguments given to FileCompare are:
+
+ * ch1: An input channel for reading the first file.
+ * ch2: An input channel for reading the second file.
+ * info1: A dictionary with info about the first file.
+ * info2: A dictionary with info about the second file.
+
+Info dictionaries contain at least elements "name" and "size".
+
+The FileCompare procedure can give the following return values:
+
+ * 0 : Files are not equal
+ * 1 : Files are equal
+ * 2 : Files are equal as far as the channels have been read.
+ Let the normal comparison finish the job.
+
+Directory diff only supports one plugin. The first plugin with FileCompare
+defined will be used.
ADDED htdocs/revision.wiki
Index: htdocs/revision.wiki
==================================================================
--- /dev/null
+++ htdocs/revision.wiki
@@ -0,0 +1,152 @@
+Revision Control Support
+
+Introduction
+
+Eskil can compare versions in many revision control systems.
+Currently RCS, CVS, Git, Fossil, Mercurial, Bazaar, Subversion, Perforce and ClearCase are supported (some features are not implemented for all systems).
+
+If you specify only one file on the command line to Eskil, it will
+automatically detect if the file is under revision control and enter revision
+control mode.
+
+By default the local file is compared against the latest checked in version.
+This is for the common case when you just want to know what you have changed
+before checking in.
+
+You can use the -r option to select which versions to compare.
+The valid values for the -r option depends on the tools used. See below for
+details on each one.
+
+Examples:
+
+Compare file.txt with the latest checked in version:
+
+eskil file.txt
+
+Compare file.txt with the specified version:
+
+eskil -r rev file.txt
+
+Compare the two revisions. This does not involve the local copy of file.txt.
+
+eskil -r rev1 -r rev2 file.txt
+
+The -r options are also available in the GUI in the "Rev 1" and "Rev 2" fields.
+
+Directory Diff
+
+Eskil can also browse and compare revisions for some systems directly in the
+directory diff. It works just like for files, but give a directory on the
+command line. Currently Git, Fossil and Subversion are supported.
+
+Commit support
+
+When comparing a file with the latest checked in version, some of the systems
+have support for committing directly from Eskil.
+If supported, the Commit button will be enabled.
+It is also possible to revert the local changes using the Revert button.
+
+Priority between systems
+
+If multiple systems are used within a directory Git/Hg/Bzr will be detected before CVS/SVN. Command line options -cvs and -svn can be used to put preference on one of those systems.
+
+Pipe a patch
+
+Eskil can read a patch from standard input, thus allowing display from any
+patch generating command. Examples:
+
+hg diff | eskil -
+git diff -p --diff-filter=M master | eskil -
+
+View all changes
+
+If the command line option -review is used, Eskil will generate a patch
+for the current tree and display it as in patch mode.
+
+eskil -review [files]
+
+E.g. in a Mercurial directory, these show the same thing:
+
+eskil -review
+hg diff | eskil -
+
+If file names are given after -review, only the listed files are included.
+If supported, the Commit button will be enabled allowing the viewed differences
+to be committed directly from Eskil.
+
+Conflict merging
+
+Eskil can be used as a conflict resolution tool. See examples below for settings.
+
+Tools Details
+
+RCS/CVS
+
+For RCS and CVS the arguments to -r are standard version numbers just like to their -r options.
+If a revision is an integer, it is added to the last number in the current version, thus giving relative versions. E.g. -1 gives the second to last version.
+
+Subversion
+
+For Subversion the arguments to -r are standard version numbers just like its -r option.
+If a revision is a negative integer, the log is searched backwards for earlier versions.
+E.g. -1 gives the second to last version.
+
+Git
+
+For Git -r is passed to show, as in "git show :".
+
+To use Eskil for conflict resolution these settings can be used.
+
+git config --global merge.tool eskil
+git config --global mergetool.eskil.cmd 'eskil -fine -a $BASE -o $MERGED $REMOTE $LOCAL'
+git config --global diff.tool eskil
+git config --global difftool.eskil.cmd 'eskil $LOCAL $REMOTE'
+
+Fossil
+
+For Fossil -r is passed to finfo, as in "fossil finfo -p -r ".
+
+Additionally, if a revision is zero or a negative integer, the log is searched backwards
+for earlier versions. E.g. -1 gives the second to last version. The search
+follows the current branch from the current version.
+
+To use Eskil for conflict resolution these settings can be used.
+
+fossil settings gmerge-command 'eskil -fine -a "%baseline" "%merge" "%original" -o "%output"' -global
+
+Mercurial
+
+For Mercurial -r mostly works as in "hg cat -r".
+However, Eskil interprets zero or negative numbers as going back from the tip, i.e. -1 is one step back, corresponding to -2 in Mercurial.
+
+Mercurial is supported in the Directory Diff, but needs the hglist extension to
+display correct file sizes and dates. If not they are faked using the file's
+sha1 and thus unique per file and gives a correct result in comparison.
+
+To use Eskil for conflict resolution these config settings can be used.
+
+[merge-tools]
+eskil.args = -fine -a $base $other $local -o $output
+eskil.priority = 1
+
+Bazaar
+
+For Bazaar -r works as in "bzr cat -r".
+
+ClearCase
+
+ClearCase has more complex version "numbers".
+ClearCase stream names are built like file paths and in -r you can access the streams
+similar to how you find files.
+Your current stream is the "current directory".
+A negative version number is offset from latest.
+
+ -r 5 : Version 5 in current stream.-r . : Latest version in current stream.-r -1 : Second to last version in current stream.-r /full/path/stream/4 : The identified version.-r /full/path/stream : Latest version in that stream.-r ../5 : Version in parent stream.-r .. : Latest in parent stream.-r stream/5 : Version in stream, anywhere in tree.-r stream : Latest in stream, anywhere in tree.
ADDED htdocs/starkit.wiki
Index: htdocs/starkit.wiki
==================================================================
--- /dev/null
+++ htdocs/starkit.wiki
@@ -0,0 +1,8 @@
+Starkit compare
+
+Eskil is [http://wiki.tcl.tk/starkit | Starkit] aware and will allow you
+to compare starkits/starpacks.
+
+If you compare one against itself, it becomes a way to browse a starkit.
+
+The kit needs to be either mentioned on the command line or called *.kit for it to work.
ADDED htdocs/starpack.wiki
Index: htdocs/starpack.wiki
==================================================================
--- /dev/null
+++ htdocs/starpack.wiki
@@ -0,0 +1,20 @@
+Starpack generation
+Starpack generation
+
+Eskil is normally distributed as a [http://wiki.tcl.tk/starkit | Starkit] which
+needs a [http://wiki.tcl.tk/tclkit | Tclkit] to run. If you have ActiveTcl
+installed, tclsh can also run a Starkit.
+
+To generate a stand-alone executable,
+a [http://wiki.tcl.tk/starpack | Starpack], of Eskil you need the following:
+ * A [http://wiki.tcl.tk/tclkit | Tclkit] for your platform. (tclkit)
+ * The [http://wiki.tcl.tk/sdx | Sdx] utility. (sdx)
+ * Eskil's Starkit. (eskil.kit)
+
+
+./tclkit sdx unwrap eskil.kit
+cp tclkit tclkit2
+./tclkit sdx wrap eskil -runtime tclkit2
+
+
+Note that this could be generated on any platform, not just the target. Then tclkit should be for the current platform and tclkit2 should be for the target platform.
ADDED htdocs/table.wiki
Index: htdocs/table.wiki
==================================================================
--- /dev/null
+++ htdocs/table.wiki
@@ -0,0 +1,22 @@
+Table diff
+Table diff
+
+Eskil can compare tables in comma/tab separated text files and display
+them like a table.
+
+
+eskil -table apa1.csv apa2.csv
+
+
+Eskil will try to auto-detect the separator but you can also give it
+using -sep. Example for tab separation:
+
+
+eskil -table -sep '\t' apa1.csv apa2.csv
+
+
+Eskil has a built in plugin, csv, than can preprocess table files. This example clears the "Short" and "Long" columns before comparison:
+
+
+eskil -table apa1.csv apa2.csv -block -sep '\t' -plugin csv -csvignore "Short Long"
+
ADDED img/dragon_16x16x32.png
Index: img/dragon_16x16x32.png
==================================================================
--- /dev/null
+++ img/dragon_16x16x32.png
cannot compute difference between binary files
ADDED img/dragon_24x24x32.png
Index: img/dragon_24x24x32.png
==================================================================
--- /dev/null
+++ img/dragon_24x24x32.png
cannot compute difference between binary files
ADDED img/dragon_256x256x32.png
Index: img/dragon_256x256x32.png
==================================================================
--- /dev/null
+++ img/dragon_256x256x32.png
cannot compute difference between binary files
ADDED img/dragon_32x32x32.png
Index: img/dragon_32x32x32.png
==================================================================
--- /dev/null
+++ img/dragon_32x32x32.png
cannot compute difference between binary files
ADDED img/dragon_48x48x32.png
Index: img/dragon_48x48x32.png
==================================================================
--- /dev/null
+++ img/dragon_48x48x32.png
cannot compute difference between binary files
ADDED img/run.sh
Index: img/run.sh
==================================================================
--- /dev/null
+++ img/run.sh
@@ -0,0 +1,15 @@
+#!/bin/bash
+
+# Icon sizes in tclkit at present:
+# 64x64x32 48x48x32 32x32x32 24x24x32 16x16x32
+# 48x48x24 32x32x24 24x24x24 16x16x24
+# 48x48x8 32x32x8 24x24x8 16x16x8
+
+# Create 64 from 48
+pngtopam -alphapam dragon_48x48x32.png | pamscale -width 64 | pamrgbatopng > apa.png
+
+# The 256 file is a "vista" file, and could be stored raw in the ico file.
+# However, the tclkit has it stored as the others
+icotool -c -o tclkit.ico apa.png dragon_48x48x32.png dragon_32x32x32.png dragon_24x24x32.png dragon_16x16x32.png dragon_256x256x32.png
+
+cp tclkit.ico ../eskil.vfs/
ADDED mergetest-fossil.sh
Index: mergetest-fossil.sh
==================================================================
--- /dev/null
+++ mergetest-fossil.sh
@@ -0,0 +1,20 @@
+#!/bin/sh
+# Build up a merge conflict in fossil
+fossil init apa.fossil
+mkdir apa_fossil
+cd apa_fossil
+fossil open ../apa.fossil
+fossil settings gmerge-command 'eskil -fine -a "%baseline" "%merge" "%original" -o "%output"'
+cp ../tests/ancestor.txt a.txt
+fossil add a.txt
+fossil commit -m a
+fossil branch new b trunk
+fossil update b
+cp ../tests/right.txt a.txt
+fossil commit -m r
+fossil update trunk
+cp ../tests/left.txt a.txt
+fossil commit -m l
+fossil update b
+#fossil merge trunk
+#fossil commit -m "Merge from trunk"
ADDED mergetest-git.sh
Index: mergetest-git.sh
==================================================================
--- /dev/null
+++ mergetest-git.sh
@@ -0,0 +1,18 @@
+#!/bin/sh
+# Build up a merge conflict in git
+mkdir apa_git
+cd apa_git
+git init
+cp ../tests/ancestor.txt a.txt
+git add a.txt
+git commit -m a
+git checkout -b b
+cp ../tests/right.txt a.txt
+git commit -am r
+git checkout master
+cp ../tests/left.txt a.txt
+git commit -am l
+git checkout b
+#git merge master
+#git mergetool
+#git commit -am m
Index: plugins/backslash.tcl
==================================================================
--- plugins/backslash.tcl
+++ plugins/backslash.tcl
@@ -1,14 +1,14 @@
##Eskil Plugin : Compare with backslash-newline removed
+#
+# This plugin replaces any backslash-newline with space, thus
+# ignoring restructured lines.
# Example file for a plugin.
-# A plugin must start exactly like this one.
+# A plugin's first line must start exactly like this one.
# The text after : is the summary you can get at the command line
-# This plugin replaces any backslash-newline with space, thus
-# ignoring restructured lines.
-
# 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} {
ADDED plugins/binary.tcl
Index: plugins/binary.tcl
==================================================================
--- /dev/null
+++ plugins/binary.tcl
@@ -0,0 +1,76 @@
+##Eskil Plugin : Compare binary files, in hex
+## Option -binsep : A set of chars to be used as "newline"
+#
+# This plugin converts files to hex to be able to compare binary files.
+# A set of chars can be defined to be used as "newline". Default "0 10 13".
+# Example usage:
+# eskil -plugin binary -binsep "0 10 13 32" f1 f2
+
+# 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
+
+# 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} {
+ set delimitL [list 0 10 13]
+ if {[llength $::Info] > 0} {
+ set delimitL $::Info
+ }
+ set i [lsearch -exact $::argv -binsep]
+ if {$i >= 0} {
+ incr i
+ set delimitL [lindex $::argv $i]
+ }
+ if {[catch {llength $delimitL}]} {
+ puts $cho "Binary plugin needs parameter to be a list"
+ return 1
+ }
+
+ # Build an RE that matches the given chars
+ set REm "\["
+ set REi "\[^"
+ foreach code $delimitL {
+ set c [format %c $code]
+ if {[string is wordchar $c]} {
+ append REm $c
+ append REi $c
+ } else {
+ # Just in case it is a special char for RE
+ append REm \\ $c
+ append REi \\ $c
+ }
+ }
+ append REm "\]"
+ append REi "\]"
+
+ set RE $REi*$REm*
+
+ fconfigure $chi -translation binary
+ # Assume small enough for memory.
+ # A file too large to read would be virtually impossible to display anyway.
+ set data [read $chi]
+ foreach line [regexp -all -inline $RE $data] {
+ puts $cho [strToHex $line]
+ }
+
+ # Signal that the file after processing should be used both
+ # for comparison and for displaying.
+ return 1
+}
+
+# Note: With 8.6 there is "binary encode hex" that might be faster
+
+# Build a string to hex mapper for speed
+set ::hexCharMap {}
+for {set i 0} {$i < 256} {incr i} {
+ lappend ::hexCharMap [format %c $i] [format "%02X " $i]
+}
+proc strToHex {str} {
+ string map $::hexCharMap $str
+}
ADDED plugins/csv.tcl
Index: plugins/csv.tcl
==================================================================
--- /dev/null
+++ plugins/csv.tcl
@@ -0,0 +1,107 @@
+##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
+#
+# This plugin compares CSV files with some preprocessing available
+# Example usage:
+# eskil -plugin csv -csvignore "head3 head5" -csvkey head2 -sep , \
+# examples/dir*/csv1.txt
+
+# 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
+
+# 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 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
+ }
+ # Allow backslash for easy access to \t
+ set opts(-sep) [subst -nocommands -novariables $opts(-sep)]
+
+ # 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'"
+ }
+ lappend kcol $i
+ }
+ }
+
+ set olines {}
+ while {[gets $chi line] >= 0} {
+ set items [split $line $opts(-sep)]
+ foreach i $icol {
+ lset items $i ""
+ }
+ lappend olines $items
+ }
+ # Sort on keys
+ foreach i [lreverse $kcol] {
+ set olines [lsort -index $i $olines]
+ }
+ foreach items $olines {
+ puts $cho [join $items $opts(-sep)]
+ }
+
+ # Signal that the file after processing should be used both
+ # for comparison and for displaying.
+ return 1
+}
ADDED plugins/grep.tcl
Index: plugins/grep.tcl
==================================================================
--- /dev/null
+++ plugins/grep.tcl
@@ -0,0 +1,43 @@
+##Eskil Plugin : Compare after filtering lines
+## Option -grepre : Regexp to filter on
+#
+# This plugin only compares lines that match a regexp pattern.
+# Example usage:
+# eskil -plugin grep -grepre "" f1 f2
+
+# 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
+
+# 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} {
+ if {[catch {llength $::Info}]} {
+ puts $cho "Grep plugin needs -plugininfo parameter to be a list"
+ return 1
+ }
+ # Look for parameters in info string
+ set opts(-re) "."
+ foreach {opt val} $::Info {
+ set opts($opt) $val
+ }
+ # And on command line
+ set i [lsearch -exact $::argv -grepre]
+ if {$i >= 0} {
+ incr i
+ set opts(-re) [lindex $::argv $i]
+ }
+ while {[gets $chi line] >= 0} {
+ if {[regexp -- $opts(-re) $line]} {
+ puts $cho $line
+ }
+ }
+ # Signal that the file after processing should be used both
+ # for comparison and for displaying.
+ return 1
+}
ADDED plugins/keyword.tcl
Index: plugins/keyword.tcl
==================================================================
--- /dev/null
+++ plugins/keyword.tcl
@@ -0,0 +1,57 @@
+##Eskil Plugin : Ignore $Keywords$
+#
+# This plugin ignores keywords like $Revision$, both in file diff
+# and in directory diff
+
+# 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 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} {
+ while {1} {
+ # Read data in large chunks for speed
+ set data [read $chi 100000]
+ if {$data eq ""} break
+ # Replace keywords with nothing
+ # Use line mode to be sure not to affect newlines
+ regsub -all -line {\$\w+:[^\$]*\$} $data {} data
+ puts -nonewline $cho $data
+ }
+ # Signal that the file after processing should be used only for
+ # comparison, not for displaying.
+ # The processed file must match the original line-wise.
+ return 0
+}
+
+# To be used in directory diff, a plugin must define this procedure.
+# ch1: An input channel for reading the first file.
+# ch2: An input channel for reading the second file.
+# info1: A dictionary with info about the first file.
+# info2: A dictionary with info about the second file.
+# Info dictionaries contain at least elements "name" and "size".
+proc FileCompare {ch1 ch2 info1 info2} {
+ set bufsz 65536
+ # 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]} {
+ # Returning 0 signals "not equal"
+ return 0
+ }
+ # Return 1 means "equal"
+ # Return 2 means "equal this far", and lets normal compare take over
+ return 2
+}
Index: plugins/nocase.tcl
==================================================================
--- plugins/nocase.tcl
+++ plugins/nocase.tcl
@@ -1,14 +1,14 @@
##Eskil Plugin : Case insensitive matching
+#
+# This plugin implements case insensitive matching, similar to the
+# -nocase flag.
# Example file for a plugin.
-# A plugin must start exactly like this one.
+# A plugin's first line must start exactly like this one.
# The text after : is the summary you can get at the command line
-# This plugin implements case insensitive matching, corresponding to the
-# -nocase flag.
-
# 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} {
@@ -22,5 +22,28 @@
# Signal that the file after processing should be used only for
# comparison, not for displaying.
# The processed file must match the original line-wise.
return 0
}
+
+# To be used in directory diff, a plugin must define this procedure.
+# ch1: An input channel for reading the first file.
+# ch2: An input channel for reading the second file.
+# info1: A dictionary with info about the first file.
+# info2: A dictionary with info about the second file.
+# Info dictionaries contain at least elements "name" and "size".
+proc FileCompare {ch1 ch2 info1 info2} {
+ set bufsz 65536
+ while 1 {
+ set f1 [read $ch1 $bufsz]
+ set f2 [read $ch2 $bufsz]
+ if {$f1 eq "" && $f2 eq ""} break
+ if {![string equal -nocase $f1 $f2]} {
+ # Returning 0 signals "not equal"
+ return 0
+ }
+ }
+
+ # Return 1 means "equal"
+ # Return 2 means "equal this far", and lets normal compare take over
+ return 1
+}
ADDED plugins/pdf.tcl
Index: plugins/pdf.tcl
==================================================================
--- /dev/null
+++ plugins/pdf.tcl
@@ -0,0 +1,55 @@
+##Eskil Plugin : Compare text from PDF files. (needs pdftotext)
+#
+# This plugin runs input through the external tool pdftotext.
+# Thus it must be run together with the -pluginallow flag.
+# Anything given in -plugininfo is passed as parameters to pdftotext.
+
+# 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 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} {
+ if {[info commands exec] eq ""} {
+ puts $cho "PDF plugin must be run with privilege to be able\
+ to execute pdftotext"
+ return 1
+ }
+ set cands [auto_execok pdftotext]
+ lappend cands [file join $::WhoAmIFull pdftotext]
+ lappend cands [file join $::WhoAmIFull .. pdftotext]
+ lappend cands [file join $::WhoAmIFull .. .. pdftotext]
+ set found 0
+ foreach cand $cands {
+ if {[file exists $cand]} {
+ set found 1
+ break
+ }
+ if {[file exists $cand.exe]} {
+ set cand $cand.exe
+ set found 1
+ break
+ }
+ }
+
+ if {!$found} {
+ puts $cho "PDF plugin needs external tool 'pdftotext' to run"
+ return 1
+ }
+ if {[catch {llength $::Info}]} {
+ puts $cho "PDF plugin needs -plugininfo parameter to be a list"
+ return 1
+ }
+ # Use source file with pdftotext since stdin is not reliable on e.g Windows
+ if {[catch {exec $cand {*}$::Info $::File($side) - >&@ $cho}]} {
+ puts $cho "**************************************"
+ puts $cho "PDF plugin got an error from pdftotext"
+ }
+
+ # Signal that the file after processing should be used both
+ # for comparison and for displaying.
+ return 1
+}
ADDED plugins/sort.tcl
Index: plugins/sort.tcl
==================================================================
--- /dev/null
+++ plugins/sort.tcl
@@ -0,0 +1,30 @@
+##Eskil Plugin : Compare files after sorting lines
+#
+# This plugin compares files after sorting the lines in each side
+
+# 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 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} {
+ set data [read $chi]
+ set endingNewLine 0
+ if {[string index $data end] eq "\n"} {
+ set data [string range $data 0 end-1]
+ set endingNewLine 1
+ }
+ set lines [split $data \n]
+ # Allow sort parameters in info
+ set lines [lsort -dictionary {*}$::Info $lines]
+ puts -nonewline $cho [join $lines \n]
+ if {$endingNewLine} {
+ puts $cho ""
+ }
+ # Signal that the file after processing should be used both
+ # for comparison and for displaying.
+ return 1
+}
ADDED plugins/swap.tcl
Index: plugins/swap.tcl
==================================================================
--- /dev/null
+++ plugins/swap.tcl
@@ -0,0 +1,33 @@
+##Eskil Plugin : Swap sides of contents
+#
+# This plugin swaps data between files. A fairly useless thing.
+# This is to test and exemplify how to use yield in a plugin.
+
+# 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 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} {
+ if {[info commands yield] eq ""} {
+ puts $cho "Swap plugin must be run with Tcl 8.6 or newer"
+ return 1
+ }
+ # Read all data from both sides
+ set ::data($side) [read $chi]
+ yield
+
+ # Output data from other side
+ if {$side eq "left"} {
+ puts $cho $::data(right)
+ } else {
+ puts $cho $::data(left)
+ }
+
+ # Signal that the file after processing should be used both
+ # for comparison and for displaying.
+ return 1
+}
Index: plugins/words.tcl
==================================================================
--- plugins/words.tcl
+++ plugins/words.tcl
@@ -1,13 +1,13 @@
##Eskil Plugin : Compare set of words
+#
+# This plugin compares the set of words in files.
# Example file for a plugin.
-# A plugin must start exactly like this one.
+# A plugin's first line must start exactly like this one.
# The text after : is the summary you can get at the command line
-# This plugin compares the set of words in files.
-
# 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} {
Index: src/clip.tcl
==================================================================
--- src/clip.tcl
+++ src/clip.tcl
@@ -31,17 +31,17 @@
proc DoClipDiff {} {
set f1 [tmpFile]
set f2 [tmpFile]
set ch [open $f1 w]
- set data1 [$::diff(wClip1) get 1.0 end]
+ set data1 [$::eskil(wClip1) get 1.0 end]
set data1 [ClipClean $data1]
puts $ch $data1
close $ch
set ch [open $f2 w]
- set data2 [$::diff(wClip2) get 1.0 end]
+ set data2 [$::eskil(wClip2) get 1.0 end]
set data2 [ClipClean $data2]
puts $ch $data2
close $ch
#set line1 [split $data1 \n]
@@ -64,11 +64,11 @@
$::widgets($top,wLine2) configure -height 1
}
}
proc ArmCatch {} {
- if {$::diff(armcatch)} {
+ if {$::eskil(armcatch)} {
bind .clipdiff {
if {[string equal %W .clipdiff]} {
after 50 CatchFromWin
}
}
@@ -76,11 +76,11 @@
bind .clipdiff {}
}
}
proc CatchFromWin {} {
- set ::diff(armcatch) 0
+ set ::eskil(armcatch) 0
ArmCatch
set win [twapi::get_foreground_window]
if {$win eq ""} {
#puts "No fg window"
return
@@ -110,22 +110,22 @@
lassign [twapi::get_window_coordinates $win] x1 y1 x2 y2
if {[catch {clipboard get} text]} continue
if {$text eq ""} continue
lappend capturedData [list $x1 $text]
}
- $::diff(wClip1) delete 1.0 end
- $::diff(wClip2) delete 1.0 end
+ $::eskil(wClip1) delete 1.0 end
+ $::eskil(wClip2) delete 1.0 end
if {[llength $capturedData] == 0} return
# Set it up left-to-right
set capturedData [lsort -index 0 -integer $capturedData]
if {[llength $capturedData] >= 1} {
set text [lindex $capturedData 0 1]
- $::diff(wClip1) insert end $text
+ $::eskil(wClip1) insert end $text
}
if {[llength $capturedData] >= 2} {
set text [lindex $capturedData 1 1]
- $::diff(wClip2) insert end $text
+ $::eskil(wClip2) insert end $text
after idle DoClipDiff
}
}
proc makeClipDiffWin {} {
@@ -144,12 +144,12 @@
set t1 [Scroll both \
text $top.t1 -width 60 -height 35 -font myfont]
set t2 [Scroll both \
text $top.t2 -width 60 -height 35 -font myfont]
- set ::diff(wClip1) $t1
- set ::diff(wClip2) $t2
+ set ::eskil(wClip1) $t1
+ set ::eskil(wClip2) $t2
bind $t1 [list focus $t2]
bind $t2 [list focus $t1]
ttk::frame $top.f
@@ -183,11 +183,11 @@
grid columnconfigure $top.f {0 3 5 8} -weight 1
grid columnconfigure $top.f 8 -minsize [winfo reqwidth $top.f.mf]
if {![catch {package require twapi}]} {
ttk::checkbutton $top.f.b6 -text "Capture" -command ArmCatch \
- -underline 0 -variable ::diff(armcatch)
+ -underline 0 -variable ::eskil(armcatch)
bind $top [list $top.f.b6 invoke]
#raise $top.f.b6
place $top.f.b6 -anchor e -relx 1.0 -rely 0.5
}
ADDED src/debug.tcl
Index: src/debug.tcl
==================================================================
--- /dev/null
+++ src/debug.tcl
@@ -0,0 +1,169 @@
+# debug.tcl
+#
+# Helpers for debugging.
+#
+#
+proc testme {x y z} {
+ puts "In Testme $x $y $z"
+ list [lindex $x 0] [lindex $y 0]
+}
+
+proc debugTRenter {cmd op} {
+ set fr [info frame -2]
+ puts "Line [dict get $fr line] Enter: '$cmd'"
+}
+proc debugTRenterstep {cmd op} {
+ set fr [info frame -2]
+ #puts "$fr"
+ puts "Line [dict get $fr line] Enterstep: '$cmd'"
+}
+proc debugTRleave {cmd core res op} {
+ puts "Leave: '$res'"
+}
+proc debugTRleavestep {cmd code res op} {
+ puts "Leavestep: '$res'"
+}
+
+proc debugTR {cmd} {
+ trace add execution $cmd enter debugTRenter
+ trace add execution $cmd leave debugTRleave
+ trace add execution $cmd enterstep debugTRenterstep
+ trace add execution $cmd leavestep debugTRleavestep
+}
+
+proc DebugMenu {m} {
+ $m add cascade -label "Debug" -menu $m.debug -underline 0
+ menu $m.debug
+
+ if {$::tcl_platform(platform) eq "windows"} {
+ $m.debug add checkbutton -label "Console" -variable consolestate \
+ -onvalue show -offvalue hide -command {console $consolestate} \
+ -underline 0
+ $m.debug add separator
+ }
+
+ $m.debug add command -label "Edit" -command ProcEditor -underline 0
+ return $m.debug
+}
+
+proc ProcEditorUpdate {a k} {
+ # Only update on keys generating characters
+ if {$a eq "" || ![string is graph $a]} return
+ #puts "Key '$a' '$k'"
+ set p [info procs $::ProcEditor(proc)]
+ if {$p eq "" && $::ProcEditor(proc) ne ""} {
+ # Try prefix matching
+ set p [info procs $::ProcEditor(proc)*]
+
+ # Include namespaces if starting with ::
+ if {[string match "::*" $::ProcEditor(proc)]} {
+ if {[regexp {^(.*::)([^:]*)$} $::ProcEditor(proc) -> ns pat]} {
+ if {[namespace exists $ns]} {
+ set child [namespace children $ns $pat*]
+ lappend p {*}$child
+ }
+ }
+ }
+ }
+ set p [lsort -dictionary $p]
+ $::ProcEditor(procW) configure -values $p
+ # Keep the first
+ set p [lindex $p 0]
+
+ if {$p eq ""} {
+ set ::ProcEditor(args) ""
+ $::ProcEditor(bodyW) delete 1.0 end
+ return
+ }
+ if {$p ne $::ProcEditor(proc)} {
+ after idle [list set "::ProcEditor(proc)" $p]
+ after idle [list $::ProcEditor(procW) selection range insert end]
+ }
+
+ after idle ProcEditorSelected
+}
+
+proc ProcEditorSelected {} {
+ set p [info procs $::ProcEditor(proc)]
+ if {$p eq ""} {
+ set ::ProcEditor(args) ""
+ $::ProcEditor(bodyW) delete 1.0 end
+ return
+ }
+ set arglist {}
+ foreach i [info args $p] {
+ if {[info default $p $i value]} {
+ lappend arglist [list $i $value]
+ } else {
+ lappend arglist [list $i]
+ }
+ }
+ set body [info body $p]
+
+ set ::ProcEditor(args) $arglist
+ $::ProcEditor(bodyW) delete 1.0 end
+ $::ProcEditor(bodyW) insert end $body
+}
+
+proc ProcEditorRedefine {} {
+ set body [$::ProcEditor(bodyW) get 1.0 end]
+ set body [string trimright $body]
+
+ ##nagelfar ignore Non constant argument to proc
+ proc $::ProcEditor(proc) $::ProcEditor(args) $body
+}
+
+proc ProcEditorDisas {} {
+ set da [tcl::unsupported::disassemble proc $::ProcEditor(proc)]
+
+ set top .proceditor.disas
+ destroy $top
+ toplevel $top
+ ttk::frame $top.bgf
+ place $top.bgf -x 0 -y 0 -relwidth 1.0 -relheight 1.0 -anchor nw
+ wm title $top "Proc Editor Disassemble"
+
+ text $top.t -yscrollcommand "$top.sby set"
+ ttk::scrollbar $top.sby -orient vertical -command "$top.t yview"
+
+ grid $top.t $top.sby -padx 3 -pady 3 -sticky news
+
+ grid columnconfigure $top 0 -weight 1
+ grid rowconfigure $top 0 -weight 1
+
+ $top.t insert end $da
+}
+
+proc ProcEditor {} {
+ set top .proceditor
+ destroy $top
+ toplevel $top -padx 3 -pady 3
+ ttk::frame $top.bgf
+ place $top.bgf -x 0 -y 0 -relwidth 1.0 -relheight 1.0 -anchor nw
+ wm title $top "Proc Editor"
+
+ ttk::label $top.l1 -text "Proc" -anchor w
+ ttk::combobox $top.e1 -textvariable ::ProcEditor(proc) -values ""
+ set ::ProcEditor(procW) $top.e1
+ bind $top.e1 {ProcEditorUpdate %A %K}
+ bind $top.e1 <> ProcEditorSelected
+ #trace add variable ::ProcEditor(proc) write "ProcEditorUpdate"
+ ttk::label $top.l2 -text "Args" -anchor w
+ ttk::entry $top.e2 -textvariable ::ProcEditor(args)
+ set ::ProcEditor(bodyW) [text $top.t -yscrollcommand "$top.sby set"]
+ ttk::scrollbar $top.sby -orient vertical -command "$top.t yview"
+
+ ttk::frame $top.fb
+ ttk::button $top.b1 -text "Redefine" -command ProcEditorRedefine
+ ttk::button $top.b2 -text "Disas" -command ProcEditorDisas
+ grid $top.b1 $top.b2 -in $top.fb
+ grid columnconfigure $top.fb all -weight 1 -uniform a
+
+ grid $top.l1 $top.e1 - -padx 3 -pady 3 -sticky we
+ grid $top.l2 $top.e2 - -padx 3 -pady 3 -sticky we
+ grid $top.t - $top.sby -padx 3 -pady 3 -sticky news
+ grid $top.fb - - -padx 3 -pady 3 -sticky we
+
+ grid columnconfigure $top 1 -weight 1
+ grid rowconfigure $top 2 -weight 1
+}
Index: src/dirdiff.tcl
==================================================================
--- src/dirdiff.tcl
+++ src/dirdiff.tcl
@@ -20,12 +20,10 @@
#
#----------------------------------------------------------------------
# $Revision$
#----------------------------------------------------------------------
-package require tablelist_tile
-
# Compare file names
proc FStrCmp {s1 s2} {
# Equality is based on platform's standard
# Order is dictionary order
@@ -38,11 +36,11 @@
if {[string equal -nocase $s1 $s2]} {
return 0
}
}
# FIXA: What's the case on Mac?
-
+
if {[lindex [lsort -dictionary [list $s1 $s2]] 0] eq $s1} {
return -1
}
return 1
}
@@ -53,11 +51,10 @@
}
# Compare two files or dirs
# Return true if equal
proc CompareFiles {file1 file2} {
- global Pref
if {[catch {file lstat $file1 stat1}]} {
return 0
}
if {[catch {file lstat $file2 stat2}]} {
return 0
@@ -65,11 +62,11 @@
# Same type?
set isdir1 [FileIsDirectory $file1]
set isdir2 [FileIsDirectory $file2]
if {$isdir1 != $isdir2} {
- return 0
+ return 0
}
# Handle links
if {$stat1(type) eq "link" && $stat2(type) eq "link"} {
set l1 [file link $file1]
set l2 [file link $file2]
@@ -79,44 +76,66 @@
}
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} {
+ if {$stat1(size) == $stat2(size) && $::Pref(dir,comparelevel) == 0} {
return 1
}
- set ignorekey $Pref(dir,ignorekey)
+ set anyPlugin $::eskil(.dirdiff,dirPlugin)
+
+ set ignorekey $::Pref(dir,ignorekey)
+ set nocase $::Pref(nocase)
# Different size is enough when doing binary compare
- if {$stat1(size) != $stat2(size) && $Pref(dir,comparelevel) == 2 \
- && !$ignorekey} {
+ 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} {
+ 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
+ return 1
}
- switch $Pref(dir,comparelevel) {
+ switch $::Pref(dir,comparelevel) {
2 -
1 { # Check contents internally
set bufsz 65536
- set eq 1
+ 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} {
+ 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,$anyPlugin) eval \
+ [list array set ::Pref [array get ::Pref]]
+ $::eskil(.dirdiff,plugin,$anyPlugin) eval \
+ [list set ::argv $::eskil(argv)]
+ interp share {} $ch1 $::eskil(.dirdiff,plugin,$anyPlugin)
+ interp share {} $ch2 $::eskil(.dirdiff,plugin,$anyPlugin)
+ set info1 [dict create name $file1 size $stat1(size)]
+ set info2 [dict create name $file2 size $stat2(size)]
+ set eq [$::eskil(.dirdiff,plugin,$anyPlugin) eval \
+ [list FileCompare $ch1 $ch2 $info1 $info2]]
+ set allow [dict get $::eskil(.dirdiff,pluginpinfo,$anyPlugin) allow]
+ if {$allow} {
+ $::eskil(.dirdiff,plugin,$anyPlugin) eval close $ch1
+ $::eskil(.dirdiff,plugin,$anyPlugin) eval close $ch2
+ } else {
+ $::eskil(.dirdiff,plugin,$anyPlugin) invokehidden close $ch1
+ $::eskil(.dirdiff,plugin,$anyPlugin) 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
@@ -126,37 +145,61 @@
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 && ![eof $ch1] && ![eof $ch2]} {
- set f1 [read $ch1 $bufsz]
- set f2 [read $ch2 $bufsz]
- if {![string equal $f1 $f2]} {
- set eq 0
- }
- }
- if {![eof $ch1] || ![eof $ch2]} {
- set eq 0
- }
- close $ch1
- close $ch2
- }
- }
- return $eq
-}
-
-# Returns the contents of a directory as a sorted list of file tails.
-proc DirContents {dir} {
- global Pref
- set files [glob -tails -directory $dir -nocomplain * {.[a-zA-Z]*}]
-
- if {$Pref(dir,onlyrev)} {
+ if {$nocase} {
+ if {![string equal -nocase $f1 $f2]} {
+ set eq 0
+ }
+ } else {
+ 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 {$nocase} {
+ if {![string equal -nocase $f1 $f2]} {
+ set eq 0
+ }
+ } else {
+ if {![string equal $f1 $f2]} {
+ set eq 0
+ }
+ }
+ }
+ if {$eq == 2 && (![eof $ch1] || ![eof $ch2])} {
+ set eq 0
+ }
+ # Errors during close are not interesting
+ catch {close $ch1}
+ catch {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 *]
+ } else {
+ set files [glob -directory $dir -nocomplain *]
+ # Handle .-files and make sure no duplicates are generated
+ set files2 [glob -directory $dir -nocomplain {.[a-zA-Z]*}]
+ foreach file $files2 {
+ if {$file ni $files} {
+ lappend files $file
+ }
+ }
+ }
+
+ if {$::Pref(dir,onlyrev)} {
# FIXA: move to rev and make general for other systems
set entries [file join $dir CVS Entries]
if {[file exists $entries]} {
set ch [open $entries r]
set data [read $ch]
@@ -175,70 +218,71 @@
}
}
set files2 {}
foreach file $files {
- set full [file join $dir $file]
+ set full $file
+ set tail [file tail $file]
# Apply filters
if {[FileIsDirectory $full]} {
- if {[llength $Pref(dir,incdirs)] == 0} {
+ if {[llength $::Pref(dir,incdirs)] == 0} {
set allowed 1
} else {
set allowed 0
- foreach pat $Pref(dir,incdirs) {
- if {[string match $pat $file]} {
+ foreach pat $::Pref(dir,incdirs) {
+ if {[string match $pat $tail]} {
set allowed 1
break
}
}
}
if {$allowed} {
- foreach pat $Pref(dir,exdirs) {
- if {[string match $pat $file]} {
+ foreach pat $::Pref(dir,exdirs) {
+ if {[string match $pat $tail]} {
set allowed 0
break
}
}
}
if {!$allowed} continue
} else {
- if {[llength $Pref(dir,incfiles)] == 0} {
+ if {[llength $::Pref(dir,incfiles)] == 0} {
set allowed 1
} else {
set allowed 0
- foreach pat $Pref(dir,incfiles) {
- if {[string match $pat $file]} {
+ foreach pat $::Pref(dir,incfiles) {
+ if {[string match $pat $tail]} {
set allowed 1
break
}
}
}
if {$allowed} {
- foreach pat $Pref(dir,exfiles) {
- if {[string match $pat $file]} {
+ foreach pat $::Pref(dir,exfiles) {
+ if {[string match $pat $tail]} {
set allowed 0
break
}
}
}
if {!$allowed} continue
}
- lappend files2 $file
+ lappend files2 $full
}
return [Fsort $files2]
}
# Bring up an editor to display a file.
proc EditFile {file} {
locateEditor ::util(editor)
- exec $::util(editor) $file &
+ # util(editor) may contain options, and is treated as a pre-command
+ exec {*}$::util(editor) $file &
}
# Pick a directory for compare
proc BrowseDir {dirVar entryW} {
- global Pref
upvar "#0" $dirVar dir
set newdir $dir
while {$newdir != "." && ![FileIsDirectory $newdir]} {
set newdir [file dirname $newdir]
@@ -257,46 +301,39 @@
component vsb
option -leftdirvariable -default "" -configuremethod SetDirOption
option -rightdirvariable -default "" -configuremethod SetDirOption
option -statusvar -default ""
+ option -changelist -default ""
variable AfterId ""
+ variable DebugCh ""
+ variable DebugTime {}
variable PauseBgProcessing 0
variable ScheduledRestart 0
+ variable AfterTime 1
variable IdleQueue {}
variable IdleQueueArr
variable leftMark ""
variable rightMark ""
variable leftDir ""
variable rightDir ""
- variable img
+ variable protect {left 0 right 0}
constructor {args} {
variable color
install tree using tablelist::tablelist $win.tree -height 20 \
-movablecolumns no -setgrid no -showseparators yes \
-expandcommand [mymethod expandCmd] \
-collapsecommand [mymethod collapseCmd] \
-fullseparators yes -selectmode none \
-columns {0 "Structure" 0 Size 0 Date 0 Copy 0 Size 0 Date}
- install vsb using scrollbar $win.vsb -orient vertical \
+ install vsb using ttk::scrollbar $win.vsb -orient vertical \
-command "$tree yview"
- install hsb using scrollbar $win.hsb -orient horizontal \
+ install hsb using ttk::scrollbar $win.hsb -orient horizontal \
-command "$tree xview"
- # Use demo images from Tablelist
- set dir $::eskil(thisDir)/../lib/tablelist/demos
- 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]]
- # 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 AfterId ""
set IdleQueue {}
$tree configure -yscrollcommand "$vsb set" -xscrollcommand "$hsb set"
@@ -308,10 +345,11 @@
$tree columnconfigure 5 -name rightdate
destroy [$tree separatorpath 1] [$tree separatorpath 4]
set color(unknown) grey
+ set color(unknown2) grey
set color(empty) grey
set color(equal) {}
set color(new) green
set color(old) blue
set color(change) red
@@ -373,22 +411,51 @@
}
if {!$ScheduledRestart} {
set ScheduledRestart 1
after idle [mymethod ReStart]
}
- }
+ }
+
+ method nice {ms} {
+ # Sanity check
+ if {$ms < 1} { set ms 1 }
+ if {$ms > 1000} {set ms 1000 }
+ set AfterTime $ms
+ }
method ReStart {} {
# Delete all idle processing
if {$AfterId ne ""} {
after cancel $AfterId
}
+ if {$DebugCh ne ""} {
+ close $DebugCh
+ set DebugCh ""
+ set DebugTime {}
+ }
+ # Uncomment to activate debug logging
+ #set DebugCh [open ~/dirdiff.log a]
+ #$self DlogTablelist
+ $self Dlog RESTART
set AfterId ""
set IdleQueue {}
set ScheduledRestart 0
array unset IdleQueueArr
-
+ set protect {left 0 right 0}
+
+ # Directory Diff only supports one plugin.
+ # Find if any configured plugin supports dir diff and choose it.
+ set ::eskil(.dirdiff,dirPlugin) 0
+ foreach item [lsort -dictionary [array names ::eskil .dirdiff,pluginname,*]] {
+ set n [lindex [split $item ","] end]
+ if {$::eskil(.dirdiff,plugin,$n) ne "" && \
+ [dict get $::eskil(.dirdiff,pluginpinfo,$n) dir]} {
+ set ::eskil(.dirdiff,dirPlugin) $n
+ break
+ }
+ }
+
# Fill in clean root data
$tree delete 0 end
set topIndex [$tree insertchild root end {}]
set d1 [file tail $leftDir]
set d2 [file tail $rightDir]
@@ -395,36 +462,53 @@
if {$d1 eq $d2} {
$tree cellconfigure $topIndex,structure -text $d1
} else {
$tree cellconfigure $topIndex,structure -text "$d1 vs $d2"
}
- $tree cellconfigure $topIndex,structure -image $img(open)
+ $tree cellconfigure $topIndex,structure -image $::img(open)
$tree rowattrib $topIndex type directory
$self SetNodeStatus $topIndex empty
- $tree rowattrib $topIndex leftfull $leftDir
- $tree rowattrib $topIndex rightfull $rightDir
+ $tree rowattrib $topIndex leftfull $leftDir
+ $tree rowattrib $topIndex rightfull $rightDir
$self UpdateDirNode $topIndex
}
method expandCmd {tbl row} {
if {[$tree childcount $row] != 0} {
- $tree cellconfigure $row,0 -image $img(open)
+ $tree cellconfigure $row,0 -image $::img(open)
}
}
method collapseCmd {tbl row} {
- $tree cellconfigure $row,0 -image $img(clsd)
+ $tree cellconfigure $row,0 -image $::img(clsd)
}
# Format a time stamp for display
proc FormatDate {date} {
clock format $date -format "%Y-%m-%d %H:%M:%S"
}
+
+ method busyCursor {} {
+ variable oldcursor
+ if {![info exists oldcursor]} {
+ set oldcursor(hull) [$hull cget -cursor]
+ set oldcursor(tree) [$tree cget -cursor]
+ }
+ $hull configure -cursor watch
+ $tree configure -cursor watch
+ }
+
+ method normalCursor {} {
+ variable oldcursor
+ $hull configure -cursor $oldcursor(hull)
+ $tree configure -cursor $oldcursor(tree)
+ }
# Remove all equal nodes from tree
method PruneEqual {} {
+ $self busyCursor
set todo [$tree childkeys root]
while {[llength $todo] > 0} {
set todoNow $todo
set todo {}
foreach node $todoNow {
@@ -434,10 +518,11 @@
} else {
lappend todo {*}[$tree childkeys $node]
}
}
}
+ $self normalCursor
}
# Open or close all directories in the tree view
method OpenAll {{state 1}} {
if {$state} {
@@ -445,52 +530,102 @@
} else {
$tree collapseall
}
}
- # Copy a file from one directory to the other
- method CopyFile {node from} {
- global dirdiff Pref
-
+ # Create a directory missing on one side
+ method CreateDir {node to} {
set lf [$tree rowattrib $node leftfull]
set rf [$tree rowattrib $node rightfull]
set parent [$tree parent $node]
set lp [$tree rowattrib $parent leftfull]
set rp [$tree rowattrib $parent rightfull]
- if {$from eq "left"} {
+ if {$to eq "right"} {
set src $lf
- if {$rf ne ""} {
- set dst $rf
- } elseif {$rp ne ""} {
+ if {$rp ne ""} {
set dst [file join $rp [file tail $src]]
} else {
return
}
- } elseif {$from eq "right"} {
+ } elseif {$to eq "left"} {
set src $rf
- if {$lf ne ""} {
- set dst $lf
- } elseif {$lp ne ""} {
+ if {$lp ne ""} {
set dst [file join $lp [file tail $src]]
} else {
return
}
+ } else {
+ error "Bad from argument to CreateDir: $to"
+ }
+ if {[tk_messageBox -icon question -title "Create dir?" -message \
+ "Create\n$dst ?" -type yesno] eq "yes"} {
+ file mkdir $dst
+ # FIXA: update file info in tree too
+ #$self SetNodeStatus $node equal
+ }
+ }
+
+ # Copy a file from one directory to the other
+ method CopyFile {node from} {
+ if {$from eq "left"} {
+ set to right
+ } elseif {$from eq "right"} {
+ set to left
} else {
error "Bad from argument to CopyFile: $from"
}
+
+ set fromf [$tree rowattrib $node ${from}full]
+ set tof [$tree rowattrib $node ${to}full]
+ set parent [$tree parent $node]
+ set fromp [$tree rowattrib $parent ${from}full]
+ set top [$tree rowattrib $parent ${to}full]
+
+ set src $fromf
+ if {$tof ne ""} {
+ set dst $tof
+ } else {
+ # Go up until we find a common parent
+ set dst [file tail $src]
+ set Count 0 ;# Safety check while debugging
+ while {$Count < 1000} {
+ if {[incr Count] > 999} {
+ error "Internal error in CopyFile $from"
+ }
+ if {$top ne ""} {
+ set dst [file join $top $dst]
+ break
+ }
+ # Continue up to a commmon parent
+ set dst [file join [file tail $fromp] $dst]
+ set parent [$tree parent $parent]
+ set fromp [$tree rowattrib $parent ${from}full]
+ set top [$tree rowattrib $parent ${to}full]
+ }
+ }
+
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
$self SetNodeStatus $node equal
}
} else {
+ set msg "Copy\n$src\nto\n$dst ?"
+ set dstdir [file dirname $dst]
+ if {![file isdirectory $dstdir]} {
+ append msg "\nCreating Directory\n$dstdir ?"
+ }
+
if {[tk_messageBox -icon question -title "Copy file?" -message \
- "Copy\n$src\nto\n$dst ?" -type yesno] eq "yes"} {
+ $msg -type yesno] eq "yes"} {
+ if {![file isdirectory $dstdir]} {
+ file mkdir $dstdir
+ }
file copy $src $dst
# FIXA: update file info in tree too
$self SetNodeStatus $node equal
}
}
@@ -547,11 +682,11 @@
set oneside [expr {($lf ne "") ^ ($rf ne "")}]
set m $win.popup
destroy $m
menu $m
-
+
if {$colname eq "structure"} {
$m add command -label "Prune equal" -command [mymethod PruneEqual]
$m add command -label "Expand all" -command [mymethod OpenAll]
$m add command -label "Collapse all" -command [mymethod OpenAll 0]
}
@@ -567,34 +702,48 @@
$m add command -label "Go down" -command [mymethod \
newTopDir $lf $rf]
}
if {$lf ne ""} {
# Directory, left exist
- $m add command -label "Go down left" -command [mymethod \
- newTopDir $lf ""]
+ $m add command -label "Go down left" -command \
+ [mymethod newTopDir $lf ""]
+ if {$rf eq ""} {
+ # Only left exist
+ $m add command -label "Create Dir right" -command \
+ [mymethod CreateDir $node right]
+ }
}
if {$rf ne ""} {
# Directory, right exist
- $m add command -label "Go down right" -command [mymethod \
- newTopDir "" $rf]
+ $m add command -label "Go down right" -command \
+ [mymethod newTopDir "" $rf]
+ if {$lf eq ""} {
+ # Only right exist
+ $m add command -label "Create Dir left" -command \
+ [mymethod CreateDir $node left]
+ }
}
}
if {$type eq "file"} {
if {([string match left* $colname] || $oneside) && $lf ne ""} {
- $m add command -label "Copy File to Right" \
- -command [mymethod CopyFile $node left]
+ if {![dict get $protect right]} {
+ $m add command -label "Copy File to Right" \
+ -command [mymethod CopyFile $node left]
+ }
$m add command -label "Edit Left File" \
-command [list EditFile $lf]
$m add command -label "Mark Left File" \
-command [list set [myvar leftMark] $lf]
if {$rightMark != ""} {
$m add command -label "Compare Left with $rightMark" \
-command [list newDiff $lf $rightMark]
}
} elseif {([string match right* $colname] || $oneside) && $rf ne ""} {
- $m add command -label "Copy File to Left" \
- -command [mymethod CopyFile $node right]
+ if {![dict get $protect left]} {
+ $m add command -label "Copy File to Left" \
+ -command [mymethod CopyFile $node right]
+ }
$m add command -label "Edit Right File" \
-command [list EditFile $rf]
$m add command -label "Mark Right File" \
-command [list set [myvar rightMark] $rf]
if {$leftMark != ""} {
@@ -601,49 +750,121 @@
$m add command -label "Compare Right with $leftMark" \
-command [list newDiff $leftMark $rf]
}
}
}
+ if {[string match left* $colname] && ![dict get $protect left]} {
+ $m add command -label "Protect Left Side" \
+ -command [mymethod ProtectSide left]
+ } elseif {[string match right* $colname] && ![dict get $protect right]} {
+ $m add command -label "Protect Right Side" \
+ -command [mymethod ProtectSide right]
+ }
tk_popup $m $X $Y
}
- method AddNodeToIdle {node} {
+ # Mark one side as protected and disable all copy buttons
+ method ProtectSide {side} {
+ variable widgets
+ dict set protect $side 1
+ foreach w [dict get $widgets $side] {
+ if {[winfo exists $w]} {
+ $w configure -state disabled
+ }
+ }
+ dict set widgets $side {}
+ }
+
+ method AddNodeToIdle {node {first 0}} {
if {[info exists IdleQueueArr($node)]} { return }
- lappend IdleQueue $node
+ if {$first} {
+ # Items are popped from the end, so last is first
+ lappend IdleQueue $node
+ } else {
+ # Avoid compiled linsert by having index in a variable
+ set c0 0
+ set IdleQueue [linsert $IdleQueue[set IdleQueue {}] $c0 $node]
+ }
+
set IdleQueueArr($node) 1
if {$AfterId eq ""} {
- set AfterId [after 1 [mymethod UpdateIdle]]
+ set AfterId [after $AfterTime [mymethod UpdateIdle]]
+ }
+ }
+ # Debug logging
+ method Dlog {args} {
+ if {$DebugCh ne ""} {
+ set msg [join $args]
+ set now [clock clicks -milliseconds]
+ set suffix ""
+ if {[dict exists $DebugTime $msg]} {
+ set delta [expr {$now - [dict get $DebugTime $msg]}]
+ set suffix " (+$delta)"
+ }
+ dict set DebugTime $msg $now
+ puts $DebugCh "$now $msg$suffix"
+ flush $DebugCh
+ }
+ }
+ method DlogTablelist {} {
+ puts DlogTablelist
+ foreach cmd [info commands ::tablelist::*] {
+ set tail [namespace tail $cmd]
+ #if {[string match *SubCmd $tail]} continue
+ if {$tail in {
+ synchronize
+ tablelistWidgetCmd cleanupWindow getTablelistPath
+ handleMotion handleMotionDelayed
+ rowIndex isInteger keyToRow colIndex
+ }} continue
+
+ trace add execution $cmd enter [mymethod Dlog]
+ puts "Traced $cmd"
}
}
method UpdateIdle {} {
+ $self Dlog UpdateIdle
set AfterId "X"
if {$PauseBgProcessing} {
+ $self Dlog Pause
set AfterId [after 200 [mymethod UpdateIdle]]
return
}
set pre [clock clicks -milliseconds]
set errors {}
+ set count 0
while {[llength $IdleQueue] > 0} {
- set node [lindex $IdleQueue 0]
- set IdleQueue [lrange $IdleQueue 1 end]
+ set node [lindex $IdleQueue end]
+ # Always make a pause before a large file
+ if {[$tree rowattrib $node type] ne "directory"} {
+ if {[$tree rowattrib $node largefile]} {
+ if {$count > 0} {
+ $self Dlog "New Lap for large file"
+ break
+ }
+ }
+ }
+ incr count
+ set IdleQueue [lrange $IdleQueue[set IdleQueue {}] 0 end-1]
unset IdleQueueArr($node)
if {[$tree rowattrib $node type] ne "directory"} {
set sts [catch {$self UpdateFileNode $node} err]
} else {
set sts [catch {$self UpdateDirNode $node} err]
}
if {$sts} {
- lappend errors $err
+ lappend errors $node $err
+ break
}
- # Work for at least 20 ms to keep things efficient
+ # Work for at least 200 ms to keep things efficient
set post [clock clicks -milliseconds]
- if {($post - $pre) > 20} break
+ if {($post - $pre) > 200} break
}
#if {($post - $pre) > 1000} {
#puts "[expr $post - $pre] ms for [$tree set $node leftfull]"
#}
@@ -651,37 +872,50 @@
if {$options(-statusvar) ne ""} {
upvar \#0 $options(-statusvar) statusvar
}
if {[llength $errors] > 0} {
- set answer [tk_messageBox -icon error -type yesno -message \
- "Error during directory processing:\n[join $errors \n]\nContinue?"]
- if {$answer eq "no"} {
+ lassign $errors node err
+ set leftfull [$tree rowattrib $node leftfull]
+ set rightfull [$tree rowattrib $node rightfull]
+ set answer [tk_messageBox -icon error -type abortretryignore \
+ -message \
+ "Error comparing\n$leftfull\nvs\n$rightfull:\n$err"]
+ if {$answer eq "retry"} {
+ $self AddNodeToIdle $node
+ } elseif {$answer eq "ignore"} {
+ # Do nothing, just continue
+ } else {
set statusvar ""
set AfterId ""
return
}
}
if {[llength $IdleQueue] > 0} {
+ set node [lindex $IdleQueue end]
set leftfull [$tree rowattrib $node leftfull]
set rightfull [$tree rowattrib $node rightfull]
if {$leftfull ne ""} {
- set statusvar $leftfull
+ set statusvar "$leftfull ($count)"
} else {
- set statusvar $rightfull
+ set statusvar "$rightfull ($count)"
}
- set AfterId [after 1 [mymethod UpdateIdle]]
+ $self Dlog Reschedule
+ set AfterId [after $AfterTime [mymethod UpdateIdle]]
} else {
+ $self Dlog DONE
set statusvar ""
set AfterId ""
}
}
method SetNodeStatus {node status} {
variable color
+ set old [$tree rowattrib $node status]
+ if {$old eq $status} return
$tree rowattrib $node status $status
$tree rowconfigure $node -foreground $color($status) \
-selectforeground $color($status)
#puts "Set [$tree item $node -text] to $status"
@@ -692,15 +926,19 @@
# If this is only present on one side, there is no need to update
set lf [$tree rowattrib $parent leftfull]
set rf [$tree rowattrib $parent rightfull]
if {$lf eq "" || $rf eq ""} { return }
+ # If parent is being filled, do not update yet
+ if {[$tree rowattrib $parent status] eq "unknown2"} {
+ return
+ }
set pstatus equal
foreach child [$tree childkeys $parent] {
set status [$tree rowattrib $child status]
switch $status {
- unknown {
+ unknown - unknown2 {
set pstatus unknown
}
new - old - change {
set pstatus change
break
@@ -720,84 +958,100 @@
}
$tree delete [$tree childkeys $node]
set leftfull [$tree rowattrib $node leftfull]
set rightfull [$tree rowattrib $node rightfull]
+ #$self Dlog "UpdateDirNode $leftfull"
$self CompareDirs $leftfull $rightfull $node
}
method UpdateFileNode {node} {
set leftfull [$tree rowattrib $node leftfull]
set rightfull [$tree rowattrib $node rightfull]
+ #$self Dlog "UpdateFileNode $leftfull"
+ # If a -changelist is given, some higher level optimisation has already
+ # figured out what has changed, so the processing time can be cut down.
+ if {[llength $options(-changelist)]} {
+ if {$rightfull ni $options(-changelist)} {
+ #puts "$rightfull equal since not in change list"
+ $self SetNodeStatus $node equal
+ return
+ }
+ #puts "$rightfull checked since in change list"
+ }
set equal [CompareFiles $leftfull $rightfull]
if {$equal} {
- $self SetNodeStatus $node equal
+ $self SetNodeStatus $node "equal"
} else {
$self SetNodeStatus $node change
}
}
# List files under a directory node
# Returns status for the new node
method ListFiles {df1 df2 node} {
- if {$df1 ne ""} {
- set type [file type $df1]
- set name [file tail $df1]
- } else {
- set type [file type $df2]
- set name [file tail $df2]
- }
if {[catch {file stat $df1 stat1}]} {
set size1 ""
set time1 ""
+ set type1 ""
} else {
set size1 $stat1(size)
set time1 [FormatDate $stat1(mtime)]
+ set type1 $stat1(type)
}
if {[catch {file stat $df2 stat2}]} {
set size2 ""
set time2 ""
+ set type2 ""
} else {
set size2 $stat2(size)
set time2 [FormatDate $stat2(mtime)]
+ set type2 $stat2(type)
+ }
+ if {$df1 ne ""} {
+ set type $type1
+ set name [file tail $df1]
+ } else {
+ set type $type2
+ set name [file tail $df2]
}
+ set largeFile 0
if {$type eq "directory"} {
- set values [list $name \
+ set values [list $name/ \
"" "" \
"" \
"" ""]
} else {
set values [list $name \
$size1 $time1 \
"" \
$size2 $time2]
+ # TODO: Configurable large file value?
+ if {$size1 > 1000000 && $size2 > 1000000} {
+ set largeFile 1
+ }
}
set id [$tree insertchild $node end $values]
$tree rowattrib $id type $type
$tree rowattrib $id status unknown
$tree rowattrib $id leftfull $df1
$tree rowattrib $id rightfull $df2
+ $tree rowattrib $id largefile $largeFile
if {$type ne "directory"} {
if {$type eq "link"} {
- $tree cellconfigure $id,structure -image $img(link)
+ $tree cellconfigure $id,structure -image $::img(link)
} else {
- $tree cellconfigure $id,structure -image $img(file)
+ $tree cellconfigure $id,structure -image $::img(file)
$tree cellconfigure $id,command -window [mymethod addCmdCol]
}
}
if {$type eq "directory"} {
## Make it so that this node is openable
$tree collapse $id
- #$tree insertchild $id end dummy ;# a dummy
- $tree cellconfigure $id,structure -text $name/
$self SetNodeStatus $id empty
- $self AddNodeToIdle $id
- $tree cellconfigure $id,structure -image $img(clsd)
- } elseif {$size1 == $size2 && \
- $time1 == $time2} {
- $self SetNodeStatus $id equal
+ $self AddNodeToIdle $id 1
} elseif {$size1 == ""} {
$self SetNodeStatus $id new
} elseif {$size2 == ""} {
$self SetNodeStatus $id old
} else {
@@ -806,23 +1060,28 @@
}
return [$tree rowattrib $id status]
}
method addCmdCol {tbl row col w} {
+ variable widgets
+ set key [$tree getfullkeys $row]
set status [$tree rowattrib $row status]
set type [$tree rowattrib $row type]
set lf [$tree rowattrib $row leftfull]
set rf [$tree rowattrib $row rightfull]
set bg [$tbl cget -background]
ttk::style configure Apa.TFrame -background $bg
- ttk::style configure Apa.Toolbutton -background $bg
+ ttk::style configure Apa.My.Toolbutton -background $bg
ttk::frame $w -style Apa.TFrame
- ttk::button $w.bl -image $img(left) -style Apa.Toolbutton \
- -command [mymethod CopyFile $row right]
- ttk::button $w.br -image $img(right) -style Apa.Toolbutton \
- -command [mymethod CopyFile $row left]
+ ttk::button $w.bl -image $::img(left) -style Apa.My.Toolbutton \
+ -command [mymethod CopyFile $key right]
+ ttk::button $w.br -image $::img(right) -style Apa.My.Toolbutton \
+ -command [mymethod CopyFile $key left]
pack $w.bl $w.br -side left -fill y
+ # Store widgets names
+ dict lappend widgets left $w.bl
+ dict lappend widgets right $w.br
if {$lf eq ""} {
$w.br configure -state disabled
}
if {$rf eq ""} {
$w.bl configure -state disabled
@@ -829,11 +1088,10 @@
}
}
# Compare two directories.
method CompareDirs {dir1 dir2 node} {
- global Pref
if {$dir1 eq ""} {
set files1 {}
} else {
set files1 [DirContents $dir1]
}
@@ -844,20 +1102,23 @@
}
set len1 [llength $files1]
set len2 [llength $files2]
+ # Unknown2 is used to mark a directory filling up
+ $self SetNodeStatus $node unknown2
+
set p1 0
set p2 0
set status_change 0
set status_unknown 0
while 1 {
if {$p1 < $len1 && $p2 < $len2} {
- set f1 [lindex $files1 $p1]
- set df1 [file join $dir1 $f1]
- set f2 [lindex $files2 $p2]
- set df2 [file join $dir2 $f2]
+ set df1 [lindex $files1 $p1]
+ set f1 [file tail $df1]
+ set df2 [lindex $files2 $p2]
+ set f2 [file tail $df2]
set apa [FStrCmp $f1 $f2]
if {$apa == 0} {
# Equal names, separate them if not the same type
set apa [expr {- [FileIsDirectory $df1] \
+ [FileIsDirectory $df2]}]
@@ -882,17 +1143,17 @@
incr p2
set status_change 1
}
}
} elseif {$p1 < $len1 && $p2 >= $len2} {
- set f1 [lindex $files1 $p1]
- $self ListFiles [file join $dir1 $f1] "" $node
+ set df1 [lindex $files1 $p1]
+ $self ListFiles $df1 "" $node
incr p1
set status_change 1
} elseif {$p1 >= $len1 && $p2 < $len2} {
- set f2 [lindex $files2 $p2]
- $self ListFiles "" [file join $dir2 $f2] $node
+ set df2 [lindex $files2 $p2]
+ $self ListFiles "" $df2 $node
incr p2
set status_change 1
} else {
break
}
@@ -921,22 +1182,18 @@
constructor {args} {
eskilRegisterToplevel $win
wm title $win "Eskil Dir"
wm protocol $win WM_DELETE_WINDOW [list cleanupAndExit $win]
- set dir $::eskil(thisDir)/images
- set img(open) [image create photo -file [file join $dir folderopen1.gif]]
- set img(up) [image create photo -file [file join $dir arrow_up.gif]]
- set h [image height $img(up)]
- set w [image width $img(up)]
- set img(upup) [image create photo -height $h -width [expr {2 * $w}]]
- $img(upup) copy $img(up) -to 0 0 [expr {2 * $w - 1}] [expr {$h - 1}]
-
install tree using DirCompareTree $win.dc \
-leftdirvariable ::dirdiff(leftDir) \
-rightdirvariable ::dirdiff(rightDir) \
-statusvar [myvar statusVar]
+
+ if {[info exists ::dirdiff(localChanges)]} {
+ $tree configure -changelist $::dirdiff(localChanges)
+ }
ttk::frame $win.fe1
ttk::frame $win.fe2
menu $win.m
@@ -958,19 +1215,35 @@
menu $win.m.mo
$win.m.mo add command -label "Prefs..." -command makeDirDiffPrefWin
$win.m.mo add cascade -label "Check" -menu $win.m.mo.mc
menu $win.m.mo.mc
- $win.m.mo.mc add radiobutton -variable Pref(dir,comparelevel) -value 0 \
+ $win.m.mo.mc add radiobutton -variable ::Pref(dir,comparelevel) -value 0 \
-label "Do not check contents"
- $win.m.mo.mc add radiobutton -variable Pref(dir,comparelevel) -value 1 \
+ $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 \
+ $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) \
+ $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 ::Pref(dir,nice) -value 1 \
+ -command [mymethod DoNice] -label 1
+ $win.m.mo.mn add radiobutton -variable ::Pref(dir,nice) -value 50 \
+ -command [mymethod DoNice] -label 50
+ $win.m.mo.mn add radiobutton -variable ::Pref(dir,nice) -value 100 \
+ -command [mymethod DoNice] -label 100
+ $win.m.mo.mn add radiobutton -variable ::Pref(dir,nice) -value 1000 \
+ -command [mymethod DoNice] -label 1000
+ $win.m.mo add separator
+ $win.m.mo add command -label "Save default" \
+ -command [list saveOptions $win]
+
$win.m add cascade -label "Tools" -underline 0 -menu $win.m.mt
menu $win.m.mt
$win.m.mt add command -label "New Diff Window" -underline 0 \
-command makeDiffWin
$win.m.mt add command -label "Clip Diff" -underline 0 \
@@ -980,17 +1253,17 @@
$win.m.mt add separator
$win.m.mt add command -label "Setup Registry" -underline 6 \
-command makeRegistryWin
}
}
-
+
$win.m add cascade -label "Help" -underline 0 -menu $win.m.help
menu $win.m.help
$win.m.help add command -label "Tutorial" -command makeTutorialWin \
-underline 0
$win.m.help add command -label "About" -command makeAboutWin -underline 0
-
+
if {$::eskil(debug)} {
$win.m add cascade -label "Debug" -menu $win.m.md -underline 0
menu $win.m.md
if {$::tcl_platform(platform) eq "windows"} {
$win.m.md add checkbutton -label "Console" -variable consolestate \
@@ -998,44 +1271,49 @@
$win.m.md add separator
}
$win.m.md add command -label "Reread Source" -underline 0 \
-command {EskilRereadSource}
$win.m.md add separator
- $win.m.md add command -label "Redraw Window" -command {makeDirDiffWin 1}
+ $win.m.md add command -label "Redraw Window" -command {makeDirDiffWin}
}
-
- ttk::button $win.bu -image $img(upup) -command [mymethod UpDir] \
+
+ ttk::button $win.bu -image $::img(upup) -command [mymethod UpDir] \
-underline 0
+ addBalloon $win.bu "Up in both."
bind $win "$win.bu invoke"
-
+
#catch {font delete myfont}
- #font create myfont -family $Pref(fontfamily) -size $Pref(fontsize)
+ #font create myfont -family $::Pref(fontfamily) -size $::Pref(fontsize)
ttk::entryX $win.e1 -textvariable dirdiff(leftDir) -width 30
- ttk::button $win.bu1 -image $img(up) -command [mymethod UpDir 1]
- ttk::button $win.bb1 -image $img(open) \
- -command "[list BrowseDir dirdiff(leftDir) $win.e1]
+ ttk::button $win.bu1 -image $::img(up) -command [mymethod UpDir 1]
+ addBalloon $win.bu1 "Up in left."
+ ttk::button $win.bb1 -image $::img(browse) \
+ -command "[list BrowseDir "dirdiff(leftDir)" $win.e1]
[mymethod DoDirCompare]"
+ addBalloon $win.bb1 "Browse left."
after 50 [list after idle [list $win.e1 xview end]]
ttk::entryX $win.e2 -textvariable dirdiff(rightDir) -width 30
- ttk::button $win.bu2 -image $img(up) -command [mymethod UpDir 2]
- ttk::button $win.bb2 -image $img(open) \
- -command "[list BrowseDir dirdiff(rightDir) $win.e2]
+ ttk::button $win.bu2 -image $::img(up) -command [mymethod UpDir 2]
+ addBalloon $win.bu2 "Up in right."
+ ttk::button $win.bb2 -image $::img(browse) \
+ -command "[list BrowseDir "dirdiff(rightDir)" $win.e2]
[mymethod DoDirCompare]"
+ addBalloon $win.bb2 "Browse right."
after 50 [list after idle [list $win.e2 xview end]]
bind $win.e1 [mymethod DoDirCompare]
bind $win.e2 [mymethod DoDirCompare]
ttk::label $win.sl -anchor w -textvariable [myvar statusVar]
-
+
pack $win.bb1 $win.bu1 -in $win.fe1 -side left -pady 1 -ipadx 10
pack $win.bu1 -padx 6
pack $win.e1 -in $win.fe1 -side left -fill x -expand 1
pack $win.bb2 $win.bu2 -in $win.fe2 -side right -pady 1 -ipadx 10
pack $win.bu2 -padx 6
pack $win.e2 -in $win.fe2 -side left -fill x -expand 1
-
+
grid $win.fe1 $win.bu $win.fe2 -sticky we
grid $tree - - -sticky news
grid $win.sl - - -sticky we
grid $win.bu -padx 6 -ipadx 15
@@ -1042,18 +1320,23 @@
grid rowconfigure $win 1 -weight 1
grid columnconfigure $win {0 2} -weight 1
}
method DoDirCompare {} {
+ # Reconfiguring the dirdiff widget triggers a rerun
$tree configure -leftdirvariable ::dirdiff(leftDir) \
-rightdirvariable ::dirdiff(rightDir)
}
+
+ method DoNice {} {
+ $tree nice $::Pref(dir,nice)
+ }
# Go up one level in directory hierarchy.
# 0 = both
method UpDir {{n 0}} {
- global dirdiff Pref
+ global dirdiff
switch $n {
0 {
set dirdiff(leftDir) [file dirname $dirdiff(leftDir)]
set dirdiff(rightDir) [file dirname $dirdiff(rightDir)]
$win.e1 xview end
@@ -1120,37 +1403,37 @@
}
wm title $top "Eskil Directory Preferences"
set check [ttk::labelframe $top.check -text "Check" -padding 3]
- ttk::radiobutton $check.rb1 -variable TmpPref(dir,comparelevel) -value 0 \
+ ttk::radiobutton $check.rb1 -variable ::TmpPref(dir,comparelevel) -value 0 \
-text "Do not check contents"
- ttk::radiobutton $check.rb2 -variable TmpPref(dir,comparelevel) -value 1 \
+ ttk::radiobutton $check.rb2 -variable ::TmpPref(dir,comparelevel) -value 1 \
-text "Normal compare"
- ttk::radiobutton $check.rb3 -variable TmpPref(dir,comparelevel) -value 2 \
+ ttk::radiobutton $check.rb3 -variable ::TmpPref(dir,comparelevel) -value 2 \
-text "Exact compare"
grid $check.rb1 -sticky w -padx 3 -pady 3
grid $check.rb2 -sticky w -padx 3 -pady 3
grid $check.rb3 -sticky w -padx 3 -pady 3
grid columnconfigure $check {0 1 2} -uniform a -weight 1
set opts [ttk::labelframe $top.opts -text "Options" -padding 3]
- ttk::checkbutton $opts.cb1 -variable TmpPref(dir,ignorekey) \
+ ttk::checkbutton $opts.cb1 -variable ::TmpPref(dir,ignorekey) \
-text "Ignore \$Keyword:\$"
- pack {*}[winfo children $opts] -side top -anchor w
+ pack {*}[winfo children $opts] -side top -anchor w
set filter [ttk::labelframe $top.filter -text "Filter" -padding 3]
ttk::label $filter.l1 -text "Include Files" -anchor w
- ttk::entryX $filter.e1 -width 20 -textvariable TmpPref(dir,incfiles)
+ ttk::entryX $filter.e1 -width 20 -textvariable ::TmpPref(dir,incfiles)
ttk::label $filter.l2 -text "Exclude Files" -anchor w
- ttk::entryX $filter.e2 -width 20 -textvariable TmpPref(dir,exfiles)
+ ttk::entryX $filter.e2 -width 20 -textvariable ::TmpPref(dir,exfiles)
ttk::label $filter.l3 -text "Include Dirs" -anchor w
- ttk::entryX $filter.e3 -width 20 -textvariable TmpPref(dir,incdirs)
+ ttk::entryX $filter.e3 -width 20 -textvariable ::TmpPref(dir,incdirs)
ttk::label $filter.l4 -text "Exclude Dirs" -anchor w
- ttk::entryX $filter.e4 -width 20 -textvariable TmpPref(dir,exdirs)
+ ttk::entryX $filter.e4 -width 20 -textvariable ::TmpPref(dir,exdirs)
ttk::checkbutton $filter.cb1 -text "Only revision controlled" \
- -variable TmpPref(dir,onlyrev)
+ -variable ::TmpPref(dir,onlyrev)
grid $filter.l1 $filter.e1 -sticky we -padx 3 -pady 3
grid $filter.l2 $filter.e2 -sticky we -padx 3 -pady 3
grid $filter.l3 $filter.e3 -sticky we -padx 3 -pady 3
grid $filter.l4 $filter.e4 -sticky we -padx 3 -pady 3
grid $filter.cb1 - -sticky w -padx 3 -pady 3
@@ -1187,24 +1470,89 @@
ttk::entryX $top.e1 -textvariable ::dirdiff(pattern) -width 15
ttk::entryX $top.e2 -textvariable ::dirdiff(replace) -width 15
ttk::label $top.l1 -text "Pattern" -anchor w
ttk::label $top.l2 -text "Subst" -anchor w
-
+
grid $top.l1 $top.e1 -sticky we
grid $top.l2 $top.e2 -sticky we
grid columnconfigure $top 1 -weight 1
grid rowconfigure $top 2 -weight 1
-
+
}
-proc makeDirDiffWin {{redraw 0}} {
+proc makeDirDiffWin {} {
if {![info exists ::dirdiff(leftDir)]} {
set ::dirdiff(leftDir) ""
}
if {![info exists ::dirdiff(rightDir)]} {
set ::dirdiff(rightDir) ""
}
+ # TODO, multi plugin for dirdiff?
+ set ::eskil(.dirdiff,plugin,1) ""
+ foreach {item val} $::eskil(defaultopts) {
+ set ::eskil(.dirdiff,$item) $val
+ }
+
+ # Support -r for directory diff
+ set revs {}
+ array set opts $::eskil(defaultopts)
+ if {[info exists opts(doptrev1)] && $opts(doptrev1) ne ""} {
+ lappend revs $opts(doptrev1)
+ }
+ if {[info exists opts(doptrev2)] && $opts(doptrev2) ne ""} {
+ lappend revs $opts(doptrev2)
+ }
+
+ # TODO: Trigger this on DirDiff, so a rerun can do it, and maybe have rev
+ # GUI fields
+ if {$::dirdiff(leftDir) eq $::dirdiff(rightDir) &&
+ $::dirdiff(leftDir) 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 ""} {
+ # No -r given; fall back on current.
+ if {[llength $revs] == 0} {
+ # Optimisation attempt for checkout vs latest, see if there
+ # is a command to detect local changes
+ if {[info commands eskil::rev::${type}::localChanges] ne ""} {
+ set ::dirdiff(localChanges) \
+ [eskil::rev::${type}::localChanges $fullname]
+ }
+ # Any vcs with dirdiff support should know that _ means current
+ set revs _
+ }
+ set revs [eskil::rev::${type}::ParseRevs $fullname $revs]
+ set rev1 [lindex $revs 0]
+ set rev2 [lindex $revs 1]
+
+ # A little "splash-screen" to show progress
+ destroy .dirdiffX
+ toplevel .dirdiffX
+ wm title .dirdiffX "Eskil Dir Diff"
+ label .dirdiffX.l1 -text "Collecting $type info for rev $rev1..."
+ label .dirdiffX.l2 -text ""
+ pack .dirdiffX.l1 .dirdiffX.l2 -side top -fill x
+ update
+
+ if {[catch {eskil::rev::${type}::mount $fullname $rev1} d1]} {
+ destroy .dirdiffX
+ tk_messageBox -icon error -message $d1 -type ok
+ # Can ony reach this from command line, so safe to exit
+ exit
+ }
+ set ::dirdiff(leftDir) $d1
+ if {$rev2 ne ""} {
+ .dirdiffX.l2 configure -text "and rev $rev2..."
+ update
+ set d2 [eskil::rev::${type}::mount $fullname $rev2]
+ set ::dirdiff(rightDir) $d2
+ }
+ destroy .dirdiffX
+ }
+ }
+
destroy .dirdiff
DirDiff .dirdiff
return .dirdiff
}
Index: src/eskil.syntax
==================================================================
--- src/eskil.syntax
+++ src/eskil.syntax
@@ -1,115 +1,132 @@
##nagelfar syntax textSearch::searchMenu x
-##nagelfar syntax textSearch::enableSearch x x*
+##nagelfar syntax textSearch::enableSearch x p*
+##nagelfar option textSearch::enableSearch -label
+##nagelfar option textSearch::enableSearch\ -label n
+##nagelfar package known textSearch
+
##nagelfar syntax DiffUtil::LocateDiffExe x
###nagelfar syntax DiffUtil::diffStrings o* x x
+##nagelfar package known DiffUtil
+
##nagelfar syntax dde s x
-##nagelfar syntax dnd s x*
+##nagelfar package known dde
+
##nagelfar syntax safeLoad x n
##nagelfar syntax helpWin x x
##nagelfar syntax commonYScroll x x*
##nagelfar syntax locateEditor n
##nagelfar syntax locateTmp n
+##nagelfar package known pstools
+##nagelfar package known psballoon
+
##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 package known wcb
+
##nagelfar syntax ::tk::GetSelection x x
##nagelfar syntax ::tk::ScrollButton2Down x x x
##nagelfar syntax console x
+
+##nagelfar syntax fileLabel x p*
+##nagelfar option fileLabel -textvariable
+##nagelfar option fileLabel\ -textvariable n
+##nagelfar syntax createPluginInterp x x x n
+
##nagelfar syntax registry x x x
+##nagelfar package known registry
+
+##nagelfar syntax vfs::filesystem s x*
+##nagelfar subcmd vfs::filesystem mount posixerror
+##nagelfar syntax vfs::filesystem\ mount x x
+##nagelfar syntax vfs::filesystem\ posixerror x
+##nagelfar syntax vfs::matchDirectories x
+##nagelfar syntax vfs::matchFiles x
+##nagelfar syntax vfs::accessMode x
+##nagelfar package known vfs
+
##nagelfar syntax pdf4tcl::getPaperSize x
##nagelfar syntax pdf4tcl::getPaperSizeList
+##nagelfar syntax pdf4tcl::loadBaseType1Font 3
+##nagelfar syntax pdf4tcl::loadBaseTrueTypeFont r 2 3
+##nagelfar syntax pdf4tcl::createFont 3
+##nagelfar package known pdf4tcl
+
##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
+##nagelfar package known twapi
+
+##nagelfar syntax tablelist::tablelist x p*
##nagelfar syntax tablelist::convEventFields x x x
+##nagelfar syntax tablelist::synchronize x
+##nagelfar syntax tablelist::updateKeyToRowMap x
+##nagelfar syntax tablelist::displayItems x
+##nagelfar syntax tablelist::cellIndex x x x
+##nagelfar syntax tablelist::findTabs x x x x n n
+##nagelfar syntax mwutil::wrongNumArgs x
+##nagelfar package known tablelist_tile
+
+##nagelfar syntax MySpinBox x p*
+##nagelfar option MySpinBox -textvariable -from -to -increment -width -format
+##nagelfar option MySpinBox\ -textvariable n
# 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
+##nagelfar implicitvarns 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
+##nagelfar implicitvarns snit::widget::DirDiff self\ _obj,DirDiff statusVar hull win self tree nice
+##########################################################
# 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 ScheduledRestart img
+##nagelfar implicitvarns snit::widget::DirCompareTree self\ _obj,DirCompareTree hull win self tree hsb vsb options AfterId PauseBgProcessing IdleQueue IdleQueueArr leftMark rightMark leftDir rightDir protect ScheduledRestart img AfterTime DebugCh DebugTime
+
+##########################################################
+# This is the annotation needed for this object definition
+
+##nagelfar syntax ttk::entryX dc=_obj,entryX p*
+##nagelfar option ttk::entryX -width -textvariable -style
+##nagelfar option ttk::entryX\ -textvariable n
+##nagelfar return ttk::entryX _obj,entryX
+##nagelfar subcmd+ _obj,entryX text newLine
+
+##nagelfar implicitvarns snit::widgetadaptor::ttk::entryX self\ _obj,entryX hull win self options
+##########################################################
# 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 syntax FourWay dc=_obj,FourWay p*
+###nagelfar option FourWay
+##nagelfar return FourWay _obj,FourWay
+###nagelfar subcmd+ _obj,FourWay text newLine
-##nagelfar implicitvar snit::widgetadaptor::ttk::entryX self\ _obj,ttk::entryX hull win self options
+##nagelfar implicitvarns snit::widget::FourWay self\ _obj,FourWay fields files filesGui revs revsGui origfiles origrevs revtype doingLine1 doingLine2 win hull
+
Index: src/eskil.tcl
==================================================================
--- src/eskil.tcl
+++ src/eskil.tcl
@@ -1,11 +1,10 @@
-#!/bin/sh
#---------------------------------------------------------- -*- tcl -*-
#
# Eskil, a Graphical frontend to diff
#
-# Copyright (c) 1998-2011, Peter Spjuth (peter.spjuth@gmail.com)
+# Copyright (c) 1998-2015, Peter Spjuth (peter.spjuth@gmail.com)
#
# Usage
# Do 'eskil' for interactive mode
# Do 'eskil --help' for command line usage
#
@@ -23,176 +22,10 @@
# 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.5
-
-# 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.5+ 2011-05-06"
-set ::eskil(thisScript) [file join [pwd] [info script]]
-
-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 {} {
- 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
- }
-
- 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]
- }
-
- # Get all other source files
- source $::eskil(thisDir)/clip.tcl
- source $::eskil(thisDir)/compare.tcl
- source $::eskil(thisDir)/map.tcl
- source $::eskil(thisDir)/merge.tcl
- source $::eskil(thisDir)/registry.tcl
- source $::eskil(thisDir)/dirdiff.tcl
- source $::eskil(thisDir)/help.tcl
- source $::eskil(thisDir)/plugin.tcl
- source $::eskil(thisDir)/printobj.tcl
- source $::eskil(thisDir)/print.tcl
- source $::eskil(thisDir)/rev.tcl
-
- set ::util(diffexe) diff
-
- # Diff functionality is in the DiffUtil package.
- package require DiffUtil
- # Help DiffUtil to find a diff executable, if needed
- catch {DiffUtil::LocateDiffExe $::eskil(thisScript)}
-
- # Figure out a place to store temporary files.
- locateTmp ::diff(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 ] eq ""} {
- bind all [bind Menubutton ]
- #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
- }
- }
- }
- # Reportedly, the ttk scrollbar looks bad on Aqua
- if {[tk windowingsystem] ne "aqua"} {
- interp alias {} scrollbar {} ttk::scrollbar
- }
- # 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] -x 0 -y 0 -relwidth 1 -relheight 1
- # Menubar looks out of place on linux. This adjusts the background
- # Which is enough to make it reasonable.
- set bg [ttk::style configure . -background]
- option add *Menubutton.background $bg
- option add *Menu.background $bg
- 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.
- 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
-}
-
-# 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]
-}
# This function is called when a toplevel is closed.
# If it is the last remaining toplevel, the application quits.
# If top = "all" it means quit.
# If eskil is embedded, this should be used to close an eskil toplevel.
@@ -199,24 +32,24 @@
proc cleanupAndExit {top} {
# A security thing to make sure we can exit.
set cont 0
if {[catch {
if {$top != "all"} {
- set i [lsearch $::diff(diffWindows) $top]
+ set i [lsearch $::eskil(diffWindows) $top]
if {$i >= 0} {
- set ::diff(diffWindows) [lreplace $::diff(diffWindows) $i $i]
+ set ::eskil(diffWindows) [lreplace $::eskil(diffWindows) $i $i]
}
set i [lsearch $::widgets(toolbars) $top.f]
if {$i >= 0} {
set ::widgets(toolbars) [lreplace $::widgets(toolbars) $i $i]
}
destroy $top
- array unset ::diff $top,*
+ array unset ::eskil $top,*
# Any windows remaining?
- if {[llength $::diff(diffWindows)] > 0} {
+ if {[llength $::eskil(diffWindows)] > 0} {
set cont 1
}
}
} errMsg]} {
tk_messageBox -icon error -title "Eskil Error" -message \
@@ -230,11 +63,11 @@
}
# If embedding, tell eskil about any other toplevel, then
# cleanupAndExit can be used to get rid of it.
proc eskilRegisterToplevel {top} {
- lappend ::diff(diffWindows) $top
+ lappend ::eskil(diffWindows) $top
}
# Format a line number
proc myFormL {lineNo} {
if {![string is integer -strict $lineNo]} {return "$lineNo\n"}
@@ -251,11 +84,11 @@
}
set name "tmpd[pid]a$::tmpcnt"
if {$tail ne ""} {
append name " [file tail $tail]"
}
- set name [file join $::diff(tmpdir) $name]
+ set name [file join $::eskil(tmpdir) $name]
lappend ::tmpfiles $name
return $name
}
# Delete temporary files
@@ -272,18 +105,45 @@
set ::tmpfiles [lreplace $::tmpfiles $i $i]
}
}
} else {
foreach f $::tmpfiles {
- catch {file delete $f}
+ catch {file delete -force $f}
}
set ::tmpfiles {}
}
}
+
+# insertLine, when in table mode
+proc insertLineTable {top n line text {tag equal}} {
+ set RE $::eskil($top,separator)
+ 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
+ }
+ }
+}
# Insert lineno and text
proc insertLine {top n line text {tag {equal}} {linetag {}}} {
+ if {$::eskil($top,view) eq "table"} {
+ insertLineTable $top $n $line $text $tag
+ return
+ }
$::widgets($top,wDiff$n) insert end "$text\n" $tag
if {$linetag ne ""} {
append tag " $linetag"
}
if {$tag != "equal"} {
@@ -292,41 +152,200 @@
$::widgets($top,wLine$n) insert end [myFormL $line] $tag
}
# Insert an empty line on one side of the diff.
proc emptyLine {top n {highlight 1}} {
+ if {$::eskil($top,view) eq "table"} {
+ # This should be ignored for table
+ return
+ }
if {$highlight} {
$::widgets($top,wLine$n) insert end "\n" hl$::HighLightCount
} else {
$::widgets($top,wLine$n) insert end "*****\n"
}
$::widgets($top,wDiff$n) insert end "\n" padding
}
+
+# Helper to take care of -sep case
+# This can be used when diffing e.g. a CSV file.
+# Each column will be handled separately, so differences will never be shown
+# crossing a separator
+proc diffWithSeparator {RE line1 line2 opts} {
+ set ixs1 [regexp -all -inline -indices -- $RE $line1]
+ set ixs2 [regexp -all -inline -indices -- $RE $line2]
+ # Fake a separator after end of line, makes the loop below simpler
+ lappend ixs1 [list [string length $line1] [string length $line1]]
+ lappend ixs2 [list [string length $line2] [string length $line2]]
+ # Res is at all times starting and ending with an equal pair
+ # i.e. same format as the result from DiffStrings
+ set res [list {} {}]
+ set s1 0
+ set s2 0
+ foreach ix1 $ixs1 ix2 $ixs2 {
+ # Handle if one index list is shorter
+ if {$ix1 eq ""} {
+ set str1 ""
+ set sep1 ""
+ } else {
+ lassign $ix1 e1 ns1
+ incr e1 -1
+ set str1 [string range $line1 $s1 $e1]
+ set sep1 [string range $line1 {*}$ix1]
+ }
+ if {$ix2 eq ""} {
+ set str2 ""
+ set sep2 ""
+ } else {
+ lassign $ix2 e2 ns2
+ incr e2 -1
+ set str2 [string range $line2 $s2 $e2]
+ set sep2 [string range $line2 {*}$ix2]
+ }
+ if {$str1 eq $str2} {
+ # Merge this equality with end of res
+ set resEq1 [lindex $res end-1]
+ set resEq2 [lindex $res end]
+ lset res end-1 $resEq1$str1$sep1
+ lset res end $resEq2$str2$sep2
+ } else {
+ set r [DiffUtil::diffStrings {*}$opts $str1 $str2]
+ # Starting equal pair
+ set rEq1a [lindex $r 0]
+ set rEq2a [lindex $r 1]
+ # Ending equal pair
+ set rEq1b [lindex $r end-1]
+ set rEq2b [lindex $r end]
+ # Mid part
+ set r [lrange $r 2 end-2]
+ # Merge starting equalities with end of res
+ set resEq1 [lindex $res end-1]
+ set resEq2 [lindex $res end]
+ lset res end-1 $resEq1$rEq1a
+ lset res end $resEq2$rEq2a
+ # Merge equality at end with separator
+ lappend res {*}$r $rEq1b$sep1 $rEq2b$sep2
+ }
+ set s1 [expr {$ns1 + 1}]
+ set s2 [expr {$ns2 + 1}]
+ }
+ #puts "RES '$res'"
+ return $res
+}
+
+# This is called from the table view whenever a cell is drawn.
+# Add color as needed.
+proc tblModeColorCallback {win w key row col tabIdx1 tabIdx2 inStripe selected} {
+ set cellX $key,$col
+ set top [winfo toplevel $win]
+ if {![dict exists $::eskil($top,tablechanges) $cellX]} {
+ # No changes, nothing to do here
+ return
+ }
+ set cinfo [dict get $::eskil($top,tablechanges) $cellX]
+ set w1 [dict get $cinfo w1]
+ set w2 [dict get $cinfo w2]
+
+ #puts "COLOR UPDATE W $win K $key R $row C $col TB1 $tabIdx1 TB2 $tabIdx2"
+ #puts " [string length $xxx] '$xxx'"
+ #puts " CHANGEME"
+
+ # Currently the displayed string is just $w1$w2
+ # The table might have cut of display of a cell so make sure to stay
+ # within the boundaries.
+ set txIdx1 [$w index $tabIdx1+1c]
+ set l1 [string length $w1]
+ set mid "$txIdx1 + $l1 char"
+ if {[$w compare $mid >= $tabIdx2]} {
+ set mid $tabIdx2
+ }
+ $w tag add new1 $txIdx1 $mid
+ $w tag add new2 $mid $tabIdx2
+
+ # Get the displayed string
+ set xxx [$w get $txIdx1 $tabIdx2]
+ if {$xxx ne "$w1$w2"} {
+ # Make sure dots are coloured
+ $w tag add change "$tabIdx2 - 3c" $tabIdx2
+ }
+}
+
+# insertMatchingLines, when in table mode
+proc insertMatchingLinesTable {top line1 line2} {
+ global doingLine1 doingLine2
+
+ set opts $::Pref(ignore)
+ if {$::Pref(nocase)} {lappend opts -nocase}
+ if {$::Pref(lineparsewords)} {lappend opts -words}
+ set RE $::eskil($top,separator)
+ set words1 [split $line1 $RE]
+ set words2 [split $line2 $RE]
+ # Lap 1, make row data
+ set rs {}
+ set row {}
+ foreach w1 $words1 w2 $words2 {
+ set r [DiffUtil::diffStrings {*}$opts $w1 $w2]
+ # Store for next lap
+ lappend rs $r
+ if {[llength $r] <= 2} {
+ # Equal
+ lappend row $w1
+ } else {
+ # TBD TABLE, simple display for now
+ lappend row $w1$w2
+ }
+ }
+ set id [$::widgets($top,wTable) insert end $row]
+
+ # 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
+}
# Insert one line in each text widget.
# Mark them as changed, and optionally parse them.
proc insertMatchingLines {top line1 line2} {
- global doingLine1 doingLine2 Pref
+ global doingLine1 doingLine2
+
+ if {$::eskil($top,view) eq "table"} {
+ insertMatchingLinesTable $top $line1 $line2
+ return
+ }
# FIXA: fully implement filter
- if {$::diff(filter) != ""} {
- if {[regexp $::diff(filter) $line1]} {
+ if {$::eskil(filter) != ""} {
+ if {[regexp $::eskil(filter) $line1]} {
insertLine $top 1 $doingLine1 $line1
insertLine $top 2 $doingLine2 $line2
incr doingLine1
incr doingLine2
- set ::diff(filterflag) 1
+ set ::eskil(filterflag) 1
return
}
- set ::diff(filterflag) 0
+ set ::eskil(filterflag) 0
}
- if {$Pref(parse) != 0} {
- set opts $Pref(ignore)
- if {$Pref(nocase)} {lappend opts -nocase}
- if {$Pref(lineparsewords)} {lappend opts -words}
- set res [DiffUtil::diffStrings {*}$opts $line1 $line2]
+ if {$::Pref(parse) != 0} {
+ set opts $::Pref(ignore)
+ if {$::Pref(nocase)} {lappend opts -nocase}
+ if {$::Pref(lineparsewords)} {lappend opts -words}
+ if {$::eskil($top,separator) ne ""} {
+ set res [diffWithSeparator $::eskil($top,separator) $line1 $line2 \
+ $opts]
+ } else {
+ set res [DiffUtil::diffStrings {*}$opts $line1 $line2]
+ }
set dotag 0
set n [expr {[llength $res] / 2}]
$::widgets($top,wLine1) insert end [myFormL $doingLine1] \
"hl$::HighLightCount change"
$::widgets($top,wLine2) insert end [myFormL $doingLine2] \
@@ -335,11 +354,11 @@
set new2 "new2"
set change "change"
foreach {i1 i2} $res {
incr n -1
if {$dotag} {
- if {$n == 1 && $Pref(marklast)} {
+ if {$n == 1 && $::Pref(marklast)} {
lappend new1 last
lappend new2 last
lappend change last
}
if {$i1 eq ""} {
@@ -448,24 +467,75 @@
return [expr {($n1 > $n2 ? $n1 : $n2) + 1}]
} else {
return [expr {-($n1 > $n2 ? $n1 : $n2)}]
}
}
+
+# Insert two blocks of lines in the compare windows.
+# No extra parsing at all.
+proc insertMatchingBlocksNoParse {top block1 block2 line1 line2 details} {
+ global doingLine1 doingLine2
+
+ set n1 [llength $block1]
+ set n2 [llength $block2]
+ # Is this a change block, a delete block or an insert block?
+ if {$n1 == 0} {set tag2 new2} else {set tag2 change}
+ if {$n2 == 0} {set tag1 new1} else {set tag1 change}
+
+ if {$n1 == $n2} {
+ # This should only happen for equal sized blocks that were deemed
+ # too large for block parsing.
+ foreach line1 $block1 line2 $block2 {
+ insertMatchingLines $top $line1 $line2
+ }
+ } else {
+ foreach line $block1 {
+ insertLine $top 1 $doingLine1 $line $tag1
+ incr doingLine1
+ }
+ foreach line $block2 {
+ insertLine $top 2 $doingLine2 $line $tag2
+ incr doingLine2
+ }
+ }
+ if {$n1 <= $n2} {
+ for {set t $n1} {$t < $n2} {incr t} {
+ emptyLine $top 1
+ }
+ addChange $top $n2 $tag2 $line1 $n1 $line2 $n2
+ nextHighlight $top
+ } elseif {$n2 < $n1} {
+ for {set t $n2} {$t < $n1} {incr t} {
+ emptyLine $top 2
+ }
+ addChange $top $n1 $tag1 $line1 $n1 $line2 $n2
+ nextHighlight $top
+ }
+}
# Insert two blocks of lines in the compare windows.
proc insertMatchingBlocks {top block1 block2 line1 line2 details} {
global doingLine1 doingLine2
- # A large block may take time. Give a small warning.
set n1 [llength $block1]
set n2 [llength $block2]
- if {$n1 * $n2 > 1000} {
+
+ set large [expr {$n1 * $n2 > 5000}]
+
+ if {$n1 == 0 || $n2 == 0 || $::Pref(parse) < 2 || \
+ ($large && $::Pref(parse) < 3)} {
+ # No extra parsing at all.
+ insertMatchingBlocksNoParse $top $block1 $block2 $line1 $line2 $details
+ return
+ }
+
+ # A large block may take time. Give a small warning.
+ if {$n1 * $n2 > 2000} {
set ::widgets($top,eqLabel) "!"
- #puts "Eskil warning: Analyzing a large block. ($size1 $size2)"
update idletasks
}
-
+
# Detect if only newlines has changed within the block, e.g.
# when rearranging newlines.
if {$::eskil(ignorenewline)} {
set res [ParseBlocksAcrossNewline $top $block1 $block2]
if {$res != 0} {
@@ -484,29 +554,29 @@
# Fine grained changes means that each line is considered its own
# chunk. This is used for merging better to avoid the same decision
# for an entire block.
set finegrain [expr {$::Pref(finegrainchunks) && $details}]
- if {$finegrain && $::diff($top,ancestorFile) ne ""} {
+ if {$finegrain && $::eskil($top,ancestorFile) ne ""} {
# Avoid fine grain depending on relation to ancestor
set leftChange 0
set leftChangeOrAdd 0
for {set t $line1} {$t < $line1 + $n1} {incr t} {
- if {[info exists ::diff($top,ancestorLeft,$t)]} {
+ if {[info exists ::eskil($top,ancestorLeft,$t)]} {
set leftChangeOrAdd 1
- if {$::diff($top,ancestorLeft,$t) eq "c"} {
+ if {$::eskil($top,ancestorLeft,$t) eq "c"} {
set leftChange 1
break
}
}
}
set rightChange 0
set rightChangeOrAdd 0
for {set t $line2} {$t < $line2 + $n2} {incr t} {
- if {[info exists ::diff($top,ancestorRight,$t)]} {
+ if {[info exists ::eskil($top,ancestorRight,$t)]} {
set rightChangeOrAdd 1
- if {$::diff($top,ancestorRight,$t) eq "c"} {
+ if {$::eskil($top,ancestorRight,$t) eq "c"} {
set rightChange 1
break
}
}
}
@@ -533,49 +603,64 @@
nextHighlight $top
}
incr t1
incr t2
} elseif {$c eq "C"} {
- # This is two lines that the block matching considered
- # too different to use line parsing on them.
- # Marked the whole line as deleted/inserted
+ # This is two lines that the block matching considered
+ # too different to use line parsing on them.
+ # Marked the whole line as deleted/inserted
set textline1 [lindex $block1 $t1]
set textline2 [lindex $block2 $t2]
- $::widgets($top,wLine1) insert end [myFormL $doingLine1] \
- "hl$::HighLightCount change"
- $::widgets($top,wDiff1) insert end "$textline1\n" new1
- $::widgets($top,wLine2) insert end [myFormL $doingLine2] \
- "hl$::HighLightCount change"
- $::widgets($top,wDiff2) insert end "$textline2\n" new2
+ if {$::eskil($top,view) eq "table"} {
+ # Fall back to proc that handles table
+ insertMatchingLinesTable $top $textline1 $textline2
+ } else {
+ # insertLine cannot be used here since lineNo and text tags
+ # are different
+ $::widgets($top,wLine1) insert end [myFormL $doingLine1] \
+ "hl$::HighLightCount change"
+ $::widgets($top,wDiff1) insert end "$textline1\n" new1
+ $::widgets($top,wLine2) insert end [myFormL $doingLine2] \
+ "hl$::HighLightCount change"
+ $::widgets($top,wDiff2) insert end "$textline2\n" new2
+ incr doingLine1
+ incr doingLine2
+ }
if {$finegrain} {
addChange $top 1 change [expr {$line1 + $t1}] 1 \
[expr {$line2 + $t2}] 1
nextHighlight $top
}
- incr doingLine1
- incr doingLine2
incr t1
incr t2
} elseif {$c eq "d"} {
set bepa [lindex $block1 $t1]
- $::widgets($top,wLine1) insert end [myFormL $doingLine1] \
- "hl$::HighLightCount change"
- $::widgets($top,wDiff1) insert end "$bepa\n" new1
- emptyLine $top 2
+ if {$::eskil($top,view) eq "table"} {
+ insertLineTable $top 1 $doingLine1 $bepa new1
+ } else {
+ $::widgets($top,wLine1) insert end [myFormL $doingLine1] \
+ "hl$::HighLightCount change"
+ $::widgets($top,wDiff1) insert end "$bepa\n" new1
+ emptyLine $top 2
+ }
incr doingLine1
if {$finegrain} {
addChange $top 1 new1 [expr {$line1 + $t1}] 1 \
[expr {$line2 + $t2}] 0
nextHighlight $top
}
incr t1
} elseif {$c eq "a"} {
set bepa [lindex $block2 $t2]
- $::widgets($top,wLine2) insert end [myFormL $doingLine2] \
- "hl$::HighLightCount change"
- $::widgets($top,wDiff2) insert end "$bepa\n" new2
- emptyLine $top 1
+ if {$::eskil($top,view) eq "table"} {
+ insertLineTable $top 2 $doingLine2 $bepa new2
+ } else {
+ $::widgets($top,wLine2) insert end [myFormL $doingLine2] \
+ "hl$::HighLightCount change"
+ $::widgets($top,wDiff2) insert end "$bepa\n" new2
+ emptyLine $top 1
+ }
incr doingLine2
if {$finegrain} {
addChange $top 1 new2 [expr {$line1 + $t1}] 0 \
[expr {$line2 + $t2}] 1
nextHighlight $top
@@ -599,59 +684,66 @@
# n1/n2 is the number of lines involved
# line1/line2 says on what lines this block starts
# If n1/n2 are both 0, it means that this is the last lines to be displayed.
# In that case line1/line2, if non-zero says the last line to display.
proc doText {top ch1 ch2 n1 n2 line1 line2} {
- global doingLine1 doingLine2 Pref
+ global doingLine1 doingLine2
if {$n1 == 0 && $n2 == 0} {
# All blocks have been processed. Continue until end of file.
# If "show all" is not on, just display a couple of context lines.
set limit -1
- if {$Pref(context) >= 0} {
- set limit $Pref(context)
+ if {$::Pref(context) >= 0} {
+ set limit $::Pref(context)
}
- # Consider any total limit on displayed lines.
- if {$::diff($top,limitlines)} {
- set limit [expr {$::diff($top,limitlines) - $::diff($top,mapMax)}]
+ # Consider any total limit on displayed lines.
+ if {$::eskil($top,limitlines)} {
+ set limit [expr {$::eskil($top,limitlines) - $::eskil($top,mapMax)}]
if {$limit < 0} {
set limit 0
}
}
if {$limit >= 0} {disallowEdit $top}
- set t 0
- while {[gets $ch2 apa] != -1} {
- if {$line2 > 0 && $doingLine2 > $line2} break
- insertLine $top 2 $doingLine2 $apa
- incr doingLine2
- addMapLines $top 1
- incr t
- if {$limit >= 0 && $t >= $limit} break
- }
- set t 0
- while {[gets $ch1 apa] != -1} {
- if {$line1 > 0 && $doingLine1 > $line1} break
- insertLine $top 1 $doingLine1 $apa
- incr doingLine1
- incr t
- if {$limit >= 0 && $t >= $limit} break
+ # Unless we are in "only diffs", display remaining lines to the limit
+ if {$limit != 0} {
+ set t 0
+ while {[gets $ch2 apa] != -1} {
+ if {$line2 > 0 && $doingLine2 > $line2} break
+ insertLine $top 2 $doingLine2 $apa
+ incr doingLine2
+ addMapLines $top 1
+ incr t
+ if {$limit >= 0 && $t >= $limit} break
+ }
+ if {$::eskil($top,view) ne "table"} {
+ set t 0
+ while {[gets $ch1 apa] != -1} {
+ if {$line1 > 0 && $doingLine1 > $line1} break
+ insertLine $top 1 $doingLine1 $apa
+ incr doingLine1
+ incr t
+ if {$limit >= 0 && $t >= $limit} break
+ }
+ }
}
return
}
- # Is this a change block, a delete block or a insert block?
+ # Is this a change block, a delete block or an insert block?
if {$n1 == 0} {set tag2 new2} else {set tag2 change}
if {$n2 == 0} {set tag1 new1} else {set tag1 change}
- # Display all equal lines before next diff
- # If only diff is on, only skip a section if the blank
+ # Display all equal lines before next diff, or skip if context is set.
+ # If context is on, only skip a section if the blank
# line replaces at least 3 lines.
set limit -1
- if {$Pref(context) >= 0 && \
- ($line1 - $doingLine1 > (2 * $Pref(context) + 2))} {
- set limit $Pref(context)
+ if {$::Pref(context) == 0} {
+ set limit 0
+ } elseif {$::Pref(context) > 0 && \
+ ($line1 - $doingLine1 > (2 * $::Pref(context) + 2))} {
+ set limit $::Pref(context)
}
if {$doingLine1 == 1} {
set allowStartFill 0
} else {
set allowStartFill 1
@@ -660,12 +752,16 @@
while {$doingLine1 < $line1} {
gets $ch1 apa
gets $ch2 bepa
if {$limit < 0 || ($t < $limit && $allowStartFill) || \
($line1 - $doingLine1) <= $limit} {
- insertLine $top 1 $doingLine1 $apa
- insertLine $top 2 $doingLine2 $bepa
+ if {$::eskil($top,view) ne "table"} {
+ insertLine $top 1 $doingLine1 $apa
+ insertLine $top 2 $doingLine2 $bepa
+ } else {
+ insertLineTable $top 1 $doingLine1 $apa
+ }
addMapLines $top 1
} elseif {$t == $limit && $allowStartFill} {
# If zero context is shown, skip the filler to keep display tight.
if {$limit > 0} {
emptyLine $top 1 0
@@ -674,12 +770,12 @@
}
}
incr doingLine1
incr doingLine2
incr t
- if {$::diff($top,limitlines) && \
- ($::diff($top,mapMax) > $::diff($top,limitlines))} {
+ if {$::eskil($top,limitlines) && \
+ ($::eskil($top,mapMax) > $::eskil($top,limitlines))} {
return
}
}
# This should not happen unless something is wrong...
if {$doingLine2 != $line2} {
@@ -692,66 +788,38 @@
$::widgets($top,wLine2) insert end "\n"
}
# Process the block
- if {$n1 == $n2 && ($n1 == 1 || $Pref(parse) < 2)} {
+ if {$n1 == $n2 && ($n1 == 1 || $::Pref(parse) < 2)} {
# Never do block parsing for one line blocks.
# If block parsing is turned off, only do line parsing for
# blocks of equal size.
for {set t 0} {$t < $n1} {incr t} {
gets $ch1 textline1
gets $ch2 textline2
insertMatchingLines $top $textline1 $textline2
}
- if {$::diff(filter) != "" && $::diff(filterflag)} {
+ if {$::eskil(filter) != "" && $::eskil(filterflag)} {
addMapLines $top $n1
} else {
addChange $top $n1 change $line1 $n1 $line2 $n2
nextHighlight $top
}
} else {
- if {$n1 != 0 && $n2 != 0 && $Pref(parse) >= 2 && \
- ($n1 * $n2 < 1000 || $Pref(parse) == 3)} {
- # Full block parsing
- set block1 {}
- for {set t 0} {$t < $n1} {incr t} {
- gets $ch1 apa
- lappend block1 $apa
- }
- set block2 {}
- for {set t 0} {$t < $n2} {incr t} {
- gets $ch2 apa
- lappend block2 $apa
- }
- insertMatchingBlocks $top $block1 $block2 $line1 $line2 1
- } else {
- # No extra parsing at all.
- for {set t 0} {$t < $n1} {incr t} {
- gets $ch1 apa
- insertLine $top 1 $doingLine1 $apa $tag1
- incr doingLine1
- }
- for {set t 0} {$t < $n2} {incr t} {
- gets $ch2 apa
- insertLine $top 2 $doingLine2 $apa $tag2
- incr doingLine2
- }
- if {$n1 <= $n2} {
- for {set t $n1} {$t < $n2} {incr t} {
- emptyLine $top 1
- }
- addChange $top $n2 $tag2 $line1 $n1 $line2 $n2
- nextHighlight $top
- } elseif {$n2 < $n1} {
- for {set t $n2} {$t < $n1} {incr t} {
- emptyLine $top 2
- }
- addChange $top $n1 $tag1 $line1 $n1 $line2 $n2
- nextHighlight $top
- }
- }
+ # Collect blocks
+ set block1 {}
+ for {set t 0} {$t < $n1} {incr t} {
+ gets $ch1 apa
+ lappend block1 $apa
+ }
+ set block2 {}
+ for {set t 0} {$t < $n2} {incr t} {
+ gets $ch2 apa
+ lappend block2 $apa
+ }
+ insertMatchingBlocks $top $block1 $block2 $line1 $line2 1
}
# Empty return value
return
}
@@ -765,27 +833,38 @@
$top.m.mt entryconfigure "Merge" -state disabled
}
proc busyCursor {top} {
global oldcursor oldcursor2
+ if {$::eskil($top,view) eq "table"} {
+ set items wTable
+ } else {
+ set items {wLine1 wDiff1 wLine2 wDiff2}
+ }
if {![info exists oldcursor]} {
set oldcursor [$top cget -cursor]
- set oldcursor2 [$::widgets($top,wDiff1) cget -cursor]
+ set i1 [lindex $items 0]
+ set oldcursor2 [$::widgets($top,$i1) cget -cursor]
}
$top config -cursor watch
- foreach item {wLine1 wDiff1 wLine2 wDiff2} {
+ foreach item $items {
if {[info exists ::widgets($top,$item)]} {
set w $::widgets($top,$item)
$w config -cursor watch
}
}
}
proc normalCursor {top} {
global oldcursor oldcursor2
+ if {$::eskil($top,view) eq "table"} {
+ set items wTable
+ } else {
+ set items {wLine1 wDiff1 wLine2 wDiff2}
+ }
$top config -cursor $oldcursor
- foreach item {wLine1 wDiff1 wLine2 wDiff2} {
+ foreach item $items {
if {[info exists ::widgets($top,$item)]} {
set w $::widgets($top,$item)
$w config -cursor $oldcursor2
}
}
@@ -794,48 +873,40 @@
#####################################
# Special cases. Conflict/patch
#####################################
proc startConflictDiff {top file} {
- set ::diff($top,mode) "conflict"
- set ::diff($top,modetype) ""
- set ::diff($top,conflictFile) $file
- set ::diff($top,rightDir) [file dirname $file]
- set ::diff($top,rightOK) 1
- set ::diff($top,rightLabel) $file
- set ::diff($top,leftLabel) $file
- set ::diff($top,leftOK) 0
+ set ::eskil($top,mode) "conflict"
+ set ::eskil($top,modetype) ""
+ set ::eskil($top,view) ""
+ set ::eskil($top,conflictFile) $file
+ set ::eskil($top,rightDir) [file dirname $file]
+ set ::eskil($top,rightOK) 1
+ set ::eskil($top,rightLabel) $file
+ set ::eskil($top,leftLabel) $file
+ set ::eskil($top,leftOK) 0
# Turn off ignore
set ::Pref(ignore) " "
set ::Pref(nocase) 0
set ::Pref(noempty) 0
# Try to autodetect line endings in file
- set ch [open $file rb]
- set data [read $ch 10000]
- close $ch
- if {[string first \r\n $data] >= 0} {
- set ::diff($top,mergetranslation) crlf
- } else {
- set ::diff($top,mergetranslation) lf
- }
+ detectLineEnd $top $file mergetranslation lf
}
# Read a conflict file and extract the two versions.
proc prepareConflict {top} {
- global Pref
-
disallowEdit $top
- set ::diff($top,leftFile) [tmpFile]
- set ::diff($top,rightFile) [tmpFile]
-
- set ch1 [open $::diff($top,leftFile) w]
- set ch2 [open $::diff($top,rightFile) w]
- set ch [open $::diff($top,conflictFile) r]
-
- set ::diff($top,conflictDiff) {}
+ set ::eskil($top,leftFile) [tmpFile]
+ set ::eskil($top,rightFile) [tmpFile]
+
+ set ch1 [open $::eskil($top,leftFile) w]
+ set ch2 [open $::eskil($top,rightFile) w]
+ set ch [open $::eskil($top,conflictFile) r]
+
+ set ::eskil($top,conflictDiff) {}
set leftLine 1
set rightLine 1
set state both
set rightName ""
set leftName ""
@@ -850,11 +921,11 @@
set start1 $leftLine
} elseif {[string match >>>>>>* $line] && $state eq "left"} {
set state both
regexp {>*\s*(.*)} $line -> leftName
set end1 [expr {$leftLine - 1}]
- lappend ::diff($top,conflictDiff) [list \
+ lappend ::eskil($top,conflictDiff) [list \
$start1 [expr {$end1 - $start1 + 1}] \
$start2 [expr {$end2 - $start2 + 1}]]
} elseif {$state eq "both"} {
puts $ch1 $line
puts $ch2 $line
@@ -871,29 +942,28 @@
close $ch
close $ch1
close $ch2
if {$leftName eq "" && $rightName eq ""} {
- set leftName "No Conflict: [file tail $::diff($top,conflictFile)]"
+ set leftName "No Conflict: [file tail $::eskil($top,conflictFile)]"
set rightName $leftName
}
- set ::diff($top,leftLabel) $leftName
- set ::diff($top,rightLabel) $rightName
+ set ::eskil($top,leftLabel) $leftName
+ set ::eskil($top,rightLabel) $rightName
update idletasks
}
# Clean up after a conflict diff.
proc cleanupConflict {top} {
- global Pref
-
- clearTmp $::diff($top,rightFile) $::diff($top,leftFile)
- set ::diff($top,rightFile) $::diff($top,conflictFile)
- set ::diff($top,leftFile) $::diff($top,conflictFile)
+ clearTmp $::eskil($top,rightFile) $::eskil($top,leftFile)
+ set ::eskil($top,rightFile) $::eskil($top,conflictFile)
+ set ::eskil($top,leftFile) $::eskil($top,conflictFile)
}
# Display one chunk from a patch file
proc displayOnePatch {top leftLines rightLines leftLine rightLine} {
+ mapNoChange $top 1
emptyLine $top 1
emptyLine $top 2
set leftlen [llength $leftLines]
set rightlen [llength $rightLines]
@@ -991,30 +1061,29 @@
set ::doingLine2 $rblockl
insertMatchingBlocks $top $lblock $rblock $lblockl $rblockl 0
set lblock {}
set rblock {}
}
+ mapNoChange $top 0
}
# Read a patch file and display it
proc displayPatch {top} {
- global Pref
-
- set ::diff($top,leftLabel) "Patch $::diff($top,patchFile): old"
- set ::diff($top,rightLabel) "Patch $::diff($top,patchFile): new"
+ set ::eskil($top,leftLabel) "Patch $::eskil($top,patchFile): old"
+ set ::eskil($top,rightLabel) "Patch $::eskil($top,patchFile): new"
update idletasks
- if {$::diff($top,patchFile) eq ""} {
- if {$::diff($top,patchData) eq ""} {
+ if {$::eskil($top,patchFile) eq ""} {
+ if {$::eskil($top,patchData) eq ""} {
set data [getFullPatch $top]
} else {
- set data $::diff($top,patchData)
+ set data $::eskil($top,patchData)
}
- } elseif {$::diff($top,patchFile) eq "-"} {
+ } elseif {$::eskil($top,patchFile) eq "-"} {
set data [read stdin]
} else {
- set ch [open $::diff($top,patchFile) r]
+ set ch [open $::eskil($top,patchFile) r]
set data [read $ch]
close $ch
}
set style ""
@@ -1023,10 +1092,11 @@
set leftLine 1
set rightLine 1
set leftLines {}
set rightLines {}
set state none
+ set fname ""
foreach line [split $data \n] {
# Detect a new file
if {[string match ======* $line] || [string match "diff *" $line]} {
if {$state != "none"} {
displayOnePatch $top $leftLines $rightLines $leftLine $rightLine
@@ -1034,10 +1104,27 @@
set leftLines {}
set rightLines {}
set state none
continue
}
+ # Detect a file name
+ if {[string match "Index: *" $line]} {
+ # If fname is set, a file that had no contents has passed.
+ # It could be a binary file or some other that the diffing source
+ # could not handle.
+ # Display the name to see that it is involved.
+ if {$fname ne ""} {
+ foreach side {1 2} {
+ emptyLine $top $side
+ insertLine $top $side "" $divider patch
+ insertLine $top $side "" $fname patch
+ insertLine $top $side "" $divider patch
+ }
+ addChange $top 4 change 0 0 0 0
+ }
+ set fname [string range $line 7 end]
+ }
# Detect the first line in a -c style diff
if {[regexp {^\*\*\* } $line]} {
if {$state eq "right"} {
displayOnePatch $top $leftLines $rightLines $leftLine $rightLine
set leftLines {}
@@ -1065,26 +1152,31 @@
set leftRE {^---\s+(.*)$}
set rightRE {^\+\+\+\s+(.*)$}
}
}
if {$state eq "newfile" && [regexp $leftRE $line -> sub]} {
+ set fname ""
emptyLine $top 1
insertLine $top 1 "" $divider patch
insertLine $top 1 "" $sub patch
insertLine $top 1 "" $divider patch
addChange $top 4 change 0 0 0 0
continue
}
if {$state eq "newfile" && [regexp $rightRE $line -> sub]} {
+ set fname ""
emptyLine $top 2
insertLine $top 2 "" $divider patch
insertLine $top 2 "" $sub patch
insertLine $top 2 "" $divider patch
continue
}
# A new section in a -u style diff
- if {[regexp {^@@\s+-(\d+),\d+\s+\+(\d+),} $line -> sub1 sub2]} {
+ # Normally the chunk starts with @@
+ # From some tools the chunk starts with ##
+ if {[regexp {^(?:@@|\#\#)\s+-(\d+)(?:,\d+)?\s+\+(\d+)} $line ->\
+ sub1 sub2]} {
if {$state eq "both"} {
displayOnePatch $top $leftLines $rightLines \
$leftLine $rightLine
}
# Look for c function annotation in -u style
@@ -1156,62 +1248,116 @@
if {![regexp {^[\s+-]} $line]} continue
set sig [string trim [string index $line 0]]
set str [string range $line 1 end]
if {$sig eq ""} {
lappend leftLines [list $leftLine "" $str]
- lappend rightLines [list $leftLine "" $str]
+ lappend rightLines [list $rightLine "" $str]
incr leftLine
incr rightLine
} elseif {$sig eq "-"} {
lappend leftLines [list $leftLine "-" $str]
incr leftLine
} else {
- lappend rightLines [list $leftLine "+" $str]
+ lappend rightLines [list $rightLine "+" $str]
incr rightLine
}
continue
}
}
if {$state != "none"} {
displayOnePatch $top $leftLines $rightLines $leftLine $rightLine
}
+ if {$fname ne ""} {
+ foreach side {1 2} {
+ emptyLine $top $side
+ insertLine $top $side "" $divider patch
+ insertLine $top $side "" $fname patch
+ insertLine $top $side "" $divider patch
+ }
+ addChange $top 4 change 0 0 0 0
+ }
}
#####################################
# Main diff
#####################################
# Prepare for a diff by creating needed temporary files
proc prepareFiles {top} {
- set ::diff($top,cleanup) {}
- if {$::diff($top,mode) eq "rev"} {
+ set ::eskil($top,cleanup) {}
+ if {$::eskil($top,mode) eq "rev"} {
prepareRev $top
- lappend ::diff($top,cleanup) "rev"
- } elseif {$::diff($top,mode) eq "conflict"} {
+ lappend ::eskil($top,cleanup) "rev"
+ } elseif {$::eskil($top,mode) eq "conflict"} {
prepareConflict $top
- lappend ::diff($top,cleanup) "conflict"
+ lappend ::eskil($top,cleanup) "conflict"
}
- if {$::diff($top,plugin) ne ""} {
- preparePlugin $top
- set ::diff($top,cleanup) "plugin $::diff($top,cleanup)"
+ # Try to autodetect line endings in files
+ detectLineEnd $top $::eskil($top,rightFile) righttranslation
+ detectLineEnd $top $::eskil($top,leftFile) lefttranslation
+ # Prepare Separator
+ set ::eskil($top,separator) \
+ [subst -nocommands -novariables $::eskil($top,separatorview)]
+ # Autodetect separator before any plugin processing
+ if {$::eskil($top,view) eq "table" && $::eskil($top,separator) eq ""} {
+ set ch1 [open $::eskil($top,leftFile)]
+ if {$::eskil($top,gz)} {
+ zlib push gunzip $ch1
+ }
+ gets $ch1 line1
+ close $ch1
+ # Any tab, comma or semicolon?
+ if {[regsub -all "\t" $line1 "\t" _] >= 2} {
+ set ::eskil($top,separator) "\t"
+ set ::eskil($top,separatorview) "\\t"
+ } elseif {[regsub -all "," $line1 "," _] >= 2} {
+ set ::eskil($top,separator) ","
+ set ::eskil($top,separatorview) ","
+ lappend ::eskil(argv) -sep ","
+ } elseif {[regsub -all ";" $line1 ";" _] >= 2} {
+ set ::eskil($top,separator) ";"
+ set ::eskil($top,separatorview) ";"
+ lappend ::eskil(argv) -sep ";"
+ }
+ }
+ # Make it look like it came from command line
+ # It could come from the GUI or auto-detect, put it in the command line
+ # to make it visible for plugins.
+ set i [lsearch -exact $::eskil(argv) "-sep"]
+ if {$i >= 0} {
+ incr i
+ lset ::eskil(argv) $i $::eskil($top,separatorview)
+ } else {
+ lappend ::eskil(argv) -sep $::eskil($top,separatorview)
+ }
+ # Prepare plugin, if any
+ if {[preparePlugin $top]} {
+ set ::eskil($top,cleanup) "plugin $::eskil($top,cleanup)"
}
}
# Clean up after a diff
proc cleanupFiles {top} {
- foreach keyword $::diff($top,cleanup) {
+ foreach keyword $::eskil($top,cleanup) {
switch $keyword {
"rev" {cleanupRev $top}
"conflict" {cleanupConflict $top}
"plugin" {cleanupPlugin $top}
}
}
- set ::diff($top,cleanup) {}
+ set ::eskil($top,cleanup) {}
}
# Redo Diff command
proc redoDiff {top} {
+ if {$::eskil($top,view) eq "table"} {
+ # TBD TABLE
+ doDiff $top
+ # Restore view
+ return
+ }
+
# Note what rows are being displayed
set w $::widgets($top,wDiff1)
set width [winfo width $w]
set height [winfo height $w]
@@ -1238,30 +1384,29 @@
}
}
# Make an appropriate tail for a window title, depending on mode and files.
proc TitleTail {top} {
- set tail1 [file tail $::diff($top,rightLabel)]
- set tail2 [file tail $::diff($top,leftLabel)]
- if {$::diff($top,mode) ne "" || $tail1 eq $tail2} {
- if {$::diff($top,mode) eq "rev"} {
- set tail1 [file tail $::diff($top,RevFile)]
- } elseif {$::diff($top,mode) eq "conflict"} {
- set tail1 [file tail $::diff($top,conflictFile)]
+ set tail1 [file tail $::eskil($top,rightLabel)]
+ set tail2 [file tail $::eskil($top,leftLabel)]
+ if {$::eskil($top,mode) ne "" || $tail1 eq $tail2} {
+ if {$::eskil($top,mode) eq "rev"} {
+ set tail1 [file tail $::eskil($top,RevFile)]
+ } elseif {$::eskil($top,mode) eq "conflict"} {
+ set tail1 [file tail $::eskil($top,conflictFile)]
}
return $tail1
} else {
return "$tail2 vs $tail1"
}
}
# Main diff function.
proc doDiff {top} {
- global Pref
global doingLine1 doingLine2
- if {$::diff($top,mode) eq "" && ($::diff($top,leftOK) == 0 || $::diff($top,rightOK) == 0)} {
+ if {$::eskil($top,mode) eq "" && ($::eskil($top,leftOK) == 0 || $::eskil($top,rightOK) == 0)} {
disableRedo $top
return
} else {
enableRedo $top
}
@@ -1268,14 +1413,22 @@
busyCursor $top
resetEdit $top
# Clear up everything before starting processing
- foreach item {wLine1 wDiff1 wLine2 wDiff2} {
- set w $::widgets($top,$item)
+ if {$::eskil($top,view) eq "table"} {
+ set w $::widgets($top,wTable)
+ # TBD TABLE
$w configure -state normal
- $w delete 1.0 end
+ $w delete 0 end
+ set ::eskil($top,tablechanges) {}
+ } else {
+ foreach item {wLine1 wDiff1 wLine2 wDiff2 wTb} {
+ set w $::widgets($top,$item)
+ $w configure -state normal
+ $w delete 1.0 end
+ }
}
clearMap $top
set ::HighLightCount 0
highLightChange $top -1
# Display a star during diff execution, to know when the internal
@@ -1283,73 +1436,84 @@
set ::widgets($top,eqLabel) "*"
wm title $top "Eskil:"
update idletasks
- if {$::diff($top,mode) eq "patch"} {
+ if {$::eskil($top,mode) eq "patch"} {
disallowEdit $top
displayPatch $top
drawMap $top -1
+ #drawEditButtons $top
foreach item {wLine1 wLine2} {
set w $::widgets($top,$item)
$w configure -state disabled
}
update idletasks
- wm title $top "Eskil: [file tail $::diff($top,patchFile)]"
+ wm title $top "Eskil: [file tail $::eskil($top,patchFile)]"
+ # TBD TABLE
$::widgets($top,wLine2) see 1.0
+ if {$::eskil($top,printFileCmd) && $::eskil($top,printFile) ne ""} {
+ after idle "doPrint $top 1 ; cleanupAndExit all"
+ }
normalCursor $top
return
} else {
prepareFiles $top
}
wm title $top "Eskil: [TitleTail $top]"
# Run diff and parse the result.
- set opts $Pref(ignore)
- if {$Pref(nocase)} {lappend opts -nocase}
- if {$Pref(noempty)} {lappend opts -noempty}
- if {[info exists ::diff($top,aligns)] && \
- [llength $::diff($top,aligns)] > 0} {
- lappend opts -align $::diff($top,aligns)
+ set opts $::Pref(ignore)
+ if {$::Pref(nocase)} {lappend opts -nocase}
+ if {$::Pref(noempty)} {lappend opts -noempty}
+ if {$::Pref(pivot) > 0} {lappend opts -pivot $::Pref(pivot)}
+ if {$::eskil($top,gz)} {lappend opts -gz}
+ if {[info exists ::eskil($top,aligns)] && \
+ [llength $::eskil($top,aligns)] > 0} {
+ lappend opts -align $::eskil($top,aligns)
}
set range {}
- if {[info exists ::diff($top,range)] && \
- [llength $::diff($top,range)] == 4} {
- set range $::diff($top,range)
+ if {[info exists ::eskil($top,range)] && \
+ [llength $::eskil($top,range)] == 4} {
+ set range $::eskil($top,range)
lappend opts -range $range
}
- if {[llength $Pref(regsub)] > 0} {
- lappend opts -regsub $Pref(regsub)
+ foreach {RE sub side} [getActivePreprocess $top] {
+ lappend opts -regsub$side [list $RE $sub]
}
# Apply nodigit after preprocess
- if {$Pref(nodigit)} {lappend opts -nodigit}
+ if {$::Pref(nodigit)} {lappend opts -nodigit}
# If a special file for diffing is present, use it.
- if {[info exists ::diff($top,leftFileDiff)]} {
- set dFile1 $::diff($top,leftFileDiff)
- } else {
- set dFile1 $::diff($top,leftFile)
- }
- if {[info exists ::diff($top,rightFileDiff)]} {
- set dFile2 $::diff($top,rightFileDiff)
- } else {
- set dFile2 $::diff($top,rightFile)
+ if {[info exists ::eskil($top,leftFileDiff)]} {
+ set dFile1 $::eskil($top,leftFileDiff)
+ } else {
+ set dFile1 $::eskil($top,leftFile)
+ }
+ if {[info exists ::eskil($top,rightFileDiff)]} {
+ set dFile2 $::eskil($top,rightFileDiff)
+ } else {
+ set dFile2 $::eskil($top,rightFile)
}
set differr [catch {DiffUtil::diffFiles {*}$opts \
$dFile1 $dFile2} diffres]
# In conflict mode we can use the diff information collected when
# parsing the conflict file. This makes sure the blocks in the conflict
# file become change-blocks during merge.
- if {$::diff($top,mode) eq "conflict" && $::diff($top,modetype) eq "Pure"} {
- set diffres $::diff($top,conflictDiff)
+ if {$::eskil($top,mode) eq "conflict" && $::eskil($top,modetype) eq "Pure"} {
+ set diffres $::eskil($top,conflictDiff)
}
if {$differr != 0} {
- $::widgets($top,wDiff1) insert end $diffres
+ if {$::eskil($top,view) eq "table"} {
+ # TBD TABLE
+ } else {
+ $::widgets($top,wDiff1) insert end $diffres
+ }
normalCursor $top
return
}
if {[llength $diffres] == 0} {
set ::widgets($top,eqLabel) "="
@@ -1362,20 +1526,59 @@
set ::widgets($top,eqLabel) " "
}
# Update the equal label immediately for better feedback
update idletasks
- if {$::diff($top,ancestorFile) ne ""} {
+ if {$::eskil($top,ancestorFile) ne ""} {
collectAncestorInfo $top $dFile1 $dFile2 $opts
}
set firstview 1
- set ch1 [open $::diff($top,leftFile)]
- set ch2 [open $::diff($top,rightFile)]
+ set ch1 [open $::eskil($top,leftFile)]
+ set ch2 [open $::eskil($top,rightFile)]
+ if {$::eskil($top,gz)} {
+ disallowEdit $top
+ zlib push gunzip $ch1
+ zlib push gunzip $ch2
+ }
set doingLine1 1
set doingLine2 1
+
+ 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
+ set headings [split $line1 $::eskil($top,separator)]
+ set columns {}
+ foreach heading $headings {
+ lappend columns 0 $heading
+ }
+ $::widgets($top,wTable) configure -columns $columns
+ if {$::eskil($top,maxwidth) > 0} {
+ set col -1
+ foreach {_ _} $columns {
+ incr col
+ $::widgets($top,wTable) columnconfigure $col \
+ -maxwidth $::eskil($top,maxwidth)
+ }
+ }
+ }
+ }
# If there is a range, skip lines up to the range
if {[llength $range] != 0} {
disallowEdit $top
lassign $range start1 end1 start2 end2
@@ -1389,18 +1592,18 @@
set t 0
foreach i $diffres {
lassign $i line1 n1 line2 n2
doText $top $ch1 $ch2 $n1 $n2 $line1 $line2
- if {$::diff($top,limitlines) && \
- ($::diff($top,mapMax) > $::diff($top,limitlines))} {
+ if {$::eskil($top,limitlines) && \
+ ($::eskil($top,mapMax) > $::eskil($top,limitlines))} {
break
}
# Get one update when the screen has been filled.
# Show the first diff.
- if {$firstview && $::diff($top,mapMax) > 100} {
+ if {$firstview && $::eskil($top,mapMax) > 100} {
set firstview 0
showDiff $top 0
update idletasks
}
}
@@ -1412,24 +1615,26 @@
set end1 0
set end2 0
}
doText $top $ch1 $ch2 0 0 $end1 $end2
- # Make sure all text widgets have the same number of lines.
- # The common y scroll doesn't work well if not.
- set max 0.0
- foreach item {wLine1 wDiff1 wLine2 wDiff2} {
- set w $::widgets($top,$item)
- if {[$w index end] > $max} {
- set max [$w index end]
- }
- }
- foreach item {wLine1 wDiff1 wLine2 wDiff2} {
- set w $::widgets($top,$item)
- set d [expr {int($max) - int([$w index end])}]
- for {set t 0} {$t < $d} {incr t} {
- $w insert end \n padding
+ if {$::eskil($top,view) ne "table"} {
+ # Make sure all text widgets have the same number of lines.
+ # The common y scroll doesn't work well if not.
+ set max 0.0
+ foreach item {wLine1 wDiff1 wLine2 wDiff2} {
+ set w $::widgets($top,$item)
+ if {[$w index end] > $max} {
+ set max [$w index end]
+ }
+ }
+ foreach item {wLine1 wDiff1 wLine2 wDiff2} {
+ set w $::widgets($top,$item)
+ set d [expr {int($max) - int([$w index end])}]
+ for {set t 0} {$t < $d} {incr t} {
+ $w insert end \n padding
+ }
}
}
close $ch1
close $ch2
@@ -1436,14 +1641,14 @@
# We can turn off editing in the text windows after everything
# is displayed.
noEdit $top
- # Mark aligned lines
- if {[info exists ::diff($top,aligns)] && \
- [llength $::diff($top,aligns)] > 0} {
- foreach {align1 align2} $::diff($top,aligns) {
+ # Mark aligned lines TBD TABLE
+ if {[info exists ::eskil($top,aligns)] && \
+ [llength $::eskil($top,aligns)] > 0} {
+ foreach {align1 align2} $::eskil($top,aligns) {
set i [$::widgets($top,wLine1) search -regexp "\\m$align1\\M" 1.0]
if {$i != ""} {
$::widgets($top,wLine1) tag add align \
"$i linestart" "$i lineend"
}
@@ -1454,33 +1659,37 @@
}
}
}
drawMap $top -1
- foreach item {wLine1 wLine2} {
- set w $::widgets($top,$item)
- $w configure -state disabled
+ #drawEditButtons $top
+ if {$::eskil($top,view) ne "table"} {
+ foreach item {wLine1 wLine2 wTb} {
+ set w $::widgets($top,$item)
+ $w configure -state disabled
+ }
+ update idletasks
+ $::widgets($top,wLine2) see 1.0
}
- update idletasks
- $::widgets($top,wLine2) see 1.0
normalCursor $top
showDiff $top 0
if {$::widgets($top,eqLabel) eq "!"} {
set ::widgets($top,eqLabel) " "
}
cleanupFiles $top
- if {$::diff($top,mode) eq "conflict"} {
+ if {$::eskil($top,mode) eq "conflict"} {
if {$::widgets($top,eqLabel) != "="} {
makeMergeWin $top
}
- } elseif {$::diff($top,ancestorFile) ne ""} {
+ } elseif {$::eskil($top,ancestorFile) ne ""} {
if {$::widgets($top,eqLabel) != "="} {
makeMergeWin $top
}
}
- if {$::diff($top,printFile) ne ""} {
+ if {$::eskil($top,printFileCmd) && $::eskil($top,printFile) ne ""} {
+ # TBD TABLE
after idle "doPrint $top 1 ; cleanupAndExit all"
}
}
# This is the entrypoint to do a diff via DDE or Send
@@ -1492,11 +1701,11 @@
# Highlight and navigation stuff
#####################################
# Scroll windows to next/previous diff
proc findDiff {top delta} {
- showDiff $top [expr {$::diff($top,currHighLight) + $delta}]
+ showDiff $top [expr {$::eskil($top,currHighLight) + $delta}]
}
# Scroll a text window to view a certain range, and possibly some
# lines before and after.
proc seeText {w si ei} {
@@ -1512,38 +1721,40 @@
}
}
# Highlight a diff
proc highLightChange {top n} {
- if {[info exists ::diff($top,currHighLight)] && \
- $::diff($top,currHighLight) >= 0} {
- $::widgets($top,wLine1) tag configure hl$::diff($top,currHighLight) \
- -background {}
- $::widgets($top,wLine2) tag configure hl$::diff($top,currHighLight) \
- -background {}
- }
- set ::diff($top,currHighLight) $n
- if {$::diff($top,currHighLight) < 0} {
- set ::diff($top,currHighLight) -1
- } elseif {$::diff($top,currHighLight) >= [llength $::diff($top,changes)]} {
- set ::diff($top,currHighLight) [llength $::diff($top,changes)]
- } else {
- $::widgets($top,wLine1) tag configure hl$::diff($top,currHighLight) \
- -background yellow
- $::widgets($top,wLine2) tag configure hl$::diff($top,currHighLight) \
+ if {[info exists ::eskil($top,currHighLight)] && \
+ $::eskil($top,currHighLight) >= 0} {
+ $::widgets($top,wLine1) tag configure hl$::eskil($top,currHighLight) \
+ -background {}
+ $::widgets($top,wLine2) tag configure hl$::eskil($top,currHighLight) \
+ -background {}
+ }
+ set ::eskil($top,currHighLight) $n
+ if {$::eskil($top,currHighLight) < 0} {
+ set ::eskil($top,currHighLight) -1
+ } elseif {$::eskil($top,currHighLight) >= [llength $::eskil($top,changes)]} {
+ set ::eskil($top,currHighLight) [llength $::eskil($top,changes)]
+ } else {
+ $::widgets($top,wLine1) tag configure hl$::eskil($top,currHighLight) \
+ -background yellow
+ $::widgets($top,wLine2) tag configure hl$::eskil($top,currHighLight) \
-background yellow
}
}
# Highlight a diff and scroll windows to it.
proc showDiff {top num} {
+ # TBD TABLE
+ if {$::eskil($top,view) eq "table"} return
highLightChange $top $num
- set change [lindex $::diff($top,changes) $::diff($top,currHighLight)]
+ set change [lindex $::eskil($top,changes) $::eskil($top,currHighLight)]
set line1 [lindex $change 0]
- if {$::diff($top,currHighLight) < 0} {
+ if {$::eskil($top,currHighLight) < 0} {
set line1 1.0
set line2 1.0
} elseif {$line1 eq ""} {
set line1 end
set line2 end
@@ -1564,17 +1775,34 @@
# Editing
#####################################
# FIXA: Use snit to adapt text widget instead of using wcb
# include seeText in such a snidget.
+
+# Try to autodetect line endings in file
+proc detectLineEnd {top file field {def {}}} {
+ set ch [open $file rb]
+ set data [read $ch 1000]
+ close $ch
+ if {[string first \r\n $data] >= 0} {
+ set ::eskil($top,$field) crlf
+ } elseif {[string first \n $data] >= 0} {
+ set ::eskil($top,$field) lf
+ } else {
+ set ::eskil($top,$field) $def
+ }
+}
# Clear Editing state
proc resetEdit {top} {
- set ::diff($top,leftEdit) 0
- set ::diff($top,rightEdit) 0
+ set ::eskil($top,leftEdit) 0
+ set ::eskil($top,rightEdit) 0
$top.m.mt entryconfigure "Edit Mode" -state normal
+ if {$::eskil($top,view) eq "table"} {
+ return
+ }
resetEditW $::widgets($top,wDiff1)
resetEditW $::widgets($top,wDiff2)
}
# Clear Editing state for a Text widget
@@ -1581,36 +1809,39 @@
proc resetEditW {w} {
$w tag configure padding -background {}
$w edit reset
$w configure -undo 0
- set ::diff($w,allowChange) all
+ set ::eskil($w,allowChange) all
wcb::callback $w before insert {}
wcb::callback $w before delete {}
}
# Do not allow any editing
proc noEdit {top} {
+ if {$::eskil($top,view) eq "table"} {
+ return
+ }
noEditW $::widgets($top,wDiff1)
noEditW $::widgets($top,wDiff2)
}
# Do not allow any editing in a Text widget
proc noEditW {w} {
- set ::diff($w,allowChange) none
+ set ::eskil($w,allowChange) none
wcb::callback $w before insert [list TextInterceptInsert $w]
wcb::callback $w before delete [list TextInterceptDelete $w]
}
proc TextInterceptInsert {w ow index str args} {
- if {$::diff($w,allowChange) eq "none"} {
+ if {$::eskil($w,allowChange) eq "none"} {
wcb::cancel
return
}
- if {$::diff($w,allowChange) eq "all"} return
+ if {$::eskil($w,allowChange) eq "all"} return
#wcb::cancel - Cancel a widget command
#wcb::replace - Replace arguments of a widget command with new ones
# Disallow all new lines
@@ -1625,15 +1856,15 @@
}
}
}
proc TextInterceptDelete {w ow from {to {}}} {
- if {$::diff($w,allowChange) eq "none"} {
+ if {$::eskil($w,allowChange) eq "none"} {
wcb::cancel
return
}
- if {$::diff($w,allowChange) eq "all"} return
+ if {$::eskil($w,allowChange) eq "all"} return
if {$to eq ""} {
set to $from+1char
}
set text [$ow get $from $to]
@@ -1647,63 +1878,63 @@
# Turn on editing for a Text widget
proc turnOnEdit {w} {
$w tag configure padding -background \#f0f0f0
$w configure -undo 1
- set ::diff($w,allowChange) line
+ set ::eskil($w,allowChange) line
}
# Turn on editing on sides where it has not been disallowed
proc allowEdit {top} {
$top.m.mt entryconfigure "Edit Mode" -state disable
- if {$::diff($top,leftEdit) == 0} {
- set ::diff($top,leftEdit) 1
+ if {$::eskil($top,leftEdit) == 0} {
+ set ::eskil($top,leftEdit) 1
turnOnEdit $::widgets($top,wDiff1)
}
- if {$::diff($top,rightEdit) == 0} {
- set ::diff($top,rightEdit) 1
+ if {$::eskil($top,rightEdit) == 0} {
+ set ::eskil($top,rightEdit) 1
turnOnEdit $::widgets($top,wDiff2)
}
}
# Turn off editing on sides that do not correspond to a file
proc disallowEdit {top {side 0}} {
if {$side == 0 || $side == 1} {
- set ::diff($top,leftEdit) -1
+ set ::eskil($top,leftEdit) -1
}
if {$side == 0 || $side == 2} {
- set ::diff($top,rightEdit) -1
+ set ::eskil($top,rightEdit) -1
}
- if {$::diff($top,leftEdit) == -1 && $::diff($top,rightEdit) == -1} {
+ if {$::eskil($top,leftEdit) == -1 && $::eskil($top,rightEdit) == -1} {
$top.m.mt entryconfigure "Edit Mode" -state disabled
}
}
# Ask if editing is allowed on a side
proc mayEdit {top side} {
if {$side == 1} {
- return [expr {$::diff($top,leftEdit) == 1}]
+ return [expr {$::eskil($top,leftEdit) == 1}]
} else {
- return [expr {$::diff($top,rightEdit) == 1}]
+ return [expr {$::eskil($top,rightEdit) == 1}]
}
}
# Start an undo block in a bunch of text widgets
proc startUndoBlock {args} {
foreach w $args {
$w configure -autoseparators 0
# Open up editing for copy functions
- set ::diff($w,allowChange) all
+ set ::eskil($w,allowChange) all
}
}
# End an undo block in a bunch of text widgets
proc endUndoBlock {args} {
foreach w $args {
$w configure -autoseparators 1
$w edit separator
- set ::diff($w,allowChange) line
+ set ::eskil($w,allowChange) line
}
}
# Copy a block
proc copyBlock {top from first last} {
@@ -1794,11 +2025,11 @@
if {![mayEdit $top $n]} {return 1}
# Only copy when in a change block
if {$hl ne ""} {
- set o [expr {3 - $n}]
+ set o [expr {3 - $n}] ;# switch 1 <-> 2
set editOther [mayEdit $top $o]
set w $::widgets($top,wLine$n)
set wo $::widgets($top,wLine$o)
@@ -1859,15 +2090,17 @@
return 0
}
proc saveFile {top side} {
if {$side == 1} {
- if {!$::diff($top,leftEdit)} return
- set fileName $::diff($top,leftFile)
+ if {!$::eskil($top,leftEdit)} return
+ set fileName $::eskil($top,leftFile)
+ set trans $::eskil($top,lefttranslation)
} else {
- if {!$::diff($top,rightEdit)} return
- set fileName $::diff($top,rightFile)
+ if {!$::eskil($top,rightEdit)} return
+ set fileName $::eskil($top,rightFile)
+ set trans $::eskil($top,righttranslation)
}
set w $::widgets($top,wDiff$side)
# Confirm dialog
@@ -1886,10 +2119,13 @@
} elseif {$apa ne "no"} {
return
}
set ch [open $fileName "w"]
+ if {$trans ne ""} {
+ fconfigure $ch -translation $trans
+ }
set save 1
foreach {key value index} [$w dump -all 1.0 end-1c] {
switch -- $key {
text {
if {$save} {
@@ -1927,20 +2163,29 @@
# Check for contents to ensure it is a kit
if {[llength [glob -nocomplain $file/*]] == 0} {
vfs::unmount $file
}
}
+ # Now it is possible that the isdirectory status has changed
+ return [file isdirectory $file]
}
}
- return [file isdirectory $file]
+ return 0
}
# A wrapper for tk_getOpenFile
proc myOpenFile {args} {
- # When in tutorial mode, make sure the Tcl file dialog is used
+ array set opts $args
+ set isVfs 0
+ if {[info exists opts(-initialdir)]} {
+ if {[string match tclvfs* [file system $opts(-initialdir)]]} {
+ set isVfs 1
+ }
+ }
+ # When in a vfs, make sure the Tcl file dialog is used
# to be able to access the files in a starkit.
- if {[info exists ::diff(tutorial)] && $::diff(tutorial)} {
+ if {$isVfs} {
# Only do this if tk_getOpenFile is not a proc.
if {[info procs tk_getOpenFile] eq ""} {
# If there is any problem, call the real one
if {![catch {set res [::tk::dialog::file:: open {*}$args]}]} {
return $res
@@ -1949,82 +2194,82 @@
}
return [tk_getOpenFile {*}$args]
}
proc doOpenLeft {top {forget 0}} {
- if {!$forget && [info exists ::diff($top,leftDir)]} {
- set initDir $::diff($top,leftDir)
- } elseif {[info exists ::diff($top,rightDir)]} {
- set initDir $::diff($top,rightDir)
+ if {!$forget && [info exists ::eskil($top,leftDir)]} {
+ set initDir $::eskil($top,leftDir)
+ } elseif {[info exists ::eskil($top,rightDir)]} {
+ set initDir $::eskil($top,rightDir)
} else {
set initDir [pwd]
}
set apa [myOpenFile -title "Select left file" -initialdir $initDir \
-parent $top]
if {$apa != ""} {
- set ::diff($top,leftDir) [file dirname $apa]
- set ::diff($top,leftFile) $apa
- set ::diff($top,leftLabel) $apa
- set ::diff($top,leftOK) 1
+ set ::eskil($top,leftDir) [file dirname $apa]
+ set ::eskil($top,leftFile) $apa
+ set ::eskil($top,leftLabel) $apa
+ set ::eskil($top,leftOK) 1
return 1
}
return 0
}
proc doOpenRight {top {forget 0}} {
- if {!$forget && [info exists ::diff($top,rightDir)]} {
- set initDir $::diff($top,rightDir)
- } elseif {[info exists ::diff($top,leftDir)]} {
- set initDir $::diff($top,leftDir)
+ if {!$forget && [info exists ::eskil($top,rightDir)]} {
+ set initDir $::eskil($top,rightDir)
+ } elseif {[info exists ::eskil($top,leftDir)]} {
+ set initDir $::eskil($top,leftDir)
} else {
set initDir [pwd]
}
set apa [myOpenFile -title "Select right file" -initialdir $initDir \
-parent $top]
if {$apa != ""} {
- set ::diff($top,rightDir) [file dirname $apa]
- set ::diff($top,rightFile) $apa
- set ::diff($top,rightLabel) $apa
- set ::diff($top,rightOK) 1
+ set ::eskil($top,rightDir) [file dirname $apa]
+ set ::eskil($top,rightFile) $apa
+ set ::eskil($top,rightLabel) $apa
+ set ::eskil($top,rightOK) 1
return 1
}
return 0
}
proc doOpenAncestor {top} {
- if {$::diff($top,ancestorFile) ne ""} {
- set initDir [file dirname $::diff($top,ancestorFile)]
- } elseif {[info exists ::diff($top,leftDir)]} {
- set initDir $::diff($top,leftDir)
- } elseif {[info exists ::diff($top,rightDir)]} {
- set initDir $::diff($top,rightDir)
+ if {$::eskil($top,ancestorFile) ne ""} {
+ set initDir [file dirname $::eskil($top,ancestorFile)]
+ } elseif {[info exists ::eskil($top,leftDir)]} {
+ set initDir $::eskil($top,leftDir)
+ } elseif {[info exists ::eskil($top,rightDir)]} {
+ set initDir $::eskil($top,rightDir)
} else {
set initDir [pwd]
}
set apa [myOpenFile -title "Select ancestor file" -initialdir $initDir \
-parent $top]
if {$apa != ""} {
- set ::diff($top,ancestorFile) $apa
+ set ::eskil($top,ancestorFile) $apa
return 1
}
return 0
}
proc openLeft {top} {
if {[doOpenLeft $top]} {
- set ::diff($top,mode) ""
- set ::diff($top,mergeFile) ""
+ set ::eskil($top,mode) ""
+ set ::eskil($top,mergeFile) ""
doDiff $top
}
}
proc openRight {top} {
if {[doOpenRight $top]} {
- set ::diff($top,mode) ""
- set ::diff($top,mergeFile) ""
+ set ::eskil($top,mode) ""
+ set ::eskil($top,mergeFile) ""
doDiff $top
}
}
proc openAncestor {top} {
@@ -2033,27 +2278,25 @@
doDiff $top
}
}
proc openConflict {top} {
- global Pref
if {[doOpenRight $top]} {
- startConflictDiff $top $::diff($top,rightFile)
- set ::diff($top,mergeFile) ""
+ startConflictDiff $top $::eskil($top,rightFile)
+ set ::eskil($top,mergeFile) ""
doDiff $top
}
}
proc openPatch {top} {
- global Pref
if {[doOpenLeft $top]} {
- set ::diff($top,mode) "patch"
- set Pref(ignore) " "
- set Pref(nocase) 0
- set Pref(noempty) 0
- set ::diff($top,patchFile) $::diff($top,leftFile)
- set ::diff($top,patchData) ""
+ set ::eskil($top,mode) "patch"
+ set ::Pref(ignore) " "
+ set ::Pref(nocase) 0
+ set ::Pref(noempty) 0
+ set ::eskil($top,patchFile) $::eskil($top,leftFile)
+ set ::eskil($top,patchData) ""
doDiff $top
}
}
# Get data from clipboard and display as a patch.
@@ -2061,39 +2304,39 @@
if {[catch {::tk::GetSelection $top CLIPBOARD} sel]} {
tk_messageBox -icon error -title "Eskil Error" -parent $top \
-message "Could not retreive clipboard" -type ok
return
}
- set ::diff($top,mode) "patch"
+ set ::eskil($top,mode) "patch"
set ::Pref(ignore) " "
set ::Pref(nocase) 0
- set ::Pref(noempty) 0
- set ::diff($top,patchFile) ""
- set ::diff($top,patchData) $sel
+ set ::Pref(noempty) 0
+ set ::eskil($top,patchFile) ""
+ set ::eskil($top,patchData) $sel
doDiff $top
}
proc openRev {top} {
if {[doOpenRight $top]} {
- set rev [detectRevSystem $::diff($top,rightFile)]
+ set rev [detectRevSystem $::eskil($top,rightFile)]
if {$rev eq ""} {
tk_messageBox -icon error -title "Eskil Error" -message \
"Could not figure out which revison control system\
- \"$::diff($top,rightFile)\" is under." -type ok
+ \"$::eskil($top,rightFile)\" is under." -type ok
return
}
- startRevMode $top $rev $::diff($top,rightFile)
- set ::diff($top,mergeFile) ""
+ startRevMode $top $rev $::eskil($top,rightFile)
+ set ::eskil($top,mergeFile) ""
doDiff $top
}
}
proc openBoth {top forget} {
if {[doOpenLeft $top]} {
if {[doOpenRight $top $forget]} {
- set ::diff($top,mode) ""
- set ::diff($top,mergeFile) ""
+ set ::eskil($top,mode) ""
+ set ::eskil($top,mergeFile) ""
doDiff $top
}
}
}
@@ -2102,34 +2345,47 @@
# FIXA: Maybe single drop during rev mode should stay in rev mode?
# Dropping two files mean set both
if {[llength $files] >= 2} {
set leftFile [lindex $files 0]
set rightFile [lindex $files 1]
- } elseif {$side eq "left"} {
- set leftFile [lindex $files 0]
- set rightFile ""
} else {
- set leftFile ""
- set rightFile [lindex $files 0]
+ if {$side eq "any"} {
+ # Dropped outside the text widgets. Try to be clever.
+ if {![info exists ::eskil($top,lastDrop)]} {
+ set side left
+ } elseif {$::eskil($top,lastDrop) eq "left"} {
+ set side right
+ } else {
+ set side left
+ }
+ }
+ if {$side eq "left"} {
+ set leftFile [lindex $files 0]
+ set rightFile ""
+ } else {
+ set leftFile ""
+ set rightFile [lindex $files 0]
+ }
+ set ::eskil($top,lastDrop) $side
}
if {$leftFile ne ""} {
- set ::diff($top,leftDir) [file dirname $leftFile]
- set ::diff($top,leftFile) $leftFile
- set ::diff($top,leftLabel) $leftFile
- set ::diff($top,leftOK) 1
- set ::diff($top,mode) ""
- set ::diff($top,mergeFile) ""
+ set ::eskil($top,leftDir) [file dirname $leftFile]
+ set ::eskil($top,leftFile) $leftFile
+ set ::eskil($top,leftLabel) $leftFile
+ set ::eskil($top,leftOK) 1
+ set ::eskil($top,mode) ""
+ set ::eskil($top,mergeFile) ""
}
if {$rightFile ne ""} {
- set ::diff($top,rightDir) [file dirname $rightFile]
- set ::diff($top,rightFile) $rightFile
- set ::diff($top,rightLabel) $rightFile
- set ::diff($top,rightOK) 1
- set ::diff($top,mode) ""
- set ::diff($top,mergeFile) ""
- }
- if {$::diff($top,leftOK) && $::diff($top,rightOK)} {
+ set ::eskil($top,rightDir) [file dirname $rightFile]
+ set ::eskil($top,rightFile) $rightFile
+ set ::eskil($top,rightLabel) $rightFile
+ set ::eskil($top,rightOK) 1
+ set ::eskil($top,mode) ""
+ set ::eskil($top,mergeFile) ""
+ }
+ if {$::eskil($top,leftOK) && $::eskil($top,rightOK)} {
doDiff $top
}
}
#####################################
@@ -2168,16 +2424,16 @@
grid $w.s -sticky news
if {$scrollx} {
$w.s configure -xscrollcommand [list $w.sbx set]
- scrollbar $w.sbx -orient horizontal -command [list $w.s xview]
+ ttk::scrollbar $w.sbx -orient horizontal -command [list $w.s xview]
grid $w.sbx -row 1 -sticky we
}
if {$scrolly} {
$w.s configure -yscrollcommand [list $w.sby set]
- scrollbar $w.sby -orient vertical -command [list $w.s yview]
+ ttk::scrollbar $w.sby -orient vertical -command [list $w.s yview]
grid $w.sby -row 0 -column 1 -sticky ns
}
grid columnconfigure $w 0 -weight 1
grid rowconfigure $w 0 -weight 1
@@ -2197,54 +2453,58 @@
}
# Remove one or all alignment pairs
proc clearAlign {top {leftline {}}} {
if {$leftline == ""} {
- set ::diff($top,aligns) {}
+ set ::eskil($top,aligns) {}
} else {
set i 0
while 1 {
- set i [lsearch -integer -start $i $::diff($top,aligns) $leftline]
+ set i [lsearch -integer -start $i $::eskil($top,aligns) $leftline]
if {$i < 0} break
if {($i % 2) == 0} {
- set ::diff($top,aligns) [lreplace $::diff($top,aligns) \
+ set ::eskil($top,aligns) [lreplace $::eskil($top,aligns) \
$i [+ $i 1]]
break
}
incr i
}
}
- if {[llength $::diff($top,aligns)] == 0} {
+ if {[llength $::eskil($top,aligns)] == 0} {
disableAlign $top
}
}
+
+proc NoMarkAlign {top} {
+ unset -nocomplain ::eskil($top,align1)
+ unset -nocomplain ::eskil($top,align2)
+ unset -nocomplain ::eskil($top,aligntext1)
+ unset -nocomplain ::eskil($top,aligntext2)
+}
# Mark a line as aligned.
proc markAlign {top n line text} {
- set ::diff($top,align$n) $line
- set ::diff($top,aligntext$n) $text
+ set ::eskil($top,align$n) $line
+ set ::eskil($top,aligntext$n) $text
- if {[info exists ::diff($top,align1)] && [info exists ::diff($top,align2)]} {
- set level 2
- if {![string equal $::diff($top,aligntext1) $::diff($top,aligntext2)]} {
+ if {[info exists ::eskil($top,align1)] && [info exists ::eskil($top,align2)]} {
+ if {![string equal $::eskil($top,aligntext1) $::eskil($top,aligntext2)]} {
set apa [tk_messageBox -icon question -title "Align" -type yesno \
-message "Those lines are not equal.\nReally align them?"]
if {$apa != "yes"} {
- return
+ return 0
}
- set level 3
}
- lappend ::diff($top,aligns) $::diff($top,align1) $::diff($top,align2)
+ lappend ::eskil($top,aligns) $::eskil($top,align1) $::eskil($top,align2)
enableAlign $top
- unset ::diff($top,align1)
- unset ::diff($top,align2)
- unset ::diff($top,aligntext1)
- unset ::diff($top,aligntext2)
+ NoMarkAlign $top
+ return 1
}
+ return 0
}
# Called by popup menus over row numbers to add command for alignment.
# Returns 1 if nothing was added.
proc alignMenu {m top n x y} {
@@ -2252,25 +2512,26 @@
set w $::widgets($top,wLine$n)
set index [$w index @$x,$y]
set row [lindex [split $index "."] 0]
set data [$w get $row.0 $row.end]
+ # Must be a line number
if {![regexp {\d+} $data line]} {
return 1
}
set text [$::widgets($top,wDiff$n) get $row.0 $row.end]
set other [expr {$n == 1 ? 2 : 1}]
set cmd [list markAlign $top $n $line $text]
- if {![info exists ::diff($top,align$other)]} {
+ if {![info exists ::eskil($top,align$other)]} {
set label "Mark line for alignment"
} else {
- set label "Align with line $::diff($top,align$other) on other side"
+ set label "Align with line $::eskil($top,align$other) on other side"
}
- if {[info exists ::diff($top,aligns)]} {
- foreach {align1 align2} $::diff($top,aligns) {
+ if {[info exists ::eskil($top,aligns)]} {
+ foreach {align1 align2} $::eskil($top,aligns) {
if {$n == 1 && $line == $align1} {
set label "Remove alignment with line $align2"
set cmd [list clearAlign $top $align1]
} elseif {$n == 2 && $line == $align2} {
set label "Remove alignment with line $align1"
@@ -2281,10 +2542,122 @@
$m add command -label $label -command $cmd
return 0
}
+
+# Set up bindings to allow setting alignment using drag
+proc SetupAlignDrag {top left right} {
+ bind $left [list startAlignDrag $top 1 %x %y %X %Y]\;break
+ bind $left [list motionAlignDrag $top 1 0 %x %y %X %Y]\;break
+ bind $left [list motionAlignDrag $top 1 1 %x %y %X %Y]\;break
+ bind $left [list endAlignDrag $top 1 %x %y %X %Y]\;break
+ bind $left break
+ bind $right [list startAlignDrag $top 2 %x %y %X %Y]\;break
+ bind $right [list motionAlignDrag $top 2 0 %x %y %X %Y]\;break
+ bind $right [list motionAlignDrag $top 2 1 %x %y %X %Y]\;break
+ bind $right [list endAlignDrag $top 2 %x %y %X %Y]\;break
+ bind $right break
+}
+
+# Button has been pressed over line window
+proc startAlignDrag {top n x y X Y} {
+ # Get the row that was clicked
+ set w $::widgets($top,wLine$n)
+ set index [$w index @$x,$y]
+ set row [lindex [split $index "."] 0]
+
+ set data [$w get $row.0 $row.end]
+ set ::eskil($top,alignDrag,state) none
+ # Must be a line number
+ if {![regexp {\d+} $data line]} {
+ return 1
+ }
+ # Set up information about start of drag
+ set text [$::widgets($top,wDiff$n) get $row.0 $row.end]
+ set other [expr {$n == 1 ? 2 : 1}]
+ set ::eskil($top,alignDrag,X) $X
+ set ::eskil($top,alignDrag,Y) $Y
+ set ::eskil($top,alignDrag,from) $n
+ set ::eskil($top,alignDrag,line$n) $line
+ set ::eskil($top,alignDrag,text$n) $text
+ set ::eskil($top,alignDrag,line$other) "?"
+ set ::eskil($top,alignDrag,state) press
+}
+
+# Mouse moves with button down
+proc motionAlignDrag {top n shift x y X Y} {
+ if {$::eskil($top,alignDrag,state) eq "press"} {
+ # Have we moved enough to call it dragging?
+ set dX [expr {abs($X - $::eskil($top,alignDrag,X))}]
+ set dY [expr {abs($Y - $::eskil($top,alignDrag,Y))}]
+ if {$dX + $dY > 3} {
+ # Start a drag action
+ set w $top.alignDrag
+ destroy $w
+ toplevel $w
+ wm overrideredirect $w 1
+ label $w.l -borderwidth 1 -relief solid -justify left
+ pack $w.l
+ set ::eskil($top,alignDrag,W) $w
+ set ::eskil($top,alignDrag,state) "drag"
+ }
+ }
+ if {$::eskil($top,alignDrag,state) eq "drag"} {
+ set w $::eskil($top,alignDrag,W)
+ # Move drag label with cursor
+ wm geometry $w +[expr {$X + 1}]+[expr {$Y + 1}]
+
+ set n $::eskil($top,alignDrag,from)
+ set other [expr {$n == 1 ? 2 : 1}]
+ set w2 $::widgets($top,wLine$other)
+ # Are we over the other line window?
+ if {[winfo containing $X $Y] eq $w2} {
+ set x [expr {$X - [winfo rootx $w2]}]
+ set y [expr {$Y - [winfo rooty $w2]}]
+ set index [$w2 index @$x,$y]
+ set row [lindex [split $index "."] 0]
+ set data [$w2 get $row.0 $row.end]
+ if {![regexp {\d+} $data line]} {
+ set ::eskil($top,alignDrag,line$other) "?"
+ } else {
+ set ::eskil($top,alignDrag,line$other) $line
+ set text [$::widgets($top,wDiff$other) get $row.0 $row.end]
+ set ::eskil($top,alignDrag,text$other) $text
+ }
+ } else {
+ set ::eskil($top,alignDrag,line$other) "?"
+ }
+ set txt "Align Left $::eskil($top,alignDrag,line1)"
+ append txt "\nwith Right $::eskil($top,alignDrag,line2)"
+ set ::eskil($top,alignDrag,shift) $shift
+ if {$shift} {
+ append txt "\nAnd Redo Diff"
+ }
+ $w.l configure -text $txt
+ }
+}
+
+# Button has been released
+proc endAlignDrag {top n x y X Y} {
+ if {$::eskil($top,alignDrag,state) eq "drag"} {
+ destroy $::eskil($top,alignDrag,W)
+ # Are both line numbers valid? I.e. is this a full align operation?
+ if {$::eskil($top,alignDrag,line1) ne "?" && \
+ $::eskil($top,alignDrag,line2) ne "?"} {
+ NoMarkAlign $top
+ markAlign $top 1 $::eskil($top,alignDrag,line1) \
+ $::eskil($top,alignDrag,text1)
+ set marked [markAlign $top 2 $::eskil($top,alignDrag,line2) \
+ $::eskil($top,alignDrag,text2)]
+ if {$::eskil($top,alignDrag,shift) && $marked} {
+ redoDiff $top
+ }
+ }
+ }
+ set ::eskil($top,alignDrag,state) none
+}
###################
# Diff highlighting
###################
@@ -2291,21 +2664,21 @@
proc hlSelect {top hl} {
highLightChange $top $hl
}
proc hlSeparate {top n hl} {
- set ::diff($top,separate$n) $hl
+ set ::eskil($top,separate$n) $hl
set wd $::widgets($top,wDiff$n)
set wl $::widgets($top,wLine$n)
if {$hl eq ""} {
set range [$wd tag ranges sel]
} else {
- set range [$wl tag ranges hl$::diff($top,separate$n)]
+ set range [$wl tag ranges hl$::eskil($top,separate$n)]
}
set text [$wd get {*}$range]
- set ::diff($top,separatetext$n) $text
+ set ::eskil($top,separatetext$n) $text
# Get the lines involved in the display
set from [lindex $range 0]
set to [lindex $range 1]
lassign [split $from "."] froml fromi
@@ -2314,36 +2687,23 @@
# Get the corresponding lines in the file
set t [$wl get $froml.0 $tol.end]
set lines [lsort -integer [regexp -all -inline {\d+} $t]]
set froml [lindex $lines 0]
set tol [lindex $lines end]
- set ::diff($top,separatelines$n) [list $froml $tol]
-
- if {[info exists ::diff($top,separate1)] && \
- [info exists ::diff($top,separate2)]} {
- if {1} {
- cloneDiff $top [concat $::diff($top,separatelines1) \
- $::diff($top,separatelines2)]
- } else {
- set f1 [tmpFile]
- set f2 [tmpFile]
- set ch [open $f1 w]
- puts $ch $::diff($top,separatetext1)
- close $ch
- set ch [open $f2 w]
- puts $ch $::diff($top,separatetext2)
- close $ch
-
- newDiff $f1 $f2
- }
- unset ::diff($top,separate1)
- unset ::diff($top,separate2)
+ set ::eskil($top,separatelines$n) [list $froml $tol]
+
+ if {[info exists ::eskil($top,separate1)] && \
+ [info exists ::eskil($top,separate2)]} {
+ cloneDiff $top [concat $::eskil($top,separatelines1) \
+ $::eskil($top,separatelines2)]
+ unset ::eskil($top,separate1)
+ unset ::eskil($top,separate2)
}
}
proc hlPopup {top n hl X Y x y} {
- if {[info exists ::diff($top,nopopup)] && $::diff($top,nopopup)} return
+ if {[info exists ::eskil($top,nopopup)] && $::eskil($top,nopopup)} return
destroy .lpm
menu .lpm
if {![editMenu .lpm $top $n $hl $x $y]} {
.lpm add separator
@@ -2353,31 +2713,31 @@
.lpm add command -label "Select" \
-command [list hlSelect $top $hl]
}
set other [expr {$n == 1 ? 2 : 1}]
- if {![info exists ::diff($top,separate$other)]} {
+ if {![info exists ::eskil($top,separate$other)]} {
set label "Mark for Separate Diff"
} else {
set label "Separate Diff"
}
.lpm add command -label $label -command [list hlSeparate $top $n $hl]
alignMenu .lpm $top $n $x $y
- set ::diff($top,nopopup) 1
+ set ::eskil($top,nopopup) 1
tk_popup .lpm $X $Y
- after idle [list after 1 [list set ::diff($top,nopopup) 0]]
+ after idle [list after 1 [list set "::eskil($top,nopopup)" 0]]
return
}
# This is called when right clicking over the line numbers which are not
# marked for changes
proc rowPopup {w X Y x y} {
set top [winfo toplevel $w]
- if {[info exists ::diff($top,nopopup)] && $::diff($top,nopopup)} return
+ if {[info exists ::eskil($top,nopopup)] && $::eskil($top,nopopup)} return
destroy .lpm
menu .lpm
regexp {(\d+)\D*$} $w -> n
set tmp1 [editMenu .lpm $top $n "" $x $y]
@@ -2387,16 +2747,20 @@
# Nothing in the menu
return
}
if {!$tmp1 && $tmp2} {.lpm delete last}
- set ::diff($top,nopopup) 1
+ set ::eskil($top,nopopup) 1
tk_popup .lpm $X $Y
- after idle [list after 1 [list set ::diff($top,nopopup) 0]]
+ after idle [list after 1 [list set "::eskil($top,nopopup)" 0]]
}
proc nextHighlight {top} {
+ # TBD TABLE, stop for now?
+ if {$::eskil($top,view) eq "table"} {
+ return
+ }
set tag hl$::HighLightCount
foreach n {1 2} {
$::widgets($top,wLine$n) tag bind $tag \
"hlPopup $top $n $::HighLightCount %X %Y %x %y ; break"
$::widgets($top,wLine$n) tag bind $tag \
@@ -2408,11 +2772,10 @@
#########
# Zooming
#########
proc zoomRow {w X Y x y} {
- global Pref
set top [winfo toplevel $w]
# Get the row that was clicked
set index [$w index @$x,$y]
set row [lindex [split $index "."] 0]
@@ -2435,22 +2798,21 @@
destroy $top.balloon
toplevel $top.balloon -background black
wm withdraw $top.balloon
wm overrideredirect $top.balloon 1
- set wid 0
foreach x {1 2} {
text $top.balloon.t$x -relief flat -font $font -background \#ffffcc \
- -foreground black -padx 2 -pady 0 -height 1 -wrap word
- $top.balloon.t$x tag configure new1 -foreground $Pref(colornew1) \
- -background $Pref(bgnew1)
- $top.balloon.t$x tag configure change -foreground $Pref(colorchange) \
- -background $Pref(bgchange)
- $top.balloon.t$x tag configure new2 -foreground $Pref(colornew2) \
- -background $Pref(bgnew2)
- $top.balloon.t$x tag configure equal -foreground $Pref(colorequal) \
- -background $Pref(bgequal)
+ -foreground black -padx 2 -pady 0 -height 1
+ $top.balloon.t$x tag configure new1 -foreground $::Pref(colornew1) \
+ -background $::Pref(bgnew1)
+ $top.balloon.t$x tag configure change -foreground $::Pref(colorchange) \
+ -background $::Pref(bgchange)
+ $top.balloon.t$x tag configure new2 -foreground $::Pref(colornew2) \
+ -background $::Pref(bgnew2)
+ $top.balloon.t$x tag configure equal -foreground $::Pref(colorequal) \
+ -background $::Pref(bgequal)
pack $top.balloon.t$x -side "top" -padx 1 -pady 1 -fill both -expand 1
set tags {}
foreach {key value index} $data($x) {
if {$key eq "tagon"} {
@@ -2472,28 +2834,28 @@
# Let geometry requests propagate
update idletasks
# Is the balloon within the diff window?
- set wid [winfo reqwidth $top.balloon]
- if {$wid + $wx > [winfo rootx $top] + [winfo width $top]} {
+ set rWidth [winfo reqwidth $top.balloon]
+ if {$rWidth + $wx > [winfo rootx $top] + [winfo width $top]} {
# No.
# Center on diff window
- set wx [expr {([winfo width $top] - $wid) / 2 + [winfo rootx $top]}]
+ set wx [expr {([winfo width $top] - $rWidth) / 2 + [winfo rootx $top]}]
if {$wx < 0} {set wx 0}
# Is the balloon not within the screen?
- if {$wx + $wid > [winfo screenwidth $top]} {
+ if {$wx + $rWidth > [winfo screenwidth $top]} {
# Center in screen
- set wx [expr {([winfo screenwidth $top] - $wid) / 2}]
+ set wx [expr {([winfo screenwidth $top] - $rWidth) / 2}]
if {$wx < 0} {set wx 0}
}
}
# Does the balloon fit within the screen?
- if {$wid > [winfo screenwidth $top]} {
+ if {$rWidth > [winfo screenwidth $top]} {
# How many rows does it take?
- set rows [expr {ceil(double($wid) / [winfo screenwidth $top])}]
+ set rows [expr {ceil(double($rWidth) / [winfo screenwidth $top])}]
# Add rows and fill screen width
$top.balloon.t1 configure -height $rows
$top.balloon.t2 configure -height $rows
# Let geometry requests propagate
update idletasks
@@ -2510,60 +2872,52 @@
destroy $top.balloon
}
# Reconfigure font
proc chFont {} {
- global Pref
-
- font configure myfont -size $Pref(fontsize) -family $Pref(fontfamily)
+ font configure myfont -size $::Pref(fontsize) -family $::Pref(fontfamily)
}
# Change color settings
proc applyColor {} {
- global dirdiff Pref
+ global dirdiff
- foreach top $::diff(diffWindows) {
+ foreach top $::eskil(diffWindows) {
if {$top eq ".clipdiff"} continue
+ if {[string match .fourway* $top]} continue
if {$top != ".dirdiff"} {
foreach item {wLine1 wDiff1 wLine2 wDiff2} {
if {![info exists ::widgets($top,$item)]} continue
set w $::widgets($top,$item)
- $w tag configure equal -foreground $Pref(colorequal) \
- -background $Pref(bgequal)
- $w tag configure new1 -foreground $Pref(colornew1) \
- -background $Pref(bgnew1)
- $w tag configure change -foreground $Pref(colorchange) \
- -background $Pref(bgchange)
- $w tag configure new2 -foreground $Pref(colornew2) \
- -background $Pref(bgnew2)
+ $w tag configure equal -foreground $::Pref(colorequal) \
+ -background $::Pref(bgequal)
+ $w tag configure new1 -foreground $::Pref(colornew1) \
+ -background $::Pref(bgnew1)
+ $w tag configure change -foreground $::Pref(colorchange) \
+ -background $::Pref(bgchange)
+ $w tag configure new2 -foreground $::Pref(colornew2) \
+ -background $::Pref(bgnew2)
}
continue
}
-
-# $dirdiff(wLeft) tag configure new1 -foreground $Pref(colornew1) \
-# -background $Pref(bgnew1)
-# $dirdiff(wLeft) tag configure change -foreground $Pref(colorchange) \
-# -background $Pref(bgchange)
-# $dirdiff(wLeft) tag configure changed -foreground $Pref(colorchange)
-# $dirdiff(wLeft) tag configure invalid -background #a9a9a9
-# $dirdiff(wRight) tag configure new2 -foreground $Pref(colornew2) \
-# -background $Pref(bgnew2)
-# $dirdiff(wRight) tag configure change -foreground $Pref(colorchange) \
-# -background $Pref(bgchange)
-# $dirdiff(wRight) tag configure changed -foreground $Pref(colorchange)
-# $dirdiff(wRight) tag configure invalid -background #a9a9a9
-
}
}
# Scroll text windows
-proc scrollText {top n what} {
+proc scrollText {top args} {
# 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
+ set class [winfo class [focus]]
+ if {$class in "Text TEntry"} {
+ return
+ }
+
+ $::widgets($top,wDiff1) {*}$args
+ if {[string index [lindex $args 0] 0] eq "x"} {
+ # x commands go to both since that is not synched
+ $::widgets($top,wDiff2) {*}$args
}
}
# Emulate a label that:
# 1 : Displays the right part of the text if there isn't enough room
@@ -2575,44 +2929,56 @@
$w configure -takefocus 0 -state readonly ;#-readonlybackground $bg
set i [lsearch $args -textvariable]
if {$i >= 0} {
- set var [lindex $args [+ $i 1]]
- uplevel \#0 "trace variable $var w \
- {after idle {$w xview end} ;#}"
+ set var [lindex $args [+ $i 1]]
+ uplevel \#0 "trace variable $var w \
+ {after idle {$w xview end} ;#}"
}
}
# Fill in default data for a diff window
proc initDiffData {top} {
- set ::diff($top,leftOK) 0
- set ::diff($top,rightOK) 0
- set ::diff($top,mode) ""
- set ::diff($top,printFile) ""
- set ::diff($top,mergeFile) ""
- set ::diff($top,ancestorFile) ""
- set ::diff($top,conflictFile) ""
- set ::diff($top,limitlines) 0
- set ::diff($top,plugin) ""
+ set ::eskil($top,leftOK) 0
+ set ::eskil($top,rightOK) 0
+ set ::eskil($top,mode) ""
+ set ::eskil($top,view) ""
+ set ::eskil($top,printFileCmd) 0
+ set ::eskil($top,printFile) ""
+ set ::eskil($top,mergeFile) ""
+ set ::eskil($top,ancestorFile) ""
+ set ::eskil($top,separator) ""
+ set ::eskil($top,separatorview) ""
+ set ::eskil($top,conflictFile) ""
+ set ::eskil($top,limitlines) 0
+ set ::eskil($top,gz) 0
+ set ::eskil($top,maxwidth) 0
+ set ::eskil($top,plugin,1) ""
+
+ # Copy the collected options from command line
+ foreach {item val} $::eskil(defaultopts) {
+ set ::eskil($top,$item) $val
+ }
}
# Create a new diff window and diff two files
proc newDiff {file1 file2 {range {}}} {
set top [makeDiffWin]
update
- set ::diff($top,leftDir) [file dirname $file1]
- set ::diff($top,leftFile) $file1
- set ::diff($top,leftLabel) $file1
- set ::diff($top,leftOK) 1
- set ::diff($top,rightDir) [file dirname $file2]
- set ::diff($top,rightFile) $file2
- set ::diff($top,rightLabel) $file2
- set ::diff($top,rightOK) 1
- set ::diff($top,mode) ""
- set ::diff($top,range) $range
+ set ::eskil($top,leftDir) [file dirname $file1]
+ set ::eskil($top,leftFile) $file1
+ set ::eskil($top,leftLabel) $file1
+ set ::eskil($top,leftOK) 1
+ set ::eskil($top,rightDir) [file dirname $file2]
+ set ::eskil($top,rightFile) $file2
+ set ::eskil($top,rightLabel) $file2
+ set ::eskil($top,rightOK) 1
+ set ::eskil($top,mode) ""
+ set ::eskil($top,view) ""
+ set ::eskil($top,range) $range
wm deiconify $top
raise $top
update
doDiff $top
return $top
@@ -2619,64 +2985,93 @@
}
# Create a new diff window equal to another, except for possibly a range
proc cloneDiff {other {range {}}} {
- set top [makeDiffWin]
+ set top [makeDiffWin $other]
update
- foreach item [array names ::diff $other,*] {
+ foreach item [array names ::eskil $other,*] {
regsub {^[^,]*,} $item {} item
- set ::diff($top,$item) $::diff($other,$item)
+ set ::eskil($top,$item) $::eskil($other,$item)
}
if {[llength $range] != 0} {
- set ::diff($top,range) $range
+ set ::eskil($top,range) $range
}
wm deiconify $top
raise $top
update
doDiff $top
}
# A thing to easily get to debug mode
-proc backDoor {a} {
+proc backDoor {top a} {
append ::eskil(backdoor) $a
set ::eskil(backdoor) [string range $::eskil(backdoor) end-9 end]
- if {$::eskil(backdoor) eq "PeterDebug"} {
+ if {$::eskil(backdoor) eq "EskilDebug"} {
set ::eskil(debug) 1
catch {console show}
set ::eskil(backdoor) ""
+ AddDebugMenu $top
}
}
+
+# Runtime disable of C version of DiffUtil
+proc DisableDiffUtilC {} {
+ uplevel \#0 [list source $::eskil(thisDir)/../lib/diffutil/tcl/diffutil.tcl]
+}
+
+# Add a debug menu to a toplevel window
+proc AddDebugMenu {top} {
+ set dMenu [DebugMenu $top.m]
+ $dMenu add checkbutton -label "Wrap" -variable wrapstate \
+ -onvalue char -offvalue none -command \
+ "$top.ft1.tt configure -wrap \$wrapstate ;\
+ $top.ft2.tt configure -wrap \$wrapstate"
+ $dMenu add command -label "Date Filter" \
+ -command {set ::eskil(filter) {^Date}}
+ $dMenu add separator
+ $dMenu add command -label "Reread Source" -underline 0 \
+ -command {EskilRereadSource}
+ $dMenu add separator
+ $dMenu add command -label "Normal Cursor" \
+ -command [list normalCursor $top]
+ $dMenu add separator
+ # Runtime disable of C version of DiffUtil
+ $dMenu add command -label "Tcl DiffUtil" -command DisableDiffUtilC
+ $dMenu add command -label "Evalstats" -command {evalstats}
+ $dMenu add command -label "_stats" -command {parray _stats}
+}
# Build the main window
-proc makeDiffWin {{top {}}} {
- global Pref tcl_platform
-
- if {$top != "" && [winfo exists $top] && [winfo toplevel $top] eq $top} {
- # Reuse the old window
- destroy {*}[winfo children $top]
- } else {
- # Locate a free toplevel name
- if {[info exists ::diff(topDiffCnt)]} {
- set t $::diff(topDiffCnt)
- } else {
- set t 0
- }
- while {[winfo exists .diff$t]} {
- incr t
- }
- set top .diff$t
- toplevel $top
- eskilRegisterToplevel $top
+# "other" is related window. Currently unused
+proc makeDiffWin {{other {}} args} {
+ global tcl_platform
+
+ # Locate a free toplevel name
+ if {[info exists ::eskil(topDiffCnt)]} {
+ set t $::eskil(topDiffCnt)
+ } else {
+ set t 0
+ }
+ while {[winfo exists .diff$t]} {
+ incr t
+ }
+ set top .diff$t
+ toplevel $top
+ eskilRegisterToplevel $top
+ initDiffData $top
+
+ if {"-table" in $args} {
+ set ::eskil($top,view) "table"
}
wm title $top "Eskil:"
wm protocol $top WM_DELETE_WINDOW [list cleanupAndExit $top]
ttk::frame $top.f
- grid $top.f -row 0 -columnspan 4 -sticky nws
+ grid $top.f -row 0 -columnspan 5 -sticky nws
lappend ::widgets(toolbars) $top.f
if {!$::Pref(toolbar)} {
grid remove $top.f
}
@@ -2721,66 +3116,67 @@
$top.m add cascade -label "Options" -underline 0 -menu $top.m.mo
menu $top.m.mo
$top.m.mo add cascade -label "Font" -underline 0 -menu $top.m.mo.f
$top.m.mo add cascade -label "Ignore" -underline 0 -menu $top.m.mo.i
$top.m.mo add command -label "Preprocess..." -underline 0 \
- -command [list EditPrefRegsub $top]
+ -command [list EditPrefPreprocess $top]
$top.m.mo add command -label "Plugins..." -underline 1 \
-command [list EditPrefPlugins $top]
$top.m.mo add cascade -label "Parse" -underline 1 -menu $top.m.mo.p
$top.m.mo add command -label "Colours..." -underline 0 -command makePrefWin
$top.m.mo add cascade -label "Context" -underline 1 -menu $top.m.mo.c
+ $top.m.mo add cascade -label "Pivot" -underline 2 -menu $top.m.mo.piv
$top.m.mo add separator
$top.m.mo add checkbutton -label "Toolbar" -variable ::Pref(toolbar)
$top.m.mo add separator
$top.m.mo add command -label "Save default" \
-command [list saveOptions $top]
menu $top.m.mo.f
$top.m.mo.f add command -label "Select..." -command makeFontWin \
-underline 0
- $top.m.mo.f add radiobutton -label 6 -variable Pref(fontsize) -value 6 \
- -command chFont
- $top.m.mo.f add radiobutton -label 7 -variable Pref(fontsize) -value 7 \
- -command chFont
- $top.m.mo.f add radiobutton -label 8 -variable Pref(fontsize) -value 8 \
- -command chFont
- $top.m.mo.f add radiobutton -label 9 -variable Pref(fontsize) -value 9 \
- -command chFont
- $top.m.mo.f add radiobutton -label 10 -variable Pref(fontsize) -value 10 \
+ $top.m.mo.f add radiobutton -label 6 -variable ::Pref(fontsize) -value 6 \
+ -command chFont
+ $top.m.mo.f add radiobutton -label 7 -variable ::Pref(fontsize) -value 7 \
+ -command chFont
+ $top.m.mo.f add radiobutton -label 8 -variable ::Pref(fontsize) -value 8 \
+ -command chFont
+ $top.m.mo.f add radiobutton -label 9 -variable ::Pref(fontsize) -value 9 \
+ -command chFont
+ $top.m.mo.f add radiobutton -label 10 -variable ::Pref(fontsize) -value 10 \
-command chFont
menu $top.m.mo.i
$top.m.mo.i add radiobutton -label "No spaces" \
- -variable Pref(ignore) -value " "
+ -variable ::Pref(ignore) -value " "
$top.m.mo.i add radiobutton -label "Space changes (-b)" \
- -variable Pref(ignore) -value "-b"
+ -variable ::Pref(ignore) -value "-b"
$top.m.mo.i add radiobutton -label "All spaces (-w)" \
- -variable Pref(ignore) -value "-w"
+ -variable ::Pref(ignore) -value "-w"
$top.m.mo.i add separator
$top.m.mo.i add checkbutton -label "Case (-i)" \
- -variable Pref(nocase)
+ -variable ::Pref(nocase)
$top.m.mo.i add checkbutton -label "Empty" \
- -variable Pref(noempty)
+ -variable ::Pref(noempty)
$top.m.mo.i add checkbutton -label "Digits" \
- -variable Pref(nodigit)
+ -variable ::Pref(nodigit)
menu $top.m.mo.p
- $top.m.mo.p add radiobutton -label "Nothing" -variable Pref(parse) -value 0
- $top.m.mo.p add radiobutton -label "Lines" -variable Pref(parse) -value 1
- $top.m.mo.p add radiobutton -label "Blocks (small)" -variable Pref(parse) \
+ $top.m.mo.p add radiobutton -label "Nothing" -variable ::Pref(parse) -value 0
+ $top.m.mo.p add radiobutton -label "Lines" -variable ::Pref(parse) -value 1
+ $top.m.mo.p add radiobutton -label "Blocks (small)" -variable ::Pref(parse) \
-value 2
- $top.m.mo.p add radiobutton -label "Blocks" -variable Pref(parse) -value 3
+ $top.m.mo.p add radiobutton -label "Blocks" -variable ::Pref(parse) -value 3
$top.m.mo.p add separator
$top.m.mo.p add radiobutton -label "Characters" \
- -variable Pref(lineparsewords) -value "0"
+ -variable ::Pref(lineparsewords) -value "0"
$top.m.mo.p add radiobutton -label "Words" \
- -variable Pref(lineparsewords) -value "1"
+ -variable ::Pref(lineparsewords) -value "1"
$top.m.mo.p add separator
- $top.m.mo.p add checkbutton -label "Fine chunks" -variable Pref(finegrainchunks)
+ $top.m.mo.p add checkbutton -label "Fine chunks" -variable ::Pref(finegrainchunks)
$top.m.mo.p add separator
- $top.m.mo.p add checkbutton -label "Mark last" -variable Pref(marklast)
+ $top.m.mo.p add checkbutton -label "Mark last" -variable ::Pref(marklast)
menu $top.m.mo.c
$top.m.mo.c add radiobutton -label "Show all lines" \
-variable ::Pref(context) -value -1
$top.m.mo.c add radiobutton -label "Show only diffs" \
@@ -2793,10 +3189,22 @@
$top.m.mo.c add radiobutton -label "Context 10 lines" \
-variable ::Pref(context) -value 10
$top.m.mo.c add radiobutton -label "Context 20 lines" \
-variable ::Pref(context) -value 20
+ menu $top.m.mo.piv
+ $top.m.mo.piv add radiobutton -label "1" \
+ -variable ::Pref(pivot) -value 1
+ $top.m.mo.piv add radiobutton -label "10" \
+ -variable ::Pref(pivot) -value 10
+ $top.m.mo.piv add radiobutton -label "100" \
+ -variable ::Pref(pivot) -value 100
+ $top.m.mo.piv add radiobutton -label "1000" \
+ -variable ::Pref(pivot) -value 1000
+ $top.m.mo.piv add radiobutton -label "Max" \
+ -variable ::Pref(pivot) -value 2000000000
+
$top.m add cascade -label "Search" -underline 0 -menu $top.m.ms
menu $top.m.ms
if {[info procs textSearch::searchMenu] != ""} {
textSearch::searchMenu $top.m.ms
} else {
@@ -2805,15 +3213,19 @@
}
$top.m add cascade -label "Tools" -underline 0 -menu $top.m.mt
menu $top.m.mt
$top.m.mt add command -label "New Diff Window" -underline 0 \
- -command makeDiffWin
+ -command [list makeDiffWin $top]
$top.m.mt add command -label "Directory Diff" -underline 0 \
-command makeDirDiffWin
$top.m.mt add command -label "Clip Diff" -underline 0 \
-command makeClipDiffWin
+ $top.m.mt add command -label "Fourway Diff" -underline 0 \
+ -command makeFourWayWin
+ $top.m.mt add command -label "Table Diff" -underline 0 \
+ -command [list makeDiffWin $top -table]
$top.m.mt add command -label "Merge" -underline 0 \
-command [list makeMergeWin $top] -state disabled
$top.m.mt add command -label "Edit Mode" -underline 0 \
-command [list allowEdit $top] -state disabled
$top.m.mt add command -label "Paste Patch" -underline 0 \
@@ -2844,25 +3256,29 @@
-command [list makeDocWin $file] -underline 0
}
$top.m.help add separator
$top.m.help add command -label "About" -command makeAboutWin -underline 0
+ # Toolbar
ttk::label $top.lr1 -text "Rev 1"
addBalloon $top.lr1 "Revision number for version diff."
- ttk::entryX $top.er1 -width 12 -textvariable diff($top,doptrev1)
+ ttk::entryX $top.er1 -width 12 -textvariable ::eskil($top,doptrev1)
set ::widgets($top,rev1) $top.er1
bind $top.er1 [list redoDiff $top]
ttk::label $top.lr2 -text "Rev 2"
addBalloon $top.lr2 "Revision number for version diff."
- ttk::entryX $top.er2 -width 12 -textvariable diff($top,doptrev2)
+ ttk::entryX $top.er2 -width 12 -textvariable ::eskil($top,doptrev2)
set ::widgets($top,rev2) $top.er2
bind $top.er2 [list redoDiff $top]
ttk::button $top.bcm -text Commit -command [list revCommit $top] \
-state disabled -underline 0
set ::widgets($top,commit) $top.bcm
+ ttk::button $top.brv -text Revert -command [list revRevert $top] \
+ -state disabled
+ set ::widgets($top,revert) $top.brv
ttk::button $top.blg -text Log -command [list revLog $top] \
-state disabled -underline 0
set ::widgets($top,log) $top.blg
ttk::button $top.bfp -text "Prev Diff" \
-command [list findDiff $top -1] \
@@ -2873,209 +3289,266 @@
bind $top [list findDiff $top 1]
bind $top [list findDiff $top -1]
bind $top [list revCommit $top]
bind $top [list revLog $top]
+ pack $top.bfn -in $top.f -side right -padx {3 6}
+ pack $top.bfp $top.bcm $top.brv $top.blg \
+ $top.er2 $top.lr2 $top.er1 $top.lr1 \
+ -in $top.f -side right -padx 3
+ # Adjust
+ pack $top.bfn $top.bfp $top.bcm -ipadx 15
+ # Add a separator entry in toolbar if table mode is on
+ if {$::eskil($top,view) eq "table"} {
+ ttk::label $top.lsep -text "Sep"
+ addBalloon $top.lsep "Separator for interpreting file as table"
+ ttk::entryX $top.esep -width 2 -textvariable ::eskil($top,separatorview)
+ set ::widgets($top,sep) $top.esep
+ bind $top.esep [list redoDiff $top]
+ pack $top.esep $top.lsep \
+ -in $top.f -side right -padx 3
+ }
+
+ # File and progress indicators
catch {font delete myfont}
- font create myfont -family $Pref(fontfamily) -size $Pref(fontsize)
-
- fileLabel $top.l1 -textvariable diff($top,leftLabel)
- fileLabel $top.l2 -textvariable diff($top,rightLabel)
-
- ttk::frame $top.ft1 -borderwidth 2 -relief sunken
- text $top.ft1.tl -height $Pref(lines) -width 5 -wrap none \
- -font myfont -borderwidth 0 -padx 0 -highlightthickness 0 \
- -takefocus 0
- text $top.ft1.tt -height $Pref(lines) -width $Pref(linewidth) -wrap none \
- -xscrollcommand [list $top.sbx1 set] \
- -font myfont -borderwidth 0 -padx 1 \
- -highlightthickness 0
- $top.ft1.tt configure -tabstyle wordprocessor
- tk::frame $top.ft1.f -width 2 -height 2 -background lightgray
- pack $top.ft1.tl -side left -fill y
- pack $top.ft1.f -side left -fill y
- pack $top.ft1.tt -side right -fill both -expand 1
- scrollbar $top.sby -orient vertical
- scrollbar $top.sbx1 -orient horizontal -command [list $top.ft1.tt xview]
- set ::widgets($top,wLine1) $top.ft1.tl
- set ::widgets($top,wDiff1) $top.ft1.tt
-
- ttk::frame $top.ft2 -borderwidth 2 -relief sunken
- text $top.ft2.tl -height $Pref(lines) -width 5 -wrap none \
- -font myfont -borderwidth 0 -padx 0 -highlightthickness 0 \
- -takefocus 0
- text $top.ft2.tt -height $Pref(lines) -width $Pref(linewidth) -wrap none \
- -xscrollcommand [list $top.sbx2 set] \
- -font myfont -borderwidth 0 -padx 1 \
- -highlightthickness 0
- $top.ft2.tt configure -tabstyle wordprocessor
- tk::frame $top.ft2.f -width 2 -height 2 -background lightgray
- pack $top.ft2.tl -side left -fill y
- pack $top.ft2.f -side left -fill y
- pack $top.ft2.tt -side right -fill both -expand 1
- scrollbar $top.sbx2 -orient horizontal -command [list $top.ft2.tt xview]
- set ::widgets($top,wLine2) $top.ft2.tl
- set ::widgets($top,wDiff2) $top.ft2.tt
- commonYScroll $top.sby $top.ft1.tl $top.ft1.tt $top.ft2.tl $top.ft2.tt
-
- # Set up a tag for incremental search bindings
- if {[info procs textSearch::enableSearch] != ""} {
- textSearch::enableSearch $top.ft1.tt -label ::widgets($top,isearchLabel)
- textSearch::enableSearch $top.ft2.tt -label ::widgets($top,isearchLabel)
- }
-
- # Set up file dropping in text windows if TkDnd is available
- if {![catch {package require tkdnd}]} {
- dnd bindtarget $top.ft1.tt text/uri-list "fileDrop $top left %D"
- dnd bindtarget $top.ft2.tt text/uri-list "fileDrop $top right %D"
- }
+ font create myfont -family $::Pref(fontfamily) -size $::Pref(fontsize)
+
+ fileLabel $top.l1 -textvariable ::eskil($top,leftLabel)
+ fileLabel $top.l2 -textvariable ::eskil($top,rightLabel)
ttk::label $top.le -textvariable ::widgets($top,eqLabel) -width 1
- addBalloon $top.le "* means external diff is running.\n= means files do\
- not differ.\n! means a large block is being processed.\nBlank\
- means files differ."
- # FIXA: verify that this label is ok after Tile migration
- ttk::label $top.ls -width 1 \
- -textvariable ::widgets($top,isearchLabel)
- addBalloon $top.ls "Incremental search indicator"
- set map [createMap $top]
-
- applyColor
- foreach w [list $top.ft1.tt $top.ft2.tt] {
- # The last change in a row is underlined
- $w tag configure last -underline 1
- # Each file in a patch view starts with a block of this type
- $w tag configure patch -background gray
- # Make sure selection is visible
- $w tag raise sel
- bind $w "zoomRow %W %X %Y %x %y"
- bind $w "unzoomRow %W"
- }
- foreach w [list $top.ft1.tl $top.ft2.tl] {
- $w tag configure align -underline 1
- bind $w "rowPopup %W %X %Y %x %y"
- }
-
- grid $top.l1 $top.le - $top.l2 -row 1 -sticky news
- grid $top.ft1 $map $top.sby $top.ft2 -row 2 -sticky news
- grid $top.sbx1 $top.ls - $top.sbx2 -row 3 -sticky news
- grid columnconfigure $top {0 3} -weight 1
- grid rowconfigure $top 2 -weight 1
- grid $map -pady [expr {[winfo reqwidth $top.sby] - 2}]
- grid $top.ls -sticky ""
-
- bind $top [list scrollText $top -1 u]
- bind $top [list scrollText $top 1 u]
- bind $top [list scrollText $top -1 pa]
- bind $top [list scrollText $top 1 pa]
+ addBalloon $top.le -fmt {
+ * means external diff is running.\n
+ = means files do not differ.\n
+ ! means a large block is being processed.\n
+ Blank means files differ.
+ }
+
+ # Main window
+ if {$::eskil($top,view) eq "table"} {
+ # Single frame for contents
+ ttk::frame $top.ft -borderwidth 2 -relief sunken
+ grid $top.l1 $top.le $top.l2 -row 1 -sticky news
+ grid $top.ft - - -row 2 -sticky news
+ grid columnconfigure $top "0 2" -weight 1
+ grid rowconfigure $top $top.ft -weight 1
+ # TBD TABLE
+ tablelist::tablelist $top.ft.tab -height 25 -width 100 \
+ -font myfont -labelfont myfont \
+ -movablecolumns no -setgrid no -showseparators no \
+ -fullseparators yes -selectmode extended \
+ -colorizecommand tblModeColorCallback
+ ttk::scrollbar $top.ft.vsb -orient vertical \
+ -command "$top.ft.tab yview"
+ ttk::scrollbar $top.ft.hsb -orient horizontal \
+ -command "$top.ft.tab xview"
+ $top.ft.tab configure -yscrollcommand "$top.ft.vsb set" \
+ -xscrollcommand "$top.ft.hsb set"
+ set body [$top.ft.tab bodypath]
+ $body tag configure new1 -foreground $::Pref(colornew1) \
+ -background $::Pref(bgnew1)
+ $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 {
+ ttk::frame $top.ft1 -borderwidth 2 -relief sunken
+ text $top.ft1.tl -height $::Pref(lines) -width 5 -wrap none \
+ -font myfont -borderwidth 0 -padx 0 -highlightthickness 0 \
+ -takefocus 0
+ text $top.ft1.tt -height $::Pref(lines) -width $::Pref(linewidth) \
+ -wrap none \
+ -xscrollcommand [list $top.sbx1 set] \
+ -font myfont -borderwidth 0 -padx 1 \
+ -highlightthickness 0
+ $top.ft1.tt configure -tabstyle wordprocessor
+ tk::frame $top.ft1.f -width 2 -height 2 -background lightgray
+ pack $top.ft1.tl -side left -fill y
+ pack $top.ft1.f -side left -fill y
+ pack $top.ft1.tt -side right -fill both -expand 1
+ ttk::scrollbar $top.sby -orient vertical
+ ttk::scrollbar $top.sbx1 -orient horizontal \
+ -command [list $top.ft1.tt xview]
+ set ::widgets($top,wLine1) $top.ft1.tl
+ set ::widgets($top,wDiff1) $top.ft1.tt
+
+ ttk::frame $top.ft2 -borderwidth 2 -relief sunken
+ text $top.ft2.tl -height $::Pref(lines) -width 5 -wrap none \
+ -font myfont -borderwidth 0 -padx 0 -highlightthickness 0 \
+ -takefocus 0
+ text $top.ft2.tt -height $::Pref(lines) -width $::Pref(linewidth) \
+ -wrap none \
+ -xscrollcommand [list $top.sbx2 set] \
+ -font myfont -borderwidth 0 -padx 1 \
+ -highlightthickness 0
+ $top.ft2.tt configure -tabstyle wordprocessor
+ tk::frame $top.ft2.f -width 2 -height 2 -background lightgray
+ pack $top.ft2.tl -side left -fill y
+ pack $top.ft2.f -side left -fill y
+ pack $top.ft2.tt -side right -fill both -expand 1
+ ttk::scrollbar $top.sbx2 -orient horizontal \
+ -command [list $top.ft2.tt xview]
+ set ::widgets($top,wLine2) $top.ft2.tl
+ set ::widgets($top,wDiff2) $top.ft2.tt
+
+ # Set up a tag for incremental search bindings
+ if {[info procs textSearch::enableSearch] != ""} {
+ textSearch::enableSearch $top.ft1.tt -label ::widgets($top,isearchLabel)
+ textSearch::enableSearch $top.ft2.tt -label ::widgets($top,isearchLabel)
+ }
+
+ # Set up file dropping in text windows if TkDnd is available
+ if {![catch {package require tkdnd}]} {
+ dnd bindtarget $top text/uri-list "fileDrop $top any %D"
+ dnd bindtarget $top.ft1.tl text/uri-list "fileDrop $top left %D"
+ dnd bindtarget $top.ft1.tt text/uri-list "fileDrop $top left %D"
+ dnd bindtarget $top.ft2.tl text/uri-list "fileDrop $top right %D"
+ dnd bindtarget $top.ft2.tt text/uri-list "fileDrop $top right %D"
+ }
+
+ # FIXA: verify that this label is ok after Tile migration
+ ttk::label $top.ls -width 1 \
+ -textvariable ::widgets($top,isearchLabel)
+ addBalloon $top.ls "Incremental search indicator"
+ set bg [ttk::style configure . -background]
+ set map [createMap $top $bg]
+
+ # Edit buttons widget
+ set ::widgets($top,wTb) $top.tb
+ text $top.tb -width 4 -wrap none -background $bg \
+ -font myfont -borderwidth 0 -padx 0 -highlightthickness 0 \
+ -takefocus 0
+ commonYScroll $top.sby $top.ft1.tl $top.ft1.tt $top.ft2.tl $top.ft2.tt \
+ ;#$top.tb
+
+ applyColor
+ foreach w [list $top.ft1.tt $top.ft2.tt] {
+ # The last change in a row is underlined
+ $w tag configure last -underline 1
+ # Each file in a patch view starts with a block of this type
+ $w tag configure patch -background gray
+ # Make sure selection is visible
+ $w tag raise sel
+ bind $w "zoomRow %W %X %Y %x %y"
+ bind $w "unzoomRow %W"
+ }
+ foreach w [list $top.ft1.tl $top.ft2.tl] {
+ $w tag configure align -underline 1
+ bind $w "rowPopup %W %X %Y %x %y"
+ }
+ SetupAlignDrag $top $top.ft1.tl $top.ft2.tl
+
+ grid $top.l1 $top.le - - $top.l2 -row 1 -sticky news
+ grid $top.ft1 $top.tb $map $top.sby $top.ft2 -row 2 -sticky news
+ grid $top.sbx1 $top.ls - - $top.sbx2 -row 3 -sticky news
+ grid columnconfigure $top "$top.ft1 $top.ft2" -weight 1
+ grid rowconfigure $top $top.ft1 -weight 1
+ grid $top.tb -pady 2
+ grid $map -pady [expr {[winfo reqwidth $top.sby] - 2}]
+ grid $top.ls -sticky ""
+
+ grid remove $top.tb ;# Hide until done
+
+ # Allow scrolling from keys at toplevel
+ bind $top [list scrollText $top yview scroll -1 u]
+ bind $top [list scrollText $top yview scroll -1 u]
+ bind $top [list scrollText $top yview scroll 1 u]
+ bind $top [list scrollText $top yview scroll 1 u]
+ bind $top [list scrollText $top yview scroll -1 pa]
+ bind $top [list scrollText $top yview scroll -1 pa]
+ bind $top [list scrollText $top yview scroll 1 pa]
+ bind $top [list scrollText $top yview scroll 1 pa]
+ bind $top [list scrollText $top xview scroll -5 u]
+ bind $top [list scrollText $top xview scroll -5 u]
+ bind $top [list scrollText $top xview scroll 5 u]
+ bind $top [list scrollText $top xview scroll 5 u]
+ bind $top [list scrollText $top yview moveto 0]
+ bind $top [list scrollText $top yview moveto 0]
+ bind $top [list scrollText $top yview moveto 1]
+ }
+
+ # Go out to toplevel with escape, whereever you are
bind $top [list focus $top]
+
if {$::eskil(debug) == 0} {
- bind $top "backDoor %A"
- }
-
- pack $top.bfn -in $top.f -side right -padx {3 6}
- pack $top.bfp $top.bcm $top.blg \
- $top.er2 $top.lr2 $top.er1 $top.lr1 \
- -in $top.f -side right -padx 3
- pack $top.bfn $top.bfp $top.bcm -ipadx 15
+ set val [bindtags $top]
+ lappend val backDoor$top
+ bindtags $top $val
+ # Keep this binding on a separate tag, so that other key
+ # bindings on the top does not steal the keys
+ bind backDoor$top "backDoor $top %A"
+ }
if {$::eskil(debug) == 1} {
- $top.m add cascade -label "Debug" -menu $top.m.md -underline 0
- menu $top.m.md
- if {$tcl_platform(platform) eq "windows"} {
- $top.m.md add checkbutton -label "Console" -variable consolestate \
- -onvalue show -offvalue hide \
- -command {console $consolestate}
- $top.m.md add separator
- }
- $top.m.md add checkbutton -label "Wrap" -variable wrapstate \
- -onvalue char -offvalue none -command \
- "$top.ft1.tt configure -wrap \$wrapstate ;\
- $top.ft2.tt configure -wrap \$wrapstate"
- $top.m.md add command -label "Date Filter" \
- -command {set ::diff(filter) {^Date}}
- $top.m.md add separator
- $top.m.md add command -label "Reread Source" -underline 0 \
- -command {EskilRereadSource}
- $top.m.md add separator
- $top.m.md add command -label "Redraw Window" \
- -command [list makeDiffWin $top]
- $top.m.md add separator
- $top.m.md add command -label "Normal Cursor" \
- -command [list normalCursor $top]
- $top.m.md add separator
- $top.m.md add command -label "Evalstats" -command {evalstats}
- $top.m.md add command -label "_stats" -command {parray _stats}
- $top.m.md add command -label "Nuisance" -command [list makeNuisance \
- $top "It looks like you are trying out the debug menu."]
- }
-
- initDiffData $top
+ AddDebugMenu $top
+ }
+
+ resetEdit $top
return $top
}
proc ValidateNewColors {} {
- global TmpPref
foreach item {colorchange bgchange colornew1 bgnew1
colornew2 bgnew2 colorequal bgequal} {
- if {![info exists TmpPref($item)]} continue
- set col $TmpPref($item)
+ if {![info exists ::TmpPref($item)]} continue
+ set col $::TmpPref($item)
if {$col eq ""} continue
if {[catch {winfo rgb . $col}]} {
# FIXA: Error message
# Just restore for now
- set TmpPref($item) $::Pref($item)
+ set ::TmpPref($item) $::Pref($item)
}
}
}
# Set new preferences.
proc applyPref {} {
- global Pref TmpPref
-
ValidateNewColors
- array set Pref [array get TmpPref]
+ array set ::Pref [array get ::TmpPref]
applyColor
}
# Update test color fields.
proc testColor {} {
- global TmpPref
-
-
ValidateNewColors
- .pr.fc.t1 tag configure change -foreground $TmpPref(colorchange) \
- -background $TmpPref(bgchange)
- .pr.fc.t2 tag configure new1 -foreground $TmpPref(colornew1) \
- -background $TmpPref(bgnew1)
- .pr.fc.t3 tag configure new2 -foreground $TmpPref(colornew2) \
- -background $TmpPref(bgnew2)
- .pr.fc.t4 tag configure equal -foreground $TmpPref(colorequal) \
- -background $TmpPref(bgequal)
+ .pr.fc.t1 tag configure change -foreground $::TmpPref(colorchange) \
+ -background $::TmpPref(bgchange)
+ .pr.fc.t2 tag configure new1 -foreground $::TmpPref(colornew1) \
+ -background $::TmpPref(bgnew1)
+ .pr.fc.t3 tag configure new2 -foreground $::TmpPref(colornew2) \
+ -background $::TmpPref(bgnew2)
+ .pr.fc.t4 tag configure equal -foreground $::TmpPref(colorequal) \
+ -background $::TmpPref(bgequal)
}
# Color dialog.
proc selColor {name} {
- global TmpPref
-
- set old $TmpPref($name)
+ set old $::TmpPref($name)
if {$old eq ""} {
set t [tk_chooseColor -parent .pr]
} else {
set t [tk_chooseColor -parent .pr -initialcolor $old]
}
if {$t != ""} {
- set TmpPref($name) $t
+ set ::TmpPref($name) $t
}
}
# Create a window for changing preferences.
# Currently only colors are changed in this dialog.
proc makePrefWin {} {
- global Pref TmpPref
-
- array set TmpPref [array get Pref]
+ array set ::TmpPref [array get ::Pref]
destroy .pr
toplevel .pr
wm title .pr "Eskil Preferences"
@@ -3083,24 +3556,24 @@
ttk::frame .pr.fc -borderwidth 1 -relief solid
ttk::label .pr.fc.l1 -text "Colours" -anchor w
ttk::label .pr.fc.l2 -text "Text" -anchor w
ttk::label .pr.fc.l3 -text "Background" -anchor w
- ttk::entryX .pr.fc.e1 -textvariable "TmpPref(colorchange)" -width 10
- ttk::entryX .pr.fc.e2 -textvariable "TmpPref(colornew1)" -width 10
- ttk::entryX .pr.fc.e3 -textvariable "TmpPref(colornew2)" -width 10
- ttk::entryX .pr.fc.e4 -textvariable "TmpPref(colorequal)" -width 10
+ ttk::entryX .pr.fc.e1 -textvariable "::TmpPref(colorchange)" -width 10
+ ttk::entryX .pr.fc.e2 -textvariable "::TmpPref(colornew1)" -width 10
+ ttk::entryX .pr.fc.e3 -textvariable "::TmpPref(colornew2)" -width 10
+ ttk::entryX .pr.fc.e4 -textvariable "::TmpPref(colorequal)" -width 10
ttk::button .pr.fc.b1 -text "Sel" -command "selColor colorchange"
ttk::button .pr.fc.b2 -text "Sel" -command "selColor colornew1"
ttk::button .pr.fc.b3 -text "Sel" -command "selColor colornew2"
ttk::button .pr.fc.b4 -text "Sel" -command "selColor colorequal"
- ttk::entryX .pr.fc.e5 -textvariable "TmpPref(bgchange)" -width 10
- ttk::entryX .pr.fc.e6 -textvariable "TmpPref(bgnew1)" -width 10
- ttk::entryX .pr.fc.e7 -textvariable "TmpPref(bgnew2)" -width 10
- ttk::entryX .pr.fc.e8 -textvariable "TmpPref(bgequal)" -width 10
+ ttk::entryX .pr.fc.e5 -textvariable "::TmpPref(bgchange)" -width 10
+ ttk::entryX .pr.fc.e6 -textvariable "::TmpPref(bgnew1)" -width 10
+ ttk::entryX .pr.fc.e7 -textvariable "::TmpPref(bgnew2)" -width 10
+ ttk::entryX .pr.fc.e8 -textvariable "::TmpPref(bgequal)" -width 10
ttk::button .pr.fc.b5 -text "Sel" -command "selColor bgchange"
ttk::button .pr.fc.b6 -text "Sel" -command "selColor bgnew1"
ttk::button .pr.fc.b7 -text "Sel" -command "selColor bgnew2"
ttk::button .pr.fc.b8 -text "Sel" -command "selColor bgequal"
@@ -3107,18 +3580,18 @@
text .pr.fc.t1 -width 12 -height 1 -font myfont -takefocus 0
text .pr.fc.t2 -width 12 -height 1 -font myfont -takefocus 0
text .pr.fc.t3 -width 12 -height 1 -font myfont -takefocus 0
text .pr.fc.t4 -width 12 -height 1 -font myfont -takefocus 0
- .pr.fc.t1 tag configure change -foreground $TmpPref(colorchange) \
- -background $TmpPref(bgchange)
- .pr.fc.t2 tag configure new1 -foreground $TmpPref(colornew1) \
- -background $TmpPref(bgnew1)
- .pr.fc.t3 tag configure new2 -foreground $TmpPref(colornew2) \
- -background $TmpPref(bgnew2)
- .pr.fc.t4 tag configure equal -foreground $TmpPref(colorequal) \
- -background $TmpPref(bgequal)
+ .pr.fc.t1 tag configure change -foreground $::TmpPref(colorchange) \
+ -background $::TmpPref(bgchange)
+ .pr.fc.t2 tag configure new1 -foreground $::TmpPref(colornew1) \
+ -background $::TmpPref(bgnew1)
+ .pr.fc.t3 tag configure new2 -foreground $::TmpPref(colornew2) \
+ -background $::TmpPref(bgnew2)
+ .pr.fc.t4 tag configure equal -foreground $::TmpPref(colorequal) \
+ -background $::TmpPref(bgequal)
.pr.fc.t1 insert end "Changed text" change
.pr.fc.t2 insert end "Deleted text" new1
.pr.fc.t3 insert end "Added text" new2
.pr.fc.t4 insert end "Equal text" equal
@@ -3147,37 +3620,34 @@
-padx 2 -pady 2
}
# Change font preference
proc applyFont {lb} {
- global Pref TmpPref
-
- set Pref(fontsize) $TmpPref(fontsize)
+ set ::Pref(fontsize) $::TmpPref(fontsize)
set i [lindex [$lb curselection] 0]
- set Pref(fontfamily) [$lb get $i]
+ set ::Pref(fontfamily) [$lb get $i]
chFont
}
# Update example font
proc exampleFont {lb} {
- global TmpPref
set i [lindex [$lb curselection] 0]
if {$i eq ""} return
- set TmpPref(fontfamily) [$lb get $i]
+ set ::TmpPref(fontfamily) [$lb get $i]
- font configure tmpfont -family $TmpPref(fontfamily)
- if {[string is integer -strict $TmpPref(fontsize)]} {
- font configure tmpfont -size $TmpPref(fontsize)
+ font configure tmpfont -family $::TmpPref(fontfamily)
+ if {[string is integer -strict $::TmpPref(fontsize)]} {
+ font configure tmpfont -size $::TmpPref(fontsize)
}
}
proc UpdateFontBox {lb} {
$lb delete 0 end
foreach {f fixed} $::FontCache {
- if {$fixed || !$::diff(fixedfont)} {
+ if {$fixed || !$::eskil(fixedfont)} {
$lb insert end $f
if {[string equal -nocase $f $::Pref(fontfamily)]} {
$lb selection set end
$lb see end
}
@@ -3185,11 +3655,11 @@
}
}
# Font dialog
proc makeFontWin {} {
- global Pref TmpPref FontCache
+ global FontCache
destroy .fo
toplevel .fo -padx 3 -pady 3
wm title .fo "Select Font"
@@ -3198,26 +3668,26 @@
update
catch {font delete tmpfont}
font create tmpfont
- array set TmpPref [array get Pref]
+ array set ::TmpPref [array get ::Pref]
ttk::labelframe .fo.lf -text "Family" -padding 3
set lb [Scroll y listbox .fo.lf.lb -width 15 -height 10 \
-exportselection no -selectmode single]
bind $lb <> [list exampleFont $lb]
pack .fo.lf.lb -fill both -expand 1
ttk::labelframe .fo.ls -text "Size" -padding 3
spinbox .fo.ls.sp -from 1 -to 30 -increment 1 -width 3 -state readonly \
- -textvariable TmpPref(fontsize) -command [list exampleFont $lb]
+ -textvariable ::TmpPref(fontsize) -command [list exampleFont $lb]
pack .fo.ls.sp -fill both -expand 1
ttk::label .fo.le -text "Example\n0Ooi1Il" -anchor w -font tmpfont \
-width 1 -justify left
- if {![info exists ::diff(fixedfont)]} {set ::diff(fixedfont) 1}
- ttk::checkbutton .fo.cb -text "Fixed" -variable ::diff(fixedfont) \
+ if {![info exists ::eskil(fixedfont)]} {set ::eskil(fixedfont) 1}
+ ttk::checkbutton .fo.cb -text "Fixed" -variable ::eskil(fixedfont) \
-command [list UpdateFontBox $lb]
ttk::button .fo.bo -text "Ok" -command "applyFont $lb ; destroy .fo"
ttk::button .fo.ba -text "Apply" -command "applyFont $lb"
ttk::button .fo.bc -text "Close" -command "destroy .fo"
@@ -3246,890 +3716,5 @@
grid columnconfigure .fo 0 -weight 1
grid rowconfigure .fo 1 -weight 1
exampleFont $lb
}
-
-###########################
-# Editor for ::Pref(regsub)
-###########################
-
-proc EditPrefRegsubOk {top w} {
- set exa $::diff($top,prefregexa)
-
- set result {}
- for {set t 1} {[info exists ::diff($top,prefregexp$t)]} {incr t} {
- set RE $::diff($top,prefregexp$t)
- set Sub $::diff($top,prefregsub$t)
- if {$RE eq ""} continue
-
- if {[catch {regsub -all -- $RE $exa $Sub _} err]} {
- return
- }
- lappend result $RE $Sub
- }
-
- set ::Pref(regsub) $result
- destroy $w
-
- array unset ::diff $top,prefregexp*
- array unset ::diff $top,prefregsub*
-}
-
-proc EditPrefRegsubUpdate {top args} {
- set exa $::diff($top,prefregexa)
- set exa2 $::diff($top,prefregexa2)
- set ok $::widgets($top,prefRegsubOk)
-
- for {set t 1} {[info exists ::diff($top,prefregexp$t)]} {incr t} {
- set RE $::diff($top,prefregexp$t)
- set Sub $::diff($top,prefregsub$t)
-
- if {$RE eq ""} continue
-
- if {[catch {regsub -all -- $RE $exa $Sub result} err]} {
- set ::diff($top,prefregresult) "$t ERROR: $err"
- $ok configure -state disabled
- return
- } else {
- set exa $result
- }
- if {[catch {regsub -all -- $RE $exa2 $Sub result} err]} {
- set ::diff($top,prefregresult2) "$t ERROR: $err"
- $ok configure -state disabled
- return
- } else {
- set exa2 $result
- }
- }
- set ::diff($top,prefregresult2) $exa2
- set ::diff($top,prefregresult) $exa
- $ok configure -state normal
-}
-
-proc AddPrefRegsub {top parent} {
- for {set t 1} {[winfo exists $parent.fr$t]} {incr t} {
- #Empty
- }
- set w [ttk::frame $parent.fr$t -borderwidth 2 -relief groove -padding 3]
- ttk::label $w.l1 -text "Regexp:" -anchor "w"
- ttk::entryX $w.e1 -textvariable ::diff($top,prefregexp$t) -width 60
- ttk::label $w.l2 -text "Subst:" -anchor "w"
- ttk::entryX $w.e2 -textvariable ::diff($top,prefregsub$t)
-
- grid $w.l1 $w.e1 -sticky we -padx 3 -pady 3
- grid $w.l2 $w.e2 -sticky we -padx 3 -pady 3
- grid columnconfigure $w 1 -weight 1
-
- pack $w -side "top" -fill x -padx 3 -pady 3
-
- trace add variable ::diff($top,prefregexp$t) write \
- [list EditPrefRegsubUpdate $top]
- trace add variable ::diff($top,prefregsub$t) write \
- [list EditPrefRegsubUpdate $top]
-}
-
-# Editor for ::Pref(regsub)
-proc EditPrefRegsub {top} {
- set w $top.prefregsub
-
- if {[winfo exists $w] && [winfo toplevel $w] eq $w} {
- wm deiconify $w
- raise $w
- focus $w
- } else {
- toplevel $w -padx 3 -pady 3
- wm title $w "Preferences: Preprocess"
- }
-
- ttk::button $w.b -text "Add" -command [list AddPrefRegsub $top $w]
-
- # Result example part
- if {![info exists ::diff($top,prefregexa)]} {
- set ::diff($top,prefregexa) \
- "An example TextString FOR_REGSUB /* Comment */"
- set ::diff($top,prefregexa2) \
- "An example TextString FOR_REGSUB /* Comment */"
- }
- ttk::labelframe $w.res -text "Preprocessing result" -padding 3
- ttk::label $w.res.l3 -text "Example 1:" -anchor "w"
- ttk::entryX $w.res.e3 -textvariable ::diff($top,prefregexa) -width 60
- ttk::label $w.res.l4 -text "Result 1:" -anchor "w"
- ttk::label $w.res.e4 -textvariable ::diff($top,prefregresult) \
- -anchor "w" -width 10
- ttk::label $w.res.l5 -text "Example 2:" -anchor "w"
- ttk::entryX $w.res.e5 -textvariable ::diff($top,prefregexa2)
- ttk::label $w.res.l6 -text "Result 2:" -anchor "w"
- ttk::label $w.res.e6 -textvariable ::diff($top,prefregresult2) \
- -anchor "w" -width 10
-
- grid $w.res.l3 $w.res.e3 -sticky we -padx 3 -pady 3
- grid $w.res.l4 $w.res.e4 -sticky we -padx 3 -pady 3
- grid $w.res.l5 $w.res.e5 -sticky we -padx 3 -pady 3
- grid $w.res.l6 $w.res.e6 -sticky we -padx 3 -pady 3
- grid columnconfigure $w.res 1 -weight 1
-
- # Buttons
- ttk::frame $w.fb -padding 3
- ttk::button $w.fb.b1 -text "Ok" -command [list EditPrefRegsubOk $top $w]
- ttk::button $w.fb.b2 -text "Cancel" -command [list destroy $w]
- set ::widgets($top,prefRegsubOk) $w.fb.b1
-
- grid $w.fb.b1 x $w.fb.b2 -sticky we
- grid columnconfigure $w.fb {0 2} -uniform a
- grid columnconfigure $w.fb 1 -weight 1
-
- # Top layout
- pack $w.b -side "top" -anchor "w" -padx 3 -pady 3 -ipadx 15
- pack $w.fb $w.res -side bottom -fill x -padx 3 -pady 3
-
- # Fill in existing or an empty line
- if {[llength $::Pref(regsub)] == 0} {
- AddPrefRegsub $top $w
- } else {
- set t 1
- foreach {RE Sub} $::Pref(regsub) {
- set ::diff($top,prefregexp$t) $RE
- set ::diff($top,prefregsub$t) $Sub
- AddPrefRegsub $top $w
- incr t
- }
- }
-
- trace add variable ::diff($top,prefregexa) write \
- [list EditPrefRegsubUpdate $top]
- trace add variable ::diff($top,prefregexa2) write \
- [list EditPrefRegsubUpdate $top]
- EditPrefRegsubUpdate $top
-}
-
-proc defaultGuiOptions {} {
- catch {package require griffin}
-
- option add *Menu.tearOff 0
- option add *Button.padX 5
- if {[tk windowingsystem] eq "x11"} {
- option add *Menu.activeBorderWidth 1
- option add *Menu.borderWidth 1
-
- option add *Listbox.exportSelection 0
- option add *Listbox.borderWidth 1
- #option add *Listbox.highlightThickness 1
- option add *Font "Helvetica -12"
- option add *Scrollbar.highlightThickness 0
- option add *Scrollbar.takeFocus 0
- }
-
- if {$::tcl_platform(platform) eq "windows"} {
- option add *Panedwindow.sashRelief flat
- option add *Panedwindow.sashWidth 4
- option add *Panedwindow.sashPad 0
- #option add *Menubutton.activeBackground SystemHighlight
- #option add *Menubutton.activeForeground SystemHighlightText
- option add *Menubutton.padY 1
- }
-
- # Use Tahoma 8 as default on Windows, which is the system default
- # on Win2K and WinXP.
- if { [tk windowingsystem] == "win32" } {
- set ASfont "Tahoma 8"
- option add *Button.font $ASfont widgetDefault
- option add *Checkbutton.font $ASfont widgetDefault
- option add *Label.font $ASfont widgetDefault
- option add *Listbox.font $ASfont widgetDefault
- option add *Menu.font $ASfont widgetDefault
- option add *Menubutton.font $ASfont widgetDefault
- option add *Message.font $ASfont widgetDefault
- option add *Radiobutton.font $ASfont widgetDefault
- option add *Spinbox.font $ASfont widgetDefault
- }
-}
-
-#####################################
-# Startup stuff
-#####################################
-
-proc printUsage {} {
- puts {Usage: eskil [options] [file1] [file2]
- [options] See below.
- [file1],[file2] Files to be compared
- 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.
- Options:
-
- -nodiff : Normally, if there are enough information on the
- command line to run diff, Eskil will do so unless
- this option is specified.
- -dir : Start in directory diff mode. Ignores other args.
- -clip : Start in clip diff mode. Ignores other args.
- -patch : View patch file.
- - : Read patch file from standard input, to allow pipes.
- -review : View revision control tree as a patch.
- -context : Show only differences, with lines of context.
- -foreach : Open one diff window per file listed.
- -close : Close windows with no changes.
-
- -noparse : Eskil can perform analysis of changed blocks to
- -line : improve display. See online help for details.
- -smallblock : The default. Do block analysis on small blocks.
- -block : Full block analysis. This can be slow if there
- are large change blocks.
-
- -char : The analysis of changes can be done on either
- -word : character or word basis. -char is the default.
-
- -noignore : Don't ignore any whitespace.
- -b : Ignore space changes. Default.
- -w : Ignore all spaces.
- -nocase : Ignore case changes.
- -nodigit : Ignore digit changes.
- -nokeyword : In directory diff, ignore $ Keywords: $
- -nonewline : Try to ignore newline changes.
- -nonewline+ : Try to ignore newline changes, and don't display.
-
- -prefix : Care mainly about words starting with "str".
- -preprocess : TBW
-
- -r : Version info for version control mode.
- -cvs : Detect CVS first, if multiple version systems are used.
- -svn : Detect SVN first, if multiple version systems are used.
-
- -a : Give anscestor file for three way merge.
- -conflict : Treat file as a merge conflict file and enter merge
- mode.
- -o : Specify merge result output file.
- -fine : Use fine grained chunks. Useful for merging.
-
- -browse : Automatically bring up file dialog after starting.
- -server : Set up Eskil to be controllable from the outside.
-
- -print : Generate PDF and exit.
- -printCharsPerLine : Adapt font size for this line length and wrap. (80)
- -printPaper : Select paper size (a4)
- -printHeaderSize : Font size for page header (10)
- -printColorChange : Color for change (1.0 0.7 0.7)
- -printColorOld : Color for old text (0.7 1.0 0.7)
- -printColorNew : Preprocess files using plugin.
- -plugininfo : Pass info to plugin (plugin specific)
- -pluginlist : List known plugins
- -plugindump : Dump plugin source to stdout
-
- -limit : Do not process more than lines.
-
-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 -`/'}
-}
-
-# Helper to validate command line option for color
-proc ValidatePdfColor {arg opt} {
- 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
- }
-}
-
-# 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 Pref
-
- set ::eskil(autoclose) 0
- set ::eskil(ignorenewline) 0
-
- if {$::eskil(argc) == 0} {
- Init
- return [makeDiffWin]
- }
-
- set allOpts {
- -w --help -help -b -noignore -i -nocase -nodigit -nokeyword -prefix
- -noparse -line -smallblock -block -char -word -limit -nodiff -dir
- -clip -patch -browse -conflict -print
- -printHeaderSize -printCharsPerLine -printPaper
- -printColorChange -printColorOld -printColorNew
- -server -o -a -fine -r -context -cvs -svn -review
- -foreach -preprocess -close -nonewline -plugin -plugininfo
- -plugindump -pluginlist
- }
-
- # 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]
- if {[lsearch -exact $allOpts $arg] < 0} {
- set match [lsearch -glob -all -inline $allOpts $arg*]
- } else {
- set match [list $arg]
- }
- puts [lsort -dictionary $match]
- exit
- }
-
- set noautodiff 0
- set autobrowse 0
- set dodir 0
- set doclip 0
- set files ""
- set nextArg ""
- set revNo 1
- set dopatch 0
- set doreview 0
- set foreach 0
- set preferedRev "GIT"
- set plugin ""
- set plugininfo ""
- set plugindump ""
- set pluginlist 0
-
- foreach arg $::eskil(argv) {
- if {$nextArg != ""} {
- if {$nextArg eq "mergeFile"} {
- set opts(mergeFile) [file join [pwd] $arg]
- } elseif {$nextArg eq "ancestorFile"} {
- set opts(ancestorFile) [file join [pwd] $arg]
- } elseif {$nextArg eq "printFile"} {
- set opts(printFile) [file join [pwd] $arg]
- } elseif {$nextArg eq "printHeaderSize"} {
- if {![string is double -strict $arg] || $arg <= 0} {
- puts "Argument -printHeaderSize must be a positive number"
- exit
- }
- set Pref(printHeaderSize) $arg
- } elseif {$nextArg eq "printCharsPerLine"} {
- if {![string is integer -strict $arg] || $arg <= 0} {
- puts "Argument -printCharsPerLine must be a positive number"
- exit
- }
- set Pref(printCharsPerLine) $arg
- } elseif {$nextArg eq "printPaper"} {
- 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
- } elseif {$nextArg eq "printColorChange"} {
- ValidatePdfColor $arg -printColorChange
- set Pref(printColorChange) $arg
- } elseif {$nextArg eq "printColorOld"} {
- ValidatePdfColor $arg -printColorOld
- set Pref(printColorNew1) $arg
- } elseif {$nextArg eq "printColorNew"} {
- ValidatePdfColor $arg -printColorNew
- set Pref(printColorNew2) $arg
- } elseif {$nextArg eq "revision"} {
- set opts(doptrev$revNo) $arg
- incr revNo
- } elseif {$nextArg eq "limitlines"} {
- set opts(limitlines) $arg
- } elseif {$nextArg eq "context"} {
- set Pref(context) $arg
- } elseif {$nextArg eq "prefix"} {
- set RE [string map [list % $arg] {^.*?\m(%\w+).*$}]
- if {$Pref(nocase)} {
- set RE "(?i)$RE"
- }
- lappend ::Pref(regsub) $RE {\1}
- } elseif {$nextArg eq "plugin"} {
- set plugin $arg
- } elseif {$nextArg eq "plugininfo"} {
- set plugininfo $arg
- } elseif {$nextArg eq "plugindump"} {
- set plugindump $arg
- } elseif {$nextArg eq "preprocess"} {
- if {[catch {llength $arg} len]} {
-
- } elseif {[llength $arg] % 2 == 1} {
-
- } else {
- # FIXA: better validity check
- foreach {RE sub} $arg {
- lappend ::Pref(regsub) $RE $sub
- }
- }
- }
- set nextArg ""
- continue
- }
- # Take care of the special case of RCS style -r
- if {$arg ne "-review" && [string range $arg 0 1] eq "-r" && \
- [string length $arg] > 2} {
- set opts(doptrev$revNo) [string range $arg 2 end]
- incr revNo
- continue
- }
- # Try to see if it is an unique abbreviation of an option.
- # If not, let it fall through to the file check.
- if {[lsearch -exact $allOpts $arg] < 0} {
- set match [lsearch -glob -all -inline $allOpts $arg*]
- if {[llength $match] == 1} {
- set arg [lindex $match 0]
- }
- }
-
- if {$arg eq "-w"} {
- set Pref(ignore) "-w"
- } elseif {$arg eq "--help" || $arg eq "-help"} {
- printUsage
- exit
- } elseif {$arg eq "-b"} {
- set Pref(ignore) "-b"
- } elseif {$arg eq "-noignore"} {
- set Pref(ignore) " "
- } elseif {$arg eq "-i"} {
- set Pref(nocase) 1
- } elseif {$arg eq "-nocase"} {
- set Pref(nocase) 1
- } elseif {$arg eq "-noempty"} {
- set Pref(noempty) 1
- } elseif {$arg eq "-nodigit"} {
- set Pref(nodigit) 1
- } 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"} {
- set Pref(parse) 1
- } elseif {$arg eq "-smallblock"} {
- set Pref(parse) 2
- } elseif {$arg eq "-block"} {
- set Pref(parse) 3
- } elseif {$arg eq "-char"} {
- set Pref(lineparsewords) 0
- } elseif {$arg eq "-word"} {
- set Pref(lineparsewords) 1
- } elseif {$arg eq "-2nd"} { # Deprecated
- #set Pref(extralineparse) 1
- } elseif {$arg eq "-no2nd"} { # Deprecated
- #set Pref(extralineparse) 0
- } elseif {$arg eq "-limit"} {
- set nextArg limitlines
- } elseif {$arg eq "-nodiff"} {
- set noautodiff 1
- } elseif {$arg eq "-dir"} {
- set dodir 1
- } elseif {$arg eq "-clip"} {
- set doclip 1
- } elseif {$arg eq "-patch"} {
- set dopatch 1
- } elseif {$arg eq "-review"} {
- set doreview 1
- } elseif {$arg eq "-browse"} {
- set autobrowse 1
- } elseif {$arg eq "-foreach"} {
- set foreach 1
- } elseif {$arg eq "-nonewline"} {
- set ::eskil(ignorenewline) 1
- } elseif {$arg eq "-nonewline+"} {
- set ::eskil(ignorenewline) 2
- } elseif {$arg eq "-close"} {
- set ::eskil(autoclose) 1
- } elseif {$arg eq "-conflict"} {
- set opts(mode) "conflict"
- # Conflict implies foreach
- set foreach 1
- } elseif {$arg eq "-print" || $arg eq "-printpdf"} {
- set nextArg printFile
- } elseif {$arg in {-printHeaderSize -printCharsPerLine -printPaper \
- -printColorChange -printColorOld -printColorNew}} {
- set nextArg [string range $arg 1 end]
- } elseif {$arg eq "-server"} {
- if {$::tcl_platform(platform) eq "windows"} {
- catch {
- package require dde
- dde servername Eskil
- }
- } else {
- package require Tk
- tk appname Eskil
- }
- } elseif {$arg eq "-o"} {
- set nextArg mergeFile
- } elseif {$arg eq "-a"} {
- set nextArg ancestorFile
- # Default is no ignore on three-way merge
- set Pref(ignore) " "
- } elseif {$arg eq "-fine"} {
- set Pref(finegrainchunks) 1
- } elseif {$arg eq "-r"} {
- set nextArg revision
- } elseif {$arg eq "-debug"} {
- set ::eskil(debug) 1
- } elseif {$arg eq "-svn"} {
- set preferedRev "SVN"
- } elseif {$arg eq "-cvs"} {
- set preferedRev "CVS"
- } elseif {$arg eq "-"} {
- # Allow "-" for stdin patch processing
- lappend files "-"
- } else {
- set apa [file normalize [file join [pwd] $arg]]
- if {![file exists $apa]} {
- puts "Bad argument: $arg"
- exit
- } else {
- lappend files $apa
- }
- }
- }
-
- Init
-
- if {$pluginlist} {
- printPlugins
- exit
- }
- if {$plugindump ne ""} {
- printPlugin $plugindump
- exit
- }
- if {$plugin ne ""} {
- set pinterp [createPluginInterp $plugin $plugininfo]
- if {$pinterp eq ""} {
- puts "Bad plugin: $plugin"
- printPlugins
- exit
- }
- set opts(plugin) $pinterp
- set opts(pluginname) $plugin
- set opts(plugininfo) $plugininfo
- }
-
- # Do we start in clip diff mode?
- if {$doclip} {
- return [makeClipDiffWin]
- }
-
- # Figure out if we start in a diff or dirdiff window.
- set len [llength $files]
-
- if {$len == 0 && $dodir} {
- set dirdiff(leftDir) [pwd]
- set dirdiff(rightDir) [pwd]
- return [makeDirDiffWin]
- }
- if {$len == 1} {
- set fullname [lindex $files 0]
- if {[FileIsDirectory $fullname 1]} {
- set dirdiff(leftDir) $fullname
- set dirdiff(rightDir) $dirdiff(leftDir)
- return [makeDirDiffWin]
- }
- } elseif {$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]
- }
- }
-
- # Ok, we have a normal diff
- set top [makeDiffWin]
- update
- # Copy the previously collected options
- foreach {item val} [array get opts] {
- set ::diff($top,$item) $val
- }
-
- # 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 ::diff($top,modetype) $rev
- set ::diff($top,mode) "patch"
- set ::diff($top,patchFile) ""
- set ::diff($top,patchData) ""
- set ::diff($top,reviewFiles) $files
- set ::Pref(toolbar) 1
- after idle [list doDiff $top]
- return $top
- }
- if {$len == 1 || $foreach} {
- set ReturnAfterLoop 0
- set first 1
- foreach file $files {
- if {$first} {
- set first 0
- } else {
- # Create new window for other files
- set top [makeDiffWin]
- update
- # Copy the previously collected options
- foreach {item val} [array get opts] {
- set ::diff($top,$item) $val
- }
- # 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 {$::diff($top,mode) eq "conflict"} {
- startConflictDiff $top $fullname
- after idle [list doDiff $top]
- set ReturnAfterLoop 1
- continue
- }
- if {!$autobrowse && !$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 ::diff($top,leftDir) $fulldir
- set ::diff($top,leftFile) $fullname
- set ::diff($top,leftLabel) $fullname
- set ::diff($top,leftOK) 1
- if {$dopatch || \
- [regexp {\.(diff|patch)$} $fullname] || \
- $fullname eq "-"} {
- set ::diff($top,mode) "patch"
- set ::diff($top,patchFile) $fullname
- set ::diff($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} {
- set fullname [file join [pwd] [lindex $files 0]]
- set fulldir [file dirname $fullname]
- set ::diff($top,leftDir) $fulldir
- set ::diff($top,leftFile) $fullname
- set ::diff($top,leftLabel) $fullname
- set ::diff($top,leftOK) 1
- set fullname [file join [pwd] [lindex $files 1]]
- set fulldir [file dirname $fullname]
- set ::diff($top,rightDir) $fulldir
- set ::diff($top,rightFile) $fullname
- set ::diff($top,rightLabel) $fullname
- set ::diff($top,rightOK) 1
- if {$noautodiff} {
- enableRedo $top
- } else {
- after idle [list doDiff $top]
- }
- }
- if {$autobrowse && (!$::diff($top,leftOK) || !$::diff($top,rightOK))} {
- if {!$::diff($top,leftOK) && !$::diff($top,rightOK)} {
- openBoth $top 0
- } elseif {!$::diff($top,leftOK)} {
- openLeft $top
- } elseif {!$::diff($top,rightOK)} {
- openRight $top
- }
- # If we cancel the second file and detect CVS, ask about it.
- if {$::diff($top,leftOK) && !$::diff($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 $::diff($top,leftFile)
- set ::diff($top,leftOK) 0
- startRevMode $top "CVS" $fullname
- after idle [list doDiff $top]
- }
- }
- }
- return $top
-}
-
-# Save options to file ~/.eskilrc
-proc saveOptions {top} {
- global Pref
-
- # 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 apa [tk_messageBox -title "Save Preferences" -icon question \
- -type yesno -message "Should I save the current window\
- size with the preferences?\nCurrent: $neww x $newh Old:\
- $Pref(linewidth) x $Pref(lines)"]
- 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] {
- # Skip unchanged options.
- if {[info exists ::DefaultPref($i)]} {
- if {$::DefaultPref($i) eq $Pref($i)} {
- continue
- }
- }
- puts $ch [list set Pref($i) $Pref($i)]
- }
- close $ch
-
- tk_messageBox -icon info -title "Saved" -message \
- "Preferences saved to:\n[file nativename $rcfile]"
-}
-
-proc getOptions {} {
- global Pref
-
- set Pref(fontsize) 8
- # Maybe change to TkFixedFont in 8.5 ?
- set Pref(fontfamily) Courier
- set Pref(ignore) "-b"
- set Pref(nocase) 0
- set Pref(noempty) 0
- set Pref(nodigit) 0
- set Pref(parse) 2
- set Pref(lineparsewords) 0
- set Pref(colorequal) ""
- set Pref(colorchange) red
- set Pref(colornew1) darkgreen
- set Pref(colornew2) blue
- set Pref(bgequal) ""
- set Pref(bgchange) \#ffe0e0
- set Pref(bgnew1) \#a0ffa0
- set Pref(bgnew2) \#e0e0ff
- set Pref(context) -1
- set Pref(finegrainchunks) 0
- set Pref(marklast) 1
- set Pref(linewidth) 80
- set Pref(lines) 60
- set Pref(editor) ""
- set Pref(regsub) {}
- set Pref(toolbar) 0
- set Pref(wideMap) 0 ;# Not settable in GUI yet
-
- # Print options
- set Pref(printHeaderSize) 10
- set Pref(printCharsPerLine) 80
- set Pref(printPaper) a4
- set Pref(printColorChange) "1.0 0.7 0.7"
- set Pref(printColorNew1) "0.7 1.0 0.7"
- set Pref(printColorNew2) "0.8 0.8 1.0"
-
- # Directory diff options
- set Pref(dir,comparelevel) 1
- set Pref(dir,ignorekey) 0
- set Pref(dir,incfiles) ""
- set Pref(dir,exfiles) "*.o"
- set Pref(dir,incdirs) ""
- set Pref(dir,exdirs) "RCS CVS .git .svn .hg"
- set Pref(dir,onlyrev) 0
-
- # Store default preferences, to filter saved preferences
- array set ::DefaultPref [array get Pref]
-
- # Backward compatibilty option
- set Pref(onlydiffs) -1
-
- set ::diff(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(onlydiffs) == 0} {
- set Pref(context) -1
- }
- 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
- }
-}
ADDED src/fourway.tcl
Index: src/fourway.tcl
==================================================================
--- /dev/null
+++ src/fourway.tcl
@@ -0,0 +1,498 @@
+#----------------------------------------------------------------------
+# Eskil, Fourway diff section
+#
+# Copyright (c) 2018, Peter Spjuth (peter.spjuth@gmail.com)
+#
+# 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.
+#
+#----------------------------------------------------------------------
+# $Revision$
+#----------------------------------------------------------------------
+
+# Top level dialog, for doing fourway diff
+snit::widget FourWay {
+ hulltype toplevel
+ widgetclass Toplevel
+ # Static
+ variable fields
+ # Gui
+ variable filesGui
+ variable revsGui
+ # Working copy of Gui
+ variable files
+ variable revs
+ # Working variables
+ variable origfiles
+ variable origrevs
+ variable revtype
+ variable doingLine1
+ variable doingLine2
+
+ constructor {args} {
+ eskilRegisterToplevel $win
+
+ wm title $win "Four Way Diff"
+ wm protocol $win WM_DELETE_WINDOW "cleanupAndExit $win"
+ $hull configure -padx 3 -pady 3
+
+ menu $win.m
+ $hull configure -menu $win.m
+ $win.m add cascade -menu $win.m.mf -label "File" -underline 0
+ menu $win.m.mf
+ $win.m.mf add command -label "Close" -underline 0 \
+ -command [list cleanupAndExit $win]
+ $win.m.mf add separator
+ $win.m.mf add command -label "Quit" -underline 0 \
+ -command [list cleanupAndExit all]
+
+ $win.m add cascade -menu $win.m.mt -label "Tools" -underline 0
+ menu $win.m.mt
+ $win.m.mt add command -label "Changeset" -underline 0 \
+ -command [mymethod changeset]
+
+ if {$::eskil(debug) == 1} {
+ AddDebugMenu $win
+ }
+
+ # Four files, with optional revision
+ set fields {base1 change1 base2 change2}
+
+ ttk::label $win.l1 -text "Base 1"
+ ttk::label $win.l2 -text "Changed 1"
+ ttk::label $win.l3 -text "Base 2"
+ ttk::label $win.l4 -text "Changed 2"
+ set txt1 {
+ First diff is made from Base 1 to Changed 1.\n
+ If a file is empty and have a revision, the other file name is used.
+ }
+ addBalloon $win.l1 -fmt $txt1
+ addBalloon $win.l2 -fmt $txt1
+ set txt2 [string map {1 2 First Second} $txt1]
+ addBalloon $win.l3 -fmt $txt2
+ addBalloon $win.l4 -fmt $txt2
+
+ ttk::label $win.el -text "File path"
+ ttk::label $win.rl -text "Rev"
+ addBalloon $win.rl -fmt {
+ If you want to use a revisioned controlled file
+ instead of the one on disk, add a revision here.
+ E.g. 0 can be used for latest commited revision.
+ }
+
+ set n 0
+ foreach field $fields {
+ incr n
+ ttk::entryX $win.e$n -width 60 \
+ -textvariable [myvar filesGui($field)]
+ ttk::button $win.b$n -text "Browse" \
+ -command [mymethod browseFile $field]
+ ttk::entryX $win.r$n -width 8 \
+ -textvariable [myvar revsGui($field)]
+ }
+
+ ttk::button $win.bd -text "Diff" -command [mymethod doFourWayDiff] \
+ -underline 0 -width 8
+ bind $win [list $win.bd invoke]
+
+ grid x $win.el x $win.rl -sticky w -padx 3 -pady 3
+ grid $win.l1 $win.e1 $win.b1 $win.r1 -sticky we -padx 3 -pady 3
+ grid $win.l2 $win.e2 $win.b2 $win.r2 -sticky we -padx 3 -pady 3
+ grid $win.l3 $win.e3 $win.b3 $win.r3 -sticky we -padx 3 -pady {10 3}
+ grid $win.l4 $win.e4 $win.b4 $win.r4 -sticky we -padx 3 -pady 3
+ grid $win.bd - - -padx 3 -pady {10 3}
+
+ grid columnconfigure $win $win.el -weight 1
+
+ # Set up file dropping in entry windows if TkDnd is available
+ if {![catch {package require tkdnd}]} {
+ dnd bindtarget $win text/uri-list "[mymethod fileDrop any ] %D"
+ dnd bindtarget $win.e1 text/uri-list "[mymethod fileDrop base1 ] %D"
+ dnd bindtarget $win.e2 text/uri-list "[mymethod fileDrop change1] %D"
+ dnd bindtarget $win.e3 text/uri-list "[mymethod fileDrop base2 ] %D"
+ dnd bindtarget $win.e4 text/uri-list "[mymethod fileDrop change2] %D"
+ }
+ }
+
+ # File drop using TkDnd
+ method fileDrop {field filesDropped} {
+ if {$field eq "any"} {
+ # Dropped outside the entry widgets. Try to be clever.
+ set todo {}
+ # Drop in empty fields first
+ foreach field $fields {
+ if {$filesGui($field) eq ""} {
+ lappend todo $field
+ }
+ }
+ # Fill fields otherwise
+ if {[llength $todo] == 0} {
+ set todo $fields
+ }
+ } else {
+ set todo [list $field]
+ }
+ foreach fn $filesDropped field $todo {
+ # Loop until any list ends
+ if {$fn eq "" || $field eq ""} break
+ # Sanity check
+ if {[file exists $fn]} {
+ set filesGui($field) $fn
+ }
+ }
+ }
+
+ # Browse for file
+ method browseFile {field} {
+ set initDir [pwd]
+ if {$filesGui($field) ne ""} {
+ set initDir [file dirname $filesGui($field)]
+ } else {
+ # Pick default dir from other files
+ foreach other [lreverse $fields] {
+ if {$other eq $field} continue
+ puts $other
+ if {$filesGui($other) ne ""} {
+ set initDir [file dirname $filesGui($other)]
+ puts $initDir
+ break
+ }
+ }
+ }
+ set apa [myOpenFile -title "Select file" -initialdir $initDir \
+ -parent $win]
+ if {$apa != ""} {
+ set filesGui($field) $apa
+ }
+ }
+
+ # Fill in working copies of variables
+ method PrepareFw {} {
+ $self PrepareFw1
+ $self PrepareFw2
+ }
+ method PrepareFw1 {} {
+ # Copy to work vars to be able to replace with defaults and parsed
+ foreach field $fields {
+ set files($field) $filesGui($field)
+ set revs($field) [string trim $revsGui($field)]
+ }
+ # Fill in defaults, if only one file is given
+ foreach {from to} $fields {
+ if {$files($to) eq ""} {
+ set files($to) $filesGui($from)
+ }
+ if {$files($from) eq ""} {
+ set files($from) $filesGui($to)
+ }
+ }
+ }
+ method PrepareFw2 {} {
+ # Remember originals for display, they might be replaced below
+ foreach field $fields {
+ set origfiles($field) $files($field)
+ set origrevs($field) $revs($field)
+ }
+ # Figure out any revisions
+ foreach field $fields {
+ set revtype($field) ""
+ # TODO: Move this to helper function in rev.tcl ?
+ if {$revs($field) ne ""} {
+ set revtype($field) [detectRevSystem $files($field)]
+ if {$revtype($field) eq ""} {
+ tk_messageBox -icon error -title "Eskil Error" \
+ -parent $win -message \
+ "Could not detect version system for file $files($field)"
+ return -level 2
+ # TBD continue
+ set revs($field) ""
+ continue
+ }
+ set revList [list $revs($field)]
+ set revList [eskil::rev::$revtype($field)::ParseRevs \
+ $files($field) $revList]
+ if {[llength $revList] == 0} {
+ tk_messageBox -icon error -title "Eskil Error" \
+ -parent $win -message \
+ "Could not parse revision for file $files($field)"
+ return -level 2
+ # TBD continue
+ set revs($field) ""
+ } else {
+ set revs($field) [lindex $revList 0]
+ }
+ }
+ }
+ }
+
+ method doFourWayDiff {{skipPrepare 0}} {
+ if {!$skipPrepare} {
+ $self PrepareFw
+ }
+ # Extract revisions
+ foreach field $fields {
+ if {$revs($field) ne ""} {
+ # Replace with checkout copy
+ set files($field) [tmpFile]
+ eskil::rev::$revtype($field)::get $origfiles($field) \
+ $files($field) $revs($field)
+ }
+ }
+
+ # Do compare of files, to generate patches
+ foreach side {1 2} {
+ set header ""
+ foreach str {From To} field "base$side change$side" {
+ set line "$str $origfiles($field)"
+ if {$revs($field) ne ""} {
+ append line " Revision $revs($field)"
+ if {$origrevs($field) ne $revs($field)} {
+ append line " ($origrevs($field))"
+ }
+ }
+ append header $line\n
+ }
+
+ set outfile($side) [tmpFile]
+ $self GenPatch $header $files(base$side) $files(change$side) \
+ $outfile($side)
+ }
+
+ # Now run a diff window with the patch files
+ set top [newDiff $outfile(1) $outfile(2)]
+ }
+
+ # Get the full change in other files corresponding to the ones listed
+ method changeset {} {
+ $self PrepareFw
+ #catch {console show}
+ foreach side {1 2} {
+ set dir [file dirname $origfiles(base$side)]
+ set revL {}
+ set type ""
+ if {$revs(base$side) ne ""} {
+ lappend revL $revs(base$side)
+ set type $revtype(base$side)
+ }
+ if {$revs(change$side) ne ""} {
+ lappend revL $revs(change$side)
+ set type $revtype(change$side)
+ }
+ if {$type eq ""} {
+ # TBD error?
+ set changes($side) {}
+ } else {
+ #puts "Getting change list in $dir for $revL"
+ set changes($side) [eskil::rev::${type}::getChangedFiles \
+ $dir $revL]
+ set changes($side) [lsort -dictionary $changes($side)]
+ #puts [join $changes($side) \n]
+ }
+ }
+ # Look for matching files in the two sets.
+ set matching(1) {}
+ set matching(2) {}
+ # Gather tail data
+ foreach side {1 2} {
+ foreach f $changes($side) {
+ set tail [file tail $f]
+ lappend file($side,$tail) $f
+ lappend file($side,nc,[string tolower $tail]) $f
+ }
+ }
+ # 1. Unique case-insensitive match in tails
+ foreach f1 $changes(1) {
+ set tail [string tolower [file tail $f1]]
+ if {[llength $file(1,nc,$tail)] == 1} {
+ if {[info exists file(2,nc,$tail)]} {
+ if {[llength $file(2,nc,$tail)] == 1} {
+ set f2 [lindex $file(2,nc,$tail) 0]
+ lappend matching(1) $f1
+ lappend matching(2) $f2
+ set done($f1) 1
+ set done($f2) 1
+ }
+ }
+ }
+ }
+ # 2. Unique case-sensitive match in tails
+ foreach f1 $changes(1) {
+ if {[info exists done($f1)]} continue
+ set tail [file tail $f1]
+ if {[llength $file(1,$tail)] == 1} {
+ if {[info exists file(2,$tail)]} {
+ if {[llength $file(2,$tail)] == 1} {
+ set f2 [lindex $file(2,$tail) 0]
+ if {[info exists done($f2)]} continue
+ lappend matching(1) $f1
+ lappend matching(2) $f2
+ set done($f1) 1
+ set done($f2) 1
+ }
+ }
+ }
+ }
+ # Rest in order
+ foreach side {1 2} {
+ set rest($side) {}
+ foreach f $changes($side) {
+ if {[info exists done($f)]} continue
+ lappend rest($side) $f
+ }
+ lappend matching($side) {*}$rest($side)
+ }
+
+ set [myvar csList1] $matching(1)
+ set [myvar csList2] $matching(2)
+
+ #destroy $win.csf
+ if {![winfo exists $win.csf]} {
+ ttk::labelframe $win.csf -text "Change Set" -padding 3
+ grid $win.csf -columnspan 4 -sticky news -padx 3 -pady 3
+ grid rowconfigure $win $win.csf -weight 1
+
+ listbox $win.csf.lb1 -height 20 -listvariable [myvar csList1] \
+ -exportselection 0
+ bind $win.csf.lb1 <> [mymethod csNewSelect]
+ listbox $win.csf.lb2 -height 20 -listvariable [myvar csList2] \
+ -exportselection 0
+ ttk::button $win.csf.bd -text "Diff" -width 8 \
+ -command [mymethod doChangesetDiff]
+ grid $win.csf.lb1 $win.csf.lb2 -sticky news -padx 3 -pady 3
+ grid $win.csf.bd - -padx 3 -pady 3
+ grid rowconfigure $win.csf 0 -weight 1
+ grid columnconfigure $win.csf all -weight 1 -uniform a
+ }
+ }
+ method csNewSelect {} {
+ set s1 [$win.csf.lb1 curselection]
+ if {[llength $s1] != 1} return
+ $win.csf.lb2 selection clear 0 end
+ $win.csf.lb2 selection set $s1
+
+ }
+
+ method doChangesetDiff {} {
+ variable csList1
+ variable csList2
+ set s1 [$win.csf.lb1 curselection]
+ set s2 [$win.csf.lb2 curselection]
+ if {[llength $s1] != 1} return
+ if {[llength $s2] != 1} return
+ set f(1) [lindex $csList1 $s1]
+ set f(2) [lindex $csList2 $s2]
+ puts "$f(1) vs $f(2)"
+
+ $self PrepareFw1
+ foreach side {1 2} {
+ set files(base$side) $f($side)
+ set files(change$side) $f($side)
+ }
+ $self PrepareFw2
+ $self doFourWayDiff 1
+ }
+
+ method GenPatch {header file1 file2 outfile} {
+ # Handle at least base options
+ set opts $::Pref(ignore)
+ if {$::Pref(nocase)} {lappend opts -nocase}
+ if {$::Pref(noempty)} {lappend opts -noempty}
+ if {$::Pref(pivot) > 0} {lappend opts -pivot $::Pref(pivot)}
+
+ set differr [catch {DiffUtil::diffFiles {*}$opts \
+ $file1 $file2} diffres]
+ set ch [open $outfile w]
+ if {$differr != 0} {
+ # TODO error
+ puts $ch $diffres
+ close $ch
+ return
+ }
+ puts $ch [string trim $header]
+ puts $ch [string repeat "-" 78]
+
+ set doingLine1 1
+ set doingLine2 1
+ set ch1 [open $file1]
+ set ch2 [open $file2]
+ foreach i $diffres {
+ lassign $i line1 n1 line2 n2
+ $self DoText $ch $ch1 $ch2 $n1 $n2 $line1 $line2
+ }
+ $self DoText $ch $ch1 $ch2 0 0 0 0
+ close $ch1
+ close $ch2
+ close $ch
+ }
+
+ # See dotext in eskil.tcl for more info since this is similar
+ method DoText {ch ch1 ch2 n1 n2 line1 line2} {
+ if {$n1 == 0 && $n2 == 0} {
+ # All blocks have been processed. Continue until end of file.
+ # TBD context
+ return
+ }
+ set limit 3
+ if {($line1 - $doingLine1 < (2 * $limit + 2))} {
+ set limit -1
+ }
+
+ # Fill in context before change block
+
+ if {$doingLine1 == 1} {
+ set allowStartFill 0
+ } else {
+ set allowStartFill 1
+ }
+ set t 0
+ while {$doingLine1 < $line1} {
+ gets $ch1 apa
+ gets $ch2 bepa
+ if {$limit < 0 || ($t < $limit && $allowStartFill) || \
+ ($line1 - $doingLine1) <= $limit} {
+ # Both sides are supposed to be equal, use one of them
+ puts $ch " $apa"
+ } elseif {$t == $limit && $allowStartFill} {
+ # TBD empty instead?
+ puts $ch [string repeat "-" 78]
+ }
+ incr doingLine1
+ incr doingLine2
+ incr t
+ }
+
+ # Output diff
+ for {set t 0} {$t < $n1} {incr t} {
+ gets $ch1 apa
+ puts $ch "- $apa"
+ incr doingLine1
+ }
+ for {set t 0} {$t < $n2} {incr t} {
+ gets $ch2 apa
+ puts $ch "+ $apa"
+ incr doingLine2
+ }
+ }
+}
+
+proc makeFourWayWin {} {
+ set t 1
+ set top .fourway$t
+ while {[winfo exists $top]} {
+ incr t
+ set top .fourway$t
+ }
+ FourWay $top
+}
Index: src/help.tcl
==================================================================
--- src/help.tcl
+++ src/help.tcl
@@ -20,41 +20,10 @@
#
#----------------------------------------------------------------------
# $Revision$
#----------------------------------------------------------------------
-# Silly experiment...
-proc makeNuisance {top {str {Hi there!}}} {
- if {[lsearch [image names] nuisance] < 0} {
- set file [file join $::eskil(thisDir) .. Nuisance.gif]
- if {![file exists $file]} return
- image create photo nuisance -file $file
- }
-
- destroy $top.nui
- toplevel $top.nui
- wm transient $top.nui $top
- wm geometry $top.nui +400+400
- wm title $top.nui ""
- ttk::label $top.nui.l -image nuisance
- pack $top.nui.l
- wm protocol $top.nui WM_DELETE_WINDOW [list destroy $top.nui2 $top.nui]
- update
-
- destroy $top.nui2
- toplevel $top.nui2 -background yellow
- wm transient $top.nui2 $top.nui
- wm overrideredirect $top.nui2 1
- wm title $top.nui2 ""
- ttk::label $top.nui2.l -text "$str\nDo you want help?" -justify left \
- -background yellow
- button $top.nui2.b -text "No, get out of my face!" \
- -command [list destroy $top.nui2 $top.nui] -background yellow
- pack $top.nui2.l $top.nui2.b -side "top" -fill x
- wm geometry $top.nui2 +[expr {405 + [winfo width $top.nui]}]+400
-}
-
# A simple window for displaying e.g. help.
# Returns the frame where things can be put.
proc helpWin {w title} {
destroy $w
@@ -81,17 +50,44 @@
$w.t insert end "A graphical frontend to diff\n\n"
$w.t insert end "$::eskil(diffver)\n\n"
$w.t insert end "Made by Peter Spjuth\n"
$w.t insert end "E-Mail: peter.spjuth@gmail.com\n"
- $w.t insert end "\nURL: http://eskil.berlios.de\n"
+ $w.t insert end "\nURL: http://eskil.tcl.tk\n"
$w.t insert end "\nTcl version: [info patchlevel]\n"
set du $::DiffUtil::version
append du " ($::DiffUtil::implementation)"
-
$w.t insert end "DiffUtil version: $du\n"
+
+ # Provide debug info to help when DiffUtil does not load.
+ if {[info exists ::DiffUtil::DebugLibFile]} {
+ set lf $::DiffUtil::DebugLibFile
+ set exist [file exists $lf]
+ set lf [file join {*}[lrange [file split $lf] end-1 end]]
+ if {$exist} {
+ $w.t insert end " DiffUtil debug: Could not load\n"
+ $w.t insert end " $lf\n"
+ } else {
+ $w.t insert end " DiffUtil debug: Could not find\n"
+ $w.t insert end " $lf\n"
+ }
+ }
+
+ if {[catch {package require pdf4tcl} pdf4tclVer]} { set pdf4tclVer None }
+ $w.t insert end "Pdf4Tcl version: $pdf4tclVer\n"
+ if {[catch {package require snit} snitVer]} { set snitVer None }
+ $w.t insert end "Snit version: $snitVer\n"
+ if {[catch {package require vfs} vfsVer]} { set vfsVer None }
+ $w.t insert end "Vfs version: $vfsVer\n"
+ if {[catch {package require wcb} wcbVer]} { set wcbVer None }
+ $w.t insert end "Wcb version: $wcbVer\n"
+ if {[catch {package require tablelist_tile} tblVer]} { set tblVer None }
+ $w.t insert end "Tablelist version: $tblVer\n"
+ if {[catch {package require tkdnd} tkdndVer]} { set tkdndVer None }
+ $w.t insert end "TkDnd version: $tkdndVer\n"
+
$w.t insert end "\nCredits:\n"
$w.t insert end "Ideas for scrollbar map and merge function\n"
$w.t insert end "taken from TkDiff"
set last [lindex [split [$w.t index end] "."] 0]
@@ -127,12 +123,10 @@
}
}
}
proc makeHelpWin {} {
- global Pref
-
set doc [file join $::eskil(thisDir) .. doc/eskil.txt]
if {![file exists $doc]} return
set w [helpWin .he "Eskil Help"]
set t [Scroll y text $w.t -width 85 -height 35]
@@ -139,16 +133,16 @@
pack $w.t -side top -expand 1 -fill both
configureDocWin $t
# Set up tags for change marks
- $t tag configure new1 -foreground $Pref(colornew1) \
- -background $Pref(bgnew1)
- $t tag configure new2 -foreground $Pref(colornew2) \
- -background $Pref(bgnew2)
- $t tag configure change -foreground $Pref(colorchange) \
- -background $Pref(bgchange)
+ $t tag configure new1 -foreground $::Pref(colornew1) \
+ -background $::Pref(bgnew1)
+ $t tag configure new2 -foreground $::Pref(colornew2) \
+ -background $::Pref(bgnew2)
+ $t tag configure change -foreground $::Pref(colorchange) \
+ -background $::Pref(bgchange)
$t tag configure ul -underline 1
set width [font measure [$t cget -font] [string repeat x 20]]
$t configure -tabs [list $width [expr {$width * 3/2}] [expr {$width * 2}]]
@@ -205,32 +199,29 @@
#focus $t
$t configure -state disabled
}
proc makeTutorialWin {} {
- global Pref
-
set doc [file join $::eskil(thisDir) .. doc/tutorial.txt]
if {![file exists $doc]} return
if {[catch {cd [file join $::eskil(thisDir) .. examples]}]} {
tk_messageBox -icon error -title "Eskil Error" -message \
"Could not locate examples directory." \
-type ok
return
}
- #set ::diff(tutorial) 1
# Start up a dirdiff in the examples directory
set ::dirdiff(leftDir) [file join [pwd] dir1]
set ::dirdiff(rightDir) [file join [pwd] dir2]
makeDirDiffWin
set w [helpWin .ht "Eskil Tutorial"]
text $w.t -width 82 -height 35 -yscrollcommand "$w.sb set"
- scrollbar $w.sb -orient vert -command "$w.t yview"
+ ttk::scrollbar $w.sb -orient vert -command "$w.t yview"
pack $w.sb -side right -fill y
pack $w.t -side left -expand 1 -fill both
configureDocWin $w.t
Index: src/map.tcl
==================================================================
--- src/map.tcl
+++ src/map.tcl
@@ -20,21 +20,19 @@
#
#----------------------------------------------------------------------
# $Revision$
#----------------------------------------------------------------------
-proc createMap {top} {
- global Pref
-
+proc createMap {top bg} {
set w $top.c_map
- if {$Pref(wideMap)} {
+ if {$::Pref(wideMap)} {
set width 20
} else {
set width 6
}
canvas $w -width $width -borderwidth 0 -selectborderwidth 0 \
- -highlightthickness 0 -height 10
+ -highlightthickness 0 -height 10 -background $bg
set map [image create photo map$top]
$w create image 0 0 -anchor nw -image $map
bind $w [list image delete $map]
bind $w [list drawMap $top %h]
@@ -42,62 +40,99 @@
return $w
}
proc clearMap {top} {
- set ::diff($top,changes) {}
- set ::diff($top,mapMax) 0
+ set ::eskil($top,changes) {}
+ set ::eskil($top,mapMax) 0
+ set ::eskil($top,mapNoChange) 0
drawMap $top -1
}
+
+# Temporarily ignore changes added by addChange.
+proc mapNoChange {top value} {
+ set ::eskil($top,mapNoChange) $value
+}
proc addChange {top n tag line1 n1 line2 n2} {
- if {$tag ne ""} {
- lappend ::diff($top,changes) [list $::diff($top,mapMax) $n \
+ if {$tag ne "" && $::eskil($top,mapNoChange) == 0} {
+ lappend ::eskil($top,changes) [list $::eskil($top,mapMax) $n \
$tag $line1 $n1 $line2 $n2]
}
- incr ::diff($top,mapMax) $n
+ incr ::eskil($top,mapMax) $n
}
proc addMapLines {top n} {
- incr ::diff($top,mapMax) $n
+ incr ::eskil($top,mapMax) $n
+}
+
+# Use the assembled information for the map to draw edit buttons
+proc drawEditButtons {top} {
+ $::widgets($top,wTb) delete 1.0 end
+ set l 0
+ foreach change $::eskil($top,changes) {
+ lassign $change start length type line1 n1 line2 n2
+ set pre [expr {($length - 1) / 2}]
+ while {$l < ($start + $pre)} {
+ incr l
+ $::widgets($top,wTb) insert end \n
+ }
+ incr l
+ $::widgets($top,wTb) image create end -image $::img(left) \
+ -pady -2 -padx 1 -name li$l
+ $::widgets($top,wTb) image create end -image $::img(right) \
+ -pady -2 -name ri$l
+ $::widgets($top,wTb) tag add lt$l li$l
+ $::widgets($top,wTb) tag add rt$l ri$l
+ # Make visible for now
+ $::widgets($top,wTb) tag configure lt$l -background pink
+ $::widgets($top,wTb) tag configure rt$l -background lightgreen
+ $::widgets($top,wTb) insert end \n
+ while {$l < ($start+ $length)} {
+ incr l
+ $::widgets($top,wTb) insert end \n
+ }
+ }
+ while {$l < $::eskil($top,mapMax)} {
+ incr l
+ $::widgets($top,wTb) insert end \n
+ }
}
proc drawMap {top newh} {
- global Pref
-
set oldh [map$top cget -height]
if {$oldh == $newh} return
map$top blank
- if {![info exists ::diff($top,changes)] || \
- [llength $::diff($top,changes)] == 0} return
+ if {![info exists ::eskil($top,changes)] || \
+ [llength $::eskil($top,changes)] == 0} return
set w [winfo width $top.c_map]
set h [winfo height $top.c_map]
- set x2 [expr {$w - ($Pref(wideMap) ? 5 : 1)}]
+ set x2 [expr {$w - ($::Pref(wideMap) ? 5 : 1)}]
if {$x2 < 0} { set x2 0 }
map$top configure -width $w -height $h
incr h -1
set y0 0
- foreach change $::diff($top,changes) {
+ foreach change $::eskil($top,changes) {
lassign $change start length type
- set y1 [expr {$start * $h / $::diff($top,mapMax) + 1}]
+ set y1 [expr {$start * $h / $::eskil($top,mapMax) + 1}]
if {!$y0} { set y0 $y1 } ;# Record first occurance
if {$y1 < 1} {set y1 1}
if {$y1 > $h} {set y1 $h}
- set y2 [expr {($start + $length) * $h / $::diff($top,mapMax) + 1}]
+ set y2 [expr {($start + $length) * $h / $::eskil($top,mapMax) + 1}]
if {$y2 < 1} {set y2 1}
if {$y2 <= $y1} {set y2 [expr {$y1 + 1}]}
if {$y2 > $h} {set y2 $h}
incr y2
- map$top put $Pref(color$type) -to 1 $y1 $x2 $y2
+ map$top put $::Pref(color$type) -to 1 $y1 $x2 $y2
}
- if {$Pref(wideMap)} {
+ if {$::Pref(wideMap)} {
map$top put black -to $x2 $y0 $w $y2
}
}
# Allow button 2 on map to jump to a position
proc ThumbMap {top y} {
incr y 15
::tk::ScrollButton2Down $top.sby 0 $y
}
Index: src/merge.tcl
==================================================================
--- src/merge.tcl
+++ src/merge.tcl
@@ -20,28 +20,28 @@
#
#----------------------------------------------------------------------
# Get all data from the files to merge
proc collectMergeData {top} {
- global diff
-
- set diff($top,leftMergeData) {}
- set diff($top,rightMergeData) {}
- set diff($top,mergeSelection,AnyConflict) 0
-
- if {![info exists ::diff($top,changes)]} {
- set ::diff($top,changes) {}
+ global eskil
+
+ set eskil($top,leftMergeData) {}
+ set eskil($top,rightMergeData) {}
+ set eskil($top,mergeSelection,AnyConflict) 0
+
+ if {![info exists eskil($top,changes)]} {
+ set eskil($top,changes) {}
}
prepareFiles $top
- set ch1 [open $::diff($top,leftFile) r]
- set ch2 [open $::diff($top,rightFile) r]
+ set ch1 [open $eskil($top,leftFile) r]
+ set ch2 [open $eskil($top,rightFile) r]
set doingLine1 1
set doingLine2 1
set changeNo 0
- foreach change $::diff($top,changes) {
+ foreach change $eskil($top,changes) {
lassign $change start length type line1 n1 line2 n2
set data1 {}
set data2 {}
while {$doingLine1 < $line1} {
gets $ch1 apa
@@ -51,12 +51,12 @@
while {$doingLine2 < $line2} {
gets $ch2 apa
append data2 $apa\n
incr doingLine2
}
- lappend diff($top,leftMergeData) $data1
- lappend diff($top,rightMergeData) $data2
+ lappend eskil($top,leftMergeData) $data1
+ lappend eskil($top,rightMergeData) $data2
set data1 {}
set data2 {}
for {set t 0} {$t < $n1} {incr t} {
gets $ch1 apa
@@ -66,18 +66,21 @@
for {set t 0} {$t < $n2} {incr t} {
gets $ch2 apa
append data2 $apa\n
incr doingLine2
}
- lappend diff($top,leftMergeData) $data1
- lappend diff($top,rightMergeData) $data2
- set diff($top,mergeSelection,$changeNo) \
- [WhichSide $top $line1 $n1 $line2 $n2 conflict comment]
- set diff($top,mergeSelection,Conflict,$changeNo) $conflict
- set diff($top,mergeSelection,Comment,$changeNo) $comment
+ lappend eskil($top,leftMergeData) $data1
+ lappend eskil($top,rightMergeData) $data2
+ set eskil($top,mergeSelection,$changeNo) \
+ [WhichSide $top $line1 $n1 $line2 $n2 conflict comment ancLines]
+ set eskil($top,mergeSelection,Conflict,$changeNo) $conflict
+ set eskil($top,mergeSelection,Comment,$changeNo) $comment
+ set ancLines [lsort -dictionary -unique $ancLines]
+ set eskil($top,mergeSelection,AncLines,$changeNo) \
+ "Lines from ancestor file:\n[join $ancLines \n]"
if {$conflict} {
- set diff($top,mergeSelection,AnyConflict) 1
+ set eskil($top,mergeSelection,AnyConflict) 1
}
incr changeNo
}
set data1 {}
set data2 {}
@@ -87,43 +90,43 @@
}
while {[gets $ch2 apa] != -1} {
append data2 $apa\n
incr doingLine2
}
- lappend diff($top,leftMergeData) $data1
- lappend diff($top,rightMergeData) $data2
+ lappend eskil($top,leftMergeData) $data1
+ lappend eskil($top,rightMergeData) $data2
close $ch1
close $ch2
cleanupFiles $top
}
# Fill up the merge window with the initial version of merged files.
proc fillMergeWindow {top} {
- global diff
+ global eskil
set w $top.merge.t
$w delete 1.0 end
set marks {}
set t 0
set firstConflict -1
- foreach {commLeft diffLeft} $diff($top,leftMergeData) \
- {commRight diffRight} $diff($top,rightMergeData) {
+ foreach {commLeft diffLeft} $eskil($top,leftMergeData) \
+ {commRight diffRight} $eskil($top,rightMergeData) {
$w insert end $commRight
- if {![info exists diff($top,mergeSelection,$t)]} continue
+ if {![info exists eskil($top,mergeSelection,$t)]} continue
$w mark set merges$t insert
$w mark gravity merges$t left
- switch $diff($top,mergeSelection,$t) {
+ switch $eskil($top,mergeSelection,$t) {
1 { $w insert end $diffLeft merge$t }
2 { $w insert end $diffRight merge$t }
12 { $w insert end $diffLeft merge$t
$w insert end $diffRight merge$t }
21 { $w insert end $diffRight merge$t
$w insert end $diffLeft merge$t }
}
- if {$diff($top,mergeSelection,Conflict,$t)} {
+ if {$eskil($top,mergeSelection,Conflict,$t)} {
$w tag configure merge$t -background grey
if {$firstConflict == -1} {
set firstConflict $t
}
}
@@ -142,99 +145,104 @@
set showFirst 0
if {$firstConflict != -1} {
set showFirst $firstConflict
}
- set diff($top,curMerge) $showFirst
- set diff($top,curMergeSel) $diff($top,mergeSelection,$showFirst)
+ set eskil($top,curMerge) $showFirst
+ set eskil($top,curMergeSel) $eskil($top,mergeSelection,$showFirst)
$w tag configure merge$showFirst -foreground red
showDiff $top $showFirst
update
# If there is any diff, show the first
if {$t > 0} {
seeText $w merges$showFirst mergee$showFirst
# Show status for first chunk
- set diff($top,mergeStatus) \
- $diff($top,mergeSelection,Comment,$showFirst)
- }
-}
-
-# Move to and highlight another diff.
-proc nextMerge {top delta} {
- global diff
-
- set w $top.merge.t
- $w tag configure merge$diff($top,curMerge) -foreground ""
-
- set last [expr {[llength $diff($top,leftMergeData)] / 2 - 1}]
-
- if {$delta == -1000} {
- # Search backward for conflict
- for {set t [expr {$diff($top,curMerge) - 1}]} {$t >= 0} {incr t -1} {
- if {$diff($top,mergeSelection,Conflict,$t)} {
- set delta [expr {$t - $diff($top,curMerge)}]
- break
- }
- }
- } elseif {$delta == 1000} {
- # Search forward for conflict
- for {set t [expr {$diff($top,curMerge) + 1}]} {$t <= $last} {incr t} {
- if {$diff($top,mergeSelection,Conflict,$t)} {
- set delta [expr {$t - $diff($top,curMerge)}]
- break
- }
- }
- }
-
- set diff($top,curMerge) [expr {$diff($top,curMerge) + $delta}]
- if {$diff($top,curMerge) < 0} {set diff($top,curMerge) 0}
- if {$diff($top,curMerge) > $last} {
- set diff($top,curMerge) $last
- }
- set diff($top,curMergeSel) $diff($top,mergeSelection,$diff($top,curMerge))
- $w tag configure merge$diff($top,curMerge) -foreground red
- showDiff $top $diff($top,curMerge)
- seeText $w merges$diff($top,curMerge) mergee$diff($top,curMerge)
-
- set diff($top,mergeStatus) \
- $diff($top,mergeSelection,Comment,$diff($top,curMerge))
-}
-
-# Select a merge setting for all diffs.
-proc selectMergeAll {top new} {
- global diff
- set end [expr {[llength $diff($top,leftMergeData)] / 2}]
- for {set t 0} {$t < $end} {incr t} {
- selectMerge2 $top $t $new
- }
- set diff($top,curMergeSel) $new
- set w $top.merge.t
- seeText $w merges$diff($top,curMerge) mergee$diff($top,curMerge)
-}
-
-# Change merge setting fo current diff.
-proc selectMerge {top} {
- global diff
-
- set w $top.merge.t
- selectMerge2 $top $diff($top,curMerge) $diff($top,curMergeSel)
- seeText $w merges$diff($top,curMerge) mergee$diff($top,curMerge)
-}
-
-# Change merge setting for a diff.
-proc selectMerge2 {top no new} {
- global diff
-
- set w $top.merge.t
- # Delete current string
- $w delete merges$no mergee$no
-
- set diff($top,mergeSelection,$no) $new
-
- set i [expr {$no * 2 + 1}]
- set diffLeft [lindex $diff($top,leftMergeData) $i]
- set diffRight [lindex $diff($top,rightMergeData) $i]
+ set eskil($top,mergeStatus) \
+ $eskil($top,mergeSelection,Comment,$showFirst)
+ set eskil($top,mergeAncLines) \
+ $eskil($top,mergeSelection,AncLines,$showFirst)
+ }
+}
+
+# Move to and highlight another diff.
+proc nextMerge {top delta} {
+ global eskil
+
+ set w $top.merge.t
+ $w tag configure merge$eskil($top,curMerge) -foreground ""
+
+ set last [expr {[llength $eskil($top,leftMergeData)] / 2 - 1}]
+
+ if {$delta == -1000} {
+ # Search backward for conflict
+ for {set t [expr {$eskil($top,curMerge) - 1}]} {$t >= 0} {incr t -1} {
+ if {$eskil($top,mergeSelection,Conflict,$t)} {
+ set delta [expr {$t - $eskil($top,curMerge)}]
+ break
+ }
+ }
+ } elseif {$delta == 1000} {
+ # Search forward for conflict
+ for {set t [expr {$eskil($top,curMerge) + 1}]} {$t <= $last} {incr t} {
+ if {$eskil($top,mergeSelection,Conflict,$t)} {
+ set delta [expr {$t - $eskil($top,curMerge)}]
+ break
+ }
+ }
+ }
+
+ set eskil($top,curMerge) [expr {$eskil($top,curMerge) + $delta}]
+ if {$eskil($top,curMerge) < 0} {set eskil($top,curMerge) 0}
+ if {$eskil($top,curMerge) > $last} {
+ set eskil($top,curMerge) $last
+ }
+ set eskil($top,curMergeSel) $eskil($top,mergeSelection,$eskil($top,curMerge))
+ $w tag configure merge$eskil($top,curMerge) -foreground red
+ showDiff $top $eskil($top,curMerge)
+ seeText $w merges$eskil($top,curMerge) mergee$eskil($top,curMerge)
+
+ set eskil($top,mergeStatus) \
+ $eskil($top,mergeSelection,Comment,$eskil($top,curMerge))
+ set eskil($top,mergeAncLines) \
+ $eskil($top,mergeSelection,AncLines,$eskil($top,curMerge))
+}
+
+# Select a merge setting for all diffs.
+proc selectMergeAll {top new} {
+ global eskil
+
+ set end [expr {[llength $eskil($top,leftMergeData)] / 2}]
+ for {set t 0} {$t < $end} {incr t} {
+ selectMerge2 $top $t $new
+ }
+ set eskil($top,curMergeSel) $new
+ set w $top.merge.t
+ seeText $w merges$eskil($top,curMerge) mergee$eskil($top,curMerge)
+}
+
+# Change merge setting fo current diff.
+proc selectMerge {top} {
+ global eskil
+
+ set w $top.merge.t
+ selectMerge2 $top $eskil($top,curMerge) $eskil($top,curMergeSel)
+ seeText $w merges$eskil($top,curMerge) mergee$eskil($top,curMerge)
+}
+
+# Change merge setting for a diff.
+proc selectMerge2 {top no new} {
+ global eskil
+
+ set w $top.merge.t
+ # Delete current string
+ $w delete merges$no mergee$no
+
+ set eskil($top,mergeSelection,$no) $new
+
+ set i [expr {$no * 2 + 1}]
+ set diffLeft [lindex $eskil($top,leftMergeData) $i]
+ set diffRight [lindex $eskil($top,rightMergeData) $i]
# Temporarily switch surrounding marks
# Two steps are enough since there can't be consecutive empty areas
# The one before and/or the one after the one being switch might
# be empty.
@@ -241,17 +249,17 @@
$w mark gravity mergee[expr {$no - 2}] left
$w mark gravity mergee[expr {$no - 1}] left
$w mark gravity merges[expr {$no + 1}] right
$w mark gravity merges[expr {$no + 2}] right
- if {$diff($top,mergeSelection,$no) == 12} {
+ if {$eskil($top,mergeSelection,$no) == 12} {
$w insert merges$no $diffLeft$diffRight merge$no
- } elseif {$diff($top,mergeSelection,$no) == 21} {
+ } elseif {$eskil($top,mergeSelection,$no) == 21} {
$w insert merges$no $diffRight$diffLeft merge$no
- } elseif {$diff($top,mergeSelection,$no) == 1} {
+ } elseif {$eskil($top,mergeSelection,$no) == 1} {
$w insert merges$no $diffLeft merge$no
- } elseif {$diff($top,mergeSelection,$no) == 2} {
+ } elseif {$eskil($top,mergeSelection,$no) == 2} {
$w insert merges$no $diffRight merge$no
}
# Switch back surrounding marks
$w mark gravity mergee[expr {$no - 2}] right
$w mark gravity mergee[expr {$no - 1}] right
@@ -261,113 +269,113 @@
# Save the merge result.
proc saveMerge {top} {
set w $top.merge.t
- if {$::diff($top,mergeFile) eq "" && $::diff($top,mode) eq "conflict"} {
+ if {$::eskil($top,mergeFile) eq "" && $::eskil($top,mode) eq "conflict"} {
set apa [tk_messageBox -parent $top.merge -icon question \
-title "Save merge file" -type yesno -message \
"Do you want to overwrite the original conflict file?"]
if {$apa == "yes"} {
- set ::diff($top,mergeFile) $::diff($top,conflictFile)
+ set ::eskil($top,mergeFile) $::eskil($top,conflictFile)
}
}
- if {$::diff($top,mergeFile) eq ""} {
+ if {$::eskil($top,mergeFile) eq ""} {
# Ask user which file
set buttons {}
set text "Overwrite file or Browse?"
- if {[file exists $::diff($top,leftFile)] && \
- $::diff($top,leftFile) eq $::diff($top,leftLabel)} {
+ if {[file exists $::eskil($top,leftFile)] && \
+ $::eskil($top,leftFile) eq $::eskil($top,leftLabel)} {
lappend buttons Left
- append text "\nLeft: $::diff($top,leftFile)"
+ append text "\nLeft: $::eskil($top,leftFile)"
}
- if {[file exists $::diff($top,rightFile)] && \
- $::diff($top,rightFile) eq $::diff($top,rightLabel)} {
+ if {[file exists $::eskil($top,rightFile)] && \
+ $::eskil($top,rightFile) eq $::eskil($top,rightLabel)} {
lappend buttons Right
- append text "\nRight: $::diff($top,rightFile)"
+ append text "\nRight: $::eskil($top,rightFile)"
}
lappend buttons Browse Cancel
if {[llength $buttons] > 2} {
set apa [tk_dialog .savemerge "Save merge file" \
$text \
questhead -1 {*}$buttons]
if {$apa < 0} return
set apa [lindex $buttons $apa]
if {$apa eq "Left"} {
- set ::diff($top,mergeFile) $::diff($top,leftFile)
+ set ::eskil($top,mergeFile) $::eskil($top,leftFile)
} elseif {$apa eq "Right"} {
- set ::diff($top,mergeFile) $::diff($top,rightFile)
+ set ::eskil($top,mergeFile) $::eskil($top,rightFile)
} elseif {$apa eq "Cancel"} {
return
}
}
- if {$::diff($top,mergeFile) eq ""} {
+ if {$::eskil($top,mergeFile) eq ""} {
# Browse
- if {[info exists ::diff($top,rightDir)]} {
- set initDir $::diff($top,rightDir)
- } elseif {[info exists ::diff($top,leftDir)]} {
- set initDir $::diff($top,leftDir)
+ if {[info exists ::eskil($top,rightDir)]} {
+ set initDir $::eskil($top,rightDir)
+ } elseif {[info exists ::eskil($top,leftDir)]} {
+ set initDir $::eskil($top,leftDir)
} else {
set initDir [pwd]
}
set apa [tk_getSaveFile -title "Save merge file" -initialdir $initDir \
-parent $top.merge]
if {$apa eq ""} return
- set ::diff($top,mergeFile) $apa
+ set ::eskil($top,mergeFile) $apa
}
}
- set ch [open $::diff($top,mergeFile) "w"]
- fconfigure $ch -translation $::diff($top,mergetranslation)
+ set ch [open $::eskil($top,mergeFile) "w"]
+ fconfigure $ch -translation $::eskil($top,mergetranslation)
puts -nonewline $ch [$w get 1.0 end-1char]
close $ch
# Detect if this is a GIT merge, and possibly add it to the index
# after save (i.e. git add file)
- if {[detectRevSystem $::diff($top,mergeFile)] eq "GIT"} {
+ if {[detectRevSystem $::eskil($top,mergeFile)] eq "GIT"} {
set apa [tk_messageBox -parent $top.merge -icon info -type yesno \
-title "Diff" \
- -message "Saved merge to file $::diff($top,mergeFile).\nAdd\
+ -message "Saved merge to file $::eskil($top,mergeFile).\nAdd\
it to GIT index?"]
if {$apa eq "yes"} {
- eskil::rev::GIT::add $::diff($top,mergeFile)
+ eskil::rev::GIT::add $::eskil($top,mergeFile)
}
} else {
tk_messageBox -parent $top.merge -icon info -type ok -title "Diff" \
- -message "Saved merge to file $::diff($top,mergeFile)."
+ -message "Saved merge to file $::eskil($top,mergeFile)."
}
}
# Close merge window and clean up.
proc closeMerge {top} {
- global diff
+ global eskil
destroy $top.merge
- set diff($top,leftMergeData) {}
- set diff($top,rightMergeData) {}
- array unset diff $top,mergeSelection,*
+ set eskil($top,leftMergeData) {}
+ set eskil($top,rightMergeData) {}
+ array unset eskil $top,mergeSelection,*
}
# Create a window to display merge result.
proc makeMergeWin {top} {
collectMergeData $top
- if {![info exists ::diff($top,mergetranslation)]} {
+ if {![info exists ::eskil($top,mergetranslation)]} {
if {$::tcl_platform(platform) eq "windows"} {
- set ::diff($top,mergetranslation) crlf
+ set ::eskil($top,mergetranslation) crlf
} else {
- set ::diff($top,mergetranslation) lf
+ set ::eskil($top,mergetranslation) lf
}
}
set w $top.merge
if {![winfo exists $w]} {
toplevel $w
} else {
destroy {*}[winfo children $w]
}
- set anyC $::diff($top,mergeSelection,AnyConflict)
+ set anyC $::eskil($top,mergeSelection,AnyConflict)
wm title $w "Merge result: [TitleTail $top]"
menu $w.m
$w configure -menu $w.m
@@ -378,60 +386,58 @@
$w.m.mf add command -label "Close" -underline 0 -command "closeMerge $top"
$w.m add cascade -label "Select" -underline 0 -menu $w.m.ms
menu $w.m.ms
$w.m.ms add radiobutton -label "Left+Right" -value 12 \
- -variable diff($top,curMergeSel) -command "selectMerge $top"
+ -variable ::eskil($top,curMergeSel) -command "selectMerge $top"
$w.m.ms add radiobutton -label "Left" -underline 0 -value 1 \
- -variable diff($top,curMergeSel) -command "selectMerge $top"
+ -variable ::eskil($top,curMergeSel) -command "selectMerge $top"
$w.m.ms add radiobutton -label "Right" -underline 0 -value 2 \
- -variable diff($top,curMergeSel) -command "selectMerge $top"
+ -variable ::eskil($top,curMergeSel) -command "selectMerge $top"
$w.m.ms add radiobutton -label "Right+Left" -value 21 \
- -variable diff($top,curMergeSel) -command "selectMerge $top"
+ -variable ::eskil($top,curMergeSel) -command "selectMerge $top"
$w.m.ms add separator
$w.m.ms add command -label "All Left" -command "selectMergeAll $top 1"
$w.m.ms add command -label "All Right" -command "selectMergeAll $top 2"
$w.m add cascade -label "Goto" -underline 0 -menu $w.m.mg
menu $w.m.mg
$w.m.mg add command -accelerator "Up" -label "Previous" -command "nextMerge $top -1"
$w.m.mg add command -accelerator "Down" -label "Next" -command "nextMerge $top 1"
if {$anyC} {
- $w.m.mg add command -accelerator "Shift-Up" -label "Previous Conflict" -command "nextMerge $top -1000"
- $w.m.mg add command -accelerator "Shift-Down" -label "Next Conflict" -command "nextMerge $top 1000"
- } else {
- $w.m.mg add command -accelerator "Shift-Up" -label "Previous 10" -command "nextMerge $top -10"
- $w.m.mg add command -accelerator "Shift-Down" -label "Next 10" -command "nextMerge $top 10"
+ $w.m.mg add command -accelerator "Ctrl-Up" -label "Previous Conflict" -command "nextMerge $top -1000"
+ $w.m.mg add command -accelerator "Ctrl-Down" -label "Next Conflict" -command "nextMerge $top 1000"
}
-
+ $w.m.mg add command -accelerator "Shift-Up" -label "Previous 10" -command "nextMerge $top -10"
+ $w.m.mg add command -accelerator "Shift-Down" -label "Next 10" -command "nextMerge $top 10"
$w.m add cascade -label "Config" -underline 0 -menu $w.m.mc
menu $w.m.mc
- $w.m.mc add radiobutton -label "Line end LF" -value lf -variable diff($top,mergetranslation)
- $w.m.mc add radiobutton -label "Line end CRLF" -value crlf -variable diff($top,mergetranslation)
- if {$::diff($top,mode) eq "conflict"} {
+ $w.m.mc add radiobutton -label "Line end LF" -value lf -variable ::eskil($top,mergetranslation)
+ $w.m.mc add radiobutton -label "Line end CRLF" -value crlf -variable ::eskil($top,mergetranslation)
+ if {$::eskil($top,mode) eq "conflict"} {
$w.m.mc add separator
- $w.m.mc add checkbutton -label "Pure" -variable diff($top,modetype) \
+ $w.m.mc add checkbutton -label "Pure" -variable ::eskil($top,modetype) \
-onvalue "Pure" -offvalue "" -command {doDiff}
}
ttk::frame $w.f
ttk::radiobutton $w.f.rb1 -text "LR" -value 12 \
- -variable diff($top,curMergeSel) \
+ -variable ::eskil($top,curMergeSel) \
-command "selectMerge $top"
ttk::radiobutton $w.f.rb2 -text "L" -value 1 \
- -variable diff($top,curMergeSel) \
+ -variable ::eskil($top,curMergeSel) \
-command "selectMerge $top"
ttk::radiobutton $w.f.rb3 -text "R" -value 2 \
- -variable diff($top,curMergeSel) \
+ -variable ::eskil($top,curMergeSel) \
-command "selectMerge $top"
ttk::radiobutton $w.f.rb4 -text "RL" -value 21 \
- -variable diff($top,curMergeSel) \
+ -variable ::eskil($top,curMergeSel) \
-command "selectMerge $top"
- bind $w "focus $w; set diff($top,curMergeSel) 1; selectMerge $top"
- bind $w "focus $w; set diff($top,curMergeSel) 2; selectMerge $top"
+ bind $w "focus $w; set ::eskil($top,curMergeSel) 1; selectMerge $top"
+ bind $w "focus $w; set ::eskil($top,curMergeSel) 2; selectMerge $top"
ttk::button $w.f.bl -text "Prev C" -command "nextMerge $top -1000"
ttk::button $w.f.br -text "Next C" -command "nextMerge $top 1000"
ttk::button $w.f.b1 -text "Prev" -command "nextMerge $top -1"
@@ -438,10 +444,12 @@
ttk::button $w.f.b2 -text "Next" -command "nextMerge $top 1"
bind $w "focus $w ; nextMerge $top 1"
bind $w "focus $w ; nextMerge $top -1"
bind $w "focus $w ; nextMerge $top 10"
bind $w "focus $w ; nextMerge $top -10"
+ bind $w "focus $w ; nextMerge $top 1000"
+ bind $w "focus $w ; nextMerge $top -1000"
ttk::button $w.f.bs -text "Save" -command "saveMerge $top"
ttk::button $w.f.bq -text "Close" -command "closeMerge $top"
wm protocol $w WM_DELETE_WINDOW "closeMerge $top"
@@ -456,16 +464,17 @@
grid columnconfigure $w.f {5 6 8 9 11 12} -uniform b
#grid columnconfigure $w.f {11 13 14} -uniform c
text $w.t -width 80 -height 20 -xscrollcommand "$w.sbx set" \
-yscrollcommand "$w.sby set" -font myfont
- scrollbar $w.sbx -orient horizontal -command "$w.t xview"
- scrollbar $w.sby -orient vertical -command "$w.t yview"
+ ttk::scrollbar $w.sbx -orient horizontal -command "$w.t xview"
+ ttk::scrollbar $w.sby -orient vertical -command "$w.t yview"
bind $w.t [list focus $w]
- ttk::label $w.ls -textvariable ::diff($top,mergeStatus)
+ ttk::label $w.ls -textvariable ::eskil($top,mergeStatus)
+ addBalloon $w.ls \[[list set "::eskil($top,mergeAncLines)"]\]
# Prevent toplevel bindings on keys to fire while in the text widget.
bindtags $w.t [list Text $w.t $w all]
bind $w.t "break"
bind $w.t "break"
@@ -484,123 +493,143 @@
fillMergeWindow $top
}
# Compare each file against an ancestor file for three-way merge
proc collectAncestorInfo {top dFile1 dFile2 opts} {
- if {![info exists ::diff($top,mergetranslation)]} {
+ if {![info exists ::eskil($top,mergetranslation)]} {
# Try to autodetect line endings in ancestor file
- set ch [open $::diff($top,ancestorFile) rb]
- set data [read $ch 10000]
- close $ch
- if {[string first \r\n $data] >= 0} {
- set ::diff($top,mergetranslation) crlf
- } else {
- set ::diff($top,mergetranslation) lf
- }
- }
- array unset ::diff $top,ancestorLeft,*
- array unset ::diff $top,ancestorRight,*
+ detectLineEnd $top $::eskil($top,ancestorFile) mergetranslation lf
+ }
+ array unset ::eskil $top,ancestorLeft,*
+ array unset ::eskil $top,ancestorRight,*
set differrA1 [catch {DiffUtil::diffFiles {*}$opts \
- $::diff($top,ancestorFile) $dFile1} diffresA1]
+ $::eskil($top,ancestorFile) $dFile1} diffresA1]
set differrA2 [catch {DiffUtil::diffFiles {*}$opts \
- $::diff($top,ancestorFile) $dFile2} diffresA2]
+ $::eskil($top,ancestorFile) $dFile2} diffresA2]
if {$differrA1 != 0 || $differrA2 != 0} {
puts $diffresA1
puts $diffresA2
return
}
+
+ # We store ancestor data to provide it as popup info.
+ # This is a bit ugly but it at least allows access to ancestor contents
+ # at all, even if a nicer presentation could probably be made.
+ set ch [open $::eskil($top,ancestorFile)]
+ set ancestorLines [split [read $ch] \n]
+ close $ch
+
foreach i $diffresA1 {
lassign $i line1 n1 line2 n2
if {$n1 == 0} {
# Added lines
for {set t $line2} {$t < $line2 + $n2} {incr t} {
- set ::diff($top,ancestorLeft,$t) a
+ set ::eskil($top,ancestorLeft,$t) a
}
} elseif {$n2 == 0} {
# Deleted lines
# Mark the following line
- set ::diff($top,ancestorLeft,d$line2) d
+ set ::eskil($top,ancestorLeft,d$line2) d
} else {
# Changed lines
+ set ancLines {}
+ for {set t $line1} {$t < $line1 + $n1} {incr t} {
+ lappend ancLines "$t: [lindex $ancestorLines [- $t 1]]"
+ }
for {set t $line2} {$t < $line2 + $n2} {incr t} {
- set ::diff($top,ancestorLeft,$t) c
+ set ::eskil($top,ancestorLeft,$t) c
+ set ::eskil($top,ancestorLeft,$t,lines) $ancLines
}
}
}
foreach i $diffresA2 {
lassign $i line1 n1 line2 n2
if {$n1 == 0} {
# Added lines
for {set t $line2} {$t < $line2 + $n2} {incr t} {
- set ::diff($top,ancestorRight,$t) a
+ set ::eskil($top,ancestorRight,$t) a
}
} elseif {$n2 == 0} {
# Deleted lines
# Mark the following line
- set ::diff($top,ancestorRight,d$line2) d
+ set ::eskil($top,ancestorRight,d$line2) d
} else {
# Changed lines
+ set ancLines {}
+ for {set t $line1} {$t < $line1 + $n1} {incr t} {
+ lappend ancLines "$t: [lindex $ancestorLines [- $t 1]]"
+ }
for {set t $line2} {$t < $line2 + $n2} {incr t} {
- set ::diff($top,ancestorRight,$t) c
+ set ::eskil($top,ancestorRight,$t) c
+ set ::eskil($top,ancestorRight,$t,lines) $ancLines
}
}
}
#parray ::diff $top,ancestor*
}
# Use ancestor info to select which side to use in a merge chunk
-##nagelfar syntax WhichSide x x x x x n n
-proc WhichSide {top line1 n1 line2 n2 conflictName commentName} {
- upvar 1 $conflictName conflict $commentName comment
+##nagelfar syntax WhichSide x x x x x n n n
+proc WhichSide {top line1 n1 line2 n2 conflictName commentName ancLinesName} {
+ upvar 1 $conflictName conflict $commentName comment $ancLinesName ancLines
set conflict 0
set comment ""
- if {$::diff($top,ancestorFile) eq ""} {
+ set ancLines {}
+ if {$::eskil($top,ancestorFile) eq ""} {
# No ancestor info, just select right side
return 2
}
if {$n1 == 0} {
- # Only to the right
- set delLeft [info exists ::diff($top,ancestorLeft,d$line1)]
- # Inserted to right : Keep right side
- if {!$delLeft} {
- set comment "Right: Add"
- return 2
- }
-
+ # This chunk has lines only to the right
+ # Look for changes on the right side
for {set t $line2} {$t < $line2 + $n2} {incr t} {
- if {[info exists ::diff($top,ancestorRight,$t)]} {
- set right($::diff($top,ancestorRight,$t)) 1
+ if {[info exists ::eskil($top,ancestorRight,$t)]} {
+ set right($::eskil($top,ancestorRight,$t)) 1
+ }
+ if {[info exists ::eskil($top,ancestorRight,$t,lines)]} {
+ lappend ancLines {*}$::eskil($top,ancestorRight,$t,lines)
}
}
- # Deleted to left : Keep left side
if {[array size right] == 0} {
+ # No changes to the right, so deleted to the left : Keep left side
set comment "Left: Delete"
return 1
+ }
+ # Is it deleted on the left side?
+ set delLeft [info exists ::eskil($top,ancestorLeft,d$line1)]
+ if {!$delLeft} {
+ # It is inserted to the right : Keep right side
+ set comment "Right: Add"
+ return 2
}
# Deleted to left and changed to the right : ?? (right for now)
# FIXA
set comment "*** Left: Delete, Right: Change"
set conflict 1
return 2
} elseif {$n2 == 0} {
- # Only to the left, this can be:
- set delRight [info exists ::diff($top,ancestorRight,d$line2)]
- # Inserted to left : Keep left side
- if {!$delRight} {
- set comment "Left: Add"
- return 1
- }
-
- for {set t $line1} {$t < $line1 + $n1} {incr t} {
- if {[info exists ::diff($top,ancestorLeft,$t)]} {
- set left($::diff($top,ancestorLeft,$t)) 1
- }
- }
- # Deleted to right : Keep right side
- if {[array size left] == 0} {
- set comment "Right: Delete"
- return 2
+ # This chunk has lines only to the left
+ # Look for changes on the left side
+ for {set t $line1} {$t < $line1 + $n1} {incr t} {
+ if {[info exists ::eskil($top,ancestorLeft,$t)]} {
+ set left($::eskil($top,ancestorLeft,$t)) 1
+ }
+ if {[info exists ::eskil($top,ancestorLeft,$t,lines)]} {
+ lappend ancLines {*}$::eskil($top,ancestorLeft,$t,lines)
+ }
+ }
+ if {[array size left] == 0} {
+ # No changes to the left, so deleted to the right : Keep right side
+ set comment "Right: Delete"
+ return 2
+ }
+ # Is it deleted on the right side?
+ set delRight [info exists ::eskil($top,ancestorRight,d$line2)]
+ if {!$delRight} {
+ # It is inserted to the left : Keep left side
+ set comment "Left: Add"
+ return 1
}
# Deleted to right and changed to the left : ?? (right for now)
# FIXA
set comment "*** Left: Change, Right: Delete"
set conflict 1
@@ -608,12 +637,15 @@
} else {
# Changed on both sides
# Collect left side info
for {set t $line1} {$t < $line1 + $n1} {incr t} {
- if {[info exists ::diff($top,ancestorLeft,$t)]} {
- set left($::diff($top,ancestorLeft,$t)) 1
+ if {[info exists ::eskil($top,ancestorLeft,$t)]} {
+ set left($::eskil($top,ancestorLeft,$t)) 1
+ }
+ if {[info exists ::eskil($top,ancestorLeft,$t,lines)]} {
+ lappend ancLines {*}$::eskil($top,ancestorLeft,$t,lines)
}
}
# No changes against ancestor on left side means it is just
# changed to the right : Keep right
@@ -622,12 +654,15 @@
return 2
}
# Collect right side info
for {set t $line2} {$t < $line2 + $n2} {incr t} {
- if {[info exists ::diff($top,ancestorRight,$t)]} {
- set right($::diff($top,ancestorRight,$t)) 1
+ if {[info exists ::eskil($top,ancestorRight,$t)]} {
+ set right($::eskil($top,ancestorRight,$t)) 1
+ }
+ if {[info exists ::eskil($top,ancestorRight,$t,lines)]} {
+ lappend ancLines {*}$::eskil($top,ancestorRight,$t,lines)
}
}
# No changes against ancestor on right side means it is just
# changed to the left : Keep left
@@ -636,11 +671,12 @@
return 1
}
if {[info exists left(a)] && ![info exists left(c)] && \
[info exists right(a)] && ![info exists right(c)]} {
- # Pure add on both sides, keep both
+ # Pure add on both sides, keep both, but mark it as a conflict
+ # to alert user
set comment "*** Left: Add, Right: Add"
set conflict 1
return 12
}
# Changed in both, right for now
Index: src/plugin.tcl
==================================================================
--- src/plugin.tcl
+++ src/plugin.tcl
@@ -1,9 +1,9 @@
#----------------------------------------------------------------------
# Eskil, Plugin handling
#
-# Copyright (c) 2008, Peter Spjuth (peter.spjuth@gmail.com)
+# Copyright (c) 2008-2016, Peter Spjuth (peter.spjuth@gmail.com)
#
# 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.
@@ -28,16 +28,18 @@
lappend dirs [file join $::eskil(thisDir) .. .. plugins]
lappend dirs [file join $::eskil(thisDir) .. plugins]
return $dirs
}
-# Locate plugin source
+# Locate plugin source and extract some info
proc LocatePlugin {plugin} {
- set src ""
+ set res [dict create name "" src "" opts ""]
+ set fSrc ""
set dirs [PluginSearchPath]
foreach dir $dirs {
+ set dir [file normalize $dir]
set files {}
lappend files [file join $dir $plugin]
lappend files [file join $dir $plugin.tcl]
foreach file $files {
if {![file exists $file]} continue
@@ -45,57 +47,107 @@
if {![file readable $file]} continue
set ch [open $file r]
set data [read $ch 20]
close $ch
if {[string match "##Eskil Plugin*" $data]} {
- set src $file
+ set fSrc $file
break
}
}
- if {$src ne ""} break
+ if {$fSrc ne ""} break
+ }
+ if {$fSrc ne ""} {
+ dict set res name $plugin
+ dict set res src $fSrc
+ # Look for declarations of command line options
+ set ch [open $fSrc r]
+ while {[gets $ch line] >= 0} {
+ # Only look until empty line
+ if {[string trim $line] eq ""} break
+ if {[regexp {^\#\# Option\s+(\S+)(.*)} $line -> name rest]} {
+ # structure is name flag doc
+ dict lappend res opts $name 0 [string trim $rest " :"]
+ }
+ if {[regexp {^\#\# Flag\s+(\S+)(.*)} $line -> name rest]} {
+ dict lappend res opts $name 1 [string trim $rest " :"]
+ }
+ }
+ close $ch
}
- return $src
+
+ return $res
}
-proc createPluginInterp {plugin info} {
- set src [LocatePlugin $plugin]
+proc createPluginInterp {plugin info allow pinfoName} {
+ upvar 1 $pinfoName pinfo
+ set res [LocatePlugin $plugin]
+ set src [dict get $res src]
if {$src eq ""} {
return ""
}
- # Create interpreter
- set pi [interp create -safe]
+ # Create interpreter and load source
+ if {$allow} {
+ set pi [interp create]
+ $pi eval [list source $src]
+ } else {
+ set pi [interp create -safe]
+ $pi invokehidden -global source $src
+ }
- # Load source
- $pi invokehidden -global source $src
+ # Setup info
$pi eval [list set ::WhoAmI [file rootname [file tail $src]]]
+ $pi eval [list set ::WhoAmIFull [file normalize $src]]
$pi eval [list set ::Info $info]
interp share {} stdout $pi
# Expose needed commands
- interp expose $pi fconfigure ;# ??
- interp hide $pi close
+ if {!$allow} {
+ interp expose $pi fconfigure ;# needed??
+ interp hide $pi close
+ }
+
+ set pinfo {file 0 dir 0}
+ dict set pinfo "allow" $allow
+ if {[$pi eval info proc PreProcess] ne ""} {
+ dict set pinfo file 1
+ }
+ if {[$pi eval info proc FileCompare] ne ""} {
+ dict set pinfo dir 1
+ }
return $pi
}
-proc printPlugin {plugin} {
- set src [LocatePlugin $plugin]
+proc printPlugin {plugin {short 0}} {
+ set res [LocatePlugin $plugin]
+ set src [dict get $res src]
if {$src eq ""} {
printPlugins
return
}
set ch [open $src]
- puts -nonewline [read $ch]
+ set lines [split [read $ch] \n]
+ foreach line $lines {
+ set line [string trim $line]
+ if {$short} {
+ if {![string match "#*" $line]} {
+ break
+ }
+ }
+ puts $line
+ }
close $ch
}
proc listPlugins {} {
set dirs [PluginSearchPath]
+ set result {}
foreach dir $dirs {
+ set dir [file normalize $dir]
set files [glob -nocomplain [file join $dir *.tcl]]
foreach file $files {
set file [file normalize $file]
if {[info exists done($file)]} continue
if {![file exists $file]} continue
@@ -103,144 +155,506 @@
if {![file readable $file]} continue
set done($file) 1
set ch [open $file r]
set data [read $ch 200]
- close $ch
if {[regexp {^\#\#Eskil Plugin :(.*?)(\n|$)} $data -> descr]} {
- set result([file rootname [file tail $file]]) $descr
+ set root [file rootname [file tail $file]]
+ dict set result $root "descr" $descr
+ dict set result $root "file" 0
+ dict set result $root "dir" 0
+ # Load it all for inspection
+ append data [read $ch]
+ if {[string first "proc PreProcess " $data] >= 0} {
+ dict set result $root "file" 1
+ }
+ if {[string first "proc FileCompare " $data] >= 0} {
+ dict set result $root "dir" 1
+ }
}
+ close $ch
}
}
- return [array get result]
+ set resultSort {}
+ foreach elem [lsort -dictionary [dict keys $result]] {
+ dict set resultSort $elem [dict get $result $elem]
+ }
+ return $resultSort
}
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 descr} $plugins {
- puts "Plugin \"$plugin\" : $descr"
+ foreach {plugin info} $plugins {
+ set descr [dict get $info descr]
+ puts "Plugin [format %-*s $w \"$plugin\"] : $descr"
}
}
proc preparePlugin {top} {
- #FIXA: plugin miffo
+ if {$::eskil($top,plugin,1) eq "" || \
+ ![dict get $::eskil($top,pluginpinfo,1) file]} {
+ return 0
+ }
+
disallowEdit $top
- $::diff($top,plugin) eval [list array set ::Pref [array get ::Pref]]
- set out1 [tmpFile]
- set out2 [tmpFile]
-
- set chi [open $::diff($top,leftFile) r]
- set cho [open $out1 w]
- interp share {} $chi $::diff($top,plugin)
- interp share {} $cho $::diff($top,plugin)
- set usenew1 [$::diff($top,plugin) eval [list PreProcess left $chi $cho]]
- $::diff($top,plugin) invokehidden close $chi
- $::diff($top,plugin) invokehidden close $cho
- close $chi
- close $cho
-
- set chi [open $::diff($top,rightFile) r]
- set cho [open $out2 w]
- interp share {} $chi $::diff($top,plugin)
- interp share {} $cho $::diff($top,plugin)
- set usenew2 [$::diff($top,plugin) eval [list PreProcess right $chi $cho]]
- $::diff($top,plugin) invokehidden close $chi
- $::diff($top,plugin) invokehidden close $cho
- close $chi
- close $cho
-
- if {$usenew1} {
- # The file after processing should be used both
- # for comparison and for displaying.
- set ::diff($top,leftFileBak) $::diff($top,leftFile)
- set ::diff($top,leftFile) $out1
- } else {
- set ::diff($top,leftFileDiff) $out1
- #set ::diff($top,leftLabel) "$::diff($top,RevFile) $tag"
- }
- if {$usenew2} {
- set ::diff($top,rightFileBak) $::diff($top,rightFile)
- set ::diff($top,rightFile) $out2
- } else {
- set ::diff($top,rightFileDiff) $out2
- #set ::diff($top,rightLabel) $::diff($top,RevFile)
- }
+ set in1 $::eskil($top,leftFile)
+ set in2 $::eskil($top,rightFile)
+
+ foreach item [lsort -dictionary [array names ::eskil $top,pluginname,*]] {
+ set n [lindex [split $item ","] end]
+
+ set allow [dict get $::eskil($top,pluginpinfo,$n) allow]
+ # Pass ::argv to plugin
+ set pArgv $::eskil(argv)
+ if {[info exists ::eskil($top,pluginargv,$n)]} {
+ lappend pArgv {*}$::eskil($top,pluginargv,$n)
+ }
+ $::eskil($top,plugin,$n) eval [list set ::argv $pArgv]
+ # Pass ::Pref to plugin
+ $::eskil($top,plugin,$n) eval [list array set ::Pref [array get ::Pref]]
+ # Pass File info to plugin
+ $::eskil($top,plugin,$n) eval [list set ::File(left) $::eskil($top,leftFile)]
+ $::eskil($top,plugin,$n) eval [list set ::File(right) $::eskil($top,rightFile)]
+
+ set out1 [tmpFile]
+ set out2 [tmpFile]
+
+ set chi [open $in1 r]
+ set cho [open $out1 w]
+ set chi2 [open $in2 r]
+ set cho2 [open $out2 w]
+ interp share {} $chi $::eskil($top,plugin,$n)
+ interp share {} $cho $::eskil($top,plugin,$n)
+ interp share {} $chi2 $::eskil($top,plugin,$n)
+ interp share {} $cho2 $::eskil($top,plugin,$n)
+
+ set cmd1 [list PreProcess left $chi $cho]
+ set cmd2 [list PreProcess right $chi2 $cho2]
+ if {[info commands yield] ne ""} {
+ # When in 8.6, this is done in coroutines allowing each call
+ # to yield and to alternate between them until done
+ set c1 __plugin_cr1$top
+ set c2 __plugin_cr2$top
+ set cmd1 [linsert $cmd1 0 coroutine $c1]
+ set cmd2 [linsert $cmd2 0 coroutine $c2]
+ set usenew1 [$::eskil($top,plugin,$n) eval $cmd1]
+ set usenew2 [$::eskil($top,plugin,$n) eval $cmd2]
+ interp alias {} pnw $::eskil($top,plugin,$n) namespace which
+ while {[pnw $c1] ne {} || [pnw $c2] ne {}} {
+ if {[pnw $c1] ne {}} {
+ set usenew1 [$::eskil($top,plugin,$n) eval $c1]
+ }
+ if {[pnw $c2] ne {}} {
+ set usenew2 [$::eskil($top,plugin,$n) eval $c2]
+ }
+ }
+ } else {
+ set usenew1 [$::eskil($top,plugin,$n) eval $cmd1]
+ set usenew2 [$::eskil($top,plugin,$n) eval $cmd2]
+ }
+
+ if {$allow} {
+ $::eskil($top,plugin,$n) eval close $chi
+ $::eskil($top,plugin,$n) eval close $cho
+ $::eskil($top,plugin,$n) eval close $chi2
+ $::eskil($top,plugin,$n) eval close $cho2
+ } else {
+ $::eskil($top,plugin,$n) invokehidden close $chi
+ $::eskil($top,plugin,$n) invokehidden close $cho
+ $::eskil($top,plugin,$n) invokehidden close $chi2
+ $::eskil($top,plugin,$n) invokehidden close $cho2
+ }
+ close $chi
+ close $cho
+ close $chi2
+ close $cho2
+
+ if {$usenew1} {
+ # The file after processing should be used both
+ # for comparison and for displaying.
+ if {![info exists ::eskil($top,leftFileBak)]} {
+ set ::eskil($top,leftFileBak) $::eskil($top,leftFile)
+ }
+ unset -nocomplain ::eskil($top,leftFileDiff)
+ set ::eskil($top,leftFile) $out1
+ } else {
+ set ::eskil($top,leftFileDiff) $out1
+ }
+ if {$usenew2} {
+ if {![info exists ::eskil($top,rightFileBak)]} {
+ set ::eskil($top,rightFileBak) $::eskil($top,rightFile)
+ }
+ unset -nocomplain ::eskil($top,rightFileDiff)
+ set ::eskil($top,rightFile) $out2
+ } else {
+ set ::eskil($top,rightFileDiff) $out2
+ }
+ # For next plugin, if any
+ set in1 $out1
+ set in2 $out2
+ }
+ return 1
}
proc cleanupPlugin {top} {
- if {[info exists ::diff($top,leftFileBak)]} {
- set ::diff($top,leftFile) $::diff($top,leftFileBak)
+ if {[info exists ::eskil($top,leftFileBak)]} {
+ set ::eskil($top,leftFile) $::eskil($top,leftFileBak)
}
- if {[info exists ::diff($top,rightFileBak)]} {
- set ::diff($top,rightFile) $::diff($top,rightFileBak)
+ if {[info exists ::eskil($top,rightFileBak)]} {
+ set ::eskil($top,rightFile) $::eskil($top,rightFileBak)
}
unset -nocomplain \
- ::diff($top,leftFileBak) ::diff($top,rightFileBak) \
- ::diff($top,leftFileDiff) ::diff($top,rightFileDiff)
+ ::eskil($top,leftFileBak) ::eskil($top,rightFileBak) \
+ ::eskil($top,leftFileDiff) ::eskil($top,rightFileDiff)
}
# GUI for plugin selection
-proc EditPrefPlugins {top} {
- set w $top.prefplugin
+proc EditPrefPlugins {top {dirdiff 0}} {
+ set wt $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
- wm title $w "Preferences: Plugins"
+ destroy $wt
+ toplevel $wt -padx 3 -pady 3
+ ttk::frame $wt._bg
+ place $wt._bg -x 0 -y 0 -relwidth 1.0 -relheight 1.0 -border outside
+ wm title $wt "Preferences: Plugins"
+
+ ttk::notebook $wt.tab
+ ttk::frame $wt.tab.plus
+ $wt.tab add $wt.tab.plus -text "+"
+ set n [llength [array names ::eskil $top,pluginname,*]]
+ if {$n < 1} { set n 1 }
+ for {set t 0} {$t < $n} {incr t} {
+ EditPrefPluginsAddTab $top $dirdiff
+ }
+ $wt.tab select 0
+ bind $wt.tab <> \
+ [list EditPrefPluginsChangeTab $top $dirdiff]
+ bind $wt.tab \
+ [list EditPrefPluginsRightClick $top $dirdiff %x %y %X %Y]
+
+ ttk::frame $wt.fb -padding 3
+ ttk::button $wt.fb.b1 -text "Ok" \
+ -command [list EditPrefPluginsOk $top $wt 0]
+ ttk::button $wt.fb.b2 -text "Apply" \
+ -command [list EditPrefPluginsOk $top $wt 1]
+ ttk::button $wt.fb.b3 -text "Cancel" -command [list destroy $wt]
+ set ::widgets($top,prefPluginsOk) $wt.fb.b1
+
+ grid $wt.fb.b1 x $wt.fb.b2 x $wt.fb.b3 -sticky we
+ grid columnconfigure $wt.fb {0 2 4} -uniform a
+ grid columnconfigure $wt.fb {1 3} -weight 1
+
+ grid $wt.tab -sticky news -padx 3 -pady 3
+ grid $wt.fb -sticky we -padx 3 -pady 3
+ grid columnconfigure $wt 0 -weight 1
+ grid row $wt 0 -weight 1
+
+}
+
+# Detect a plugin tab change to add tab when "+" is selected.
+proc EditPrefPluginsChangeTab {top dirdiff} {
+ set wt $top.prefplugin.tab
+ set n [$wt index end]
+ set t [$wt index [$wt select]]
+
+ if {$t + 1 == $n} {
+ # Plus selected
+ EditPrefPluginsAddTab $top $dirdiff
+ $wt select $t
+ }
+}
+
+# Context menu
+proc EditPrefPluginsRightClick {top dirdiff x y X Y} {
+ set wt $top.prefplugin.tab
+ set elem [$wt identify element $x $y]
+ set t [$wt identify tab $x $y]
+ if {$elem eq "" || ![string is integer -strict $t]} return
+
+ set m [winfo toplevel $wt].pm
+ destroy $m
+ menu $m
+ set n [$wt index end]
+
+ $m add command -label "Add left" \
+ -command [list EditPrefPluginsAddTab $top $dirdiff $t]
+ if {$t > 0 && $t < ($n - 1)} {
+ $m add command -label "Move left" \
+ -command [list EditPrefPluginsMoveLeft $top $t]
+ }
+ tk_popup $m $X $Y
+}
+
+# Move a tab to the left
+proc EditPrefPluginsMoveLeft {top pos} {
+ set wt $top.prefplugin.tab
+ set win [lindex [$wt tabs] $pos]
+ incr pos -1
+ $wt insert $pos $win
+}
+
+# Add a tab to plugin prefernces
+proc EditPrefPluginsAddTab {top dirdiff {pos {}}} {
+ set wt $top.prefplugin.tab
+ set n [$wt index end]
+ if {$pos eq "" || $pos >= ($n - 1)} {
+ # Since the "+" tab is last, the index is n for any new one
+ set pos [expr {$n - 1}]
+ }
+ ttk::frame $wt.f,$n
+ $wt insert $pos $wt.f,$n -text "Plugin"
+
+ set wt $wt.f,$n
set plugins [listPlugins]
if {[llength $plugins] == 0} {
- grid [ttk::label $w.l -text "No plugins found."] - -padx 3 -pady 3
- }
- if {![info exists ::diff($top,pluginname)]} {
- set ::diff($top,pluginname) ""
- }
- if {![info exists ::diff($top,plugininfo)]} {
- set ::diff($top,plugininfo) ""
- }
- set ::diff($top,edit,pluginname) $::diff($top,pluginname)
- set ::diff($top,edit,plugininfo) $::diff($top,plugininfo)
+ grid [ttk::label $wt.l -text "No plugins found."] - -padx 3 -pady 3
+ }
+ if {![info exists ::eskil($top,pluginname,$n)]} {
+ set ::eskil($top,pluginname,$n) ""
+ }
+ if {![info exists ::eskil($top,plugininfo,$n)]} {
+ set ::eskil($top,plugininfo,$n) ""
+ }
+ if {![info exists ::eskil($top,pluginallow,$n)]} {
+ set ::eskil($top,pluginallow,$n) 0
+ }
+ set ::eskil($top,edit,pluginname,$n) $::eskil($top,pluginname,$n)
+ set ::eskil($top,edit,plugininfo,$n) $::eskil($top,plugininfo,$n)
+ set ::eskil($top,edit,pluginallow,$n) $::eskil($top,pluginallow,$n)
+
+ ttk::labelframe $wt.lfs -text "Select"
+ grid columnconfigure $wt.lfs 1 -weight 1
+
+ set t 0
+ foreach {plugin info} $plugins {
+ set descr [dict get $info descr]
+ if {$dirdiff && ![dict get $info dir]} continue
+ ttk::radiobutton $wt.rb$t -variable ::eskil($top,edit,pluginname,$n) \
+ -value $plugin -text $plugin
+ ttk::label $wt.l$t -text $descr -anchor w
+ grid $wt.rb$t $wt.l$t -in $wt.lfs -sticky we -padx 3 -pady 3
+ incr t
+ }
+ ttk::radiobutton $wt.rb$t -variable ::eskil($top,edit,pluginname,$n) \
+ -value "" -text "No Plugin"
+ ttk::button $wt.bs -text "Show" \
+ -command "ShowPlugin $wt \$::eskil($top,edit,pluginname,$n)"
+ addBalloon $wt.bs "Show plugin source code."
+ grid $wt.rb$t $wt.bs -in $wt.lfs -sticky we -padx 3 -pady 3
+ grid $wt.bs -sticky e
+
+ ttk::labelframe $wt.lfgc -text "Generic Configuration"
+ grid columnconfigure $wt.lfgc 1 -weight 1
+
+ ttk::label $wt.li -text "Info" -anchor w
+ addBalloon $wt.li "Info passed to plugin. Plugin specific."
+ ttk::entry $wt.ei -textvariable ::eskil($top,edit,plugininfo,$n)
+ grid $wt.li $wt.ei -in $wt.lfgc -sticky we -padx 3 -pady 3
+
+ ttk::checkbutton $wt.cb -text "Privilege" \
+ -variable ::eskil($top,edit,pluginallow,$n)
+ addBalloon $wt.cb "Run plugin with raised privileges"
+ grid $wt.cb - -in $wt.lfgc -sticky w -padx 3 -pady 3
+
+ ttk::labelframe $wt.lfsc -text "Specific Configuration"
+ set ::widgets($top,prefPluginsSpec,$n) $wt.lfsc
+ trace add variable ::eskil($top,edit,pluginname,$n) write \
+ [list UpdateSpecificPluginConf $top $n]
+ UpdateSpecificPluginConf $top $n
+
+ grid $wt.lfs -sticky we -padx 3 -pady 3
+ grid $wt.lfgc -sticky we -padx 3 -pady 3
+ grid $wt.lfsc -sticky we -padx 3 -pady 3
+ grid columnconfigure $wt 0 -weight 1
+}
+
+# When a new plugin is selected, update the list of specific options.
+# "args" is needed to swallow the extra variable trace args.
+proc UpdateSpecificPluginConf {top n args} {
+ set w $::widgets($top,prefPluginsSpec,$n)
+ # If the dialog is closed w might not exist
+ if {![winfo exists $w]} return
+ eval destroy [winfo children $w]
+
+ set arg $::eskil($top,edit,pluginname,$n)
+ set pOpts {}
+ if {$arg ne ""} {
+ set res [LocatePlugin $arg]
+ set pOpts [dict get $res opts]
+ }
+ # Look for defaults on the command line
+ set pArgv $::eskil(argv)
+ if {[info exists ::eskil($top,pluginargv,$n)]} {
+ lappend pArgv {*}$::eskil($top,pluginargv,$n)
+ }
+ # Look for declarations of command line options
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
+ set ::eskil($top,edit,opts,$n) $pOpts
+ foreach {name flag doc} $pOpts {
+ ttk::label $w.l$t -text $name
+ addBalloon $w.l$t -fmt $doc
+ grid $w.l$t -sticky "w" -padx 3 -pady 3
+ if {$flag} {
+ # Initialise if given.
+ if {[lsearch -exact $pArgv $name] >= 0} {
+ set ::eskil($top,edit,$name,$n) 1
+ # Move responsibility from global argv
+ set ix [lsearch -exact $::eskil(argv) $name]
+ if {$ix >= 0} {
+ set ::eskil(argv) [lreplace $::eskil(argv) $ix $ix]
+ lappend ::eskil($top,pluginargv,$n) $name
+ }
+ }
+ ttk::checkbutton $w.s$t -text "On" \
+ -variable ::eskil($top,edit,$name,$n)
+ grid $w.s$t -row $t -column 1 -sticky "w" -padx 3 -pady 3
+ } else {
+ # Initialise if given.
+ set ix [lsearch -exact $pArgv $name]
+ if {$ix >= 0} {
+ set ::eskil($top,edit,$name,$n) [lindex $pArgv $ix+1]
+ # Move responsibility from global argv
+ set ix [lsearch -exact $::eskil(argv) $name]
+ if {$ix >= 0} {
+ lappend ::eskil($top,pluginargv,$n) $name \
+ [lindex $::eskil(argv) $ix+1]
+ set ::eskil(argv) [lreplace $::eskil(argv) $ix $ix+1]
+ }
+ }
+ ttk::entry $w.s$t \
+ -textvariable ::eskil($top,edit,$name,$n)
+ grid $w.s$t -row $t -column 1 -sticky we -padx 3 -pady 3
+ }
+ incr t
+ }
+ grid columnconfigure $w 1 -weight 1
+ if {$t == 0} {
+ ttk::label $w.l -text "No specific configuration"
+ grid $w.l -sticky "w" -padx 3 -pady 3
+ return
+ }
+}
+
+# Ok or Apply pressend in Plugin Preference
+proc EditPrefPluginsOk {top wt apply} {
+ # Compress plugin info in tab order
+ set allN {}
+ foreach win [$wt.tab tabs] {
+ set n [lindex [split $win ","] end]
+ if {![string is integer -strict $n]} continue
+ # Find all used.
+ if {$::eskil($top,edit,pluginname,$n) ne ""} {
+ lappend allN $n
+ }
+ }
+ if {[llength $allN] == 0} {
+ lappend allN 1
+ }
+
+ # Keep the dialog if we are only applying
+ if {!$apply} {
+ destroy $wt
+ }
+
+ # Transfer them to consecutive numbers
+ set t 1
+ foreach n $allN {
+ set ::eskil($top,pluginname,$t) $::eskil($top,edit,pluginname,$n)
+ set ::eskil($top,plugininfo,$t) $::eskil($top,edit,plugininfo,$n)
+ set ::eskil($top,pluginallow,$t) $::eskil($top,edit,pluginallow,$n)
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
-
- grid $w.fb.b1 x $w.fb.b2 -sticky we
- grid columnconfigure $w.fb {0 2} -uniform a
- grid columnconfigure $w.fb 1 -weight 1
-
- grid $w.fb - -sticky we
- grid columnconfigure $w 1 -weight 1
-}
-
-proc EditPrefPluginsOk {top w} {
- destroy $w
- set ::diff($top,pluginname) $::diff($top,edit,pluginname)
- set ::diff($top,plugininfo) $::diff($top,edit,plugininfo)
- if {$::diff($top,pluginname) ne ""} {
- set pinterp [createPluginInterp $::diff($top,pluginname) $::diff($top,plugininfo)]
- } else {
- set pinterp ""
- }
- set ::diff($top,plugin) $pinterp
+ # Remove any old
+ foreach item [array names ::eskil $top,pluginname,*] {
+ set n [lindex [split $item ","] end]
+ if {$n >= $t} {
+ unset ::eskil($top,pluginname,$n)
+ set ::eskil($top,plugininfo,$n) ""
+ set ::eskil($top,pluginallow,$n) 0
+ }
+ }
+
+ # Handle all plugins
+ foreach item [array names ::eskil $top,pluginname,*] {
+ set n [lindex [split $item ","] end]
+ if {$::eskil($top,pluginname,$n) ne ""} {
+ set pinterp [createPluginInterp $::eskil($top,pluginname,$n) \
+ $::eskil($top,plugininfo,$n) \
+ $::eskil($top,pluginallow,$n) pinfo]
+ } else {
+ set pinterp ""
+ set pinfo ""
+ }
+ set ::eskil($top,plugin,$n) $pinterp
+ set ::eskil($top,pluginpinfo,$n) $pinfo
+ set ::eskil($top,pluginargv,$n) {}
+ foreach {name flag doc} $::eskil($top,edit,opts,$n) {
+ if {$flag} {
+ if {[info exists ::eskil($top,edit,$name,$n)] && \
+ $::eskil($top,edit,$name,$n)} {
+ lappend ::eskil($top,pluginargv,$n) $name
+ }
+ } else {
+ if {[info exists ::eskil($top,edit,$name,$n)] && \
+ $::eskil($top,edit,$name,$n) ne ""} {
+ lappend ::eskil($top,pluginargv,$n) $name \
+ $::eskil($top,edit,$name,$n)
+ }
+ }
+ }
+ }
+}
+
+# Put Tcl code in a text widget, with some syntax highlighting
+proc TextViewTcl {t data} {
+ $t tag configure comment -foreground "#b22222"
+ foreach line [split $data \n] {
+ if {[regexp {^\s*#} $line]} {
+ $t insert end $line\n comment
+ } elseif {[regexp {^(.*;\s*)(#.*)$} $line -> pre post]} {
+ $t insert end $pre
+ $t insert end $post\n comment
+ } else {
+ $t insert end $line\n
+ }
+ }
+}
+
+# Show plugin source
+proc ShowPlugin {parent plugin} {
+ set res [LocatePlugin $plugin]
+ set src [dict get $res src]
+ if {$src eq ""} return
+ set ch [open $src]
+ set data [read $ch]
+ close $ch
+ set wt $parent.plugin
+ if {[winfo exists $wt]} {
+ wm deiconify $wt
+ } else {
+ toplevel $wt -padx 3 -pady 3
+ }
+ destroy {*}[winfo children $wt]
+ ttk::frame $wt._bg
+ place $wt._bg -x 0 -y 0 -relwidth 1.0 -relheight 1.0 -border outside
+ wm title $wt "Plugin: $plugin"
+
+ set t [Scroll both text $wt.t -width 80 -height 30 -font myfont -wrap none]
+ pack $wt.t -fill both -expand 1
+ bind $t "[list $t tag add sel 1.0 end];break"
+
+ TextViewTcl $t $data
}
ADDED src/preprocess.tcl
Index: src/preprocess.tcl
==================================================================
--- /dev/null
+++ src/preprocess.tcl
@@ -0,0 +1,515 @@
+#---------------------------------------------------------- -*- tcl -*-
+# Eskil, Preprocess dialog
+#
+# Copyright (c) 2004-2017, Peter Spjuth (peter.spjuth@gmail.com)
+#
+# 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 format of the ::Pref(preprocessn) is:
+# Flat list of stride 2, (name data)
+# Data dict elements: preprocess active save
+# Preprocess element is a flat list of stride 3 (RE sub side)
+# If side is a special word, it is a special shortcut format.
+#
+# There used to be a ::Pref(preprocess) with a different format, the new
+# was named a bit different for compatibilty with saved preferences.
+
+# Return active preprocess items as a flat list with stride 3
+proc getActivePreprocess {top} {
+ set res {}
+ set count 0
+ foreach {name data} $::Pref(preprocessn) {
+ if {[dict get $data active]} {
+ foreach {RE sub side} [dict get $data preprocess] {
+ if {$side eq "Subst"} {
+ # Translate to Regexps
+ # Unique substitution
+ set pattern __$count[clock clicks -microseconds]__
+ incr count
+ lappend res $RE $pattern left
+ lappend res $sub $pattern right
+ } elseif {$side eq "Prefix"} {
+ # Translate to Regexp
+ set RE2 [string map [list % $RE] {^.*?\m(%\w+).*$}]
+ lappend res $RE2 {\1} ""
+ } else {
+ # Generic
+ lappend res $RE $sub $side
+ }
+ }
+ }
+ }
+ return $res
+}
+
+# Entry for adding preprocess from command line
+proc addPreprocess {name RE sub side} {
+ set data {}
+ dict set data preprocess [list $RE $sub $side]
+ dict set data active 1
+ dict set data save 0
+ lappend ::Pref(preprocessn) $name $data
+}
+
+# Get the value used when saving preferences
+proc getPreprocessSave {} {
+ set res {}
+ foreach {name data} $::Pref(preprocessn) {
+ if {[dict get $data save]} {
+ # Always save with active 0 for now.
+ # A user can edit the save file to have it by default.
+ dict set data active 0
+ lappend res $name $data
+ }
+ }
+ return $res
+}
+
+# This is called when Ok or Apply is pressed.
+# Update preference from dialog contents.
+proc EditPrefRegsubOk {top w item {keep 0}} {
+ set exa $::eskil($top,prefregexa)
+
+ set result {}
+ for {set t 1} {[info exists ::eskil($top,prefregexp$t)]} {incr t} {
+ set RE $::eskil($top,prefregexp$t)
+ set Sub $::eskil($top,prefregsub$t)
+ set l $::eskil($top,prefregleft$t)
+ set r $::eskil($top,prefregright$t)
+ if {$RE eq ""} continue
+ switch $::eskil($top,prefregtype$t) {
+ Subst {
+ lappend result $RE $Sub Subst
+ }
+ Prefix {
+ lappend result $RE "" Prefix
+ }
+ default {
+ set side ""
+ if {$l && !$r} { set side left }
+ if {!$l && $r} { set side right }
+ if {!$l && !$r} { continue }
+
+ if {[catch {regsub -all -- $RE $exa $Sub _} err]} {
+ return
+ }
+ lappend result $RE $Sub $side
+ }
+ }
+ }
+
+ set ::TmpPref(preprocess,re,$item) $result
+ set ::TmpPref(preprocess,active,$item) 1
+
+ if {$keep} {
+ # Apply was pressed, also apply main dialog
+ # TODO: Get widgets right. Right now it does not matter
+ EditPrefPrepOk . $top 1
+ return
+ }
+ destroy $w
+
+ array unset ::eskil $top,prefregexp*
+ array unset ::eskil $top,prefregsub*
+ array unset ::eskil $top,prefregleft*
+ array unset ::eskil $top,prefregright*
+ array unset ::eskil $top,prefregtype*
+}
+
+# Update the example in the preprocess dialog
+proc EditPrefRegsubUpdate {top args} {
+ set exal $::eskil($top,prefregexa)
+ set exar $::eskil($top,prefregexa)
+ set exal2 $::eskil($top,prefregexa2)
+ set exar2 $::eskil($top,prefregexa2)
+ set ok $::widgets($top,prefRegsubOk)
+ set app $::widgets($top,prefRegsubApply)
+
+ set pp {}
+ for {set t 1} {[info exists ::eskil($top,prefregexp$t)]} {incr t} {
+ set RE $::eskil($top,prefregexp$t)
+ set Sub $::eskil($top,prefregsub$t)
+ set l $::eskil($top,prefregleft$t)
+ set r $::eskil($top,prefregright$t)
+
+ if {$RE eq ""} continue
+
+ switch $::eskil($top,prefregtype$t) {
+ Subst {
+ set pattern __$t[clock clicks -microseconds]__
+ lappend pp $RE $pattern 1 0
+ lappend pp $Sub $pattern 0 1
+ }
+ Prefix {
+ set RE2 [string map [list % $RE] {^.*?\m(%\w+).*$}]
+ lappend pp $RE2 {\1} 1 1
+ }
+ default {
+ lappend pp $RE $Sub $l $r
+ }
+ }
+ }
+ foreach {RE Sub l r} $pp {
+ if {$l} {
+ if {[catch {regsub -all -- $RE $exal $Sub result} err]} {
+ set ::eskil($top,prefregresultl) "$t ERROR: $err"
+ $ok configure -state disabled
+ $app configure -state disabled
+ return
+ } else {
+ set exal $result
+ }
+ if {[catch {regsub -all -- $RE $exal2 $Sub result} err]} {
+ set ::eskil($top,prefregresultl2) "$t ERROR: $err"
+ $ok configure -state disabled
+ $app configure -state disabled
+ return
+ } else {
+ set exal2 $result
+ }
+ }
+ if {$r} {
+ if {[catch {regsub -all -- $RE $exar $Sub result} err]} {
+ set ::eskil($top,prefregresultr) "$t ERROR: $err"
+ $ok configure -state disabled
+ $app configure -state disabled
+ return
+ } else {
+ set exar $result
+ }
+ if {[catch {regsub -all -- $RE $exar2 $Sub result} err]} {
+ set ::eskil($top,prefregresultr2) "$t ERROR: $err"
+ $ok configure -state disabled
+ $app configure -state disabled
+ return
+ } else {
+ set exar2 $result
+ }
+ }
+ }
+ set ::eskil($top,prefregresultl2) $exal2
+ set ::eskil($top,prefregresultr2) $exar2
+ set ::eskil($top,prefregresultl) $exal
+ set ::eskil($top,prefregresultr) $exar
+ $ok configure -state normal
+ $app configure -state normal
+}
+
+# Add a new entry in the preprocess dialog
+proc AddPrefRegsub {top parent {type {}}} {
+ # Figure out next number to use
+ for {set t 1} {[winfo exists $parent.fr$t]} {incr t} {
+ #Empty
+ }
+ # Default values
+ if {![info exists ::eskil($top,prefregexp$t)]} {
+ set ::eskil($top,prefregtype$t) Generic
+ set ::eskil($top,prefregexp$t) ""
+ set ::eskil($top,prefregexp$t) ""
+ set ::eskil($top,prefregsub$t) ""
+ set ::eskil($top,prefregleft$t) 1
+ set ::eskil($top,prefregright$t) 1
+ }
+ # Override type if given
+ if {$type ne ""} {
+ set ::eskil($top,prefregtype$t) $type
+ }
+
+ set w [ttk::frame $parent.fr$t -borderwidth 2 -relief groove -padding 3]
+ pack $w -side "top" -fill x -padx 3 -pady 3
+
+ switch $::eskil($top,prefregtype$t) {
+ Subst {
+ ttk::label $w.l1 -text "Left:" -anchor "w"
+ ttk::entryX $w.e1 -textvariable ::eskil($top,prefregexp$t) -width 20
+ ttk::label $w.l2 -text "Right:" -anchor "w"
+ ttk::entryX $w.e2 -textvariable ::eskil($top,prefregsub$t)
+ grid $w.l1 $w.e1 $w.l2 $w.e2 -sticky we -padx 3 -pady 3
+ grid columnconfigure $w {0 2} -uniform a
+ grid columnconfigure $w {1 3} -weight 1 -uniform b
+
+ addBalloon $w.l1 -fmt {
+ Each pattern is applied to its side and substituted
+ for a common unique string.
+ }
+ }
+ Prefix {
+ ttk::label $w.l1 -text "Prefix:" -anchor "w"
+ ttk::entryX $w.e1 -textvariable ::eskil($top,prefregexp$t) -width 20
+ grid $w.l1 $w.e1 -sticky we -padx 3 -pady 3
+ grid columnconfigure $w 1 -weight 1
+ addBalloon $w.l1 -fmt {
+ Only one word that start with prefix is valid for line
+ comparison.
+ }
+ }
+ default {
+ ttk::label $w.l1 -text "Regexp:" -anchor "w"
+ ttk::entryX $w.e1 -textvariable ::eskil($top,prefregexp$t) -width 60
+ ttk::label $w.l2 -text "Subst:" -anchor "w"
+ ttk::entryX $w.e2 -textvariable ::eskil($top,prefregsub$t)
+ ttk::checkbutton $w.cb1 -text "Left" -variable ::eskil($top,prefregleft$t)
+ ttk::checkbutton $w.cb2 -text "Right" -variable ::eskil($top,prefregright$t)
+ addBalloon $w.cb1 "Apply to left file"
+ addBalloon $w.cb2 "Apply to right file"
+
+ grid $w.l1 $w.e1 $w.cb1 -sticky we -padx 3 -pady 3
+ grid $w.l2 $w.e2 $w.cb2 -sticky we -padx 3 -pady 3
+ grid columnconfigure $w 1 -weight 1
+ }
+ }
+
+ trace add variable ::eskil($top,prefregexp$t) write \
+ [list EditPrefRegsubUpdate $top]
+ trace add variable ::eskil($top,prefregsub$t) write \
+ [list EditPrefRegsubUpdate $top]
+ trace add variable ::eskil($top,prefregleft$t) write \
+ [list EditPrefRegsubUpdate $top]
+ trace add variable ::eskil($top,prefregright$t) write \
+ [list EditPrefRegsubUpdate $top]
+}
+
+# Editor for one item in ::Pref(preprocessn)
+proc EditPrefRegsub {top item} {
+ set w $top.prefregsub
+
+ ToplevelForce $w "Preferences: Preprocess group"
+
+ # Buttons
+ ttk::frame $w.fb1 -padding 3
+ ttk::button $w.fb1.b1 -text "Add" -command [list AddPrefRegsub $top $w Generic]
+ addBalloon $w.fb1.b1 "Add generic pattern"
+ ttk::button $w.fb1.b2 -text "Add Subst" -command [list AddPrefRegsub $top $w Subst]
+ addBalloon $w.fb1.b2 "Add using substitution shortcut"
+ ttk::button $w.fb1.b3 -text "Add Prefix" -command [list AddPrefRegsub $top $w Prefix]
+ addBalloon $w.fb1.b3 "Add using prefix shortcut"
+ grid $w.fb1.b1 $w.fb1.b2 $w.fb1.b3 -sticky we -ipadx 5 -padx 3 -pady 3
+ grid columnconfigure $w.fb1 all -uniform a
+ grid anchor $w.fb1 "w"
+
+ # Result example part
+ if {![info exists ::eskil($top,prefregexa)]} {
+ set ::eskil($top,prefregexa) \
+ "An example TextString FOR_REGSUB /* Comment */"
+ set ::eskil($top,prefregexa2) \
+ "An example TextString FOR_REGSUB /* Comment */"
+ }
+ ttk::labelframe $w.res -text "Preprocessing result" -padding 3
+ ttk::label $w.res.l3 -text "Example 1:" -anchor "w"
+ ttk::entryX $w.res.e3 -textvariable ::eskil($top,prefregexa) -width 60
+ ttk::label $w.res.l4l -text "Result 1 L:" -anchor "w"
+ ttk::label $w.res.l4r -text "Result 1 R:" -anchor "w"
+ ttk::label $w.res.e4l -textvariable ::eskil($top,prefregresultl) \
+ -anchor "w" -width 10
+ ttk::label $w.res.e4r -textvariable ::eskil($top,prefregresultr) \
+ -anchor "w" -width 10
+ ttk::label $w.res.l5 -text "Example 2:" -anchor "w"
+ ttk::entryX $w.res.e5 -textvariable ::eskil($top,prefregexa2)
+ ttk::label $w.res.l6l -text "Result 2 L:" -anchor "w"
+ ttk::label $w.res.l6r -text "Result 2 R:" -anchor "w"
+ ttk::label $w.res.e6l -textvariable ::eskil($top,prefregresultl2) \
+ -anchor "w" -width 10
+ ttk::label $w.res.e6r -textvariable ::eskil($top,prefregresultr2) \
+ -anchor "w" -width 10
+
+ grid $w.res.l3 $w.res.e3 -sticky we -padx 3 -pady 3
+ grid $w.res.l4l $w.res.e4l -sticky we -padx 3 -pady 3
+ grid $w.res.l4r $w.res.e4r -sticky we -padx 3 -pady 3
+ grid $w.res.l5 $w.res.e5 -sticky we -padx 3 -pady 3
+ grid $w.res.l6l $w.res.e6l -sticky we -padx 3 -pady 3
+ grid $w.res.l6r $w.res.e6r -sticky we -padx 3 -pady 3
+ grid columnconfigure $w.res 1 -weight 1
+
+ # Buttons
+ ttk::frame $w.fb -padding 3
+ ttk::button $w.fb.b1 -text "Ok" -command [list EditPrefRegsubOk $top $w $item]
+ ttk::button $w.fb.b2 -text "Apply" -command [list EditPrefRegsubOk $top $w $item 1]
+ ttk::button $w.fb.b3 -text "Cancel" -command [list destroy $w]
+ set ::widgets($top,prefRegsubOk) $w.fb.b1
+ set ::widgets($top,prefRegsubApply) $w.fb.b2
+
+ grid $w.fb.b1 x $w.fb.b2 x $w.fb.b3 -sticky we
+ grid columnconfigure $w.fb {0 2 4} -uniform a
+ grid columnconfigure $w.fb {1 3} -weight 1
+
+ # Top layout
+ pack $w.fb1 -side "top" -fill x -padx 3 -pady 3
+ pack $w.fb $w.res -side bottom -fill x -padx 3 -pady 3
+
+ # Fill in existing or an empty line
+ set preprocess $::TmpPref(preprocess,re,$item)
+
+ if {[llength $preprocess] == 0} {
+ AddPrefRegsub $top $w Generic
+ } else {
+ set t 1
+ foreach {RE Sub side} $preprocess {
+ set ::eskil($top,prefregexp$t) $RE
+ set ::eskil($top,prefregsub$t) $Sub
+ set ::eskil($top,prefregleft$t) 0
+ set ::eskil($top,prefregright$t) 0
+ set ::eskil($top,prefregtype$t) Generic
+ if {$side in {Subst Prefix}} {
+ set ::eskil($top,prefregtype$t) $side
+ } else {
+ if {$side eq "" || $side eq "left"} {
+ set ::eskil($top,prefregleft$t) 1
+ }
+ if {$side eq "" || $side eq "right"} {
+ set ::eskil($top,prefregright$t) 1
+ }
+ }
+ AddPrefRegsub $top $w
+ incr t
+ }
+ }
+
+ trace add variable ::eskil($top,prefregexa) write \
+ [list EditPrefRegsubUpdate $top]
+ trace add variable ::eskil($top,prefregexa2) write \
+ [list EditPrefRegsubUpdate $top]
+ EditPrefRegsubUpdate $top
+}
+
+
+# This is called when Ok or Apply is pressed.
+proc EditPrefPrepOk {top w {keep 0}} {
+ # Update preference from dialog contents.
+ set new {}
+ for {set r 1} {$r <= $::TmpPref(preprocess,n)} {incr r} {
+ set name $::TmpPref(preprocess,name,$r)
+ set act $::TmpPref(preprocess,active,$r)
+ set save $::TmpPref(preprocess,save,$r)
+ set re $::TmpPref(preprocess,re,$r)
+ lappend new $name
+ lappend new [dict create active $act "save" $save preprocess $re]
+ }
+ set ::Pref(preprocessn) $new
+
+ if {$keep} return
+ destroy $w
+}
+
+# Create a toplevel, even if it exists
+proc ToplevelForce {w title} {
+ destroy $w
+ ttk::toplevel $w -padx 3 -pady 3
+ wm title $w $title
+}
+
+# Move an item one step up
+proc EditPrefPreUp {r} {
+ puts EditPrefPreUp$r
+ # Sanity check
+ if {$r <= 1 || $r > $::TmpPref(preprocess,n)} {
+ return
+ }
+ set p [expr {$r - 1}]
+ foreach item {name active save re} {
+ set tmp $::TmpPref(preprocess,$item,$r)
+ set ::TmpPref(preprocess,$item,$r) $::TmpPref(preprocess,$item,$p)
+ set ::TmpPref(preprocess,$item,$p) $tmp
+ }
+}
+
+proc EditPrefPreprocessAddItem {w} {
+ set r $::TmpPref(preprocess,n)
+ incr r
+ if {![info exists ::TmpPref(preprocess,name,$r)]} {
+ set ::TmpPref(preprocess,name,$r) ""
+ set ::TmpPref(preprocess,active,$r) 0
+ set ::TmpPref(preprocess,save,$r) 0
+ set ::TmpPref(preprocess,re,$r) ""
+ }
+ ttk::entry $w.fp.ne$r -textvariable ::TmpPref(preprocess,name,$r)
+ addBalloon $w.fp.ne$r "Name of preprocess group (optional)"
+ ttk::checkbutton $w.fp.cba$r -text "Active" \
+ -variable ::TmpPref(preprocess,active,$r)
+ addBalloon $w.fp.cba$r "Activate group for this session"
+ ttk::checkbutton $w.fp.cbs$r -text "Save" \
+ -variable ::TmpPref(preprocess,save,$r)
+ addBalloon $w.fp.cbs$r "Save group when preferences are saved"
+ ttk::button $w.fp.be$r -text "Edit" \
+ -command [list EditPrefRegsub $w $r]
+ addBalloon $w.fp.be$r "Edit the associated list of regexps"
+ ttk::button $w.fp.bu$r -image $::img(up) \
+ -command [list EditPrefPreUp $r]
+ addBalloon $w.fp.bu$r "Move group up in list"
+ grid $w.fp.ne$r $w.fp.cba$r $w.fp.cbs$r $w.fp.be$r $w.fp.bu$r -sticky we \
+ -padx 3 -pady 3
+ # Make buttons symmetric
+ grid $w.fp.be$r $w.fp.bu$r -sticky news
+
+ set ::TmpPref(preprocess,n) $r
+}
+
+proc EditPrefPreprocess {top} {
+ set w $top.prefpreprocess
+
+ # Make a working copy more suitable for GUI connection
+ set r 0
+ foreach {name data} $::Pref(preprocessn) {
+ incr r
+ set ::TmpPref(preprocess,name,$r) $name
+ set ::TmpPref(preprocess,active,$r) [dict get $data active]
+ set ::TmpPref(preprocess,save,$r) [dict get $data save]
+ set ::TmpPref(preprocess,re,$r) [dict get $data preprocess]
+ }
+ # Create one if there is none, to simplify GUI usage
+ if {$r == 0} {
+ incr r
+ }
+ set ::TmpPref(preprocess,n) 0
+ set nItems $r
+
+ ToplevelForce $w "Preferences: Preprocess"
+
+ # Frame for List of preprocessing
+ ttk::frame $w.fp -padding 3
+ grid columnconfigure $w.fp 0 -weight 1
+
+ for {set r 1} {$r <= $nItems} {incr r} {
+ EditPrefPreprocessAddItem $w
+ }
+
+ # Frame for action buttons
+ ttk::frame $w.fa -padding 3
+ ttk::button $w.fa.b1 -text "Add" \
+ -command [list EditPrefPreprocessAddItem $w]
+ addBalloon $w.fa.b1 "Add a preprocess group"
+
+ grid $w.fa.b1 -sticky we
+ grid columnconfigure $w.fa {0 2 4} -uniform a
+ grid columnconfigure $w.fa {1 3} -weight 1
+
+
+ # Frame for dialog Buttons
+ ttk::frame $w.fb -padding 3
+ ttk::button $w.fb.b1 -text "Ok" -command [list EditPrefPrepOk $top $w]
+ ttk::button $w.fb.b2 -text "Apply" -command [list EditPrefPrepOk $top $w 1]
+ ttk::button $w.fb.b3 -text "Cancel" -command [list destroy $w]
+
+ grid $w.fb.b1 x $w.fb.b2 x $w.fb.b3 -sticky we
+ grid columnconfigure $w.fb {0 2 4} -uniform a
+ grid columnconfigure $w.fb {1 3} -weight 1
+
+ # Top layout
+ pack $w.fb -side bottom -fill x
+ pack $w.fa -side bottom -fill x
+ pack $w.fp -side "top" -fill both -expand 1
+}
Index: src/print.tcl
==================================================================
--- src/print.tcl
+++ src/print.tcl
@@ -96,10 +96,14 @@
}
# Find the lastnumber in a text widget
proc FindLastNumber {w} {
set index [$w search -backwards -regexp {\d} end]
+ if {$index eq ""} {
+ # There where no numbers there, treat it like 0
+ return 0
+ }
set line [$w get "$index linestart" "$index lineend"]
#puts "X '$line' '$index'"
regexp {\d+} $line number
return $number
}
@@ -228,32 +232,32 @@
lappend wraplines1 {}
}
}
}
- PdfPrint $top $wraplength $maxlen $wraplines1 $wraplines2
+ PdfPrint $top $wraplength $maxlen $wraplines1 $wraplines2 $quiet
# Finished
normalCursor $top
}
-proc PdfPrint {top cpl cpln wraplines1 wraplines2} {
+proc PdfPrint {top cpl cpln wraplines1 wraplines2 {quiet 0}} {
- if {$::diff($top,printFile) != ""} {
- set pdfFile $::diff($top,printFile)
+ if {$::eskil($top,printFile) != ""} {
+ set pdfFile $::eskil($top,printFile)
} else {
set pdfFile ~/eskil.pdf
}
- if {![regexp {^(.*)( \(.*?\))$} $::diff($top,leftLabel) -> lfile lrest]} {
- set lfile $::diff($top,leftLabel)
+ if {![regexp {^(.*)( \(.*?\))$} $::eskil($top,leftLabel) -> lfile lrest]} {
+ set lfile $::eskil($top,leftLabel)
set lrest ""
}
set lfile [file tail $lfile]$lrest
- if {![regexp {^(.*)( \(.*?\))$} $::diff($top,rightLabel) -> rfile rrest]} {
- set rfile $::diff($top,rightLabel)
+ if {![regexp {^(.*)( \(.*?\))$} $::eskil($top,rightLabel) -> rfile rrest]} {
+ set rfile $::eskil($top,rightLabel)
set rrest ""
}
set rfile [file tail $rfile]$rrest
set pdf [eskilprint %AUTO% -file $pdfFile -cpl $cpl -cpln $cpln \
@@ -260,10 +264,37 @@
-headleft $lfile -headright $rfile -headsize 10]
set linesPerPage [$pdf getNLines]
$pdf setTag change $::Pref(printColorChange)
$pdf setTag new1 $::Pref(printColorNew1)
$pdf setTag new2 $::Pref(printColorNew2)
+
+ # Preprocess for page breaks in patch mode
+ if {$::eskil($top,mode) eq "patch"} {
+ set i 0
+ set newWlines1 {}
+ set newWlines2 {}
+ foreach wline1 $wraplines1 wline2 $wraplines2 {
+ if {[string match "-+-+-+-+-+-+-+-+-*" [lindex $wline1 0]]} {
+ # This is a patch chunk header
+ if {$i > 3} {
+ for {} {$i < $linesPerPage} {incr i} {
+ lappend newWlines1 {}
+ lappend newWlines2 {}
+ }
+ set i 0
+ }
+ }
+ incr i
+ if {$i >= $linesPerPage} {
+ set i 0
+ }
+ lappend newWlines1 $wline1
+ lappend newWlines2 $wline2
+ }
+ set wraplines1 $newWlines1
+ set wraplines2 $newWlines2
+ }
set len1 [llength $wraplines1]
set len2 [llength $wraplines2]
set max [expr {$len1 > $len2 ? $len1 : $len2}]
@@ -285,39 +316,122 @@
$pdf drawTextLine [lindex $wraplines2 $i2]
$pdf newLine
}
}
$pdf endPrint
+
+ if {!$quiet} {
+ tk_messageBox -title "Eskil Print" -parent $top \
+ -message "Printed $npages pages to $pdfFile" -type ok
+ }
}
# Count the length of a line during a text dump
proc AccumulateMax {key value index} {
set index [lindex [split $index "."] 1]
set len [expr {[string length $value] + $index - 1}]
- if {$len > $::diff(currentCharsPerLine)} {
- set ::diff(currentCharsPerLine) $len
+ if {$len > 0} {
+ lappend ::eskil(currentCharsPerLine) $len
}
}
# Count the longest line length in the current display
proc CountCharsPerLine {top} {
- set ::diff(currentCharsPerLine) 0
+ set ::eskil(currentCharsPerLine) {}
$::widgets($top,wDiff1) dump -text -command AccumulateMax 1.0 end
$::widgets($top,wDiff2) dump -text -command AccumulateMax 1.0 end
- return $::diff(currentCharsPerLine)
+ set ::eskil(currentCharsPerLine) \
+ [lsort -integer $::eskil(currentCharsPerLine)]
+ return [lindex $::eskil(currentCharsPerLine) end]
+}
+
+# In a sorted list of integers, figure out where val fits
+# In 8.6 this could use lsearch -bisect
+proc FindPercentile {l val} {
+ set len [llength $l]
+ # No elements, so all are covered in a way
+ if {$len == 0} { return 100 }
+ # Above range, so 100%
+ if {[lindex $l end] <= $val} { return 100 }
+ # Under range, so 0%
+ if {[lindex $l 0] > $val} { return 0 }
+ # Single element should not slip through...
+ if {$len <= 1} { return 0 }
+
+ set i [lsearch -integer -all $l $val]
+ set i [lindex $i end]
+ if {$i >= 0} {
+ return [expr {100 * $i / ($len - 1)}]
+ }
+
+ # To keep search down, just look at multiples of 1%
+ set prev 0
+ for {set t 0} {$t <= 100} {incr t} {
+ set i [expr {$t * ($len - 1) / 100}]
+ if {$val < [lindex $l $i]} {
+ return $prev
+ }
+ set prev $t
+ }
+ return 99
+}
+
+# Figure out reasonable selections for line length.
+# 80 chars, and longest line used are always included.
+proc CharsPerLineOptions {top} {
+ set values [list 80]
+ set cpl [CountCharsPerLine $top]
+ if {$cpl ne "" && $cpl != 0} {
+ lappend values $cpl
+ }
+ if {[string is digit -strict $::Pref(printCharsPerLine)]} {
+ lappend values $::Pref(printCharsPerLine)
+ }
+ # Include 90% if reasonable
+ set len [llength $::eskil(currentCharsPerLine)]
+ set cpl [lindex $::eskil(currentCharsPerLine) [expr {9*$len/10}]]
+ if {$cpl ne "" && $cpl != 0} {
+ lappend values $cpl
+ }
+
+ set values [lsort -unique -integer $values]
+ set result {}
+ foreach value $values {
+ set p [FindPercentile $::eskil(currentCharsPerLine) $value]
+ lappend result $value "$value ($p %)" \
+ "$p % of the lines are within this line length"
+ }
+ return $result
}
proc BrowsePrintFileName {top entry} {
- set prev $::diff($top,printFile)
+ set prev $::eskil($top,printFile)
set dir [file dirname $prev]
set apa [tk_getSaveFile -initialdir $dir -initialfile [file tail $prev] \
-parent [winfo toplevel $entry] -title "PDF file"]
- if {$apa ne ""} {
- set ::diff($top,printFile) $apa
- $entry xview end
+ if {$apa eq ""} return
+ # Auto-add .pdf
+ if {[file extension $apa] eq ""} {
+ append apa .pdf
+ }
+
+ set ::eskil($top,printFile) $apa
+ $entry xview end
+}
+
+# Fix to give spinbox nicer appearance
+proc MySpinBox {w args} {
+ # Handle if ttk::spinbox is not there since it was introduced later
+ if {[info commands ttk::spinbox] eq ""} {
+ set cmd [list tk::spinbox $w]
+ } else {
+ set cmd [list ttk::spinbox $w]
+ lappend cmd -command [list $w selection clear] -state readonly
}
+ lappend cmd {*}$args
+ {*}$cmd
}
# Create a print dialog for PDF.
proc doPrint {top {quiet 0}} {
if {$quiet} {
@@ -330,28 +444,22 @@
wm title .pr "Print diffs to PDF"
# Layout
ttk::label .pr.hsl -anchor w -text "Header Size"
- tk::spinbox .pr.hss -textvariable ::Pref(printHeaderSize) \
- -from 5 -to 16 -width 3
+ MySpinBox .pr.hss -textvariable ::Pref(printHeaderSize) \
+ -from 5 -to 16 -width 3 -format %.0f
ttk::label .pr.cll -anchor w -text "Chars per line"
ttk::entryX .pr.cle -textvariable ::Pref(printCharsPerLine) -width 4
ttk::frame .pr.clf
- set values [list 80]
- set cpl [CountCharsPerLine $top]
- if {$cpl != 0} {
- lappend values $cpl
- }
- if {[string is digit -strict $::Pref(printCharsPerLine)]} {
- lappend values $::Pref(printCharsPerLine)
- }
- set values [lsort -unique -integer $values]
- foreach value $values {
+
+ set values [CharsPerLineOptions $top]
+ foreach {value label balloon} $values {
ttk::radiobutton .pr.clf.$value -variable ::Pref(printCharsPerLine) \
- -value $value -text $value
+ -value $value -text $label
+ addBalloon .pr.clf.$value $balloon
pack .pr.clf.$value -side left -padx 3 -pady 3
}
# Select paper size
set paperlist [lsort -dictionary [pdf4tcl::getPaperSizeList]]
@@ -365,54 +473,62 @@
foreach {::TmpPref(n1r) ::TmpPref(n1g) ::TmpPref(n1b)} \
$::Pref(printColorNew1) break
foreach {::TmpPref(n2r) ::TmpPref(n2g) ::TmpPref(n2b)} \
$::Pref(printColorNew2) break
trace add variable ::TmpPref write {
- set ::Pref(printColorChange) [list $::TmpPref(chr) $::TmpPref(chg) $::TmpPref(chb)]
- set ::Pref(printColorNew1) [list $::TmpPref(n1r) $::TmpPref(n1g) $::TmpPref(n1b)]
- set ::Pref(printColorNew2) [list $::TmpPref(n2r) $::TmpPref(n2g) $::TmpPref(n2b)]
+ set ::Pref(printColorChange) \
+ [list $::TmpPref(chr) $::TmpPref(chg) $::TmpPref(chb)]
+ set ::Pref(printColorNew1) \
+ [list $::TmpPref(n1r) $::TmpPref(n1g) $::TmpPref(n1b)]
+ set ::Pref(printColorNew2) \
+ [list $::TmpPref(n2r) $::TmpPref(n2g) $::TmpPref(n2b)]
list}
ttk::labelframe .pr.cf -text "Color" -padding 3
+ ttk::label .pr.cf.hr -text "Red"
+ ttk::label .pr.cf.hg -text "Green"
+ ttk::label .pr.cf.hb -text "Blue"
+
ttk::label .pr.cf.l1 -text "Change"
- tk::spinbox .pr.cf.s1r -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
+ MySpinBox .pr.cf.s1r -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
-width 4 -textvariable ::TmpPref(chr)
- tk::spinbox .pr.cf.s1g -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
+ MySpinBox .pr.cf.s1g -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
-width 4 -textvariable ::TmpPref(chg)
- tk::spinbox .pr.cf.s1b -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
+ MySpinBox .pr.cf.s1b -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
-width 4 -textvariable ::TmpPref(chb)
ttk::label .pr.cf.l2 -text "Old"
- tk::spinbox .pr.cf.s2r -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
+ MySpinBox .pr.cf.s2r -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
-width 4 -textvariable ::TmpPref(n1r)
- tk::spinbox .pr.cf.s2g -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
+ MySpinBox .pr.cf.s2g -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
-width 4 -textvariable ::TmpPref(n1g)
- tk::spinbox .pr.cf.s2b -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
+ MySpinBox .pr.cf.s2b -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
-width 4 -textvariable ::TmpPref(n1b)
ttk::label .pr.cf.l3 -text "New"
- tk::spinbox .pr.cf.s3r -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
+ MySpinBox .pr.cf.s3r -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
-width 4 -textvariable ::TmpPref(n2r)
- tk::spinbox .pr.cf.s3g -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
+ MySpinBox .pr.cf.s3g -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
-width 4 -textvariable ::TmpPref(n2g)
- tk::spinbox .pr.cf.s3b -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
+ MySpinBox .pr.cf.s3b -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
-width 4 -textvariable ::TmpPref(n2b)
+ grid x .pr.cf.hr .pr.cf.hg .pr.cf.hb -pady 1
grid .pr.cf.l1 .pr.cf.s1r .pr.cf.s1g .pr.cf.s1b -sticky w -padx 3 -pady 3
grid .pr.cf.l2 .pr.cf.s2r .pr.cf.s2g .pr.cf.s2b -sticky w -padx 3 -pady 3
grid .pr.cf.l3 .pr.cf.s3r .pr.cf.s3g .pr.cf.s3b -sticky w -padx 3 -pady 3
# File
ttk::label .pr.fnl -anchor w -text "File name"
- ttk::entryX .pr.fne -textvariable ::diff($top,printFile) -width 30
+ ttk::entryX .pr.fne -textvariable ::eskil($top,printFile) -width 30
ttk::button .pr.fnb -text Browse \
-command [list BrowsePrintFileName $top .pr.fne]
- if {$::diff($top,printFile) eq ""} {
- set ::diff($top,printFile) "~/eskil.pdf"
+ if {$::eskil($top,printFile) eq ""} {
+ set ::eskil($top,printFile) "~/eskil.pdf"
}
ttk::frame .pr.fb
ttk::button .pr.b1 -text "Print to File" \
-command "destroy .pr; update; PrintDiffs $top"
Index: src/printobj.tcl
==================================================================
--- src/printobj.tcl
+++ src/printobj.tcl
@@ -52,11 +52,11 @@
variable page
constructor {args} {
set tmp(-file) $options(-file)
catch {array set tmp $args}
- install pdf using pdf4tcl::pdf4tcl %AUTO% \
+ install pdf using pdf4tcl::new %AUTO% -compress 1 \
-landscape 1 -paper a4 -margin 15mm -file $tmp(-file)
$self configurelist $args
$self StartPrint
}
destructor {
@@ -66,11 +66,11 @@
method StartPrint {} {
# Page size
lassign [$pdf getDrawableArea] width height
# Header metrics
- $pdf setFont $options(-headsize) Courier
+ $pdf setFont $options(-headsize) $::eskil(printFont)
set headoffset [expr {$options(-headsize) + [$pdf getFontMetric bboxy]}]
set hoy $headoffset
# Figure out font size from number of chars per line
set charwidthHead [$pdf getCharWidth "0"]
@@ -77,11 +77,13 @@
set charwidth [expr {$width / 2.0 / ($options(-cpl) + $options(-cpln) + 1)}]
set fontsize [expr {$options(-headsize) * $charwidth / $charwidthHead}]
$pdf setFont $fontsize
# Text metrics
- set linesize $fontsize
+ set linesize [$pdf getFontMetric height] ;# $fontsize
+ set spacing [expr {$linesize / $fontsize}]
+ $pdf setLineSpacing $spacing
set offset [expr {$fontsize + [$pdf getFontMetric bboxy]}]
set charwidth [$pdf getCharWidth "0"]
set nlinesf [expr {($height - $options(-headsize)) / $linesize}]
# Number of lines per page
set nlines [expr {int($nlinesf - 1.0)}]
@@ -114,18 +116,18 @@
# Center line
$pdf line [/ $width 2.0] $options(-headsize) \
[/ $width 2.0] $height
# Header
- $pdf setFont $options(-headsize) Courier
+ $pdf setFont $options(-headsize) $::eskil(printFont)
$pdf text $options(-headleft) -x 0 -y $hoy
$pdf text "Page $page of $options(-headnpages)" \
-x [expr {$width / 2.0}] -y $hoy -align center
$pdf text $options(-headright) -x $width -y $hoy -align right
# Normal font
- $pdf setFont $fontsize Courier
+ $pdf setFont $fontsize $::eskil(printFont)
}
method setHalf {half} {
if {$half eq "left"} {
$pdf setTextPosition $ox1 $oy
Index: src/registry.tcl
==================================================================
--- src/registry.tcl
+++ src/registry.tcl
@@ -118,13 +118,17 @@
set new "$valbase \"%1\""
MakeRegistryFrame $top.dd "Directory Diff" $keydd $new
pack $top.d $top.c $top.dd -side "top" -fill x -padx 4 -pady 4
locateEditor ::util(editor)
- if {[string match "*runemacs.exe" $::util(editor)]} {
+ if {[string match "*runemacs.exe" [lindex $::util(editor) 0]]} {
# Set up emacs
- set newkey "\"[file nativename $::util(editor)]\" \"%1\""
+ set newkey "\"[file nativename [lindex $::util(editor) 0]]\""
+ foreach eArg [lrange $::util(editor) 1 end] {
+ append newkey " \"$eArg\""
+ }
+ append newkey " \"%1\""
MakeRegistryFrame $top.e "Emacs" $keye $newkey
pack $top.e -side "top" -fill x -padx 4 -pady 4
}
ttk::button $top.close -text "Close" -width 10 \
Index: src/rev.tcl
==================================================================
--- src/rev.tcl
+++ src/rev.tcl
@@ -34,11 +34,11 @@
# Returns true if controlled or false if not.
# eskil::rev::XXX::ParseRevs {filename revs}
#
# Figure out revision from a list given by user
-#
+#
# Returns a list of revisions to display.
#
# Filename may be empty, the rev corresponds to the working tree
# eskil::rev::XXX::get {filename outfile rev}
@@ -51,22 +51,40 @@
#
# Get a patch of the file tree, between the revisions given.
# revs is in any format understood by this system, and
# should be retrieved from ParseRevs
# An optional list of files that should be included can be given.
+# Note that current directory must be correct before calling.
+
+# eskil::rev::XXX::getChangedFiles {dir revs}
+#
+# Get a list of files changed between the revisions given.
+# revs is in any format understood by this system, and
+# should be retrieved from ParseRevs
# eskil::rev::XXX::commitFile {top args}
#
# If implemented, enables the commit feature when comparing edited
# file(s) agains latest check in.
# If no files are given, all edited files are committed.
+# eskil::rev::XXX::revertFile {top args}
+#
+# If implemented, enables the revert feature when comparing edited
+# file(s) agains latest check in.
+# If no files are given, all edited files are reverted.
+
# eskil::rev::XXX::viewLog {top filename revs}
#
# If implemented, enables the log feature when comparing revisions.
# View log between displayed versions
+# eskil::rev::XXX::mount {dir rev}
+#
+# If implemented, directory diff can view revisions for this system.
+# Mounts a directory revision as a VFS, and returns the mount point
+
namespace eval eskil::rev::CVS {}
namespace eval eskil::rev::RCS {}
namespace eval eskil::rev::CT {}
namespace eval eskil::rev::GIT {}
namespace eval eskil::rev::FOSSIL {}
@@ -76,10 +94,12 @@
namespace eval eskil::rev::P4 {}
proc eskil::rev::CVS::detect {file} {
if {$file eq ""} {
set dir [pwd]
+ } elseif {[file isdirectory $file]} {
+ set dir $file
} else {
set dir [file dirname $file]
}
if {[file isdirectory [file join $dir CVS]]} {
if {[auto_execok cvs] ne ""} {
@@ -88,50 +108,30 @@
}
return 0
}
proc eskil::rev::SVN::detect {file} {
- if {$file eq ""} {
- set dir [pwd]
- } else {
- set dir [file dirname $file]
- }
- if {[file isdirectory [file join $dir .svn]]} {
+ # From SVN 1.7, there is only a .svn at the top of the checkout
+ if {[SearchUpwardsFromFile $file .svn]} {
if {[auto_execok svn] ne ""} {
return 1
}
}
return 0
}
proc eskil::rev::HG::detect {file} {
- if {$file eq ""} {
- set dir [pwd]
- } else {
- set dir [file dirname $file]
- }
- # HG, detect two steps down. Could be improved. FIXA
- if {[file isdirectory [file join $dir .hg]] ||
- [file isdirectory [file join $dir .. .hg]] ||
- [file isdirectory [file join $dir .. .. .hg]]} {
+ if {[SearchUpwardsFromFile $file .hg]} {
if {[auto_execok hg] ne ""} {
return 1
}
}
return 0
}
proc eskil::rev::BZR::detect {file} {
- if {$file eq ""} {
- set dir [pwd]
- } else {
- set dir [file dirname $file]
- }
- # HG, detect two steps down. Could be improved. FIXA
- if {[file isdirectory [file join $dir .bzr]] ||
- [file isdirectory [file join $dir .. .bzr]] ||
- [file isdirectory [file join $dir .. .. .bzr]]} {
+ if {[SearchUpwardsFromFile $file .bzr]} {
if {[auto_execok bzr] ne ""} {
return 1
}
}
return 0
@@ -164,37 +164,20 @@
}
return 0
}
proc eskil::rev::GIT::detect {file} {
- if {$file eq ""} {
- set dir [pwd]
- } else {
- set dir [file dirname $file]
- }
- # Git, detect two steps down. Could be improved. FIXA
- if {[file isdirectory [file join $dir .git]] ||
- [file isdirectory [file join $dir .. .git]] ||
- [file isdirectory [file join $dir .. .. .git]]} {
+ if {[SearchUpwardsFromFile $file .git]} {
if {[auto_execok git] ne ""} {
return 1
}
}
return 0
}
proc eskil::rev::FOSSIL::detect {file} {
- if {$file eq ""} {
- set dir [pwd]
- } else {
- set dir [file dirname $file]
- }
- # Fossil, detect three steps down. Could be improved. FIXA
- if {[file exists [file join $dir _FOSSIL_]] ||
- [file exists [file join $dir .. _FOSSIL_]] ||
- [file exists [file join $dir .. .. _FOSSIL_]] ||
- [file exists [file join $dir .. .. .. _FOSSIL_]]} {
+ if {[SearchUpwardsFromFile $file _FOSSIL_ .fslckout .fos]} {
if {[auto_execok fossil] ne ""} {
return 1
}
}
return 0
@@ -205,10 +188,69 @@
if {[catch {exec csh -c "icmp4 have $file"} p4have]} { return 0 }
if {[lindex $p4have 1] eq "-"} { return 1 }
}
return 0
}
+
+# Find the repo top dir given a file/dir reference.
+# Return the tail relative to top dir.
+# cands is a list of candidates for top marker
+proc GetTopDirCand {ref cands dirName tailName} {
+ upvar 1 $dirName dir $tailName tail
+ if {[file isdirectory $ref]} {
+ set dir $ref
+ set tail ""
+ } else {
+ set dir [file dirname $ref]
+ set tail [file tail $ref]
+ }
+ # Locate the top directory
+ while {[file readable $dir] && [file isdirectory $dir]} {
+ set found 0
+ foreach candidate $cands {
+ if {[file exists [file join $dir $candidate]]} {
+ set found 1
+ break
+ }
+ }
+ if {$found} break
+
+ set parent [file dirname $dir]
+ # Make sure to stop if we reach a dead end
+ if {$parent eq $dir} break
+ set tail [file join [file tail $dir] $tail]
+ set dir $parent
+ }
+}
+
+# Find the repo top dir given a file/dir reference.
+# Return the tail relative to top dir.
+proc eskil::rev::SVN::GetTopDir {ref dirName tailName} {
+ upvar 1 $dirName dir $tailName tail
+ GetTopDirCand $ref .svn dir tail
+}
+
+# Find the repo top dir given a file/dir reference.
+# Return the tail relative to top dir.
+proc eskil::rev::GIT::GetTopDir {ref dirName tailName} {
+ upvar 1 $dirName dir $tailName tail
+ GetTopDirCand $ref .git dir tail
+}
+
+# Find the repo top dir given a file/dir reference.
+# Return the tail relative to top dir.
+proc eskil::rev::HG::GetTopDir {ref dirName tailName} {
+ upvar 1 $dirName dir $tailName tail
+ GetTopDirCand $ref .hg dir tail
+}
+
+# Find the repo top dir given a file/dir reference.
+# Return the tail relative to top dir.
+proc eskil::rev::FOSSIL::GetTopDir {ref dirName tailName} {
+ upvar 1 $dirName dir $tailName tail
+ GetTopDirCand $ref ".fos .fslckout _FOSSIL_" dir tail
+}
# Get a CVS revision
proc eskil::rev::CVS::get {filename outfile rev} {
set old ""
set dir [file dirname $filename]
@@ -254,10 +296,15 @@
return ""
}
}
return $res
}
+
+proc eskil::rev::CVS::getChangedFiles {dir revs} {
+ # Not supported yet
+ return ""
+}
# Get a SVN revision
proc eskil::rev::SVN::get {filename outfile rev} {
set old ""
set dir [file dirname $filename]
@@ -267,14 +314,20 @@
cd $dir
set filename [file tail $filename]
}
set cmd [list exec svn cat]
- if {$rev != ""} {
- lappend cmd -r $rev
+ if {[string match "*://*" $rev]} {
+ # Full URL
+ lappend cmd $rev
+ } else {
+ if {$rev != ""} {
+ lappend cmd -r $rev
+ }
+ lappend cmd [file nativename $filename]
}
- lappend cmd [file nativename $filename] > $outfile
+ lappend cmd > $outfile
if {[catch {eval $cmd} res]} {
if {![string match "*Checking out*" $res]} {
tk_messageBox -icon error -title "SVN error" -message $res
}
}
@@ -281,25 +334,109 @@
if {$old != ""} {
cd $old
}
}
+
+# List local changes in a checkout
+# This is used to optimise dirdiff in the case of current vs local.
+# For SVN a lot of server calls can thus be avoided.
+proc eskil::rev::SVN::localChanges {dir} {
+ set old [pwd]
+ cd $dir
+ set info [exec svn status --ignore-externals -q]
+ cd $old
+ set changes {}
+ foreach line [split $info \n] {
+ set line [string trim $line]
+ if {[regexp {\S+$} $line file]} {
+ lappend changes [file join $dir $file]
+ }
+ }
+ return $changes
+}
+proc eskil::rev::FOSSIL::localChanges {dir} {
+ set old [pwd]
+ cd $dir
+ set info [exec fossil changes]
+ cd $old
+ set changes {}
+ foreach line [split $info \n] {
+ set line [string trim $line]
+ if {[regexp {^\S+\s+(\S+)$} $line -> file]} {
+ lappend changes [file join $dir $file]
+ }
+ }
+ return $changes
+}
+proc eskil::rev::GIT::localChanges {dir} {
+ set old [pwd]
+ cd $dir
+ set info [exec git status -s --porcelain]
+ cd $old
+ set changes {}
+ foreach line [split $info \n] {
+ set line [string trim $line]
+ if {[regexp {^(\S+)\s+(\S+)$} $line -> pre file]} {
+ lappend changes [file join $dir $file]
+ }
+ }
+ return $changes
+}
# Get a SVN patch
proc eskil::rev::SVN::getPatch {revs {files {}}} {
set cmd [list exec svn diff]
foreach rev $revs {
- lappend cmd -r $rev
+ # TODO: What happens in strange combinations ?
+ if {[string match "*://*" $rev]} {
+ # Full URL
+ lappend cmd $rev
+ } else {
+ lappend cmd -r $rev
+ }
}
lappend cmd {*}$files
if {[catch {eval $cmd} res]} {
tk_messageBox -icon error -title "SVN error" -message $res
return ""
}
return $res
}
+
+proc eskil::rev::SVN::getChangedFiles {dir revs} {
+ # Must call SVN in top dir to get full changeset
+ GetTopDir $dir top tail
+ set cmd [list execDir $top svn diff --summarize]
+ set revs2 {}
+ foreach rev $revs {
+ # TODO: What happens in strange combinations ?
+ if {[string match "*://*" $rev]} {
+ # Full URL
+ lappend cmd $rev
+ } else {
+ lappend revs2 $rev
+ }
+ }
+ if {[llength $revs2] > 0} {
+ lappend cmd -r [join $revs2 :]
+ }
+
+ if {[catch {eval $cmd} res]} {
+ tk_messageBox -icon error -title "SVN error" -message $res
+ return ""
+ }
+ # Result is one file per line, with an info word before
+ set files {}
+ foreach line [split $res \n] {
+ if {[regexp {^\S+\s+(.*)} $line -> f]} {
+ lappend files [file join $top $f]
+ }
+ }
+ return $files
+}
# Get a HG revision
proc eskil::rev::HG::get {filename outfile rev} {
set old ""
set dir [file dirname $filename]
@@ -338,10 +475,32 @@
tk_messageBox -icon error -title "HG error" -message $res
return ""
}
return $res
}
+
+proc eskil::rev::HG::getChangedFiles {dir revs} {
+ set cmd [list execDir $dir hg diff --stat]
+ foreach rev $revs {
+ lappend cmd -r $rev
+ }
+
+ if {[catch {eval $cmd} res]} {
+ tk_messageBox -icon error -title "HG error" -message $res
+ return ""
+ }
+ # Result is one file per line, with an info word before
+ GetTopDir $dir top tail
+ set files {}
+ foreach line [split $res \n] {
+ if {[regexp {(.+)\|} $line -> f]} {
+ set f [string trim $f]
+ lappend files [file join $top $f]
+ }
+ }
+ return $files
+}
# Get a BZR revision
proc eskil::rev::BZR::get {filename outfile rev} {
set old ""
set dir [file dirname $filename]
@@ -384,10 +543,15 @@
return ""
}
}
return $res
}
+
+proc eskil::rev::BZR::getChangedFiles {dir revs} {
+ # Not supported yet
+ return ""
+}
# Get an RCS revision
proc eskil::rev::RCS::get {filename outfile {rev {}}} {
catch {exec co -p$rev [file nativename $filename] \
> $outfile}
@@ -396,46 +560,31 @@
# Get a RCS patch
proc eskil::rev::RCS::getPatch {revs {files {}}} {
# Not supported yet.
return ""
}
+
+proc eskil::rev::RCS::getChangedFiles {dir revs} {
+ # Not supported yet.
+ return ""
+}
# Get a GIT revision
# No support for revisions yet
proc eskil::rev::GIT::get {filename outfile rev} {
- set old [pwd]
- set dir [file dirname $filename]
- set tail [file tail $filename]
- # Locate the top directory
- while {![file isdirectory $dir/.git]} {
- set thisdir [file tail $dir]
- set dir [file dirname $dir]
- set tail [file join $thisdir $tail]
- }
+ GetTopDir $filename dir tail
if {$rev eq ""} {
set rev HEAD
}
- cd $dir
- catch {exec git show $rev:$tail > $outfile}
- cd $old
+ catch {execDir $dir git show $rev:$tail > $outfile}
# example: git show HEAD^^^:apa
}
# Add file to GIT index
proc eskil::rev::GIT::add {filename} {
- set old [pwd]
- set dir [file dirname $filename]
- set tail [file tail $filename]
- # Locate the top directory
- while {![file isdirectory $dir/.git]} {
- set thisdir [file tail $dir]
- set dir [file dirname $dir]
- set tail [file join $thisdir $tail]
- }
- cd $dir
- catch {exec git add $tail}
- cd $old
+ GetTopDir $filename dir tail
+ catch {execDir $dir git add $tail}
}
# Get a GIT patch
proc eskil::rev::GIT::getPatch {revs {files {}}} {
set cmd [list exec git diff -p]
@@ -453,30 +602,45 @@
tk_messageBox -icon error -title "GIT error" -message $res
return ""
}
return $res
}
+
+# Get a GIT change set
+proc eskil::rev::GIT::getChangedFiles {dir revs} {
+ set cmd [list execDir $dir git diff --name-only]
+ if {[llength $revs] == 0} {
+ # Always default to HEAD to see changes regardless of index
+ lappend cmd HEAD
+ } else {
+ foreach rev $revs {
+ lappend cmd $rev
+ }
+ }
+
+ if {[catch {eval $cmd} res]} {
+ tk_messageBox -icon error -title "GIT error" -message $res
+ return ""
+ }
+ # Result is one file per line, relative to repo
+ GetTopDir $dir top tail
+ set files {}
+ foreach line [split $res \n] {
+ lappend files [file join $top $line]
+ }
+ return $files
+}
# Get a FOSSIL revision
# No support for revisions yet
proc eskil::rev::FOSSIL::get {filename outfile rev} {
- set old [pwd]
- set dir [file dirname $filename]
- set tail [file tail $filename]
- # Locate the top directory
- while {![file exists $dir/_FOSSIL_]} {
- set thisdir [file tail $dir]
- set dir [file dirname $dir]
- set tail [file join $thisdir $tail]
- }
- cd $dir
+ GetTopDir $filename dir tail
if {$rev eq "HEAD" || $rev eq ""} {
- catch {exec fossil finfo -p $tail > $outfile}
+ catch {execDir $dir fossil finfo -p $tail > $outfile}
} else {
- catch {exec fossil finfo -p $tail -r $rev > $outfile}
+ catch {execDir $dir fossil finfo -p $tail -r $rev > $outfile}
}
- cd $old
}
# Get a FOSSIL patch
proc eskil::rev::FOSSIL::getPatch {revs {files {}}} {
set cmd [list exec fossil diff]
@@ -491,24 +655,53 @@
# Fossil diff only handles one file at a time.
set res ""
foreach file $files {
set fcmd $cmd
lappend fcmd $file
- if {[catch {eval $cmd} fres]} {
+ if {[catch {eval $fcmd} fres]} {
tk_messageBox -icon error -title "FOSSIL error" -message $fres
return ""
}
+ # Fake the per-file rows
+ append res "Index: $file\n==================================\n"
append res $fres
}
} else {
+ # Include added files contents
+ lappend cmd -N
if {[catch {eval $cmd} res]} {
tk_messageBox -icon error -title "FOSSIL error" -message $res
return ""
}
}
return $res
}
+
+proc eskil::rev::FOSSIL::getChangedFiles {dir revs} {
+ set cmd [list execDir $dir fossil diff]
+
+ if {[llength $revs] >= 1} {
+ lappend cmd --from [lindex $revs 0]
+ }
+ if {[llength $revs] >= 2} {
+ lappend cmd --to [lindex $revs 1]
+ }
+
+ lappend cmd --brief
+ if {[catch {eval $cmd} res]} {
+ tk_messageBox -icon error -title "FOSSIL error" -message $res
+ return ""
+ }
+ # Result is one file per line, with an info word before
+ GetTopDir $dir top tail
+ set files {}
+ foreach line [split $res \n] {
+ regexp {\S+\s+(.*)} $line -> f
+ lappend files [file join $top $f]
+ }
+ return $files
+}
# Get a ClearCase revision
proc eskil::rev::CT::get {filename outfile rev} {
set filerev [file nativename $filename@@$rev]
if {[catch {exec cleartool get -to $outfile $filerev} msg]} {
@@ -520,10 +713,15 @@
# Get a CT patch
proc eskil::rev::CT::getPatch {revs {files {}}} {
# Not supported yet
return ""
}
+
+proc eskil::rev::CT::getChangedFiles {dir revs} {
+ # Not supported yet
+ return ""
+}
# Get a P4 revision
proc eskil::rev::P4::get {filename outfile rev} {
set dir [file dirname $filename]
if {[catch {exec csh -c "icmp4 print -q $filename\\#$rev" > $outfile} msg]} {
@@ -557,11 +755,11 @@
}
return $rev
}
# Return current revision of a SVN file
-proc eskil::rev::SVN::GetCurrent {filename} {
+proc eskil::rev::SVN::GetCurrent {filename {fullInfo 0}} {
set old ""
if {$filename eq ""} {
set cmd [list exec svn info]
} else {
set dir [file dirname $filename]
@@ -574,26 +772,33 @@
set cmd [list exec svn info [file nativename $filename]]
}
if {[catch {eval $cmd} res]} {
# What to do here?
set rev "1"
+ set res ""
} else {
if {![regexp {Last Changed Rev:\s+(\d+)} $res -> rev]} {
set rev "1"
}
}
if {$old != ""} {
cd $old
}
+ if {$fullInfo} {
+ return $res
+ }
return $rev
}
# Return revision list of a SVN file
proc eskil::rev::SVN::GetRevList {filename} {
if {$filename eq ""} {
set cmd [list exec svn log -q -l 50]
+ } elseif {[string match "*://*" $filename]} {
+ # Full URL
+ set cmd [list exec svn log -q -l 50 $filename]
} else {
set cmd [list exec svn log -q -l 50 [file nativename $filename]]
}
if {[catch {eval $cmd} res]} {
# What to do here?
@@ -607,10 +812,125 @@
}
}
}
return $revs
}
+
+# Return revision list of a HG file
+proc eskil::rev::HG::GetRevList {filename} {
+ if {$filename eq ""} {
+ set cmd [list exec hg log -q -l 50]
+ } else {
+ set cmd [list exec hg log -q -l 50 [file nativename $filename]]
+ }
+ if {[catch {eval $cmd} res]} {
+ # What to do here?
+ set revs [list 1]
+ } else {
+ set revs {}
+ foreach line [split $res \n] {
+ if {[regexp {^(\d+):} $line -> rev]} {
+ lappend revs $rev
+ }
+ }
+ }
+ return $revs
+}
+
+# Return revision list of a GIT file
+proc eskil::rev::GIT::GetRevList {filename} {
+ set old ""
+ set cmd [list exec git log --first-parent --oneline -n 50]
+ if {$filename eq ""} {
+ # Nothing
+ } elseif {[file isdirectory $filename]} {
+ set old [pwd]
+ cd $filename
+ } else {
+ set old [pwd]
+ cd [file dirname $filename]
+ lappend cmd [file nativename [file tail $filename]]
+ }
+ if {[catch {eval $cmd} res]} {
+ # What to do here?
+ puts "ERROR for '$filename' $res"
+ set revs [list HEAD]
+ } else {
+ set lines [split $res \n]
+ set revs {}
+ foreach line $lines {
+ if {[regexp {^(\w+)} $line -> rev]} {
+ lappend revs $rev
+ }
+ }
+ }
+ if {$old ne ""} {
+ cd $old
+ }
+ return $revs
+}
+
+# Return revision list of a FOSSIL file
+proc eskil::rev::FOSSIL::GetRevList {filename} {
+ # Keep on current branch
+ set x [execDir $filename fossil branch list]
+ if { ! [regexp -line {^\* (.*)$} $x -> branch]} {
+ set branch ""
+ }
+
+ # First, traverse timeline to get a set of ancestor checkins on the
+ # current branch
+ set x [execDir $filename fossil timeline ancestors current -t ci -n 5000]
+ set ancestors {}
+ set lines ""
+ set currentArtefact ""
+ foreach line [split $x \n] {
+ # Recognise the first line of each checkin
+ if {[regexp {^\d\d:\d\d:\d\d \[(\w+)\]} $line -> newArtefact]} {
+ # Check the accumulated lines before this for tags
+ if {[regexp {tags:\s+([^\)]+)} $lines -> tags]} {
+ if {$branch eq ""} {
+ set branch [lindex $tags 0]
+ }
+ if {$branch in $tags} {
+ dict set ancestors $currentArtefact 1
+ }
+ }
+ set currentArtefact $newArtefact
+ set lines [string trim $line]
+ } else {
+ set line [string trim $line]
+ if {[string index $lines end] eq "-"} {
+ append lines $line
+ } else {
+ append lines \n$line
+ }
+ }
+ }
+ #puts "Assuming branch '$branch'"
+ #puts "Found [dict size $ancestors] ancestors in timeline"
+
+ if {[file isdirectory $filename]} {
+ # Just use the ancestors as is. TBD to filter this for a sub directory
+ return [dict keys $ancestors]
+ }
+
+ # Now get all commits on the file. If finfo had a tag filter,
+ # this would be much easier.
+ set x [execDir $filename fossil finfo -l -b $filename]
+ set fAncestors {}
+ foreach line [split $x \n] {
+ if {[regexp {^(\w+)} $line -> artefact]} {
+ if {[dict exists $ancestors $artefact]} {
+ lappend fAncestors $artefact
+ }
+ }
+ }
+ #puts "Found [llength $fAncestors] ancestors for file"
+ #puts [join $fAncestors \n]
+ return $fAncestors
+}
# Figure out RCS revision from arguments
proc eskil::rev::RCS::ParseRevs {filename revs} {
if {$filename eq ""} {
# RCS does not support tree versions
@@ -618,40 +938,71 @@
}
return $revs
}
# Figure out GIT revision from arguments
+# The resulting rev should work with 'git show :filename'
proc eskil::rev::GIT::ParseRevs {filename revs} {
set result ""
foreach rev $revs {
- switch -glob -- $rev {
- HEAD - master - * { # Let anything through for now
- lappend result $rev
+ # Special cases that shortcuts to GIT special names
+ if {$rev eq "_" || $rev eq "0"} {set rev HEAD}
+
+ if {[string is integer -strict $rev] && $rev < 0} {
+ # A negative integer rev is a relative rev
+ set revList [eskil::rev::GIT::GetRevList $filename]
+
+ set rev [lindex $revList [- $rev]]
+ if {$rev eq ""} {
+ set rev [lindex $revs end]
}
}
+ # Let anything else through
+ lappend result $rev
}
return $result
}
# Figure out FOSSIL revision from arguments
proc eskil::rev::FOSSIL::ParseRevs {filename revs} {
set result ""
foreach rev $revs {
- switch -glob -- $rev {
- HEAD - master - * { # Let anything through for now FIXA
- lappend result $rev
+ # Special cases that shortcuts to Fossil special names
+ if {$rev eq "_" || $rev eq "0"} {set rev current}
+ # Previous does not work for files
+ #if {$rev eq "-1"} {set rev previous}
+
+ if {[string is integer -strict $rev] && $rev < 0} {
+ # A negative integer rev is a relative rev
+ set revList [eskil::rev::FOSSIL::GetRevList $filename]
+
+ set rev [lindex $revList [- $rev]]
+ if {$rev eq ""} {
+ set rev [lindex $revList end]
}
}
+ # Let anything else through
+ lappend result $rev
}
return $result
}
# Figure out HG revision from arguments
proc eskil::rev::HG::ParseRevs {filename revs} {
set result ""
foreach rev $revs {
- # No parsing yet...
+ # Shortcut to HG special names
+ if {$rev eq "_" || $rev eq "0"} {set rev tip}
+
+ if {[string is integer -strict $rev] && $rev < 0} {
+ # A negative integer rev is a relative rev
+ set revList [eskil::rev::HG::GetRevList $filename]
+ set rev [lindex $revList [- $rev]]
+ if {$rev eq ""} {
+ set rev [lindex $revList end]
+ }
+ }
lappend result $rev
}
return $result
}
@@ -683,36 +1034,104 @@
}
lappend result $rev
}
return $result
}
+
+# Look for alternative version in a branch
+# Return value, if any, is a full URL to the file
+proc eskil::rev::SVN::LookForBranch {filename rev} {
+ set info [eskil::rev::SVN::GetCurrent $filename 1]
+ if {![regexp -line {URL:\s+(.+)} $info -> URL]} {
+ return
+ }
+ if {![regexp -line {Repository Root:\s+(.+)} $info -> Root]} {
+ return
+ }
+ set tail [string range $URL [string length $Root] end]
+ if {![string match "/*" $tail]} {
+ return
+ }
+ set tail [string range $tail 1 end]
+ set parts [file split $tail]
+ set alt {}
+ switch [lindex $parts 0] {
+ trunk {
+ lappend alt [file join [lreplace $parts 0 0 branches $rev]]
+ lappend alt [file join [lreplace $parts 0 0 tags $rev]]
+ if {$rev eq "trunk"} {
+ lappend alt [file join [lreplace $parts 0 0 trunk]]
+ }
+ }
+ branches - tags {
+ if {$rev eq "trunk"} {
+ lappend alt [file join [lreplace $parts 0 1 trunk]]
+ }
+ lappend alt [file join [lreplace $parts 0 1 branches $rev]]
+ lappend alt [file join [lreplace $parts 0 1 tags $rev]]
+ }
+ }
+ foreach tailAlt $alt {
+ set urlAlt $Root/[join $tailAlt /]
+ if {[catch {exec svn "info" $urlAlt} res]} {
+ continue
+ }
+ # Is it enough that svn info worked to check success? Seems so
+ return $urlAlt
+ }
+ return
+}
# Figure out SVN revision from arguments
proc eskil::rev::SVN::ParseRevs {filename revs} {
set result {}
foreach rev $revs {
- # A negative integer rev is a relative rev
- if {[string is integer -strict $rev] && $rev < 0} {
- # Save a roundtrip to the server in the case where we
- # can start from current
- if {$rev == -1} {
- set curr [eskil::rev::SVN::GetCurrent $filename]
- set rev [expr {$curr + $rev}]
+ set Url ""
+ # Non-numeric could be a branch or tag. Look for it.
+ if {![string is integer -strict $rev]} {
+ if {[regexp {^([^@]+)@(.+)$} $rev -> pre post]} {
+ set rev $pre
+ set atRev $post
} else {
- # Get a list from the log
- if {$filename eq ""} {
- set filename "."
- }
- set cmd [list svn log -q [file nativename $filename]]
+ set atRev ""
+ }
+ set Url [eskil::rev::SVN::LookForBranch $filename $rev]
+ if {$Url ne ""} {
+ set rev $atRev
+ }
+ }
+ if {$rev eq "_" || $rev eq "0"} {
+ # Common names for current
+ # Use BASE since SVN then knows to use the local copy and avoid
+ # server calls.
+ set rev BASE
+ #set rev [eskil::rev::SVN::GetCurrent $filename]
+ } elseif {[string is integer -strict $rev] && $rev <= 0} {
+ # Zero means current
+ # A negative integer rev is a relative rev
+ # Get a list from the log
+ if {$filename eq ""} {
+ set filename "."
+ }
+ if {$Url ne ""} {
+ set revs [eskil::rev::SVN::GetRevList $Url]
+ } else {
set revs [eskil::rev::SVN::GetRevList $filename]
- set rev [lindex $revs [- $rev]]
- if {$rev eq ""} {
- set rev [lindex $revs end]
- }
+ }
+ set rev [lindex $revs [- $rev]]
+ if {$rev eq ""} {
+ set rev [lindex $revs end]
}
}
- lappend result $rev
+ if {$Url ne ""} {
+ if {$rev ne ""} {
+ append Url @$rev
+ }
+ lappend result $Url
+ } else {
+ lappend result $rev
+ }
}
return $result
}
# Figure out ClearCase revision from arguments
@@ -806,15 +1225,14 @@
set target all
} elseif {[llength $args] == 1} {
set target [file tail [lindex $args 0]]
} else {
set target "[file tail [lindex $args 0]] ..."
- }
- set logmsg [LogDialog $top $target]
- if {$logmsg ne ""} {
- catch {exec cvs -q commit -m $logmsg {*}$args}
}
+ set precmd [list cvs -q commit -m]
+ set postcmd $args
+ CommitDialog $top $target CVS $precmd $postcmd
}
# Check in SVN controlled file
proc eskil::rev::SVN::commitFile {top args} {
if {[llength $args] == 0} {
@@ -821,15 +1239,28 @@
set target all
} elseif {[llength $args] == 1} {
set target [file tail [lindex $args 0]]
} else {
set target "[file tail [lindex $args 0]] ..."
- }
- set logmsg [LogDialog $top $target]
- if {$logmsg ne ""} {
- catch {exec svn -q commit -m $logmsg {*}$args}
+ }
+ set precmd [list svn -q commit -m]
+ set postcmd $args
+ CommitDialog $top $target SVN $precmd $postcmd
+}
+
+# Check in HG controlled file
+proc eskil::rev::HG::commitFile {top args} {
+ if {[llength $args] == 0} {
+ set target all
+ } elseif {[llength $args] == 1} {
+ set target [file tail [lindex $args 0]]
+ } else {
+ set target "[file tail [lindex $args 0]] ..."
}
+ set precmd [list hg -q commit -m]
+ set postcmd $args
+ CommitDialog $top $target HG $precmd $postcmd
}
# Check in GIT controlled file
proc eskil::rev::GIT::commitFile {top args} {
if {[llength $args] == 0} {
@@ -836,18 +1267,22 @@
set target all
} elseif {[llength $args] == 1} {
set target [file tail [lindex $args 0]]
} else {
set target "[file tail [lindex $args 0]] ..."
- }
- set logmsg [LogDialog $top $target]
- if {$logmsg eq ""} return
-
+ }
if {[llength $args] == 0} {
- catch {exec git commit -a -m $logmsg}
+ set precmd [list git commit -a -m]
} else {
- catch {exec git commit -m $logmsg {*}$args}
+ set precmd [list git commit -m]
+ }
+ set postcmd $args
+ set gitmsg [CommitDialog $top $target GIT $precmd $postcmd 1]
+ if {[string match "*detached HEAD*" $gitmsg]} {
+ # Make sure to make a detached HEAD commit visible.
+ tk_messageBox -icon info -title "GIT commit message" -message $gitmsg \
+ -parent $top
}
}
# Check in Fossil controlled file
proc eskil::rev::FOSSIL::commitFile {top args} {
@@ -855,15 +1290,124 @@
set target all
} elseif {[llength $args] == 1} {
set target [file tail [lindex $args 0]]
} else {
set target "[file tail [lindex $args 0]] ..."
- }
- set logmsg [LogDialog $top $target]
- if {$logmsg eq ""} return
+ }
+ set precmd [list fossil commit -m]
+ set postcmd $args
+ CommitDialog $top $target Fossil $precmd $postcmd 1
+}
+
+
+# Revert SVN controlled file
+proc eskil::rev::SVN::revertFile {top args} {
+ if {[llength $args] == 0} {
+ set target all
+ } elseif {[llength $args] == 1} {
+ set target [file tail [lindex $args 0]]
+ } else {
+ set target "[file tail [lindex $args 0]] ..."
+ }
+ set ok [RevertDialog $top $target]
+ if {$ok ne "ok"} return
+
+ if {[llength $args] == 0} {
+ set args "-R ."
+ }
+ set sts [catch {exec svn revert -q {*}$args} svnmsg]
+ set svnmsg [string trim $svnmsg]
+ if {$svnmsg ne ""} {
+ tk_messageBox -icon error -title "SVN revert error" -message $svnmsg \
+ -parent $top
+ }
+}
+
+# Revert HG controlled file
+proc eskil::rev::HG::revertFile {top args} {
+ if {[llength $args] == 0} {
+ set target all
+ } elseif {[llength $args] == 1} {
+ set target [file tail [lindex $args 0]]
+ } else {
+ set target "[file tail [lindex $args 0]] ..."
+ }
+ set ok [RevertDialog $top $target]
+ if {$ok ne "ok"} return
+
+ if {[llength $args] == 0} {
+ set args "--all"
+ }
+ set sts [catch {exec hg revert -q -C {*}$args} svnmsg]
+ set svnmsg [string trim $svnmsg]
+ if {$svnmsg ne ""} {
+ tk_messageBox -icon error -title "HG revert error" -message $svnmsg \
+ -parent $top
+ }
+}
+
+# Revert Fossil controlled file
+proc eskil::rev::FOSSIL::revertFile {top args} {
+ if {[llength $args] == 0} {
+ set target all
+ } elseif {[llength $args] == 1} {
+ set target [file tail [lindex $args 0]]
+ } else {
+ set target "[file tail [lindex $args 0]] ..."
+ }
+ set ok [RevertDialog $top $target]
+ if {$ok ne "ok"} return
+
+ set sts [catch {exec fossil revert {*}$args} errmsg]
+ if {$sts} {
+ tk_messageBox -icon error -title "Fossil revert error" \
+ -message $errmsg -parent $top
+ }
+}
+
+# Revert Git controlled file
+proc eskil::rev::GIT::revertFile {top args} {
+ if {[llength $args] == 0} {
+ set target all
+ } elseif {[llength $args] == 1} {
+ set target [file tail [lindex $args 0]]
+ } else {
+ set target "[file tail [lindex $args 0]] ..."
+ }
+ set ok [RevertDialog $top $target]
+ if {$ok ne "ok"} return
+
+ if {[llength $args] == 0} {
+ set sts [catch {exec git checkout .} gitmsg]
+ } else {
+ set sts [catch {exec git checkout {*}$args} gitmsg]
+ }
+ set gitmsg [string trim $gitmsg]
+ if {$sts} {
+ tk_messageBox -icon error -title "GIT revert error" -message $gitmsg \
+ -parent $top
+ }
+}
+
+# Mount a directory revision as a VFS, and return the mount point
+proc eskil::rev::FOSSIL::mount {dir rev} {
+ return [vcsvfs::fossil::mount $dir $rev]
+}
+
+# Mount a directory revision as a VFS, and return the mount point
+proc eskil::rev::SVN::mount {dir rev} {
+ return [vcsvfs::svn::mount $dir $rev]
+}
+
+# Mount a directory revision as a VFS, and return the mount point
+proc eskil::rev::HG::mount {dir rev} {
+ return [vcsvfs::hg::mount $dir $rev]
+}
- catch {exec fossil commit -m $logmsg {*}$args}
+# Mount a directory revision as a VFS, and return the mount point
+proc eskil::rev::GIT::mount {dir rev} {
+ return [vcsvfs::git::mount $dir $rev]
}
# View log between displayed versions
proc eskil::rev::CVS::viewLog {top filename revs} {
set cmd [list exec cvs -q log -N]
@@ -885,10 +1429,38 @@
if {[llength $revs] > 1} {
lappend cmd -r [join $revs ":"]
} else {
lappend cmd -r HEAD:[lindex $revs 0]
}
+ lappend cmd $filename
+ if {[catch {eval $cmd} result]} {
+ #return
+ }
+ ViewLog $top $filename $result
+}
+
+# View log between displayed versions
+proc eskil::rev::GIT::viewLog {top filename revs} {
+ set cmd [list exec git log]
+ if {[llength $revs] > 1} {
+ lappend cmd [join $revs ".."]
+ } else {
+ lappend cmd [lindex $revs 0]..
+ }
+ lappend cmd $filename
+ if {[catch {eval $cmd} result]} {
+ #return
+ }
+ ViewLog $top $filename $result
+}
+
+# View log between displayed versions
+proc eskil::rev::HG::viewLog {top filename revs} {
+ set cmd [list exec hg log]
+ foreach rev $revs {
+ lappend cmd -r $rev
+ }
lappend cmd $filename
if {[catch {eval $cmd} result]} {
#return
}
ViewLog $top $filename $result
@@ -923,11 +1495,11 @@
if {[info exists cache($file)]} {
return $cache($file)
}
}
-
+
set searchlist [list $preference GIT FOSSIL HG BZR P4]
foreach ns [namespace children eskil::rev] {
lappend searchlist [namespace tail $ns]
}
foreach rev $searchlist {
@@ -941,47 +1513,47 @@
}
# Initialise revision control mode
# The file name should be an absolute normalized path.
proc startRevMode {top rev file} {
- set ::diff($top,mode) "rev"
- set ::diff($top,modetype) $rev
- set ::diff($top,rightDir) [file dirname $file]
- set ::diff($top,RevFile) $file
- set ::diff($top,rightLabel) $file
- set ::diff($top,rightFile) $file
- set ::diff($top,rightOK) 1
- set ::diff($top,leftLabel) $rev
- set ::diff($top,leftOK) 0
+ set ::eskil($top,mode) "rev"
+ set ::eskil($top,modetype) $rev
+ set ::eskil($top,rightDir) [file dirname $file]
+ set ::eskil($top,RevFile) $file
+ set ::eskil($top,rightLabel) $file
+ set ::eskil($top,rightFile) $file
+ set ::eskil($top,rightOK) 1
+ set ::eskil($top,leftLabel) $rev
+ set ::eskil($top,leftOK) 0
set ::Pref(toolbar) 1
}
# Prepare for revision diff. Checkout copies of the versions needed.
proc prepareRev {top} {
- global Pref
-
$::widgets($top,commit) configure -state disabled
+ $::widgets($top,revert) configure -state disabled
$::widgets($top,log) configure -state disabled
- set type $::diff($top,modetype)
+ set type $::eskil($top,modetype)
set revs {}
# Search for revision options
- if {$::diff($top,doptrev1) != ""} {
- lappend revs $::diff($top,doptrev1)
+ if {$::eskil($top,doptrev1) != ""} {
+ lappend revs $::eskil($top,doptrev1)
}
- if {$::diff($top,doptrev2) != ""} {
- lappend revs $::diff($top,doptrev2)
+ if {$::eskil($top,doptrev2) != ""} {
+ lappend revs $::eskil($top,doptrev2)
}
- set revs [eskil::rev::${type}::ParseRevs $::diff($top,RevFile) $revs]
+ set revs [eskil::rev::${type}::ParseRevs $::eskil($top,RevFile) $revs]
set revlabels {}
foreach rev $revs {
+ # TODO: In SVN rev could be a full URL, display it nicer
lappend revlabels [GetLastTwoPath $rev]
}
- set ::diff($top,RevRevs) $revs
+ set ::eskil($top,RevRevs) $revs
if {[llength $revs] < 2} {
# Compare local file with specified version.
disallowEdit $top 1
if {[llength $revs] == 0} {
@@ -989,35 +1561,38 @@
set tag "($type)"
} else {
set r [lindex $revs 0]
set tag "($type [lindex $revlabels 0])"
}
- set ::diff($top,leftFile) [tmpFile]
- set ::diff($top,leftLabel) "$::diff($top,RevFile) $tag"
- set ::diff($top,rightLabel) $::diff($top,RevFile)
- set ::diff($top,rightFile) $::diff($top,RevFile)
+ set ::eskil($top,leftFile) [tmpFile]
+ set ::eskil($top,leftLabel) "$::eskil($top,RevFile) $tag"
+ set ::eskil($top,rightLabel) $::eskil($top,RevFile)
+ set ::eskil($top,rightFile) $::eskil($top,RevFile)
- eskil::rev::${type}::get $::diff($top,RevFile) $::diff($top,leftFile) $r
+ eskil::rev::${type}::get $::eskil($top,RevFile) $::eskil($top,leftFile) $r
if {[llength $revs] == 0} {
if {[info commands eskil::rev::${type}::commitFile] ne ""} {
$::widgets($top,commit) configure -state normal
+ }
+ if {[info commands eskil::rev::${type}::revertFile] ne ""} {
+ $::widgets($top,revert) configure -state normal
}
}
} else {
# Compare the two specified versions.
disallowEdit $top
set r1 [lindex $revs 0]
set r2 [lindex $revs 1]
- set ::diff($top,leftFile) [tmpFile]
- set ::diff($top,rightFile) [tmpFile]
-
- set ::diff($top,leftLabel) \
- "$::diff($top,RevFile) ($type [lindex $revlabels 0])"
- set ::diff($top,rightLabel) \
- "$::diff($top,RevFile) ($type [lindex $revlabels 1])"
- eskil::rev::${type}::get $::diff($top,RevFile) $::diff($top,leftFile) $r1
- eskil::rev::${type}::get $::diff($top,RevFile) $::diff($top,rightFile) $r2
+ set ::eskil($top,leftFile) [tmpFile]
+ set ::eskil($top,rightFile) [tmpFile]
+
+ set ::eskil($top,leftLabel) \
+ "$::eskil($top,RevFile) ($type [lindex $revlabels 0])"
+ set ::eskil($top,rightLabel) \
+ "$::eskil($top,RevFile) ($type [lindex $revlabels 1])"
+ eskil::rev::${type}::get $::eskil($top,RevFile) $::eskil($top,leftFile) $r1
+ eskil::rev::${type}::get $::eskil($top,RevFile) $::eskil($top,rightFile) $r2
}
if {[llength $revs] > 0} {
if {[info commands eskil::rev::${type}::viewLog] ne ""} {
$::widgets($top,log) configure -state normal
}
@@ -1026,53 +1601,62 @@
update idletasks
}
# Clean up after a revision diff.
proc cleanupRev {top} {
- global Pref
-
- clearTmp $::diff($top,rightFile) $::diff($top,leftFile)
- set ::diff($top,rightFile) $::diff($top,RevFile)
- set ::diff($top,leftFile) $::diff($top,RevFile)
+ clearTmp $::eskil($top,rightFile) $::eskil($top,leftFile)
+ set ::eskil($top,rightFile) $::eskil($top,RevFile)
+ set ::eskil($top,leftFile) $::eskil($top,RevFile)
}
proc revCommit {top} {
if {[$::widgets($top,commit) cget -state] eq "disabled"} return
- set type $::diff($top,modetype)
- if {$::diff($top,mode) eq "patch"} {
- set files $::diff($top,reviewFiles)
+ set type $::eskil($top,modetype)
+ if {$::eskil($top,mode) eq "patch"} {
+ set files $::eskil($top,reviewFiles)
} else {
- set files [list $::diff($top,RevFile)]
+ set files [list $::eskil($top,RevFile)]
}
eskil::rev::${type}::commitFile $top {*}$files
}
+
+proc revRevert {top} {
+ if {[$::widgets($top,revert) cget -state] eq "disabled"} return
+ set type $::eskil($top,modetype)
+ if {$::eskil($top,mode) eq "patch"} {
+ set files $::eskil($top,reviewFiles)
+ } else {
+ set files [list $::eskil($top,RevFile)]
+ }
+ eskil::rev::${type}::revertFile $top {*}$files
+}
proc revLog {top} {
if {[$::widgets($top,log) cget -state] eq "disabled"} return
- set type $::diff($top,modetype)
- eskil::rev::${type}::viewLog $top $::diff($top,RevFile) \
- $::diff($top,RevRevs)
+ set type $::eskil($top,modetype)
+ eskil::rev::${type}::viewLog $top $::eskil($top,RevFile) \
+ $::eskil($top,RevRevs)
}
# Get a complete tree patch from this system.
+# Note that current directory must be correct before calling.
proc getFullPatch {top} {
- global Pref
-
$::widgets($top,commit) configure -state disabled
+ $::widgets($top,revert) configure -state disabled
$::widgets($top,log) configure -state disabled
- set type $::diff($top,modetype)
- set files $::diff($top,reviewFiles)
+ set type $::eskil($top,modetype)
+ set files $::eskil($top,reviewFiles)
set revs {}
# Search for revision options
- if {$::diff($top,doptrev1) != ""} {
- lappend revs $::diff($top,doptrev1)
+ if {$::eskil($top,doptrev1) != ""} {
+ lappend revs $::eskil($top,doptrev1)
}
- if {$::diff($top,doptrev2) != ""} {
- lappend revs $::diff($top,doptrev2)
+ if {$::eskil($top,doptrev2) != ""} {
+ lappend revs $::eskil($top,doptrev2)
}
set revs [eskil::rev::${type}::ParseRevs "" $revs]
set revlabels {}
foreach rev $revs {
@@ -1081,18 +1665,60 @@
if {[llength $revs] == 0} {
if {[info commands eskil::rev::${type}::commitFile] ne ""} {
$::widgets($top,commit) configure -state normal
}
+ if {[info commands eskil::rev::${type}::revertFile] ne ""} {
+ $::widgets($top,revert) configure -state normal
+ }
}
return [eskil::rev::${type}::getPatch $revs $files]
}
##############################################################################
# Utilities
##############################################################################
+
+# Execute a command within a specific dir as pwd
+proc execDir {dir args} {
+ set old [pwd]
+ if {[file isdirectory $dir]} {
+ cd $dir
+ } else {
+ # A file may be given as reference
+ cd [file dirname $dir]
+ }
+ try {
+ exec {*}$args
+ } finally {
+ cd $old
+ }
+}
+
+# Search upwards the directory structure for a file
+proc SearchUpwardsFromFile {file args} {
+ if {$file eq ""} {
+ set dir [pwd]
+ } elseif {[file isdirectory $file]} {
+ set dir $file
+ } else {
+ set dir [file dirname $file]
+ }
+ while {[file readable $dir] && [file isdirectory $dir]} {
+ foreach candidate $args {
+ if {[file exists [file join $dir $candidate]]} {
+ return 1
+ }
+ }
+ set parent [file dirname $dir]
+ # Make sure to stop if we reach a dead end
+ if {$parent eq $dir} break
+ set dir $parent
+ }
+ return 0
+}
# Get the last two elements in a file path
proc GetLastTwoPath {path} {
set last [file tail $path]
set penultimate [file tail [file dirname $path]]
@@ -1101,52 +1727,84 @@
} else {
return [file join $penultimate $last]
}
}
-# Dialog for log message
-proc LogDialog {top target {clean 0}} {
+# Dialog for commit, getting log message
+proc CommitDialog {top target system precmd postcmd {useSts 0}} {
set w $top.logmsg
destroy $w
toplevel $w -padx 3 -pady 3
wm title $w "Commit log message for $target"
- set ::diff($top,logdialogok) 0
+ set ::eskil($top,logdialogok) 0
+
+ # Dummy frame used for detecting closed window
+ ttk::frame $w.dummy -width 10 -height 10
+ place $w.dummy -x 0 -y 0
- text $w.t -width 70 -height 10
- if {!$clean && [info exists ::diff(logdialog)]} {
- $w.t insert end $::diff(logdialog)
+ text $w.t -width 70 -height 10 -font myfont
+ if {[info exists ::eskil(logdialog)]} {
+ $w.t insert end $::eskil(logdialog)
$w.t tag add sel 1.0 end-1c
$w.t mark set insert 1.0
}
ttk::button $w.ok -width 10 -text "Commit" -underline 1 \
- -command "set ::diff($top,logdialogok) 1 ; \
- set ::diff(logdialog) \[$w.t get 1.0 end\] ; \
- destroy $w"
+ -command "set ::eskil($top,logdialogok) 1 ; \
+ set ::eskil(logdialog) \[$w.t get 1.0 end\] ; \
+ destroy $w.dummy"
ttk::button $w.ca -width 10 -text "Cancel" -command "destroy $w" \
-underline 0
bind $w [list $w.ok invoke]\;break
bind $w [list destroy $w]\;break
bind $w [list destroy $w]\;break
grid $w.t - -sticky news -padx 3 -pady 3
grid $w.ok $w.ca -padx 3 -pady 3
+ grid columnconfigure $w $w.t -weight 1 -uniform a
+ grid rowconfigure $w $w.t -weight 1
tkwait visibility $w
focus -force $w.t
- tkwait window $w
-
- if {$::diff($top,logdialogok)} {
- set res [string trim $::diff(logdialog)]
- set ::diff(logdialog) $res
- if {$res eq ""} {
- set res "No Log"
- }
- } else {
- set res ""
- }
- return $res
+ tkwait window $w.dummy
+
+ if {!$::eskil($top,logdialogok)} {
+ return
+ }
+
+ set res [string trim $::eskil(logdialog)]
+ set ::eskil(logdialog) $res
+
+ # Splash screen for visual feedback
+ set now [clock clicks -milliseconds]
+ ttk::label $w.splash -text "Committing" -anchor center -font myfont
+ place $w.splash -x 0 -y 0 -relwidth 1.0 -relheight 1.0
+ update
+ # Commit
+ set cmd [list {*}$precmd $res {*}$postcmd]
+ set sts [catch {exec {*}$cmd} msg]
+ set msg [string trim $msg]
+ if {($useSts && $sts) || (!$useSts && $msg ne "")} {
+ destroy $w
+ tk_messageBox -icon error -title "$system commit error" -message $msg \
+ -parent $top
+ return
+ }
+ # Keep it up for a decent length, regardless of commit delay
+ while {abs([clock clicks -milliseconds] - $now) < 500} {
+ after 100
+ }
+ destroy $w
+ return $msg
+}
+
+# Dialog for revert acknowledge
+proc RevertDialog {top target} {
+ set msg "Discard local changes for $target ?"
+ set result [tk_messageBox -type okcancel -icon question -parent $top \
+ -title "Revert" -message $msg]
+ return $result
}
# Dialog for log view
proc ViewLog {top filename message} {
set w $top.logview
@@ -1153,11 +1811,11 @@
destroy $w
toplevel $w -padx 3 -pady 3
wm title $w "Log for [file tail $filename]"
text $w.t -width 80 -height 15 -yscrollcommand "$w.sby set" -wrap none
- scrollbar $w.sby -orient vertical -command "$w.t yview"
+ ttk::scrollbar $w.sby -orient vertical -command "$w.t yview"
$w.t insert end $message
ttk::button $w.ok -width 10 -text "Dismiss" -command "destroy $w" \
-underline 0
bind $w [list destroy $w]\;break
ADDED src/startup.tcl
Index: src/startup.tcl
==================================================================
--- /dev/null
+++ src/startup.tcl
@@ -0,0 +1,1308 @@
+#!/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
+# Version string is loaded from version.txt
+set ::eskil(diffver) "Version Unknown"
+set ::eskil(thisScript) [file join [pwd] [info script]]
+set ::eskil(thisDir) [file dirname $::eskil(thisScript)]
+
+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
+
+ if {[catch {package require psballoon}]} {
+ # Add a dummy if it does not exist.
+ proc addBalloon {args} {}
+ } else {
+ namespace import -force psballoon::addBalloon
+ }
+
+ # 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]
+ }
+
+ 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 ] eq ""} {
+ bind all [bind Menubutton ]
+ #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.
+ 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
+ source $srcdir/debug.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 . <>] EskilThemeInit] == -1} {
+ bind . <> +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 {} {
+ puts {Usage: eskil [options] [files...]
+ [options] See below.
+ [files...] Files to be compared
+
+ 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:}
+
+ # 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]} {
+ append outName " "
+ }
+ # Line up shorter ones
+ if {[string length $outName] < 10} {
+ set outName [format %-10s $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 src]
+ 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]} {
+ 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."
+ addFlags -browse -nodiff
+ docFlag -browse "Automatically bring up file dialog 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 windows 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 lines of context"
+ addPrefOpt -printHeaderSize printHeaderSize 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 -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 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"
+ # These affect Pref but via special processing later
+ addMultOpt -prefix
+ docFlag -prefix "Care mainly about words starting with \"str\""
+ addMultOpt -preprocess
+ addMultOpt -preprocessleft
+ addMultOpt -preprocessright
+ docFlag -preprocess "TBW "
+ docFlag -preprocessleft "TBW "
+ docFlag -preprocessright "TBW "
+ # These affect opts
+ addOptsOpt -limit limitlines
+ docFlag -limit "Do not process more than 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 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 foreach [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 -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]
+ }
+ if {$len == 1} {
+ set fullname [lindex $files 0]
+ if {[FileIsDirectory $fullname 1]} {
+ set dirdiff(leftDir) $fullname
+ set dirdiff(rightDir) $dirdiff(leftDir)
+ return [makeDirDiffWin]
+ }
+ } elseif {$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]
+ }
+ }
+
+ # 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 || $foreach} {
+ 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 {!$autobrowse && !$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} {
+ set fullname [file join [pwd] [lindex $files 0]]
+ 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] [lindex $files 1]]
+ 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
+
+ # Print options
+ set ::DefaultPref(printHeaderSize) 10
+ 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
+
+ package require pstools
+ namespace import -force pstools::*
+ getOptions
+ if {![info exists ::eskil_testsuite]} {
+ InitSourceEarly
+ parseCommandLine
+ }
+}
ADDED src/vcsvfs.tcl
Index: src/vcsvfs.tcl
==================================================================
--- /dev/null
+++ src/vcsvfs.tcl
@@ -0,0 +1,860 @@
+#----------------------------------------------------------------------
+# Virtual File System for Version Control Systems
+#
+# Copyright (c) 2014-2015, Peter Spjuth
+#
+# License for vcsvfs package: Same as for Tcl
+#----------------------------------------------------------------------
+
+package require vfs
+package provide vcsvfs 0.2
+
+namespace eval vcsvfs {
+ variable DataRefChan
+ variable mpoints {}
+ namespace eval fossil {}
+ namespace eval svn {}
+ namespace eval git {}
+ namespace eval hg {}
+}
+
+# Create a Virtual File System showing a revision of a fossil checkout
+#
+# dir: Directory in a fossil checkout
+# rev: Revision to mount
+#
+# Returns: path to the generated VFS
+proc vcsvfs::fossil::mount {dir rev} {
+ variable ::vcsvfs::mpoints
+ set dir [file normalize $dir]
+
+ # Fossil command must be run within the dir, so temporarily change pwd
+ set oldpwd [pwd]
+ cd $dir
+
+ # The mount point will always be at the fossil root, even if
+ # a sub directory was given.
+ # Locate fossil root for the given directory.
+ set info [exec fossil info]
+ regexp -line {local-root:\s*(\S.*)} $info -> root
+ set root [file normalize $root]
+ cd $root
+
+ # Getting files via manifest artifact
+ # This is a quick and robust way to get the file tree and each file's sha
+ # Other info is trickier and is handled below
+ if {[catch {exec fossil artifact $rev} artifact]} {
+ return -code error "No such fossil revision: $rev"
+ }
+ set commitTime 0
+ set cTime now
+ set finfo {}
+ set todo [split $artifact \n]
+ while {[llength $todo] > 0} {
+ set line [lindex $todo 0]
+ set todo [lrange $todo 1 end]
+ # Expected format in a line:
+ # B baseline
+ # F tests/left.txt c1572b3809a1ba6ab2de9307c96b1cfeefdcf0ba
+ # D 2015-02-23T23:30:07.509
+ if {[regexp {^B (.*)} $line -> bUuid]} {
+ # Pick up a baseline manifest and parse it first
+ set artifact [exec fossil "artifact" $bUuid]
+ set todo [concat [split $artifact \n] $todo]
+ continue
+ }
+ if {[regexp {^D (.*)} $line -> cTime]} {
+ # Remove decimals and middle T
+ regsub {\.\d+} $cTime "" cTime
+ regsub {T} $cTime " " cTime
+ set commitTime [clock scan $cTime -gmt 1]
+ }
+ if {[regexp {^F (\S+) (\S+)} $line -> fName fSha]} {
+ # File names can have spaces, coded with \s
+ set fName [string map {\\s " "} $fName]
+ dict set finfo $fName sha $fSha
+ dict set finfo $fName mtimestr $cTime ;# Anything
+ dict set finfo $fName type file
+ dict set finfo $fName isfile 1
+ dict set finfo $fName isdir 0
+ # Setting size is delayed until needed since the needed
+ # calls are relatively expensive.
+
+ # Mark all known directory paths and build up file tree info
+ set parentStr ""
+ foreach dirPath [file split $fName] {
+ dict set finfo $parentStr child $dirPath 1
+ dict set finfo $parentStr isfile 0
+ dict set finfo $parentStr isdir 1
+ dict set finfo $parentStr type directory
+ set parentStr [file join $parentStr $dirPath]
+ }
+ }
+ }
+ # Try to use "fossil ls -r, available in newer versions"
+ set doneCollecting 0
+ if {![catch {exec fossil ls -r $rev -v} lsdata]} {
+ set lsdata [string trim $lsdata \n]
+ foreach line [split $lsdata \n] {
+ # Expected format in a line:
+ # 2012-08-21 20:38:19 4563 tests/rev.test
+ regexp {(\S+ \S+)\s+(\d+)\s+(.+)} $line -> fDate fSize fName
+ dict set finfo $fName mtimestr $fDate
+ dict set finfo $fName size $fSize
+ }
+ set doneCollecting 1
+ }
+
+ # Getting files via http fileage to aquire file times
+ # Since dates are parsed from the age string they are rather imprecise
+ # Use a while around it to be able to break free easily (faking goto)
+ while {!$doneCollecting} {
+ set html [exec fossil http << "GET /fileage?name=$rev"]
+ if {![regexp {Files in.*} $html html]} {
+ # Not the expected format of response, skip
+ break
+ }
+ if {![regexp {\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2}} $html cTime2]} {
+ # Not the expected format of response, skip
+ break
+ }
+ # This is currently unused since we do not trust the formatted time in
+ # the web page. The time stamp from the artifact is used later.
+ set commitTime2 [clock scan $cTime2 -gmt 1]
+ #puts "CT $commitTime CT2 $commitTime2"
+ # Rows in the HTML table
+ foreach row [regexp -all -inline {.*? } $html] {
+ # Columns in the HTML table
+ set cols [regexp -all -inline {(.*?) } $row]
+ set col1 [string trim [lindex $cols 1]]
+ set col2 [string trim [lindex $cols 3]]
+ # First column is age, in readable format
+ # e.g. "current" "36.4 minutes" "97.0 days" "1.06 years"
+ if {$col1 eq ""} continue
+ if {$col1 eq "current"} {
+ set fTime $commitTime
+ set err 0
+ } else {
+ set value [lindex $col1 0]
+ set unit [lindex $col1 1]
+ set err 0
+ switch -glob $unit {
+ second* {
+ set value [expr {int($value)}]
+ set unit second
+ set err 0
+ }
+ minute* {
+ # In general, try to underestimate the value. The web
+ # page rounds to one decimal.
+ set value [expr {int(($value-0.05)*60)}]
+ set unit second
+ set err 6
+ }
+ hour* {
+ set value [expr {int(($value-0.05)*60*60)}]
+ set unit second
+ set err 360
+ }
+ day* {
+ set value [expr {int(($value-0.05)*60*60*24)}]
+ set unit second
+ set err 8640
+ }
+ year* {
+ # Year has two decimals
+ set value [expr {int(($value-0.005)*60*60*24*365)}]
+ set unit second
+ set err [expr {6*60*24*365}]
+ }
+ default {
+ puts "Unhandled unit: $unit in '$col1'"
+ set value [expr {int($value)}]
+ }
+ }
+ set fTime [expr {$commitTime - $value}]
+ }
+ #puts "AGE $col1 -> $fTime"
+
+ # Second column is file names, separated by } $col2 "" col2
+ regsub -all { } $col2 "" col2
+ regsub -all {\n} $col2 "" col2
+ regsub -all {(.*) } $line -> fName]} {
+ continue
+ }
+ if {[regexp {(.*) } $line -> fDate]} {
+ dict set finfo $fName mtimestr $fDate
+ continue
+ }
+ if {[regexp {(.*) } $line -> fSize]} {
+ dict set finfo $fName size $fSize
+ continue
+ }
+ }
+
+ cd $oldpwd
+
+ # Generate a mount point.
+ set tail [string range $dir [string length $root] end]
+ set mountpoint "${root} ($rev)"
+
+ dict set mpoints $mountpoint "finfo" $finfo
+ dict set mpoints $mountpoint "origroot" $root
+ dict set mpoints $mountpoint "rev" $rev
+ dict set mpoints $mountpoint "vcstype" svn
+ vfs::filesystem mount $mountpoint [list vcsvfs::Vfs]
+
+ set result $mountpoint$tail
+ #puts $result
+ #puts [dict size $finfo]
+ #puts [dict get $finfo [lindex $finfo 0]]
+ return $result
+}
+
+proc vcsvfs::svn::unmount {dir} {
+ variable ::vcsvfs::mpoints
+ # TBD: Find the mountpoint
+ #dict unset mpoints $mountpoint
+ #vfs::filesystem unmount $mountpoint
+}
+
+# Create a Virtual File System showing a revision of a HG checkout
+#
+# dir: Directory in an HG checkout
+# rev: Revision to mount
+#
+# Returns: path to the generated VFS
+proc vcsvfs::hg::mount {dir rev} {
+ variable ::vcsvfs::mpoints
+ set dir [file normalize $dir]
+
+ # Command must be run within the dir, so temporarily change pwd
+ set oldpwd [pwd]
+ cd $dir
+
+ # The mount point will normally be at the wc root, even if
+ # a sub directory was given.
+ # Locate root for the given directory.
+ set root [exec hg root]
+ # TBD: Always root at given dir, for speed
+ #set root .
+ #set root [file normalize $root]
+ #cd $root
+
+ # Getting files via manifest
+ set allfiles [exec hg manifest --debug -r $rev]
+ # Expected line format:
+ # sha1sum perms *? name
+ foreach line [split $allfiles \n] {
+ # Each line is one file name
+ regexp {^(\S+)\s+\S+\s+\*?\s*(\S.*)$} $line -> sha fName
+ dict set finfo $fName isfile 1
+ dict set finfo $fName isdir 0
+ dict set finfo $fName "sha" $sha
+ dict set finfo $fName type file
+ # Fake mtime and size from sha, to make same look same
+ dict set finfo $fName mtime [scan [string range $sha 0 6] %x]
+ dict set finfo $fName size [scan [string range $sha 7 9] %x]
+ # Mark all known directory paths and build up file tree info
+ set parentStr ""
+ foreach dirPath [file split $fName] {
+ dict set finfo $parentStr child $dirPath 1
+ dict set finfo $parentStr isfile 0
+ dict set finfo $parentStr isdir 1
+ dict set finfo $parentStr type directory
+ set parentStr [file join $parentStr $dirPath]
+ }
+ }
+ # TBD: Any way to get file sizes and mtimes from HG?
+
+ # Try using the hglist extension
+ set cmd [list hg ls --template "{size} {date} {name}\n" -a \
+ --recursive -r $rev]
+ if {![catch {exec {*}$cmd} allfiles]} {
+ # Expected line format:
+ # size date name
+ foreach line [split $allfiles \n] {
+ if {[regexp {^(\d+)\s+(\d+)\S*\s+(\S.*)$} $line -> size mtime fName]} {
+ # Check that it matches something filled in from the manifest
+ if {[dict exists $finfo $fName]} {
+ dict set finfo $fName "mtime" $mtime
+ dict set finfo $fName "size" $size
+ }
+ }
+ }
+ }
+
+ cd $oldpwd
+
+ # Generate a mount point.
+ set tail [string range $dir [string length $root] end]
+ set mountpoint "${root} ($rev)"
+
+ dict set mpoints $mountpoint "finfo" $finfo
+ dict set mpoints $mountpoint "origroot" $root
+ dict set mpoints $mountpoint "rev" $rev
+ dict set mpoints $mountpoint "vcstype" hg
+ vfs::filesystem mount $mountpoint [list vcsvfs::Vfs]
+
+ set result $mountpoint$tail
+ return $result
+}
+
+proc vcsvfs::hg::unmount {dir} {
+ variable ::vcsvfs::mpoints
+ # TBD: Find the mountpoint
+ #dict unset mpoints $mountpoint
+ #vfs::filesystem unmount $mountpoint
+}
+
+# Create a Virtual File System showing a revision of a GIT checkout
+#
+# dir: Directory in an GIT checkout
+# rev: Revision to mount
+#
+# Returns: path to the generated VFS
+proc vcsvfs::git::mount {dir rev} {
+ variable ::vcsvfs::mpoints
+ set dir [file normalize $dir]
+
+ # Command must be run within the dir, so temporarily change pwd
+ set oldpwd [pwd]
+ cd $dir
+
+ # The mount point will be at the given dir
+ set root $dir
+
+ # Getting files via ls
+ set allfiles [exec git ls-tree -r --long $rev .]
+ foreach line [split $allfiles \n] {
+ # Each line is:
+ # SP SP SP TAB
+ regexp {(\S)+\s+(\S+)\s+(\S+)\s+(\S+)\t(.*)} $line -> \
+ mode type sha size fName
+ # TBD: check mode to see a link
+ if {$type eq "tree"} {
+ dict set finfo $fName isfile 0
+ dict set finfo $fName isdir 1
+ dict set finfo $fName "type" directory
+ } else {
+ # This is a file
+ dict set finfo $fName isfile 1
+ dict set finfo $fName isdir 0
+ dict set finfo $fName "type" file
+ dict set finfo $fName "sha" $sha
+ dict set finfo $fName "size" $size
+ # TBD: Delay this call until mtime is needed?
+ set mtime [exec git log --pretty=format:%ct -n 1 $fName]
+ dict set finfo $fName "mtime" $mtime
+ }
+ # Mark all known directory paths and build up file tree info
+ set parentStr ""
+ foreach dirPath [file split $fName] {
+ dict set finfo $parentStr child $dirPath 1
+ dict set finfo $parentStr isfile 0
+ dict set finfo $parentStr isdir 1
+ dict set finfo $parentStr "type" directory
+ set parentStr [file join $parentStr $dirPath]
+ }
+ }
+
+ cd $oldpwd
+
+ # Generate a mount point.
+ set tail [string range $dir [string length $root] end]
+ set mountpoint "${root} ($rev)"
+
+ dict set mpoints $mountpoint "finfo" $finfo
+ dict set mpoints $mountpoint "origroot" $root
+ dict set mpoints $mountpoint "rev" $rev
+ dict set mpoints $mountpoint "vcstype" git
+ vfs::filesystem mount $mountpoint [list vcsvfs::Vfs]
+
+ set result $mountpoint$tail
+ #puts $result
+ #puts [dict size $finfo]
+ #puts [dict get $finfo [lindex $finfo 0]]
+ return $result
+}
+
+proc vcsvfs::git::unmount {dir} {
+ variable ::vcsvfs::mpoints
+ # TBD: Find the mountpoint
+ #dict unset mpoints $mountpoint
+ #vfs::filesystem unmount $mountpoint
+}
+
+# Handler for Reflected Channel
+proc vcsvfs::DataRefChan {id cmd chId args} {
+ variable DataRefChan
+ switch $cmd {
+ initialize {
+ set mode [lindex $args 0]
+ return "initialize finalize watch read"
+ }
+ finalize {
+ unset DataRefChan($id,data)
+ return
+ }
+ watch {
+ #set eventSpec [lindex $args 0]
+ return
+ }
+ read {
+ set count [lindex $args 0]
+ set si $DataRefChan($id,ptr)
+ set newPtr [expr {$si + $count}]
+ set ei [expr {$newPtr - 1}]
+ set data [string range $DataRefChan($id,data) $si $ei]
+ set DataRefChan($id,ptr) $newPtr
+ return $data
+ }
+ }
+}
+
+# Set up a Reflected Channel which reads the provided data
+proc vcsvfs::CreateDataRefChan {data} {
+ variable DataRefChan
+ set t 0
+ while {[info exists DataRefChan($t,data)]} {
+ incr t
+ }
+ set DataRefChan($t,data) $data
+ set DataRefChan($t,ptr) 0
+ set chId [chan create r [list vcsvfs::DataRefChan $t]]
+ return $chId
+}
+
+# This is used before closing a pipe from a command.
+# It should read all data to avoid errors from the command.
+proc vcsvfs::ReadAllBeforeClose {chId} {
+ read $chId
+}
+
+# Helper for glob matching in directory
+proc vcsvfs::MatchInDirectory {finfo relative actual args} {
+ set pattern [lindex $args 0]
+ set types [lindex $args 1]
+ set allowFile 0
+ set allowDir 0
+ if {[vfs::matchDirectories $types]} {set allowDir 1}
+ if {[vfs::matchFiles $types]} {set allowFile 1}
+
+ set result {}
+ if {[dict exists $finfo $relative child]} {
+ set childD [dict get $finfo $relative child]
+ } else {
+ # Empty dir
+ return {}
+ }
+ foreach child [dict keys $childD] {
+ if {![string match $pattern $child]} continue
+ set local [file join $relative $child]
+ if {[dict get $finfo $local isfile] && !$allowFile} continue
+ if {[dict get $finfo $local isdir] && !$allowDir} continue
+ lappend result [file join $actual $child]
+ }
+ return $result
+}
+
+# Extract file data from Fossil revision
+proc vcsvfs::fossil::openFile {rootD relative mode} {
+ set oldpwd [pwd]
+ cd [dict get $rootD "origroot"]
+ set rev [dict get $rootD rev]
+ # Which way of extracting file data is best?
+ # fossil finfo -p -r $rev $relative
+ # set sha [dict get $finfor sha]
+ # fossil artifact $sha
+ # fossil cat $relative -r $rev
+ # Read through a pipe to get requested mode
+ set chId [open [list |fossil cat $relative -r $rev] $mode]
+ cd $oldpwd
+
+ return [list $chId [list vcsvfs::ReadAllBeforeClose $chId]]
+}
+
+# Extract file data from Subversion revision
+proc vcsvfs::svn::openFile {rootD relative mode} {
+ set oldpwd [pwd]
+ cd [dict get $rootD "origroot"]
+ set rev [dict get $rootD rev]
+ # Read through a pipe to get requested mode
+ set chId [open [list |svn cat -r $rev $relative] $mode]
+ cd $oldpwd
+
+ return [list $chId [list vcsvfs::ReadAllBeforeClose $chId]]
+}
+
+# Extract file data from HG revision
+proc vcsvfs::hg::openFile {rootD relative mode} {
+ set oldpwd [pwd]
+ cd [dict get $rootD "origroot"]
+ set rev [dict get $rootD rev]
+ # Read through a pipe to get requested mode
+ set chId [open [list |hg cat -r $rev $relative] $mode]
+ cd $oldpwd
+
+ return [list $chId [list vcsvfs::ReadAllBeforeClose $chId]]
+}
+
+# Some notes about git commands that can be good to have
+proc vcsvfs::git::openFile {rootD relative mode} {
+ set oldpwd [pwd]
+ cd [dict get $rootD "origroot"]
+ set sha [dict get $rootD finfo $relative sha]
+ #git cat-file
+ #git show ^{tree}
+ # example: git show HEAD^^^:apa
+
+ # Read through a pipe to get requested mode
+ set chId [open [list |git cat-file blob $sha] $mode]
+ cd $oldpwd
+
+ return [list $chId [list vcsvfs::ReadAllBeforeClose $chId]]
+}
+
+# Fossil may delay filling in size, this takes car of that
+proc vcsvfs::fossil::size {finfo} {
+ # Use "fossil whatis" on its sha
+ # Expected format in a line:
+ # size: 629 bytes
+ set whatis [exec fossil whatis [dict get $finfo sha]]
+ regexp {size:\s+(\d+)} $whatis -> fSize
+ return $fSize
+}
+
+# Parse a time string from Fossil
+proc vcsvfs::fossil::mTime {finfo} {
+ set mtimestr [dict get $finfo mtimestr]
+ # TBD parse to mtime correct?
+ set mtime [clock scan $mtimestr -gmt 1]
+ return $mtime
+}
+
+# Parse a time string from Subversion
+proc vcsvfs::svn::mTime {finfo} {
+ set mtimestr [dict get $finfo mtimestr]
+ # TBD parse to mtime correct?
+ # Remove any decimals from time string
+ regsub {\.\d+Z} $mtimestr "" mtimestr
+ set mtime [clock scan $mtimestr -gmt 1]
+ return $mtime
+}
+
+# The handler for the mounted VFS
+proc vcsvfs::Vfs {subcmd root relative actual args} {
+ variable mpoints
+ #puts "\nVfs called:"
+ #puts " Su $subcmd"
+ #puts " Ro $root"
+ #puts " Re $relative"
+ #puts " Ac $actual"
+ #puts " Ar $args"
+
+ set rootD [dict get $mpoints $root]
+ set origroot [dict get $rootD origroot]
+ set finfo [dict get $rootD finfo]
+ set vcstype [dict get $rootD vcstype]
+
+ if {![dict exists $finfo $relative]} {
+ # Unknown path
+ vfs::filesystem posixerror $::vfs::posix(EACCES)
+ return -code error $::vfs::posix(EACCES)
+ }
+ set finfor [dict get $finfo $relative]
+ #puts " $finfor"
+
+ switch $subcmd {
+ access {
+ set mode [vfs::accessMode [lindex $args 0]]
+ # Only read supported
+ if {$mode ne "R"} {
+ vfs::filesystem posixerror $::vfs::posix(EACCES)
+ return -code error $::vfs::posix(EACCES)
+ }
+ return
+ }
+ fileattributes {
+ #set index [lindex $args 0]
+ #set value [lindex $args 1]
+ return
+ }
+ matchindirectory {
+ return [vcsvfs::MatchInDirectory $finfo $relative $actual {*}$args]
+ }
+ open {
+ set mode [lindex $args 0]
+ if {$mode == {}} {set mode r}
+ #set permissions [lindex $args 1]
+ if {$mode ne "r" && $mode ne "rb"} {
+ # Read only
+ vfs::filesystem posixerror $::vfs::posix(EACCES)
+ return -code error $::vfs::posix(EACCES)
+ }
+
+ return [vcsvfs::${vcstype}::openFile $rootD $relative $mode]
+ }
+ stat {
+ set res [dict create dev 0 ino 0 "mode" 0 nlink 0 uid 0 gid 0 \
+ size 0 atime 0 mtime 0 ctime 0 type file]
+ dict set res type [dict get $finfor type]
+ if {[dict get $finfor isfile]} {
+ # Fill in any postponed info
+ if {![dict exists $finfor mtime]} {
+ set mtime [vcsvfs::${vcstype}::mTime $finfor]
+ dict set finfor "mtime" $mtime
+ # Cache in main dictionary too
+ dict set mpoints $root "finfo" $relative "mtime" $mtime
+ }
+ if {![dict exists $finfor size]} {
+ set size [vcsvfs::${vcstype}::size $finfor]
+ dict set finfor "size" $size
+ # Cache in main dictionary too
+ dict set mpoints $root "finfo" $relative "size" $size
+ }
+ dict set res "mtime" [dict get $finfor "mtime"]
+ dict set res "size" [dict get $finfor "size"]
+ }
+ return $res
+ }
+ createdirectory - deletefile - removedirectory - utime {
+ # Read-only, always error
+ }
+ }
+ vfs::filesystem posixerror $::vfs::posix(EACCES)
+ return -code error $::vfs::posix(EACCES)
+}
+
+##################################################################
+# Test structure
+##################################################################
+if 0 {
+# File traversing stuff from wiki...
+proc ftw_1 {{dirs .}} {
+ while {[llength $dirs]} {
+ set dirs [lassign $dirs name]
+ lappend dirs {*}[glob -nocomplain -directory $name -type d *]
+ puts $name
+ }
+}
+proc ls-l { dir } {
+ # Get the current year, because the date format depends on it.
+ set thisYear [clock format [clock seconds] -format %Y]
+ # Walk the files in the given directory, accumulating lines
+ # in $retval
+ set retval {}
+ set sep {}
+ # In Tcl older than 8.3 use 'glob [file join $dir *]'
+ foreach fileName [lsort [glob -dir $dir *]] {
+ append retval $sep
+ set sep \n
+ # Get status of the file
+ #file stat $fileName stat
+ # use 'file lstat' instead: if the file is a symbolic link we don't want info about its target
+ file lstat $fileName stat
+ # Put in one character for file type. Use - for a plain file.
+ set type -
+ if { [info exists stat(type)]
+ && [string compare file $stat(type)] } {
+ set type [string index $stat(type) 0]
+ }
+ append retval $type
+ # Decode $stat(mode) into permissions the way that ls does it.
+ foreach { mask pairs } {
+ 00400 { 00400 r }
+ 00200 { 00200 w }
+ 04100 { 04100 s 04000 S 00100 x }
+ 00040 { 00040 r }
+ 00020 { 00020 w }
+ 02010 { 02010 s 02000 S 00010 x }
+ 00004 { 00004 r }
+ 00002 { 00002 w }
+ 01001 { 01001 t 01000 T 00001 x }
+ } {
+ set value [expr $stat(mode) & $mask]
+ set bit -
+ foreach { x b } $pairs {
+ if { $value == $x } {
+ set bit $b
+ }
+ }
+ append retval $bit
+ }
+ # Put in link count, user ID, and size. Note that the UID
+ # will be numeric. If you know how to back-translate this
+ # from Tcl, please feel free to edit it in!
+ # LV writes - use file userid and file groupid to convert the numbers back to names.
+ # I don't know what version of Tcl added those commands...
+ append retval [format %4d $stat(nlink)] { }
+ array set attribs [file attributes $fileName]
+ if {[info exists attribs(-owner)]} {
+ append retval [format %-8s $attribs(-owner)]
+ append retval [format %-8s $attribs(-group)]
+ } else {
+ append retval [format %8d $stat(uid)]
+ append retval [format %8d $stat(gid)]
+ }
+ append retval [format %9d $stat(size)]
+ # Put in the date. The current year is formatted differently
+ # from prior years.
+ set year [clock format $stat(mtime) -format "%Y"]
+ if { $year == $thisYear } {
+ set modified [clock format $stat(mtime) -format "%h %e %H:%M"]
+ } else {
+ set modified [clock format $stat(mtime) -format "%h %e %Y"]
+ }
+ # glennj: see note below
+ append retval { } $modified { }
+ # Finally, put in the file name, stripping off the directory.
+ append retval [file tail $fileName]
+ if {[string compare $stat(type) link] == 0} {
+ append retval " -> [file readlink $fileName]"
+ }
+ if {$type eq "-"} {
+ set ch [open $fileName]
+ set x [read $ch]
+ set x [string range $x 0 4]
+ close $ch
+ append retval " = '$x'"
+ }
+ unset stat attribs
+ }
+ return $retval
+}
+
+
+set d [vcsvfs::fossil::mount ~/src/eskil f96b0fd915]
+puts "------------- GLOB:"
+puts [join [glob -dir $d *] \n]
+puts "------------- FTW:"
+ftw_1 [list $d]
+puts "------------- LS:"
+puts [ls-l $d]
+}
Index: tests/all.tcl
==================================================================
--- tests/all.tcl
+++ tests/all.tcl
@@ -1,33 +1,37 @@
#!/bin/sh
#----------------------------------------------------------------------
# $Revision$
#----------------------------------------------------------------------
# the next line restarts using tclsh \
-exec tclsh8.5 "$0" "$@"
+exec tclsh "$0" "$@"
set testScript [file normalize [file join [pwd] [info script]]]
set testDir [file dirname $testScript]
lappend auto_path eskil.vfs/lib
package require tcltest 2.2
namespace import tcltest::*
-tcltest::configure -verbose "body error"
+tcltest::configure -verbose "body error" -singleproc 1
#testConstraint knownbug 1
#tcltest::configure -match print-*
+
+if {$argc > 0} {
+ eval tcltest::configure $argv
+}
package require Tk
wm withdraw .
set ::eskil_testsuite 1
-if {[file exists src/eskil.tcl_i]} {
+if {[file exists eskil.vfs/src/startup.tcl_i]} {
puts "Running with code coverage"
- source src/eskil.tcl_i
+ source eskil.vfs/src/startup.tcl_i
} else {
- source src/eskil.tcl
+ source eskil.vfs/src/startup.tcl
}
Init
# Helpers to temporarily stub things out
set ::stubs {}
@@ -45,15 +49,16 @@
rename _stub_$name $name
}
set ::stubs {}
}
+proc ExecEskil {args} {
+ return [exec ./eskil.kit {*}$args]
+}
-puts "Running Tests"
+tcltest::testsDirectory $testDir
+tcltest::runAllTests
-foreach test [glob -nocomplain $testDir/*.test] {
- source $test
- clearstub
-}
+cleanupTestFile
tcltest::cleanupTests 1
exit
Index: tests/blocks.test
==================================================================
--- tests/blocks.test
+++ tests/blocks.test
@@ -1,8 +1,7 @@
-# Tests for comparing blocks. -*- tcl -*-
-#----------------------------------------------------------------------
-# $Revision$
+#------------------------------------------------------------*- tcl -*-
+# Tests for comparing blocks.
#----------------------------------------------------------------------
test blocks-1.1 {
Change-block parsing
} -body {
ADDED tests/cmdline.test
Index: tests/cmdline.test
==================================================================
--- /dev/null
+++ tests/cmdline.test
@@ -0,0 +1,11 @@
+#------------------------------------------------------------*- tcl -*-
+# Tests for command line.
+#----------------------------------------------------------------------
+
+test cmdline-1.1 {cmd line query} -body {
+ set res [ExecEskil --query -]
+} -match glob -result {*-browse *-help *-table *}
+
+test cmdline-1.2 {cmd line query} -body {
+ set res [ExecEskil --query -l]
+} -result {-limit -line}
Index: tests/dir.test
==================================================================
--- tests/dir.test
+++ tests/dir.test
@@ -1,12 +1,13 @@
-# Tests for comparing directories. -*- tcl -*-
-#----------------------------------------------------------------------
-# $Revision$
+#------------------------------------------------------------*- tcl -*-
+# Tests for comparing directories.
#----------------------------------------------------------------------
set ::Pref(dir,ignorekey) 0
set ::Pref(dir,comparelevel) 1
+set ::eskil(.dirdiff,plugin) ""
+set ::eskil(.dirdiff,dirPlugin) 0
proc testCompareFiles {text1 text2 {sametime 0}} {
set ch [open _f1_ w]
puts -nonewline $ch $text1
close $ch
@@ -115,13 +116,13 @@
set res [testCompareFiles "abab" "baba"]
# Different size
append res [testCompareFiles "abab" "babax"]
set ::Pref(dir,comparelevel) 1
append res [testCompareFiles "abab" "baba"]
- # Same time
+ # Same time is not enough anymore
append res [testCompareFiles "abab" "baba" 1]
-} -result {11000011}
+} -result {11000000}
test dir-5.1 {
CompareFiles, directories
} -body {
touch _f1_
Index: tests/gui.test
==================================================================
--- tests/gui.test
+++ tests/gui.test
@@ -1,10 +1,8 @@
#------------------------------------------------------------*- tcl -*-
# Tests for GUI
#----------------------------------------------------------------------
-# $Revision$
-#----------------------------------------------------------------------
lappend ::auto_path /home/peter/src/TkTest
package require TkTest
wm withdraw .
@@ -23,21 +21,28 @@
exec xhost -
}
XauthSecure
proc RestartClient {args} {
- set ::clientfile ./eskil.kit
+ if {[file exists eskil.vfs/main.tcl_i]} {
+ puts "Starting gui instrumented"
+ set src eskil.vfs/main.tcl_i
+ } else {
+ set src eskil.vfs/main.tcl
+ }
+ set cmd [list tclkit $src]
+ #set ::clientfile ./eskil.kit
#if {[file exists ${::clientfile}_i]} {
# set ::clientfile ${::clientfile}_i
#}
if {![catch {send -async Eskil exit}]} {
update
after 500
}
- set slavepid [exec $::clientfile -server {*}$args &]
+ set slavepid [exec {*}$cmd -server {*}$args &]
after 1000
while {[catch {tktest::init Eskil}]} {
after 500
}
@@ -96,15 +101,15 @@
test gui-1.1 {Run 3-way merge} -setup {
set f1 [tcltest::makeFile {} _test1]
} -body {
RestartClient -fine -a tests/ancestor.txt tests/left.txt tests/right.txt -o $f1
tktest::waitFocus press Save
- tktest::waitFocus press No
+ tktest::waitFocus press Ok
tktest::press Close
catch {exec diff $f1 tests/merge.txt}
} -cleanup {
tcltest::removeFile {} _test1
} -result {0}
catch {tktest::menu File Quit}
catch {send -async Eskil exit}
update
Index: tests/patch.test
==================================================================
--- tests/patch.test
+++ tests/patch.test
@@ -1,32 +1,65 @@
-# Tests for patch file parsingunctions -*- tcl -*-
-#----------------------------------------------------------------------
-# $Revision$
+#------------------------------------------------------------*- tcl -*-
+# Tests for patch file parsing functions
#----------------------------------------------------------------------
# Overload exec during these tests
-set ::diff(gurka,patchFile) ""
-set ::diff(gurka,patchData) ""
+set ::eskil(gurka,patchFile) ""
+set ::eskil(gurka,patchData) ""
stub update args {}
stub getFullPatch {top} {
return $::testpatch
}
stub displayOnePatch {top leftLines rightLines leftLine rightLine} {
+ # Line per patch
+ lappend ::_patchfiles(pll) $leftLine
+ lappend ::_patchfiles(prl) $rightLine
+ # All lines
+ foreach l $leftLines {
+ lassign $l lline lmode lstr
+ lappend ::_patchfiles(ll) $lline
+ }
+ foreach l $rightLines {
+ lassign $l lline lmode lstr
+ lappend ::_patchfiles(rl) $lline
+ }
}
stub emptyLine {top n {highlight 1}} {
- incr ::_patchfiles
+ incr ::_patchfiles(e)
}
stub insertLine {top n line text {tag {equal}} {linetag {}}} {
}
stub addChange {top n tag line1 n1 line2 n2} {}
proc _PatchInit {} {
- set ::_patchfiles 0
-
+ set ::_patchfiles(e) 0
+ set ::_patchfiles(pll) {}
+ set ::_patchfiles(prl) {}
+ set ::_patchfiles(ll) {}
+ set ::_patchfiles(rl) {}
}
+
test patch-1.1 {
Xxx
+} -body {
+ _PatchInit
+ set ::testpatch [string trim {
+--- foo.txt 2016-07-10 21:53:36.671932638 -0700
++++ bar.txt 2016-07-10 21:53:54.739860205 -0700
+@@ -1 +1,2 @@
++0
+ 1
+@@ -5 +8,9 @@
++0
+ 1
+ }]
+ displayPatch gurka
+ concat $_patchfiles(ll) $_patchfiles(rl)
+} -result {1 5 1 2 8 9}
+
+test patch-1.2 {
+ Xxx
} -body {
_PatchInit
set ::testpatch {
Index: vhdl/tb/tb_system.bhv
===================================================================
@@ -131,7 +164,43 @@
procedure TcAddrCalc(PresentAddr : in integer;
AccWidth : in DynamicSize_T;
}
displayPatch gurka
- set ::_patchfiles
+ set ::_patchfiles(e)
} -result {6}
+
+test patch-2.1 {
+ Format with #
+} -body {
+ _PatchInit
+ set ::testpatch [string trim {
+--- foo.txt 2016-07-10 21:53:36.671932638 -0700
++++ bar.txt 2016-07-10 21:53:54.739860205 -0700
+## -1 +1,2 ##
++0
+ 1
+## -5 +8,9 ##
++0
+ 1
+ }]
+ displayPatch gurka
+ concat $_patchfiles(ll) $_patchfiles(rl)
+} -result {1 5 1 2 8 9}
+
+test patch-2.2 {
+ FOrmat with #
+} -body {
+ _PatchInit
+ set ::testpatch [string trim {
+--- foo.txt 2016-07-10 21:53:36.671932638 -0700
++++ bar.txt 2016-07-10 21:53:54.739860205 -0700
+## -1 +1 ##
++0
+ 1
+## -5 +8 ##
++0
+ 1
+ }]
+ displayPatch gurka
+ concat $_patchfiles(ll) $_patchfiles(rl)
+} -result {1 5 1 2 8 9}
Index: tests/print.test
==================================================================
--- tests/print.test
+++ tests/print.test
@@ -1,8 +1,7 @@
-# Tests for printing. -*- tcl -*-
-#----------------------------------------------------------------------
-# $Revision$
+#------------------------------------------------------------*- tcl -*-
+# Tests for printing.
#----------------------------------------------------------------------
test print-1.1 {Tab expansion} {FixTextBlock "a\fp\fa" 1.0} {apa}
test print-1.2 {Tab expansion} {FixTextBlock "\tapa" 1.0} { apa}
test print-1.3 {Tab expansion} {FixTextBlock "\tapa" 1.1} { apa}
@@ -19,11 +18,15 @@
set f1 [tcltest::makeFile {} _test1]
set f2 [tcltest::makeFile {} _test2]
set f3 [tcltest::makeFile {} _test3]
set ch1 [open $f1 w]
set ch2 [open $f2 w]
- set data [string repeat xx\n 12345]
+ set dlines {}
+ for {set t 1} {$t <= 12345} {incr t} {
+ lappend dlines "xx$t"
+ }
+ set data [join $dlines \n]
puts $ch1 "Diffline0.1"
puts $ch2 "Diffline0.2"
puts $ch1 $data
puts $ch2 $data
puts $ch1 "Diffline1.1"
@@ -35,41 +38,45 @@
puts $ch1 $data
puts $ch2 $data
close $ch1
close $ch2
} -body {
- set res [exec ./eskil.kit -context 5 -printpdf $f3 $f1 $f2]
+ set res [ExecEskil -context 5 -printpdf $f3 $f1 $f2]
puts $res
- set ch [open $f3 r]
+ set ch [open $f3 rb]
set data [read $ch]
close $ch
+ # Find first stream, which is the page obj
+ regexp {stream\n(.*?)endstream} $data -> pageStream
+ catch {package require zlib}
+ set data [zlib decompress $pageStream]
# Check that line numbers take up 7 chars
string match "*( 3: )*(24690: )*" $data
} -cleanup {
tcltest::removeFile {} _test1
tcltest::removeFile {} _test2
tcltest::removeFile {} _test3
} -result {1}
test print-3.1 {Pdf, cmd line} -body {
- set res [exec ./eskil.kit -printHeaderSize x]
+ set res [ExecEskil -printHeaderSize x]
} -result {Argument -printHeaderSize must be a positive number}
test print-3.2 {Pdf, cmd line} -body {
- set res [exec ./eskil.kit -printCharsPerLine -5]
+ set res [ExecEskil -printCharsPerLine -5]
} -result {Argument -printCharsPerLine must be a positive number}
test print-3.3 {Pdf, cmd line} -body {
- set res [exec ./eskil.kit -printPaper qx]
+ set res [ExecEskil -printPaper qx]
} -match glob -result {Argument -printPaper must be a valid paper size*}
test print-3.4 {Pdf, cmd line} -body {
- set res [exec ./eskil.kit -printColorChange x]
+ set res [ExecEskil -printColorChange x]
} -result {Argument -printColorChange must be a list of RBG values from 0.0 to 1.0}
test print-3.5 {Pdf, cmd line} -body {
- set res [exec ./eskil.kit -printColorOld "0 1 2"]
+ set res [ExecEskil -printColorOld "0 1 2"]
} -result {Argument -printColorOld must be a list of RBG values from 0.0 to 1.0}
test print-3.6 {Pdf, cmd line} -body {
- set res [exec ./eskil.kit -printColorNew "0 -1 0.5"]
+ set res [ExecEskil -printColorNew "0 -1 0.5"]
} -result {Argument -printColorNew must be a list of RBG values from 0.0 to 1.0}
Index: tests/procs.test
==================================================================
--- tests/procs.test
+++ tests/procs.test
@@ -1,8 +1,7 @@
-# Tests for comparing misc procedures. -*- tcl -*-
-#----------------------------------------------------------------------
-# $Revision$
+#------------------------------------------------------------*- tcl -*-
+# Tests for comparing misc procedures.
#----------------------------------------------------------------------
test procs-1.1 {
Linit
} -body {
Index: tests/rev.test
==================================================================
--- tests/rev.test
+++ tests/rev.test
@@ -1,8 +1,7 @@
-# Tests for revision control functions -*- tcl -*-
-#----------------------------------------------------------------------
-# $Revision$
+#------------------------------------------------------------*- tcl -*-
+# Tests for revision control functions
#----------------------------------------------------------------------
# Overload exec during these tests
stub exec {args} {
set cmd [lindex $args 0]
@@ -9,11 +8,11 @@
switch -- $cmd {
cleartool {
# cleartool lshistory -short $filename
# cleartool pwv -s
# cleartool get -to $outfile $filerev
- # cleartool ls $::diff($top,RevFile)
+ # cleartool ls $::eskil($top,RevFile)
if {[lindex $args 1] eq "lshistory"} {
return [join [list x@/Apa/Bepa/12 x@/Apa/Cepa/2 x@/Apa/22 x@/Apa] \n]
}
if {[lindex $args 1] eq "pwv"} {
return $::ct_pwv
@@ -56,17 +55,18 @@
}
}
return
}
default {
- eval _stub_exec $args
+ #eval _stub_exec $args
}
}
}
-# Do not detect git
+# Do not detect git or fossil
set ::auto_execs(git) ""
+set ::auto_execs(fossil) ""
test rev-1.1 {
ClearCase revisions
} -body {
set ::ct_ls @@/Bepa/5
@@ -292,21 +292,165 @@
}
set res [detectRevSystem $f]
if {!$apa} {
file delete _FOSSIL_
}
+ set ::auto_execs(fossil) ""
set res
} -cleanup {
tcltest::removeFile {} _rev2_12
} -result {FOSSIL}
test rev-3.1 {
Subversion revisions
} -body {
eskil::rev::SVN::ParseRevs filename -1
-} -result {157}
+} -result {117}
test rev-3.2 {
Subversion revisions
} -body {
eskil::rev::SVN::ParseRevs filename -2
} -result {115}
+
+test rev-3.3 {
+ Subversion revisions
+} -body {
+ eskil::rev::SVN::ParseRevs filename 0
+} -result {BASE}
+
+
+# Tests below tries to use the real tools and temporary repos.
+# They are dependent on running on a system with tools installed.
+clearstub
+
+proc Fill1 {} {
+ cd $::work
+ file mkdir dir1
+ file mkdir dir2
+ exec touch f1
+ exec touch f2
+ exec touch dir1/f11
+ exec touch dir1/f12
+ exec touch dir2/f21
+ exec touch dir2/f22
+}
+proc Fill2 {} {
+ cd $::work
+ exec echo Hej > f1
+ exec echo Hopp > f2
+}
+proc Fill3 {} {
+ cd $::work
+ exec echo Nisse > dir1/f11
+ exec echo Hult > dir2/f21
+ exec echo Lingonben >> f1
+}
+
+proc CreateRepo {type} {
+ set repoDir [tmpFile]
+ file mkdir $repoDir
+ switch $type {
+ FOSSIL {
+ set repo $repoDir/apa.fossil
+ set ::work $repoDir/wk
+ exec fossil new $repo
+ file mkdir $::work
+ cd $::work
+ exec fossil open $repo
+ set cmt "fossil commit -m"
+ }
+ GIT {
+ set ::work $repoDir
+ file mkdir $::work
+ cd $::work
+ exec git init
+ set cmt "git commit -am"
+ }
+ SVN {
+ exec svnadmin create $repoDir
+ set ::work [tmpFile]
+ exec svn checkout file://$repoDir $::work
+ cd $::work
+ set cmt "svn commit -m"
+ }
+ HG {
+ set ::work $repoDir
+ file mkdir $::work
+ cd $::work
+ exec hg init
+ set cmt "hg commit -u Eskil -m"
+ }
+ default { error MOO }
+ }
+ Fill1
+ switch $type {
+ FOSSIL { exec fossil addremove }
+ GIT { exec git add *}
+ SVN { exec svn add {*}[glob *]}
+ HG { exec hg add {*}[glob *]}
+ }
+ exec {*}$cmt "First"
+ Fill2
+ exec {*}$cmt "Second"
+ Fill3
+ exec {*}$cmt "Third"
+
+ # Any cleanup?
+ switch $type {
+ SVN { exec svn update }
+ }
+}
+
+foreach type {FOSSIL GIT SVN HG} {
+ test rev-4.$type.1 {
+ Setup fake repo
+ } -body {
+ CreateRepo $type
+ # Dump info for debug of setup
+ if 0 {
+ switch $type {
+ FOSSIL { puts [exec fossil timeline -v] }
+ GIT { puts [exec git log --name-only] }
+ SVN { puts [exec svn log --verbose] }
+ }
+ }
+ list
+ }
+
+ test rev-4.$type.2 {
+ GetTopDir
+ } -body {
+ cd ~
+ eskil::rev::${type}::GetTopDir $::work/dir1/f11 dir tail
+ list [expr {$dir eq $::work}] $tail
+ } -result {1 dir1/f11}
+
+ test rev-4.$type.3 {
+ get
+ } -body {
+ cd ~
+ set out [tmpFile]
+ eskil::rev::${type}::get $::work/dir1/f11 $out ""
+ exec cat $out
+ } -result {Nisse}
+
+ test rev-4.$type.4 {
+ getChangedFiles
+ } -body {
+ cd ~
+ set f $::work/dir1/f11
+ set revs [eskil::rev::${type}::ParseRevs $f "-1 0"]
+ lsort -dictionary [eskil::rev::${type}::getChangedFiles $f $revs]
+ } -match regexp -result {^/\S+/dir1/f11 /\S+/dir2/f21 /\S+/f1 /\S+/f2$}
+
+ test rev-4.$type.5 {
+ getChangedFiles
+ } -body {
+ cd ~
+ set f $::work/f1
+ set revs [eskil::rev::${type}::ParseRevs $f "-1 0"]
+ lsort -dictionary [eskil::rev::${type}::getChangedFiles $f $revs]
+ } -match regexp -result {^/\S+/dir1/f11 /\S+/dir2/f21 /\S+/f1$}
+
+ clearTmp
+}
-
+
