Index: Changes
==================================================================
--- Changes
+++ Changes
@@ -1,11 +1,463 @@
+Released 2.8.5
+
+2023-04-23
+ Added -printLineSpace. Corrected -printHeaderSize.
+
+2021-09-23
+ Allow revision control detect with -browse.
+
+2021-03-29
+ Support -context/-w/-b for -review.
+
+2021-03-01
+ Bumped revision to 2.8.5
+
+2021-02-28
+ Ballonhelp within frame.
+
+2020-12-10
+ Working towards runtime plugins.
+
+2020-10-30
+ Correct parent in dialogs.
+
+2020-09-28
+ Prune alone files dir diff.
+
+2020-09-02
+ Fixed bug where copy context menu used the wrong key.
+
+2020-04-14
+ Added gunzip plugin.
+
+2020-01-15
+ Do not traverse a unique side in dir diff.
+ Support -norun for dir diff.
+ Prune empty directories in dir diff.
+ Added -includefile/dir command line, for dir diff.
+
+2020-01-07
+ Handle multiple screens better for balloon help
+
+2019-11-10
+ More combinations allowed in edit mode. Including copy block of selected text.
+
+2019-11-10
+ Code cleanup to adhere a bit to some consistent standard.
+
+2019-08-28
+ Allow multiple pairs of files on the command line to open multiple windows.
+
+2019-07-05
+ Ctrl-E to enable Edit Mode.
+ Do not ask about overwriting in Edit Mode. Hidden preference to turn it on.
+ Added -subst command line, to acces PreProcess Subst function.
+
+2019-06-12
+ Better SVN commit, when added directories are included.
+
+2019-03-12
+ Auto-open prefix group dialog.
+
+Released 2.8.4
+
+2019-02-06
+ Bumped revision to 2.8.4
+
+2019-02-04
+ Include a file selector when committing multiple files.
+ Allow directory with -review.
+
+2018-10-03
+ Handle deleted files in GIT vcsvfs
+
+2018-09-23
+ Upgraded tablelist to 6.3
+
+2018-06-20
+ Added save-reload option in edit mode.
+ Upgraded tablelist to 6.2
+
+Released 2.8.3
+
+2018-06-13
+ Bumped revision to 2.8.3
+ Better visibility that commit happened.
+
+2018-06-05
+ Working on shortcuts for preprocess dialog.
+
+2018-05-14
+ Added changeset tool to fourway,
+
+2018-05-13
+ Adjustments to fourway UI.
+
+Released 2.8.2
+
+2018-05-13
+ Bumped revision to 2.8.2
+ Fixed bug in Fossil handling. Rev -1 did not work.
+
+2018-05-12
+ Added fourway diff.
+
+Released 2.8.1
+
+2018-01-14
+ Removed support for old RCS style -rREV command line.
+ Process directory diff in a nicer order.
+
+2018-01-11
+ Bumped revision to 2.8.1
+ Corrected detected of Emacs for Registry. (Broken in 2.7.4)
+
+2017-12-28
+ Pause before a large file in dirdiff processing to make it clear where it is
+ slowed down.
+
+2017-12-22
+ Added -excludedir and -excludefile options for dir diff.
+
+2017-12-16
+ Make sure plugins are applied in the right order.
+ Make sure Dir Diff can pick one out of many plugins.
+ Dir Diff no longer shortcuts for files with same size&mtime.
+
+2017-12-13
+ Use same font in commit window as in diff window.
+ Upgraded tablelist to 6.0
+
+2017-12-07
+ Support -nocase in dirdiff.
+ Repaired plugins for dirdiff (broken by multi plugin).
+
+2017-12-07
+ Handle GIT revisions better for directory diff.
+
+2017-12-05
+ Bumped revision to 2.8.0
+
+2017-12-04
+ Support multiple plugins from command line.
+
+2017-12-02
+ Support multiple plugins.
+ Changed default pivot to 10. Include GUI choice for 1.
+
+2017-12-01
+ Added GUI for multiple plugins. No function yet.
+
+Released 2.7.4
+
+2017-11-30
+ Allow multi select in table diff.
+
+2017-06-19
+ Allow one side of directory diff to be protected from editing.
+ Allow directories to be created in directory diff.
+
+2017-03-18
+ When needing an editor, try VISUAL and EDITOR plus a set of common ones.
+
+2017-02-05
+ Bumped revision to 2.7.4
+ Handle multiple preprocess definitions that can be saved with preferences.
+
+2017-02-04
+ Support more areas for file drop.
+
+2017-01-31
+ Made --query work again; lost in option reorganisation.
+
+2017-01-12
+ Added -gz flag to compare compressed files.
+
+2016-09-04
+ Preserve line endings when saving during Edit Mode.
+
+2016-08-30
+ Bumped revision to 2.7.3
+
+2016-08-21
+ Auto-detect semicolon separator. Connect GUI separator with plugin.
+
+2016-08-19
+ GUI support for table and separator.
+
+2016-08-15
+ Bumped revision to 2.7.2
+
+2016-07-29
+ Include plugin command line options in command line help.
+ Include plugin options in plugin dialog.
+
+2016-07-29
+ Corrected right side numbering when parsing patch. [288be8f321]
+
+2016-07-06
+ Support negative revisions with GIT. Added log view for GIT.
+
+2016-07-01
+ When displaying a patch, detect chunks marked with ##.
+ E.g. svn diff lists changed properties like that.
+
+2016-06-10
+ Reorganised code for option descriptions.
+
+2016-06-09
+ Upgraded to DiffUtilTcl 0.3.9 to get consistent word parse behaviour.
+
+2016-04-13
+ Allow plugin to know file names. Use source file with pdftotext in PDF plugin
+ since stdin is not reliable there.
+
+2016-04-13
+ When displaying a patch, detect a file with no changed chunks.
+ E.g. svn diff lists changed binary files like that.
+
+2016-04-08
+ Allow GUI to set privilege for plugins.
+ Better search for pdftotext in pdf plugin.
+
+2015-11-22
+ Bumped revision to 2.7.1
+ Allow plugins to define command line options.
+
+2015-11-20
+ Rebuilt command line option handling.
+
+2015-11-19
+ Added binary plugin.
+
+2015-11-17
+ Compress printed PDF.
+
+2015-10-14
+ Page break between files when printing in patch mode.
+
+2015-10-12
+ Use tablelist 5.14 that includes -colorizecommand, for table diff.
+
+2015-07-02
+ Printing followed by redo diff closed Eskil. Fixed this.
+
+2015-06-02
+ Made a patched version of tablelist for table diff. Patch stored in src dir.
+ Table diff works reasonable now
+
+2015-04-19
+ Started working on table diff.
+ Added grep plugin.
+
+2015-04-09
+ Started working on a edit buttons shown between diffs.
+
+2015-03-18
+ Allow plugins to yield if Eskil is run in Tcl 8.6 or newer.
+ Added swap plugin to exemplify this.
+
+2015-03-18
+ Added command line flag "-pluginallow" to allow a plugin to run in a standard
+ interpreter instead of a safe one.
+ Added pdf plugin.
+
+2015-03-17
+ Added command line flag "-sep" to set a separator for table-like files
+ like CSV.
+
+2015-03-16
+ Added csv plugin.
+ Pass ::argv to plugins.
+
+2015-03-15
+ Extended Mercurial support to commit, revert, log and directory diff.
+
+2015-03-09
+ Released 2.7
+
+2015-03-06
+ Generate release files for Mac, now when DiffUtil supports Mac.
+
+2015-03-01
+ Added more key bindings to scroll diff.
+
+2015-02-25
+ Allow saving prefs from dirdiff window.
+ Put "nice" setting in preferences.
+
+2015-02-24
+ Bumped revision to 2.7
+
+2015-02-23
+ Version support in directory diff, for Fossil, GIT and Subversion.
+
+2014-12-17
+ Changed the included print font to a true type font.
+ Allow -printFont to be "Courier" for fallback to PDF builtin.
+
+2014-11-25
+ Added command line -printFont to select a font file for PDF.
+
+2014-11-16
+ First working plugin in dirdiff.
+
+2014-11-13
+ Undid all dirdiff refactoring from August. Bad idea...
+
+2014-11-12
+ Bumped revision to 2.6.7
+
+2014-11-12
+ Added vcsvfs, to be used for revision aware dirdiff.
+
+2014-11-07
+ Fixed silly error from dirdiff refactoring. [da1ad24ee2]
+
+2014-10-27
+ Bumped revision to 2.6.6
+
+2014-10-27
+ Store default prefs as comment in rc file
+
+2014-08-12
+ Started to refactor dirdiff code.
+ This prepares for making dirdiff revision aware.
+
+2014-02-01
+ Added a font fallback in psballon. [0ff6d72ab9]
+
+2014-01-24
+ Bumped revision to 2.6.5
+
+2014-01-24
+ Include tclkit.ico and tclkit.inf in kit, to get info on Windows.
+
+2014-01-11
+ Detect Subversion 1.7 working copy where .svn is just in the top.
+
+2013-09-28
+ Support direct print in patch mode. [6bce349e95]
+
+2013-09-28
+ Added hourglass cursor during prune equal in directory diff. [766b7a4695]
+
+2013-09-26
+ Fixed error printing patch with only deleted or inserted files. [2d89cee14d]
+
+2013-08-22
+ Bumped revision to 2.6.4
+
+2013-08-22
+ Include afm font for PDF printing.
+
+2013-08-22
+ Do not allow edit in text widget after startup. [51ad7323ff]
+
+2013-02-18
+ Add .pdf to print file by default [e093eb8eef]
+
+2012-11-15
+ No changes in scroll map when displaying a patch.
+
+2012-09-17
+ Avoid getting double .-files in dirdiff on Windows.
+ Added "nice" option to control dirdiff speed.
+
+2012-08-30
+ Corrected display of ancestor lines in three-way merge.
+
+2012-08-21
+ Bumped revision to 2.6.3
+
+2012-08-21
+ Added Preferences menu for Pivot value.
+
+2012-08-21
+ Added Revert button in Revision mode
+
+2012-07-12
+ DiffUtilTcl is now 0.3.7.
+ This added -pivot to exclude very common lines, and post processing of
+ the excluded lines. This cuts down processing time for certain large files.
+
+2012-07-11
+ Detect and display error if commit fails.
+
+2012-06-22
+ Added -pivot command line flag to control C diff's -pivot.
+
+2012-06-18 Release 2.6.2
+
+2012-06-12
+ DiffUtilTcl is now 0.3.5.
+
+2012-06-12
+ Added -nocdiff command line flag for debug.
+
+2012-02-28
+ Support negative revisions with Fossil.
+
+2012-02-21
+ Support branches in Subversion. [b71c8cf01b]
+
+2012-02-19
+ Support regsub preprocessing controlled per side.
+
+2012-02-18
+ Improved PDF print dialog.
+
+2012-02-17
+ Improved plugin viewer.
+
+2012-02-14
+ Include added files when using -review with Fossil.
+
+2012-02-07
+ Fixed bug where extra lines showed when displaying only diffs (no context).
+
+Release 2.6.1
+
+2011-11-01
+ Fixed bug where copy button in directory diff picked the wrong file.
+ Use a custom Toolbutton layout to get a small toolbutton in directory diff.
+
+Release 2.6
+
+2011-10-27
+ Rebuilt rev-detection to handle any dir depth.
+ Detect .fos as fossil indicator.
+
+2011-10-15
+ Added Show in plugin dialog. Added sort plugin. [FR 3735]
+
+2011-10-15
+ Added procedure editor to debug menu.
+
+2011-10-15
+ Corrected search of plugins to find them in VFS. [Bug 18395]
+
+2011-10-05
+ Respect block parse setting when showing a patch. [Bug 18147]
+
+2011-10-04
+ Fall back to Tcl-dialog when accessing a vfs. [Bug 18371]
+
+2011-05-09
+ Use mouse dragging to set alignment.
+
+2011-05-09
+ Rewritten directory diff to use tablelist.
+ Redesigned appearance of directory diff.
+
2011-04-30
Improved three-way merge.
Highlight conflicts and navigate directly between conflicts.
- Include status for each merge chunk to see the descision made.
+ Include status for each merge chunk to see the decision made.
Added Goto menu in merge window to get fewer toolbar buttons.
- Autodetect line endings in ancestor file to select merge output.
+ Auto-detect line endings in ancestor file to select merge output.
2011-04-28
Code cleanup to get clean Nagelfar run
2011-04-28
@@ -13,12 +465,12 @@
2011-04-24
Added basic GUI for plugin selection.
2011-04-22
- Merging did not work properly if alignement was used. [Bug 9925]
-
+ Merging did not work properly if alignment was used. [Bug 9925]
+
2011-04-11
Support files and revisions with -review in Fossil.
Support revisions with -review in Git.
New DiffUtil has a fallback to pure Tcl LCS.
@@ -38,11 +490,11 @@
2010-11-07
Added tkdnd support. [FR 5125]
2010-11-07
- Autodetect line endings in conflict file.
+ Auto-detect line endings in conflict file.
Allow line ending selection in merge save. [FR 5160]
Added menu bar to merge window.
2010-06-23
Support -noempty from DiffUtil, to try it out.
@@ -90,11 +542,11 @@
2008-11-19
Bug fix in Clip Diff Capture
2008-11-10
Improved patch parsing.
- Includ Twapi in windows executable
+ Include Twapi in windows executable
2008-11-06
Added Capture in Clip Diff on Windows.
Handle Rev and Plugin at the same time.
@@ -172,11 +624,11 @@
2007-01-29
Finished dirdiff filters. [FR 3040]
2007-01-28
Started on dirdiff filters.
- Added dirdiff preferences dialog.
+ Added dirdiff preferences dialog.
2007-01-09
Document --query flag. [FR 3027]
Smarter save in merge. [FR 2957]
@@ -276,11 +728,11 @@
Full -r support for ClearCase.
2004-06-24
Added simple -r support to ClearCase diff.
Support ignore case in block matching.
-
+
Release 2.0.4
2004-06-17
Added ignore case option.
@@ -325,11 +777,11 @@
2004-02-10
Added preferences for width and height.
Added Tools menu to directory diff window.
Made it simpler to save a conflict in the same file.
-
+
2004-02-05
Stopped Tk from interfering with the command line.
2004-01-30
Release 2.0
DELETED Eskil.html
Index: Eskil.html
==================================================================
--- Eskil.html
+++ /dev/null
@@ -1,181 +0,0 @@
-
-
-
- Eskil - A graphical frontend to Diff
-
-
-
-
Bug tracker and mailing list can be found at the
-Project page
-
-
Eskil: A graphical frontend to Diff
-Download
-Features
-Screenshots
-Changes
-
-
About Eskil
-The first major application I wrote in Tcl/Tk was this tool (somewhere around
-1997). Writing it is what made me learn and enjoy Tcl. (I already liked Tk
-but still found Tcl annoying at the time.)
-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>
-
-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.
-Directory diff.
-CVS/RCS/ClearCase/GIT/SVN/BZR/HG/Perforce/Fossil diff. Conflict 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 browsing.
-
-Download
-
-Version 2.5:Project page
-both as a Starkit and as Starpacks for Windows, Linux and Solaris.
-
-The license for the application source is GPL but the bundled packages
-are under the same license as Tcl.
-
-
More information about Starkits
-and Starpacks .
-
-
Screenshots
-
-
-A "zoom" feature for long lines.
-
Changes
-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 readonly,
- fixed dir diff window menu,
- improved patch file parsing.
-
-
- 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.
-
-
- Added regsub preprocessing option.
- Added -prefix command line option.
- Improved merge window.
- Added ignore keyword option to directory diff.
-
-
- Added Ignore Digit option.
- Fixed bug in -r for ClearCase.
- Edit Mode made more robust.
-
-
- Option -r can now be used with ClearCase diff.
- Edit Mode allows simple editing in the diff display and saving.
-
-
- Added ignore case option.
- Improved alignment function.
-
-
- 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.
-
-
- Fixed a bug in ClearCase support.
- Improved enscipt usage in print command.
- Added "mark file" in dirdiff context menu.
-
-
- Added preference for width and height.
- Added Tools menu to directory diff window.
- Made it simpler to save a conflict in the same file.
-
-Usage " > htdocs/usage.wiki
+ echo "" >> htdocs/usage.wiki
+ echo "Command Line Usage " >> htdocs/usage.wiki
+ echo "" >> htdocs/usage.wiki
+ echo "" >> htdocs/usage.wiki
+ $(TCLKIT_LINUX) eskil.vfs/main.tcl -help | grep -v " Version " >> htdocs/usage.wiki
+ echo " " >> htdocs/usage.wiki
+ echo "Documentation " > htdocs/toc.wiki
+ echo "" >> htdocs/toc.wiki
+ grep title htdocs/*.wiki | grep -v Documentation | \
+ sed -e 's/htdocs/[./' -e 's/:/|/' -e 's, ,],' | \
+ awk '{print $0; print ""};' >> htdocs/toc.wiki
#----------------------------------------------------------------
# Testing
#----------------------------------------------------------------
spell:
@cat doc/*.txt | ispell -d british -l | sort -u
-NAGELFARFLAGS = -s syntaxdb86.tcl -filter "*Non constant definition*" -quiet
+CHKFILES = $(SRCFILES) $(wildcard plugins/*.tcl) \
+ eskil.vfs/lib/psmenu-1.1.tm \
+ eskil.vfs/lib/pstools-1.0.tm \
+ eskil.vfs/lib/psdebug-1.0.tm \
+ eskil.vfs/lib/psballoon-1.3.tm
+NAGELFARFLAGS = -s syntaxdb.tcl -pkgpicky -filter "*Non constant definition*" -quiet -plugin nfplugin.tcl
# Create a common "header" file for all source files.
-eskil_h.syntax: $(SRCFILES) src/eskil.syntax
+eskil_h.syntax: $(SRCFILES) src/eskil.syntax nfplugin.tcl
@echo Creating syntax header file...
@$(NAGELFAR) $(NAGELFARFLAGS) -header eskil_h.syntax $(SRCFILES)
check: eskil_h.syntax
@echo Checking...
- @for i in $(SRCFILES); do $(NAGELFAR) $(NAGELFARFLAGS) eskil_h.syntax $$i ; done
+ @for i in $(CHKFILES); do $(NAGELFAR) $(NAGELFARFLAGS) eskil_h.syntax $$i ; done
test:
- @./tests/all.tcl
+ @./tests/all.tcl $(TESTFLAGS)
+
+run:
+ $(TCLKIT_LINUX) eskil.vfs/main.tcl -debug
#----------------------------------------------------------------
# Coverage
#----------------------------------------------------------------
# Source files for code coverage
-COVFILES = src/rev.tcl src/eskil.tcl
+COVFILES = eskil.vfs/main.tcl eskil.vfs/src/rev.tcl eskil.vfs/src/eskil.tcl eskil.vfs/src/merge.tcl eskil.vfs/src/startup.tcl
IFILES = $(COVFILES:.tcl=.tcl_i)
LOGFILES = $(COVFILES:.tcl=.tcl_log)
MFILES = $(COVFILES:.tcl=.tcl_m)
# Instrument source file for code coverage
-%.tcl_i: %.tcl
- @$(NAGELFAR) -instrument $<
+%.tcl_i: %.tcl eskil_h.syntax
+ @$(NAGELFAR) -instrument eskil_h.syntax $<
# Target to prepare for code coverage run. Makes sure log file is clear.
instrument: $(IFILES)
@rm -f $(LOGFILES)
@@ -157,25 +220,36 @@
#----------------------------------------------------------------
# Packaging/Releasing
#----------------------------------------------------------------
-wrap:
+tagversion:
+ echo "Version $(DOTVERSION) `date --iso-8601`" > eskil.vfs/version.txt
+
+wrap: tagversion
sdx wrap eskil.kit
-wrapexe:
- @\rm -f eskil.linux eskil.exe eskil.solaris
+wrapexe: tagversion
+ @\rm -f eskil.linux eskil.exe
sdx wrap eskil.linux -runtime $(TCLKIT_LINUX)
- sdx wrap eskil.solaris -runtime $(TCLKIT_SOLARIS)
+ sdx wrap eskil.mac -runtime $(TCLKIT_MAC)
cd eskil.vfs/lib ; ln -s $(TWAPI) twapi
sdx wrap eskil.exe -runtime $(TCLKIT_WIN)
rm eskil.vfs/lib/twapi
release: setup wrap wrapexe
@cp eskil.kit eskil`date +%Y%m%d`.kit
@cp eskil.kit eskil$(VERSION).kit
@gzip eskil.linux
@mv eskil.linux.gz eskil$(VERSION).linux.gz
- @gzip eskil.solaris
- @mv eskil.solaris.gz eskil$(VERSION).solaris.gz
+ @gzip eskil.mac
+ @mv eskil.mac.gz eskil$(VERSION).mac.gz
@zip eskil$(VERSION).win.zip eskil.exe
@zip eskil`date +%Y%m%d`.win.zip eskil.exe
+
+tofossil:
+ fossil unversioned add eskil$(VERSION).kit --as htdocs/download/eskil$(VERSION).kit
+ fossil unversioned add eskil$(VERSION).linux.gz --as htdocs/download/eskil$(VERSION).linux.gz
+ fossil unversioned add eskil$(VERSION).mac.gz --as htdocs/download/eskil$(VERSION).mac.gz
+ fossil unversioned add eskil$(VERSION).win.zip --as htdocs/download/eskil$(VERSION).win.zip
+ fossil unversioned list
+ @echo 'Remember: fossil unversioned sync'
Index: TODO
==================================================================
--- TODO
+++ TODO
@@ -35,5 +35,12 @@
med ändrade namn.
Print: utföra printkommando. Via dialog och -print? Klara t.ex. lp -n 2
Kanske generera pdf och pipea till lp?
+
+
+Rev:
+SVN: Vad göra med Log när -r är en branch?
+Kan den fixas oom två -r är på samma branch?
+
+Fossil: Kan man fixa Log om man använder -r -1?
Index: bindiff.tcl
==================================================================
--- bindiff.tcl
+++ bindiff.tcl
@@ -1,220 +1,220 @@
-#!/bin/sh
-# the next line restarts using wish \
-exec wish "$0" "$@"
-
-set thisScript [file join [pwd] [info script]]
-
-proc busyCursor {} {
- global oldcursor oldcursor2
- if {![info exists oldcursor]} {
- set oldcursor [. cget -cursor]
- set oldcursor2 [.e1 cget -cursor]
- }
- . config -cursor watch
- foreach w {.e1 .e2} {
- $w config -cursor watch
- }
-}
-
-proc normalCursor {} {
- global oldcursor oldcursor2
- . config -cursor $oldcursor
- foreach w {.e1 .e2} {
- $w config -cursor $oldcursor2
- }
-}
-
-proc browse {varName} {
- upvar $varName file
-
- if {$file == ""} {
- set initdir [pwd]
- } else {
- set initdir [file dirname $file]
- }
- set apa [tk_getOpenFile -title "Select file" -initialdir $initdir]
- if {$apa != ""} {
- set file [file join $initdir $apa]
- cd [file dirname $file]
- }
-}
-
-proc doComp {{extra 0}} {
- global compRes file1 file2
-
- busyCursor
- update idletasks
-
- file stat $file1 stat1
- file stat $file2 stat2
-
- set compRes ""
- if {$stat1(size) == $stat2(size) && $stat1(mtime) == $stat2(mtime)} {
- set compRes "Size&Time "
- }
-
- update idletasks
-
- set eqbut 0
- set bufsz 65536
- set eq 1
- set ch1 [open $file1 r]
- set ch2 [open $file2 r]
- fconfigure $ch1 -translation binary
- fconfigure $ch2 -translation binary
- while {![eof $ch1] && ![eof $ch2]} {
- set f1 [read $ch1 $bufsz]
- set f2 [read $ch2 $bufsz]
- if {![string equal $f1 $f2]} {
- set eq 0
- set len1 [string length $f1]
- set len2 [string length $f2]
- if {$len1 != $len2} {
- set len [expr {$len1 < $len2 ? $len1 : $len2}]
- if {[string equal -length $len $f1 $f2]} {
- set eqbut [expr {$len1 < $len2 ? 2 : 1}]
- }
- }
- break
- }
- }
- if {([eof $ch1] + [eof $ch2]) < 2} {
- set eq 0
- }
- close $ch1
- close $ch2
-
- if {$eq} {
- append compRes Equal
- } else {
- append compRes "Not Equal"
- }
-
- if {$eqbut} {
- append compRes " but [expr {abs($stat1(size) - $stat2(size))}]($eqbut)"
- }
-
- if {!$extra || $eq || $eqbut} {
- normalCursor
- return
- }
-
- update idletasks
- set ch1 [open $file1 r]
- set ch2 [open $file2 r]
- fconfigure $ch1 -translation binary -buffersize 524288
- fconfigure $ch2 -translation binary -buffersize 524288
- set data1 [read $ch1]
- set data2 [read $ch2]
- close $ch1
- close $ch2
- set len1 [string length $data1]
- set len2 [string length $data2]
-
- if {$len1 < 2000 || $len2 < 2000} {
- normalCursor
- return
- }
-
- set mid1 [expr {$len1 / 2 - 500}]
- set midstr1 [string range $data1 $mid1 [expr {$mid1 + 999}]]
- set places {}
- for {set i2 0} {$i2 < $len2} {incr i2} {
- set i2 [string first $midstr1 $data2 $i2]
- if {$i2 == -1} break
- lappend places $i2
- }
- if {[llength $places] > 1} {
- append compRes " multiple parts"
- } elseif {[llength $places] == 1} {
- set i2 [lindex $places 0]
- append compRes " s"
- if {$mid1 < $i2} {
- set start1 0
- set start2 [expr {$i2 - $mid1}]
- } else {
- set start1 [expr {$mid1 - $i2}]
- set start2 0
- }
- if {($len1 - $mid1) > ($len2 - $i2)} {
- set end1 [expr {$mid1 + ($len2 - $i2) - 1}]
- set end2 [expr {$len2 - 1}]
- } else {
- set end1 [expr {$len1 - 1}]
- set end2 [expr {$i2 + ($len1 - $mid1) - 1}]
- }
- if {$end2 - $start2 != $end1 - $start1} {
- append compRes " ($mid1=$i2 '$start1-$end1' '$start2-$end2')"
- }
- for {set s1 $start1 ; set s2 $start2} {$s1 < $mid1} {incr s1 1000 ; incr s2 1000} {
- if {[string equal [string range $data1 $s1 [expr {$s1 + 999}]] \
- [string range $data2 $s2 [expr {$s2 + 999}]]]} {
- break
- }
- }
- for {set e1 $end1 ; set e2 $end2} {$e1 > $mid1} {incr e1 -1000 ; incr e2 -1000} {
- if {[string equal [string range $data1 [expr {$e1 - 999}] $e1] \
- [string range $data2 [expr {$e2 - 999}] $e2]]} {
- break
- }
- }
- set eql [expr {$e1 - $s1 + 1}]
- append compRes " '$s1 - $e1' == '$s2 - $e2' ($eql)($len1)($len2)"
- } else {
- append compRes " no"
- }
- normalCursor
-}
-
-# File drop using TkDnd
-proc fileDrop {var files} {
- set $var [lindex $files 0]
-}
-
-proc makeWin {} {
- global tcl_platform
- eval destroy [winfo children .]
-
- frame .fm
-
- menubutton .md -text Debug -menu .md.m -relief ridge
- menu .md.m
- if {$tcl_platform(platform) == "windows"} {
- .md.m add checkbutton -label Console -variable consolestate \
- -onvalue show -offvalue hide -command {console $consolestate}
- .md.m add separator
- }
- .md.m add command -label "Stack trace" -command {bgerror Debug}
- .md.m add separator
- .md.m add command -label "Reread Source" -command {source $thisScript}
- .md.m add separator
- .md.m add command -label "Redraw Window" -command {makeWin}
- .md.m add separator
- .md.m add command -label "Extra Comp" -command {doComp 1}
-
- pack .md -in .fm -side left
-
- button .bd -text Comp -command doComp
- label .l -textvariable compRes
-
- entry .e1 -width 50 -textvariable file1
- entry .e2 -width 50 -textvariable file2
- button .b1 -text Browse -command "browse file1"
- button .b2 -text Browse -command "browse file2"
-
- # Set up file dropping in entries if TkDnd is available
- if {![catch {package require tkdnd}]} {
- dnd bindtarget .e1 text/uri-list {fileDrop ::file1 %D}
- dnd bindtarget .e2 text/uri-list {fileDrop ::file2 %D}
- }
-
- grid .fm .l .bd -sticky wns
- grid .e1 - .b1 -sticky news
- grid .e2 - .b2 -sticky news
- grid .l .bd -sticky news
- grid columnconfigure . 1 -weight 1
-}
-
-if {![winfo exists .fm]} {
- makeWin
-}
+#!/bin/sh
+# the next line restarts using wish \
+exec wish "$0" "$@"
+
+set thisScript [file join [pwd] [info script]]
+
+proc busyCursor {} {
+ global oldcursor oldcursor2
+ if {![info exists oldcursor]} {
+ set oldcursor [. cget -cursor]
+ set oldcursor2 [.e1 cget -cursor]
+ }
+ . config -cursor watch
+ foreach w {.e1 .e2} {
+ $w config -cursor watch
+ }
+}
+
+proc normalCursor {} {
+ global oldcursor oldcursor2
+ . config -cursor $oldcursor
+ foreach w {.e1 .e2} {
+ $w config -cursor $oldcursor2
+ }
+}
+
+proc browse {varName} {
+ upvar $varName file
+
+ if {$file == ""} {
+ set initdir [pwd]
+ } else {
+ set initdir [file dirname $file]
+ }
+ set apa [tk_getOpenFile -title "Select file" -initialdir $initdir]
+ if {$apa != ""} {
+ set file [file join $initdir $apa]
+ cd [file dirname $file]
+ }
+}
+
+proc doComp {{extra 0}} {
+ global compRes file1 file2
+
+ busyCursor
+ update idletasks
+
+ file stat $file1 stat1
+ file stat $file2 stat2
+
+ set compRes ""
+ if {$stat1(size) == $stat2(size) && $stat1(mtime) == $stat2(mtime)} {
+ set compRes "Size&Time "
+ }
+
+ update idletasks
+
+ set eqbut 0
+ set bufsz 65536
+ set eq 1
+ set ch1 [open $file1 r]
+ set ch2 [open $file2 r]
+ fconfigure $ch1 -translation binary
+ fconfigure $ch2 -translation binary
+ while {![eof $ch1] && ![eof $ch2]} {
+ set f1 [read $ch1 $bufsz]
+ set f2 [read $ch2 $bufsz]
+ if {![string equal $f1 $f2]} {
+ set eq 0
+ set len1 [string length $f1]
+ set len2 [string length $f2]
+ if {$len1 != $len2} {
+ set len [expr {$len1 < $len2 ? $len1 : $len2}]
+ if {[string equal -length $len $f1 $f2]} {
+ set eqbut [expr {$len1 < $len2 ? 2 : 1}]
+ }
+ }
+ break
+ }
+ }
+ if {([eof $ch1] + [eof $ch2]) < 2} {
+ set eq 0
+ }
+ close $ch1
+ close $ch2
+
+ if {$eq} {
+ append compRes Equal
+ } else {
+ append compRes "Not Equal"
+ }
+
+ if {$eqbut} {
+ append compRes " but [expr {abs($stat1(size) - $stat2(size))}]($eqbut)"
+ }
+
+ if {!$extra || $eq || $eqbut} {
+ normalCursor
+ return
+ }
+
+ update idletasks
+ set ch1 [open $file1 r]
+ set ch2 [open $file2 r]
+ fconfigure $ch1 -translation binary -buffersize 524288
+ fconfigure $ch2 -translation binary -buffersize 524288
+ set data1 [read $ch1]
+ set data2 [read $ch2]
+ close $ch1
+ close $ch2
+ set len1 [string length $data1]
+ set len2 [string length $data2]
+
+ if {$len1 < 2000 || $len2 < 2000} {
+ normalCursor
+ return
+ }
+
+ set mid1 [expr {$len1 / 2 - 500}]
+ set midstr1 [string range $data1 $mid1 [expr {$mid1 + 999}]]
+ set places {}
+ for {set i2 0} {$i2 < $len2} {incr i2} {
+ set i2 [string first $midstr1 $data2 $i2]
+ if {$i2 == -1} break
+ lappend places $i2
+ }
+ if {[llength $places] > 1} {
+ append compRes " multiple parts"
+ } elseif {[llength $places] == 1} {
+ set i2 [lindex $places 0]
+ append compRes " s"
+ if {$mid1 < $i2} {
+ set start1 0
+ set start2 [expr {$i2 - $mid1}]
+ } else {
+ set start1 [expr {$mid1 - $i2}]
+ set start2 0
+ }
+ if {($len1 - $mid1) > ($len2 - $i2)} {
+ set end1 [expr {$mid1 + ($len2 - $i2) - 1}]
+ set end2 [expr {$len2 - 1}]
+ } else {
+ set end1 [expr {$len1 - 1}]
+ set end2 [expr {$i2 + ($len1 - $mid1) - 1}]
+ }
+ if {$end2 - $start2 != $end1 - $start1} {
+ append compRes " ($mid1=$i2 '$start1-$end1' '$start2-$end2')"
+ }
+ for {set s1 $start1 ; set s2 $start2} {$s1 < $mid1} {incr s1 1000 ; incr s2 1000} {
+ if {[string equal [string range $data1 $s1 [expr {$s1 + 999}]] \
+ [string range $data2 $s2 [expr {$s2 + 999}]]]} {
+ break
+ }
+ }
+ for {set e1 $end1 ; set e2 $end2} {$e1 > $mid1} {incr e1 -1000 ; incr e2 -1000} {
+ if {[string equal [string range $data1 [expr {$e1 - 999}] $e1] \
+ [string range $data2 [expr {$e2 - 999}] $e2]]} {
+ break
+ }
+ }
+ set eql [expr {$e1 - $s1 + 1}]
+ append compRes " '$s1 - $e1' == '$s2 - $e2' ($eql)($len1)($len2)"
+ } else {
+ append compRes " no"
+ }
+ normalCursor
+}
+
+# File drop using TkDnd
+proc fileDrop {var files} {
+ set $var [lindex $files 0]
+}
+
+proc makeWin {} {
+ global tcl_platform
+ eval destroy [winfo children .]
+
+ frame .fm
+
+ menubutton .md -text Debug -menu .md.m -relief ridge
+ menu .md.m
+ if {$tcl_platform(platform) == "windows"} {
+ .md.m add checkbutton -label Console -variable consolestate \
+ -onvalue show -offvalue hide -command {console $consolestate}
+ .md.m add separator
+ }
+ .md.m add command -label "Stack trace" -command {bgerror Debug}
+ .md.m add separator
+ .md.m add command -label "Reread Source" -command {source $thisScript}
+ .md.m add separator
+ .md.m add command -label "Redraw Window" -command {makeWin}
+ .md.m add separator
+ .md.m add command -label "Extra Comp" -command {doComp 1}
+
+ pack .md -in .fm -side left
+
+ button .bd -text Comp -command doComp
+ label .l -textvariable compRes
+
+ entry .e1 -width 50 -textvariable file1
+ entry .e2 -width 50 -textvariable file2
+ button .b1 -text Browse -command "browse file1"
+ button .b2 -text Browse -command "browse file2"
+
+ # Set up file dropping in entries if TkDnd is available
+ if {![catch {package require tkdnd}]} {
+ dnd bindtarget .e1 text/uri-list {fileDrop ::file1 %D}
+ dnd bindtarget .e2 text/uri-list {fileDrop ::file2 %D}
+ }
+
+ grid .fm .l .bd -sticky wns
+ grid .e1 - .b1 -sticky news
+ grid .e2 - .b2 -sticky news
+ grid .l .bd -sticky news
+ grid columnconfigure . 1 -weight 1
+}
+
+if {![winfo exists .fm]} {
+ makeWin
+}
ADDED bumprev.txt
Index: bumprev.txt
==================================================================
--- /dev/null
+++ bumprev.txt
@@ -0,0 +1,31 @@
+These files need to be changed when bumping revisions:
+
+Makefile (VERSION and DOTVERSION)
+eskil.vfs/tclkit.inf (fileversion/productversion)
+
+Also, mark it in:
+Changes
+
+------------
+File Release
+
+Make sure revision is bumped and everything is committed.
+Clean run of make check / make test
+make release
+make tofossil
+
+Update htdocs/download.html with info from above.
+Update htdocs/changes.wiki
+Update Changes
+
+Commit, and do 'fossil unversioned sync'
+
+---------------
+New Source File
+
+These changes are needed when adding a new source files:
+
+Add source to e.g. src/apa.tcl (plus add to fossil)
+In src/startup.tcl, update InitReSource
+In Makefile, update SRCFILES
+Do make -B newsrc
Index: doc/cmdline.txt
==================================================================
--- doc/cmdline.txt
+++ doc/cmdline.txt
@@ -20,10 +20,12 @@
- : 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.
+ -sep : See char as separator between columns in files.
+ -gz : Uncompress files.
-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
@@ -52,26 +54,29 @@
-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.
+ -browse : Bring up file dialog for missing files 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)
+ -printFont : Select font to use in PDF, afm or ttf. If
+ is given as "Courier", PDF built in font is used.
-printColorChange : Color for change (1.0 0.7 0.7)
-printColorOld : Color for old text (0.7 1.0 0.7)
- -printColorNew : Color for new text (0.8 0.8 1.0)
-plugin : Preprocess files using plugin.
-plugininfo : Pass info to plugin (plugin specific)
-pluginlist : List known plugins
-plugindump : Dump plugin source to stdout
+ -pluginallow : Allow full access for a plugin.
-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 -`/'
Index: doc/editmode.txt
==================================================================
--- doc/editmode.txt
+++ doc/editmode.txt
@@ -1,3 +1,13 @@
-To be written...
+The files on display may be edited if you turn on Edit Mode.
+This is done with the Tools->Edit Mode menu.
+Onle real files may be edited. If you are comparing versions fetched from a
+Revision Control system, it cannot be edited.
+
+If an edited side has empty areas, i.e. lines that are not part of the file
+and only there to line up with the other side, those will be gray.
+
+Edit mode will not allow you to enter or remove newlines freely. Only by
+copying blocks from other side lines may change.
-Hint: Right click over line numbers when in Edit Mode.
+By right clicking over a change's line numbers you get options to copy
+lines and blocks between the two sides, as well as the options to save a file.
Index: doc/eskil.txt
==================================================================
--- doc/eskil.txt
+++ doc/eskil.txt
@@ -33,10 +33,13 @@
\t highlight full words only, or check single characters.
\t Mark last : Last change of a line is underlined
Colours\t: Choose highlight colours.
Context\t: You can select that only differing lines shall be displayed,
\t and how many surrounding lines are shown.
+ Pivot \t: If many lines in a file are equal, runtime may go up. By initially
+ \t disregarding such lines this can be kept at a more reasonable
+ \t level. The pivot sets how many lines must be equal to be ignored.
Toolbar\t: Show/hide toolbar
Save default\t: Save current option settings in ~/.eskilrc
Search Menu
Find \t: Search dialog
Index: doc/plugins.txt
==================================================================
--- doc/plugins.txt
+++ doc/plugins.txt
@@ -1,33 +1,50 @@
-Eskil provides a plugin system where a plugin can preprocess data
+Eskil provides a plugin system where plugins 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.
+
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 -help
-A plugin is a Tcl script that must follow a specific format.
-Dump one of the included plugins to see what it looks like.
+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.
+
The plugin is executed in a safe interpreter and thus cannot do any
-damage.
+damage. You can turn this safety off with -pluginallow.
A plugin is set up with these global variables filled in:
-::WhoAmI : The name of the plugin
-::Info : The contents of -plugininfo parameter
-::Pref : A copy if Eskil's internal preferences array.
-
-Example plugins are included in the kit.
+::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
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 main plugin procedure
-returns 0 to signify this case.
+should return 0 to signify this case.
If the plugin procedure returns 1, the processed data is used also for
displaying.
-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.
+
+Directory diff only supports one plugin. The first plugin with FileCompare
+defined will be used.
Index: doc/revision.txt
==================================================================
--- doc/revision.txt
+++ doc/revision.txt
@@ -15,13 +15,20 @@
eskil -r rev1 -r rev2 file.txt
Compare the two revisions. This does not involve the local copy of file.txt.
The -r options are also available in the GUI in the "Rev 1" and "Rev 2" fields.
+
+
+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.
+
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.
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.
@@ -31,22 +38,22 @@
hg diff | eskil -
git diff -p --diff-filter=M master | eskil -
-If the command line option -review is used. Eskil will generate a patch
+If the command line option -review is used, Eskil will generate a patch
for the current tree and display it as in patch mode.
E.g. in a Mercurial directory, these show the same thing:
-eskil -preview
+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.
-For RCS and CVS the arguments to -r are standard version numbers just like to their -r options. RCS style -r\u003crev\u003e is allowed.
+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.
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.
@@ -53,17 +60,39 @@
For Git -r is passed to show, as in "git show :".
+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'
+
For Fossil -r is passed to finfo, as in "fossil finfo -p -r ".
+Additionaly, if a revision is 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.
+
+fossil settings gmerge-command 'eskil -fine -a "%baseline" "%merge" "%original" -o "%output"' -global
+
For Mercurial -r 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
For Bazaar -r works as in "bzr cat -r".
Index: doc/tutorial.txt
==================================================================
--- doc/tutorial.txt
+++ doc/tutorial.txt
@@ -43,26 +43,28 @@
\u2022\tDouble click on merge.txt to bring up the diff.
\u2022\tSelect menu File->Open Ancestor File.
\u2022\tSelect file mergeanc.txt
-The merge window will appear with most changes merged. Conflicts are marked with gray, and a row of asterisks in the status bar. Conflicts are resolved to the right initially. Navigate between conflicts using shift-up/down keys. Select side with left/right keys.
+The merge window will appear with most changes merged. Conflicts are marked with gray, and a row of asterisks in the status bar. Conflicts are resolved to the right initially. Navigate between conflicts using ctrl-up/down keys. Select side with left/right keys. Hover over the status bar to see ancestor info.
Regular expression preprocessing
-Double click on enum.c to bring up the diff.
-[write something here to explain the problem and the goal]
+Sometimes there are things in files being compared that you want to highlight or disregard. This preprocessing step applies search/replace regular expressions on the files being compared before lines are matched. The result is only used for determining equality. The original is always used for display and if lines differ after preprocessing, all changes are shown for that line.
[add reference to re_syntax and regsub manuals]
+
+Double click on enum.c to bring up the diff.
\u2022\tSelect menu Options->Preprocess.
-\u2022\tPress "Add" to add a new preprocessing set.
-\u2022\tEnter the regular expression "^.*?\\m(Apa\\w+).*$" in the field.
+\u2022\tIf there is no clear set, press "Add" to add a new preprocessing set.
+\u2022\tPress "Edit" to edit that preprocessing set.
+\u2022\tEnter the regular expression "^.*?\\m(Apa\\w+).*$" in the Regexp field.
\u2022\tEnter "\\1" in the substitution field.
\u2022\tEnter a word starting with "Apa" in one of the example fields and see that the result is just that word.
\u2022\tPress "Ok" and select menu File->Redo Diff.
-A shortcut for the above is to use "-prefix Apa" on the command line.
+A shortcut for the above is to use "-prefix Apa" on the command line, or to use the "Add Prefix" button and enter "Apa" as prefix.
Changed filename in directory diff
\u2022\tRight click on "namechange1" in Directory Diff's left window.
\u2022\tSelect "Mark File" in the menu.
DELETED eskil.vfs/COPYING
Index: eskil.vfs/COPYING
==================================================================
--- eskil.vfs/COPYING
+++ /dev/null
@@ -1,1 +0,0 @@
-../COPYING
DELETED eskil.vfs/doc
Index: eskil.vfs/doc
==================================================================
--- eskil.vfs/doc
+++ /dev/null
@@ -1,1 +0,0 @@
-../doc
DELETED eskil.vfs/examples
Index: eskil.vfs/examples
==================================================================
--- eskil.vfs/examples
+++ /dev/null
@@ -1,1 +0,0 @@
-../examples
ADDED eskil.vfs/lib/psballoon-1.3.tm
Index: eskil.vfs/lib/psballoon-1.3.tm
==================================================================
--- /dev/null
+++ eskil.vfs/lib/psballoon-1.3.tm
@@ -0,0 +1,343 @@
+#---------------------------------------------------------*-tcl-*------
+#
+# psballoon.tcl,
+# Procedures to create help message balloons or display balloons for
+# listboxes and labels that can't display all of their contents.
+#
+# Copyright (c) 2003-2024, Peter Spjuth (peter.spjuth@gmail.com)
+#
+# Permission is granted to use this code under the same terms as
+# for the Tcl core code.
+#
+#----------------------------------------------------------------------
+# This is used as a Tcl Module. Use it like this:
+# ::tcl::tm::path add
+# package require psballoon
+# namespace import psballoon::*
+#
+# addBalloon .l .b "My help text"
+# addBalloon .f -fmt {
+# Write help more freely.\n
+# New lines need to be explicit like above.
+# }
+#----------------------------------------------------------------------
+
+package provide psballoon 1.3
+
+namespace eval psballoon {
+ variable balloon
+ variable config
+
+ set config(-useframe) 0
+ set balloon(W) ""
+ set balloon(pending) 0
+ set balloon(created) 0
+ set balloon(id) ""
+ namespace export addBalloon
+}
+
+# -useframe
+proc psballoon::configure {args} {
+ variable config
+ foreach {arg val} $args {
+ set config($arg) $val
+ }
+}
+
+# Do some simple formatting, to be able to have cleaner text in source
+proc psballoon::Fmt {msg} {
+ # Remove any newlines.
+ set msg [regsub -all "\n" $msg " "]
+ # Remove multiple whitespace
+ set msg [regsub -all {\s+} $msg " "]
+ set msg [string trim $msg]
+ # Any explicitly requested newlines?
+ set msg [regsub -all {\\n\s*} $msg "\n"]
+ # Any remaining substs like tabs?
+ set msg [subst -nocommands -novariables $msg]
+ # Further line breaks by length?
+ set lines {}
+ foreach line [split $msg \n] {
+ while {[string length $line] > 80} {
+ # There should be no path through this loop that does not
+ # shorten $line
+ set ix [string last " " $line 80]
+ if {$ix < 0} {
+ set ix [string first " " $line]
+ if {$ix < 0} {
+ # Just cut at 80
+ set ix 80
+ }
+ }
+
+ if {$ix == 0} {
+ set line [string trim $line]
+ } else {
+ lappend lines [string range $line 0 $ix-1]
+ set line [string range $line $ix+1 end]
+ }
+ }
+ lappend lines $line
+ }
+ set msg [join $lines \n]
+ return $msg
+}
+
+# addBalloon widget ?widgets...? ?-fmt? ?msg?
+# If message is not given, it is extracted from widget. This is used to show
+# e.g. labels where text might not be fully visible.
+# Message may contain callbacks in [] for dynamic text.
+proc psballoon::addBalloon {W args} {
+ variable balloon
+ variable config
+
+ set frame $config(-useframe)
+
+ # Last argument is message
+ set msg [lindex $args end]
+
+ set Wlist [list $W]
+ foreach arg [lrange $args 0 end-1] {
+ switch $arg {
+ -fmt {
+ # Request for formatting
+ if {$msg ne ""} {
+ set msg [Fmt $msg]
+ }
+ }
+ -frame {
+ set frame 1
+ }
+ -top {
+ set frame 0
+ }
+ default {
+ lappend Wlist $arg
+ }
+ }
+ }
+
+ foreach W $Wlist {
+ AddBalloon2 $W $msg $frame
+ }
+}
+
+proc psballoon::AddBalloon2 {W msg frame} {
+ variable balloon
+
+ set c [winfo class $W]
+ if {$msg == "" && $c != "Listbox" && $c != "Label"} {
+ error "Missing message to balloon for $W ($c)"
+ }
+ set balloon(msg,$W) $msg
+ set balloon(frame,$W) $frame
+
+ if {$msg eq "_"} {
+ bind $W ""
+ bind $W ""
+ bind $W ""
+ bind $W ""
+ return
+ }
+
+ bind $W {
+ set ::psballoon::balloon(pending) 1
+ set ::psballoon::balloon(created) 0
+ set ::psballoon::balloon(lastX) %X
+ set ::psballoon::balloon(lastY) %Y
+ set ::psballoon::balloon(id) [after 500 {psballoon::createBalloon %W %x %y}]
+ }
+ bind $W {
+ psballoon::killBalloon
+ }
+ bind $W {
+ psballoon::killBalloon
+ }
+ bind $W {
+ psballoon::motionBalloon %W %X %Y %x %y
+ }
+}
+
+proc psballoon::motionBalloon {W X Y x y} {
+ if {$::psballoon::balloon(pending) == 1} {
+ after cancel $::psballoon::balloon(id)
+ }
+ if {$::psballoon::balloon(created) == 1} {
+ if {$::psballoon::balloon(lastX) == $X && \
+ $::psballoon::balloon(lastY) == $Y} {
+ # Sometimes when the balloon is created, a motion event with
+ # the same coordinates arrive. Ignore that to avoid killing the
+ # new balloon.
+ return
+ }
+ psballoon::killBalloon
+ }
+ set ::psballoon::balloon(lastX) $X
+ set ::psballoon::balloon(lastY) $Y
+ set ::psballoon::balloon(id) [after 500 "psballoon::createBalloon $W $x $y"]
+ set ::psballoon::balloon(pending) 1
+}
+
+proc psballoon::killBalloon {} {
+ variable balloon
+ if {$balloon(pending) == 1} {
+ after cancel $balloon(id)
+ }
+ if {[winfo exists $balloon(W)]} {
+ destroy $balloon(W)
+ }
+ set balloon(created) 0
+ set balloon(pending) 0
+}
+
+# Measure display width needed for a text with line breaks
+proc psballoon::Measure {font txt} {
+ set len 0
+ foreach line [split $txt \n] {
+ set lw [font measure $font $line]
+ if {$lw > $len} {
+ set len $lw
+ }
+ }
+ return $len
+}
+
+# Returns a list of minX maxX for each screen.
+# maxX are exclusive and normally equal to the next minX
+proc psballoon::FigureOutScreenWidths {W} {
+ set screens {}
+ # Range of X over multiple windows
+ set minX [winfo vrootx $W]
+ set maxX [expr {$minX + [winfo vrootwidth $W]}]
+ set sW [winfo screenwidth $W]
+
+ # Guess: If minX is negative, there is a screen from minX to 0
+ if {$minX < 0} {
+ lappend screens $minX 0
+ }
+ # Guess: Main screen is in the middle if three
+
+ # Main screen is 0 to screenWidth
+ lappend screens 0 $sW
+
+ # Guess: If maxX is larger than screen width (main screen), there
+ # is one more screen to the right
+ if {$maxX > $sW} {
+ lappend screens $sW $maxX
+ }
+ return $screens
+}
+
+proc psballoon::createBalloon {W mouseX mouseY} {
+ variable balloon
+ variable config
+ if { ! [winfo exists $W]} {
+ return
+ }
+ if {$balloon(created)} {
+ return
+ }
+
+ # Figure out widget's font
+ if {[catch {set font [$W cget -font]}]} {
+ set font [ttk::style lookup [winfo class $W] -font]
+ }
+ # Fallback to something reasonable if font fails.
+ if {$font eq ""} {
+ set font TkDefaultFont
+ }
+
+ # Widget Geometry
+ set wWidth [winfo width $W]
+ set wHeight [winfo height $W]
+ if {[winfo class $W] in {TLabelframe Labelframe TNotebook}} {
+ # Put it below the label, not the entire widget.
+ # 1.5 font heights is a reasonable guess
+ set fontHeight [font metrics $font -linespace]
+ set wHeight [expr {$fontHeight * 3 /2 }]
+ # Below cursor at least
+ if {$wHeight <= $mouseY} {
+ set wHeight [expr {$mouseY + 5}]
+ }
+ }
+
+ # Item Geometry within Widget (if any)
+ set itemX 0
+ set itemY 0
+ set create 1
+ set msg $balloon(msg,$W)
+ if {$msg == ""} {
+ # Extract text from widget
+ switch [winfo class $W] {
+ Listbox {
+ set i [$W index @$mouseX,$mouseY]
+ set msg [$W get $i]
+ foreach {itemX itemY itemWidth wHeight} [$W bbox $i] {break}
+ set bWidth $itemWidth
+ }
+ Label {
+ set msg [$W cget -text]
+ set bWidth [Measure $font $msg]
+ }
+ }
+ # Don't create a balloon if the text is fully visible.
+ set create [expr {$bWidth > $wWidth - 8}]
+ } else {
+ if {[string index $msg 0] eq "\["} {
+ set msg [subst -novariables -nobackslashes $msg]
+ }
+ set bWidth [Measure $font $msg]
+ }
+
+ if { ! $create} return
+
+ # Preferred position of the balloon
+ set rootX [expr {[winfo rootx $W] + $itemX}]
+ set rootY [expr {[winfo rooty $W] + $itemY + $wHeight + 2}]
+
+ set useframe $balloon(frame,$W)
+
+ if {$useframe} {
+ set top [winfo toplevel $W]
+ set posX [expr {$rootX - [winfo rootx $top]}]
+ set posY [expr {$rootY - [winfo rooty $top]}]
+ set minX 6
+ set maxX [expr {[winfo width $top] - 6}]
+ } else {
+ set posX $rootX
+ set posY $rootY
+
+ # Limits of current screen.
+ foreach {minX maxX} [FigureOutScreenWidths $W] {
+ if {$minX <= $rootX && $rootX < $maxX} break
+ }
+ }
+ # Move it to the left as needed to fit on screen
+ if {$posX + $bWidth + 8 > $maxX} {
+ set posX [expr {$maxX - $bWidth - 8}]
+ }
+
+ if {$useframe} {
+ if {$top eq "."} {
+ set B .balloon
+ } else {
+ set B $top.balloon
+ }
+ frame $B -borderwidth 1 -relief solid
+ } else {
+ set B .balloon
+ toplevel $B -bg black
+ wm overrideredirect $B 1
+ }
+ label $B.l \
+ -text $msg -relief flat -font $font -justify left \
+ -bg #ffffaa -fg black -padx 2 -pady 0 -anchor "w"
+ pack $B.l -side left -padx 1 -pady 1
+ if {$useframe} {
+ place $B -x $posX -y $posY -anchor nw
+ } else {
+ wm geometry $B +${posX}+${posY}
+ }
+ set balloon(W) $B
+ set balloon(created) 1
+}
DELETED eskil.vfs/lib/psballoon/pkgIndex.tcl
Index: eskil.vfs/lib/psballoon/pkgIndex.tcl
==================================================================
--- eskil.vfs/lib/psballoon/pkgIndex.tcl
+++ /dev/null
@@ -1,11 +0,0 @@
-# Tcl package index file, version 1.1
-# This file is generated by the "pkg_mkIndex" command
-# and sourced either when an application starts up or
-# by a "package unknown" script. It invokes the
-# "package ifneeded" command to set up package-related
-# information so that packages will be loaded automatically
-# in response to "package require" commands. When this
-# script is sourced, the variable $dir must contain the
-# full path name of this file's directory.
-
-package ifneeded psballoon 1.0 [list source [file join $dir psballoon.tcl]]
DELETED eskil.vfs/lib/psballoon/psballoon.tcl
Index: eskil.vfs/lib/psballoon/psballoon.tcl
==================================================================
--- eskil.vfs/lib/psballoon/psballoon.tcl
+++ /dev/null
@@ -1,113 +0,0 @@
-#----------------------------------------------------------------------
-#
-# psballoon.tcl,
-# Procedures to create help message balloons or display balloons for
-# listboxes and labels that can't display all of their contents.
-#
-# Copyright (c) 2003, Peter Spjuth (peter.spjuth@space.se)
-#
-# Permission is granted to use this code under the same terms as
-# for the Tcl core code.
-#
-#----------------------------------------------------------------------
-# $Revision: 1.1 $
-#----------------------------------------------------------------------
-
-package provide psballoon 1.0
-
-namespace eval psballoon {
- variable balloon
-
- set balloon(pending) 0
- set balloon(created) 0
- set balloon(id) ""
- namespace export addBalloon
-}
-
-proc psballoon::addBalloon {w {msg ""}} {
- variable balloon
-
- set c [winfo class $w]
- if {$msg == "" && $c != "Listbox" && $c != "Label"} {
- error "Missing message to balloon for $w ($c)"
- }
- set balloon(msg,$w) $msg
- bind $w {
- set ::psballoon::balloon(pending) 1
- set ::psballoon::balloon(created) 0
- set ::psballoon::balloon(id) [after 500 {psballoon::createBalloon %W %x %y}]
- }
- bind $w {
- psballoon::killBalloon
- }
- bind $w {
- psballoon::killBalloon
- }
- bind $w {
- if {$::psballoon::balloon(pending) == 1} {
- after cancel $::psballoon::balloon(id)
- }
- if {$::psballoon::balloon(created) == 1} {
- psballoon::killBalloon
- }
- set ::psballoon::balloon(id) [after 500 {psballoon::createBalloon %W %x %y}]
- set ::psballoon::balloon(pending) 1
- }
-}
-
-proc psballoon::killBalloon {} {
- variable balloon
- if {$balloon(pending) == 1} {
- after cancel $balloon(id)
- }
- if {[winfo exists .balloon] == 1} {
- destroy .balloon
- }
- set balloon(created) 0
- set balloon(pending) 0
-}
-
-proc psballoon::createBalloon {w mx my} {
- variable balloon
- if {$balloon(created) == 0} {
- set font [$w cget -font]
- set ww [winfo width $w]
- set ih [winfo height $w]
- set ix 0
- set iy 0
- set create 1
- set msg $balloon(msg,$w)
- if {$msg == ""} {
- switch [winfo class $w] {
- Listbox {
- set i [$w index @$mx,$my]
- set msg [$w get $i]
- foreach {ix iy iw ih} [$w bbox $i] {break}
- }
- Label {
- set msg [$w cget -text]
- set iw [font measure $font $msg]
- }
- }
- #Don't create a balloon if the text is fully visible.
- set create [expr {$iw > $ww - 8}]
- } else {
- set iw [font measure $font $msg]
- }
- if {$create} {
- set x [expr {[winfo rootx $w] + $ix}]
- set y [expr {[winfo rooty $w] + $iy + $ih + 2}]
- if {$x + $iw + 8 > [winfo screenwidth $w]} {
- set x [expr {[winfo screenwidth $w] - $iw - 8}]
- }
- toplevel .balloon -bg black
- wm overrideredirect .balloon 1
- label .balloon.l \
- -text $msg -relief flat -font $font -justify left \
- -bg #ffffaa -fg black -padx 2 -pady 0 -anchor w
- pack .balloon.l -side left -padx 1 -pady 1
- wm geometry .balloon +${x}+${y}
- set balloon(created) 1
- }
- }
-}
ADDED eskil.vfs/lib/psdebug-1.0.tm
Index: eskil.vfs/lib/psdebug-1.0.tm
==================================================================
--- /dev/null
+++ eskil.vfs/lib/psdebug-1.0.tm
@@ -0,0 +1,883 @@
+#---------------------------------------------------------*-tcl-*------
+#
+# psdebug.tcl,
+# Helpers for debugging.
+#
+# Copyright (c) 2024, Peter Spjuth (peter.spjuth@gmail.com)
+#
+# Permission is granted to use this code under the same terms as
+# for the Tcl core code.
+#
+#----------------------------------------------------------------------
+# This is used as a Tcl Module. Use it like this:
+# ::tcl::tm::path add
+# package require psdebug
+# namespace import ::_PsDebug::*
+#----------------------------------------------------------------------
+
+package provide psdebug 1.0
+
+namespace eval ::_PsDebug {
+ variable allcmds
+ namespace export debugMenu
+}
+
+#-----------------------------------------------------------------------------
+# Misc useful stuff
+#-----------------------------------------------------------------------------
+
+proc ::_PsDebug::dumpMyMemUsage {str} {
+ try {
+ set xx [exec ps --pid [pid] --format vsize]
+ set mem 0
+ regexp {\d+} $xx mem
+ puts "$str : memory usage $mem"
+ } on error {} {
+ puts "$str : memory usage unknown, call to ps failed"
+ }
+}
+
+#-----------------------------------------------------------------------------
+# Tracing
+#-----------------------------------------------------------------------------
+
+proc ::_PsDebug::TRenter {cmd op} {
+ set fr [info frame -2]
+ set line X
+ if {[dict exists $fr line]} {
+ set line [dict get $fr line]
+ }
+ puts "Line $line Enter: '$cmd'"
+}
+proc ::_PsDebug::TRenterstep {cmd op} {
+ set fr [info frame -2]
+ set line X
+ if {[dict exists $fr line]} {
+ set line [dict get $fr line]
+ }
+ puts "Line $line Enterstep: '$cmd'"
+}
+proc ::_PsDebug::TRleave {cmd code res op} {
+ puts "Leave: '$res'"
+}
+proc ::_PsDebug::TRleavestep {cmd code res op} {
+ puts "Leavestep: '$res'"
+}
+proc ::_PsDebug::TR {cmd {step 0}} {
+ TRoff $cmd
+ trace add execution $cmd enter ::_PsDebug::TRenter
+ trace add execution $cmd leave ::_PsDebug::TRleave
+ if {$step} {
+ trace add execution $cmd enterstep ::_PsDebug::TRenterstep
+ trace add execution $cmd leavestep ::_PsDebug::TRleavestep
+ }
+}
+proc ::_PsDebug::TRoff {cmd} {
+ trace remove execution $cmd enter ::_PsDebug::TRenter
+ trace remove execution $cmd leave ::_PsDebug::TRleave
+ trace remove execution $cmd enterstep ::_PsDebug::TRenterstep
+ trace remove execution $cmd leavestep ::_PsDebug::TRleavestep
+}
+
+#-----------------------------------------------------------------------------
+# GUI
+#-----------------------------------------------------------------------------
+
+proc ::_PsDebug::debugMenu {mW args} {
+ if {"-append" in $args} {
+ set dW $mW
+ } else {
+ set dW $mW.debug
+ $mW add cascade -label "Debug" -menu $dW -underline 0
+ menu $dW
+ }
+
+ if {$::tcl_platform(platform) eq "windows"} {
+ $dW add checkbutton -label "Console" -variable ::consoleState \
+ -onvalue show -offvalue hide -command {console $::consoleState} \
+ -underline 0
+ $dW add separator
+ }
+
+ $dW add command -label "Edit" -command ::_PsDebug::ProcEditor \
+ -underline 0
+ $dW add command -label "Windows" -command ::_PsDebug::WindowBrowser \
+ -underline 0
+ return $dW
+}
+
+#-----------------------------------------------------------------------------
+# Window structure browser
+#-----------------------------------------------------------------------------
+proc ::_PsDebug::WindowBrowser {} {
+ set top .windowbrowser
+ destroy $top
+ tk::toplevel $top -padx 3 -pady 3
+ place [ttk::frame $top.tilebg] -border outside \
+ -x 0 -y 0 -relwidth 1 -relheight 1
+ wm title $top "Window Browser"
+ wm protocol $top WM_DELETE_WINDOW [list ::_PsDebug::WindowBrowserClosed $top]
+
+ ttk::panedwindow $top.pw -orient horizontal
+ pack $top.pw -fill both -expand 1
+
+ # Widget Tree
+ ttk::frame $top.ftree
+ set tree $top.ftree.tree
+ ttk::treeview $tree -height 20 -selectmode browse -show "tree" \
+ -yscrollcommand "$top.ftree.sby set"
+ ttk::scrollbar $top.ftree.sby -orient vertical -command "$tree yview"
+ $tree column "#0" -minwidth 50 -width 200
+
+ pack $top.ftree.sby -side right -fill y -pady 3 -padx {0 3}
+ pack $tree -fill both -expand 1 -pady 3 -padx {3 0}
+
+ # Info Text
+ text $top.t -width 80 -wrap word
+
+ set ::_PsDebug::WindowBrowser(treeW) $tree
+ set ::_PsDebug::WindowBrowser(textW) $top.t
+ bind $tree <> ::_PsDebug::WindowBrowserSelected
+
+ $top.pw add $top.ftree -weight 1
+ $top.pw add $top.t -weight 2
+
+ set ::_PsDebug::WindowBrowser(deselect) ""
+ PopulateWindowBrowser $tree
+}
+
+proc ::_PsDebug::WindowBrowserClosed {top} {
+ destroy $top
+ if {$::_PsDebug::WindowBrowser(deselect) ne ""} {
+ {*}$::_PsDebug::WindowBrowser(deselect)
+ set ::_PsDebug::WindowBrowser(deselect) ""
+ }
+}
+
+# An item was selected. Show info
+proc ::_PsDebug::WindowBrowserSelected {} {
+ $::_PsDebug::WindowBrowser(textW) delete 1.0 end
+ if {$::_PsDebug::WindowBrowser(deselect) ne ""} {
+ #puts "DESEL: $::_PsDebug::WindowBrowser(deselect)"
+ {*}$::_PsDebug::WindowBrowser(deselect)
+ set ::_PsDebug::WindowBrowser(deselect) ""
+ }
+ set tree $::_PsDebug::WindowBrowser(treeW)
+ set items [$tree selection]
+ if {[llength $items] < 1} return
+ set item [lindex $items 0]
+ set values [$tree item $item -values]
+ set d [lindex $values 0]
+ set txt [dict get $d out]
+ $::_PsDebug::WindowBrowser(textW) insert end $txt
+
+ set interp [dict get $d interp]
+ set i [list interp eval $interp]
+ set w [dict get $d w]
+
+ # A few experiments to highlight selection.
+ try {
+ # Overlaid frame seems to work best
+ set tl [{*}$i winfo toplevel $w]
+ set wx [expr [{*}$i winfo rootx $w] - [{*}$i winfo rootx $tl]]
+ set wy [expr [{*}$i winfo rooty $w] - [{*}$i winfo rooty $tl]]
+ set ww [{*}$i winfo width $w]
+ set wh [{*}$i winfo height $w]
+ set cleancmd ""
+ if {$tl eq "."} {
+ set tl ""
+ }
+ for {set t 1} {$t <= 4} {incr t} {
+ set whl($t) $tl._debug_hl_$t
+ destroy $whl($t)
+ append cleancmd [list destroy $whl($t)]\;
+ frame $whl($t) -background red
+ }
+ place $whl(1) -x $wx -y $wy -width $ww -height 3
+ place $whl(2) -x $wx -y $wy -width 3 -height $wh
+ place $whl(3) -x [+ $wx $ww] -y $wy -width 3 -height $wh
+ place $whl(4) -x $wx -y [+ $wy $wh] -width $ww -height 3
+ set ::_PsDebug::WindowBrowser(deselect) \
+ [list eval $cleancmd]
+ return
+ } on error {err info} {
+ #puts "In $interp"
+ #puts "$err"
+ #puts "$info"
+ }
+
+ try {
+ # Reconfiguring class. Does not work with disabled buttons e.g.
+ set class [{*}$i winfo class $w]
+ set oldstyle [{*}$i $w cget -style]
+ if {$oldstyle eq ""} {
+ set basestyle $class
+ } else {
+ set basestyle $oldstyle
+ }
+ set style HighLightRed.$basestyle
+ {*}$i ttk::style configure $style -background red -fieldbackground red
+ {*}$i $w configure -style $style
+ set ::_PsDebug::WindowBrowser(deselect) \
+ [list {*}$i [list $w configure -style $oldstyle]]
+ #puts "CLASS $class STYLE $style"
+ #puts [{*}$i ttk::style configure $basestyle]
+ #puts [{*}$i ttk::style configure $style]
+ return
+ } on error {err info} {
+ #puts "In $interp"
+ #puts "$err"
+ #puts "$info"
+ }
+ try {
+ # Tk style background change. Only works with Tk.
+ set bg [{*}$i $w cget -background]
+ {*}$i $w configure -background red
+ set ::_PsDebug::WindowBrowser(deselect) \
+ [list {*}$i [list $w configure -background $bg]]
+ return
+ } on error {err info} {
+ #puts "In $interp"
+ #puts "$err"
+ #puts "$info"
+ }
+ #puts "MOO $w"
+}
+
+# Format configure data from a widget for display
+proc ::_PsDebug::FormatConfigure {configData} {
+ set first ""
+ set last ""
+ foreach param $configData {
+ lassign $param flag _ _ def value
+ if {$value ne $def} {
+ # List changed values first
+ append first "[list $flag $value] "
+ } else {
+ append last "[list $flag $value] "
+ }
+ }
+ set first [string trim $first]
+ set last [string trim $last]
+
+ if {$first ne ""} {
+ set first "Changed Parameters:\n$first\n"
+ }
+
+ if {$last ne ""} {
+ append first "Default Parameters:\n" $last
+ }
+ return [string trim $first]
+}
+
+# Populate
+proc ::_PsDebug::PopulateWindowBrowser {tree} {
+ $tree delete [$tree children {}]
+ set todo [list . {}]
+ # Outer loop for subinterps TBD
+ while {[llength $todo] > 0} {
+ set containers {}
+ while {[llength $todo] > 0} {
+ # POP
+ set w [lindex $todo 0]
+ set interp [lindex $todo 1]
+ set i [list interp eval $interp]
+ set todo [lrange $todo 2 end]
+ set long $interp$w
+ if {$w in {.windowbrowser}} continue
+
+ foreach child [lsort -dictionary [{*}$i winfo children $w]] {
+ lappend todo $child $interp
+ }
+ set id($long) "N$long"
+ if {[info exists parents($long)]} {
+ # Parent passed from other interp
+ set parentId $id($parents($long))
+ } else {
+ set parent [{*}$i winfo parent $w]
+ if {$parent eq ""} {
+ set parentId ""
+ } else {
+ set parentId $id($interp$parent)
+ }
+ }
+
+ set class [{*}$i winfo class $w]
+ # Info to be displayed
+ set out "$w ($class)\n"
+ set configData [{*}$i $w configure]
+ append out [FormatConfigure $configData]
+ foreach param $configData {
+ lassign $param flag _ _ def value
+ if {$flag eq "-container" && $value == 1} {
+ lappend containers $w $interp
+ }
+ }
+ # Add grid info, if any
+ try {
+ set ix [{*}$i grid info $w]
+ if {$ix ne ""} {
+ append out "\n\ngrid\n$ix"
+ }
+ } on error {} {}
+ # Add pack info, if any
+ try {
+ set ix [{*}$i pack info $w]
+ if {$ix ne ""} {
+ append out "\n\npack\n$ix"
+ }
+ } on error {} {}
+ # Add menu info, if menu
+ try {
+ set last [{*}$i $w index end]
+ for {set ix 0} {$ix <= $last} {incr ix} {
+ set configData [{*}$i $w entryconfigure $ix]
+ append out \n\n [FormatConfigure $configData]
+ }
+ } trap {TCL LOOKUP INDEX} {} {
+ # Non-menu widgets will normally error out on not having the
+ # "index" subcommand, which ends up here. Ignore.
+ } on error {msg erri} {
+ # Give some hint on other errors
+ #puts "MOOO $msg\n$erri"
+ }
+
+ set name $w
+ regexp {\.[^.]+$} $w name
+
+ set open 1
+ if {[string match "*#*" $w]} {
+ set open 0
+ }
+
+ set d {}
+ dict set d w $w
+ dict set d interp $interp
+ dict set d id $id($long)
+ dict set d out $out
+
+ $tree insert $parentId end -id $id($long) -open $open \
+ -text $name -values [list $d]
+ }
+ # TODO: Handle -container and subinterp? How?
+ foreach {w interp} $containers {
+ set wid [winfo id $w]
+ foreach sub [interp slaves $interp] {
+ try {
+ set subId [interp eval $sub . cget -use]
+ if {$subId == $wid} {
+ #puts "Found interp $sub for $w"
+ set parents($sub.) $interp$w
+ lappend todo . $sub
+ }
+ } on error {} {}
+
+ }
+ }
+ #break
+ }
+}
+
+#-----------------------------------------------------------------------------
+# Procedure/method editor
+#-----------------------------------------------------------------------------
+
+# An item was selected. Show it and make it editable.
+proc ::_PsDebug::ProcEditorSelected {} {
+ variable allcmds
+
+ set ::_PsDebug::ProcEditor(current) ""
+ set ::_PsDebug::ProcEditor(parent) ""
+ set ::_PsDebug::ProcEditor(proc) ""
+ set ::_PsDebug::ProcEditor(args) ""
+ $::_PsDebug::ProcEditor(bodyW) delete 1.0 end
+
+ set tree $::_PsDebug::ProcEditor(treeW)
+ set items [$tree selection]
+ if {[llength $items] < 1} return
+ set item [lindex $items 0]
+ set d $allcmds($item)
+ set type [dict get $d type]
+ set parent [dict get $d parent]
+ set name [dict get $d name]
+
+ set ::_PsDebug::ProcEditor(current) $item
+ set ::_PsDebug::ProcEditor(parent) $parent
+ set ::_PsDebug::ProcEditor(proc) $name
+ set ::_PsDebug::ProcEditor(args) ""
+ $::_PsDebug::ProcEditor(bodyW) delete 1.0 end
+
+ set traceState normal
+ if {$type eq "proc"} {
+ set arglist {}
+ foreach i [info args $item] {
+ if {[info default $item $i value]} {
+ lappend arglist [list $i $value]
+ } else {
+ lappend arglist [list $i]
+ }
+ }
+ set body [info body $item]
+ set ::_PsDebug::ProcEditor(args) $arglist
+ $::_PsDebug::ProcEditor(bodyW) insert end $body
+ } elseif {$type eq "method"} {
+ lassign [info class definition $parent $name] arglist body
+ set traceState disabled
+ set ::_PsDebug::ProcEditor(args) $arglist
+ $::_PsDebug::ProcEditor(bodyW) insert end $body
+ } else {
+ set traceState disabled
+ }
+ foreach w $::_PsDebug::ProcEditor(traceWs) {
+ $w configure -state $traceState
+ }
+
+}
+
+# Redefine currently edited proc/method
+proc ::_PsDebug::ProcEditorRedefine {} {
+ variable allcmds
+ set body [$::_PsDebug::ProcEditor(bodyW) get 1.0 end]
+ set body [string trimright $body]
+
+ set item $::_PsDebug::ProcEditor(current)
+ set d $allcmds($item)
+ set type [dict get $d type]
+ set parent [dict get $d parent]
+ set name [dict get $d name]
+
+ if {$type eq "proc"} {
+ set todo [list proc $item \
+ $::_PsDebug::ProcEditor(args) $body]
+ set ::_PsDebug::redefines($item) $todo
+ uplevel \#0 $todo
+ } elseif {$type eq "method"} {
+ set todo [list oo::define $parent method $name \
+ $::_PsDebug::ProcEditor(args) $body]
+ set ::_PsDebug::redefines($parent..$name) $todo
+ uplevel \#0 $todo
+ }
+}
+
+proc ::_PsDebug::ProcEditorCopy {} {
+ clipboard clear
+ foreach item [array names ::_PsDebug::redefines] {
+ clipboard append $::_PsDebug::redefines($item)\n
+ }
+}
+
+# Tracing of commands
+proc ::_PsDebug::ProcEditorTrace {level} {
+ variable allcmds
+ set item $::_PsDebug::ProcEditor(current)
+ set d $allcmds($item)
+ set type [dict get $d type]
+ set parent [dict get $d parent]
+ set name [dict get $d name]
+ if {$type ni "proc method"} return
+
+ # TODO: methods
+ if {$type eq "proc"} {
+ if {$level == 1} {
+ TR $item
+ } elseif {$level == 2} {
+ TR $item 1
+ } else {
+ TRoff $item
+ }
+ }
+}
+
+# Disassemble of current
+proc ::_PsDebug::ProcEditorDisas {} {
+ variable allcmds
+ set item $::_PsDebug::ProcEditor(current)
+ set d $allcmds($item)
+ set type [dict get $d type]
+ set parent [dict get $d parent]
+ set name [dict get $d name]
+ if {$type ni "proc method"} return
+
+ if {$type eq "proc"} {
+ set da [tcl::unsupported::disassemble proc $item]
+ } else {
+ set da [tcl::unsupported::disassemble method $parent $name]
+ }
+
+ set top .proceditor.disas
+ destroy $top
+ tk::toplevel $top -padx 3 -pady 3
+ place [ttk::frame $top.tilebg] -border outside \
+ -x 0 -y 0 -relwidth 1 -relheight 1
+ 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
+}
+
+# Treeview filtering. React on keystroke
+proc ::_PsDebug::ProcEditorFilter {aVal kVal} {
+ set f $::_PsDebug::ProcEditor(filter)
+ set fx $::_PsDebug::ProcEditor(filterx)
+ # Do not react unless changed.
+ if {$f eq $fx} {
+ return
+ }
+ set tree $::_PsDebug::ProcEditor(treeW)
+
+ # Recreate the tree.
+ # This is easier since the treeview does not have an item hide attribute.
+ set pat *$f*
+ TreePopulate $tree $pat
+ set ::_PsDebug::ProcEditor(filterx) $f
+}
+
+# Make sure the hierarchy for a leaf exist, creating if needed.
+proc ::_PsDebug::TreeCreatePath {tree path} {
+ if {[$tree exists $path]} return
+ set d $::_PsDebug::allcmds($path)
+ set parent [dict get $d parent]
+ if {$path ni {"" ::}} {
+ TreeCreatePath $tree $parent
+ }
+ set text [dict get $d name]
+ if {$parent eq "::"} {
+ set parent ""
+ }
+
+ $tree insert $parent end -id $path -text $text -open 1 \
+ -values [list $parent]
+}
+
+# Populate the treeview with all known procs and methods
+proc ::_PsDebug::TreePopulate {tree {filter *}} {
+ $tree delete [$tree children {}]
+ foreach cmd [lsort -dictionary [array names ::_PsDebug::allcmds]] {
+ set d $::_PsDebug::allcmds($cmd)
+ set type [dict get $d type]
+ if {$type ni "proc method"} continue
+ if { ! [string match -nocase $filter [dict get $d name]]} continue
+
+ set path [dict get $d parent]
+ if {$path ne ""} {
+ TreeCreatePath $tree $path
+ }
+ $tree insert $path end -id $cmd \
+ -text [dict get $d name] -values [list $path]
+ }
+}
+
+# Main Proc Editor window
+proc ::_PsDebug::ProcEditor {} {
+ ::_PsDebug::CollectInfo
+
+ set top .proceditor
+ destroy $top
+ tk::toplevel $top -padx 3 -pady 3
+ place [ttk::frame $top.tilebg] -border outside \
+ -x 0 -y 0 -relwidth 1 -relheight 1
+ wm title $top "Proc Editor"
+
+ ttk::frame $top.ftree
+ set ::_PsDebug::ProcEditor(filter) ""
+ set ::_PsDebug::ProcEditor(filterx) ""
+ ttk::entry $top.ftree.ef -textvariable ::_PsDebug::ProcEditor(filter)
+ addBalloon $top.ftree.ef "Filter"
+ bind $top.ftree.ef {::_PsDebug::ProcEditorFilter %A %K}
+ set tree $top.ftree.tree
+ set ::_PsDebug::ProcEditor(treeW) $tree
+ ttk::treeview $tree -height 20 -selectmode browse -show "tree" \
+ -yscrollcommand "$top.ftree.sby set"
+ ttk::scrollbar $top.ftree.sby -orient vertical -command "$tree yview"
+ $tree tag configure highlight -background pink
+ $tree column "#0" -minwidth 50 -width 200
+ pack $top.ftree.ef -side "top" -fill x -padx 3 -pady 3
+ pack $top.ftree.sby -side right -fill y -pady 3 -padx {0 3}
+ pack $tree -fill both -expand 1 -pady 3 -padx {3 0}
+ TreePopulate $tree
+ bind $tree <> ::_PsDebug::ProcEditorSelected
+
+ ttk::label $top.l1a -text "Parent" -anchor w
+ ttk::label $top.l1b -textvariable ::_PsDebug::ProcEditor(parent) -anchor w
+ ttk::label $top.l2a -text "Proc/Method" -anchor w
+ ttk::label $top.l2b -textvariable ::_PsDebug::ProcEditor(proc) -anchor w
+ ttk::label $top.l3a -text "Args" -anchor w
+ ttk::label $top.l3b -textvariable ::_PsDebug::ProcEditor(args) -anchor w
+ ttk::button $top.bc -text "Copy" -command ::_PsDebug::ProcEditorCopy
+ addBalloon $top.bc "Put all redefines on clipboard"
+
+ set ::_PsDebug::ProcEditor(bodyW) [text $top.t -yscrollcommand "$top.sby set" \
+ -width 90]
+ ttk::scrollbar $top.sby -orient vertical -command "$top.t yview"
+
+ ttk::frame $top.fb
+ ttk::button $top.b1 -text "Redefine" -command ::_PsDebug::ProcEditorRedefine
+ addBalloon $top.b1 "Redefine for this session"
+ ttk::button $top.b2 -text "Disas" -command ::_PsDebug::ProcEditorDisas
+ addBalloon $top.b2 "Show byte code"
+ ttk::button $top.b3 -text "Trace" -command "::_PsDebug::ProcEditorTrace 1"
+ addBalloon $top.b3 "Enable execution trace"
+ ttk::button $top.b4 -text "Tr Step" -command "::_PsDebug::ProcEditorTrace 2"
+ addBalloon $top.b4 "Enable detailed execution trace"
+ ttk::button $top.b5 -text "Tr Off" -command "::_PsDebug::ProcEditorTrace 0"
+ addBalloon $top.b5 "Disable execution trace"
+ set ::_PsDebug::ProcEditor(traceWs) [list $top.b3 $top.b4 $top.b5]
+ grid $top.b1 $top.b2 $top.b3 $top.b4 $top.b5 -in $top.fb
+ grid columnconfigure $top.fb all -weight 1 -uniform a
+
+ grid $top.ftree $top.l1a $top.l1b - $top.bc - -padx 3 -pady 3 -sticky news
+ grid ^ $top.l2a $top.l2b - - - -padx 3 -pady 3 -sticky we
+ grid ^ $top.l3a $top.l3b - - - -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 2 -weight 1
+ grid rowconfigure $top $top.t -weight 1
+}
+
+#-----------------------------------------------------------------------------
+# Procedure/method information collection
+#-----------------------------------------------------------------------------
+#
+# There is nuances to namespace handling that needs awareness.
+#
+# "parent" operates on just existing namespaces and cannot be used on
+# procedures. It returns a normalized name, with a slight gotcha that
+# top namespace is "::", thus ending in colons. Thus this cannot be used
+# directly for joining without care.
+# % namespace parent ::eskil::rev
+# ::eskil
+# % namespace parent eskil::rev
+# ::eskil
+# % namespace parent ::eskil
+# ::
+# % namespace parent ::
+#
+# "qualifier" pairs with "tail"
+# It just parses the string and does not need to make sense.
+# Thus this can be used on qualified procedure names.
+# % namespace qualifier ::eskil::rev
+# ::eskil
+# % namespace qualifier eskil::rev
+# eskil
+# % namespace qualifier ::eskil
+#
+# Ditto with "tail"
+# % namespace tail ::eskil::rev
+# rev
+# % namespace tail ::eskil
+# eskil
+# % namespace tail ::
+#
+# "children", like "parent", operates on real namespace and normalizes.
+# % namespace children ::eskil
+# ::eskil::rev
+# % namespace children ::eskil::
+# ::eskil::rev
+# % namespace children ""
+# ::eskil ::zlib ::pkg ::oo ::tcl
+#
+# Conclusion:
+# If a namespace is always kept with "::" at the end things are mostly easy.
+# "parent" and "children" will work, as well as joining with $parent$tail.
+# This cannot be used with "qualifiers", so extra care is needed there.
+# The helpers below handles this.
+
+# Parent namespace. Always ends with ::
+proc ::_PsDebug::Qualifiers {ns} {
+ set ns [string trimright $ns ":"]
+ set q [namespace qualifiers $ns]
+ if { ! [string match *:: $q]} {
+ append q ::
+ }
+ return $q
+}
+# Parent namespace. Always ends with ::
+proc ::_PsDebug::Parent {ns} {
+ set p [namespace parent $ns]
+ if { ! [string match *:: $p]} {
+ append p ::
+ }
+ return $p
+}
+
+# allcmds structure:
+# fullId for different things:
+# proc: Its qualified namespace path. Name = leaf
+# namespace: Its qualified namespace path ending in ::. Name = leaf::
+# class: Its qualified namespace path. Name = leaf
+# method: A list of class id + method. Name = method
+# allcmds(fullId) = dict:
+# type = proc/namespace/class/method/import
+# parent = fullId of parent/class
+# name = leaf name
+# origin = for import
+
+# Collect all info about procedures/method/whatever.
+# This is work in progress...
+proc ::_PsDebug::CollectInfo {} {
+ variable allcmds
+ array set allcmds {}
+
+ # Only do this once
+ if {[array size allcmds] > 0} return
+
+ # Find all commands in all namespaces
+ set todoNs [list ::]
+ while {[llength $todoNs] != 0} {
+ set nsId [lindex $todoNs 0]
+ set todoNs [lrange $todoNs 1 end]
+
+ if {$nsId eq "::_PsDebug::"} continue
+
+ set tail [namespace tail [string trimright $nsId ":"]]
+ dict set allcmds($nsId) type namespace
+ dict set allcmds($nsId) parent [Parent $nsId]
+ dict set allcmds($nsId) name ${tail}::
+
+ foreach child [namespace children $nsId] {
+ lappend todoNs ${child}::
+ }
+ array unset thisround
+ array set thisround {}
+ # First collect commands, since we want to override with detail later
+ foreach cmd [info commands $nsId*] {
+ dict set allcmds($cmd) type "cmd"
+ dict set allcmds($cmd) parent [Qualifiers $cmd]
+ dict set allcmds($cmd) name [namespace tail $cmd]
+ set thisround($cmd) 1
+ }
+ # Which ones are procs?
+ foreach cmd [info procs $nsId*] {
+ dict set allcmds($cmd) type "proc"
+ dict set allcmds($cmd) parent [Qualifiers $cmd]
+ dict set allcmds($cmd) name [namespace tail $cmd]
+ set thisround($cmd) 0
+ }
+ # Which ones are imports?
+ if { ! [catch {namespace eval $nsId {namespace import}} imports]} {
+ foreach cmd $imports {
+ dict set allcmds($nsId$cmd) type "import"
+ dict set allcmds($nsId$cmd) origin \
+ [namespace origin $nsId$cmd]
+ set thisround($nsId$cmd) 0
+ }
+ }
+
+ # Look through and command that is not something identified
+ foreach cmd [array names thisround] {
+ if { ! $thisround($cmd)} continue
+
+ # Is it an ensemble?
+ if {[namespace ensemble exists $cmd]} {
+ #puts "ENSEMBLE $cmd"
+ dict set allcmds($cmd) type ensemble
+ foreach {key val} [namespace ensemble configure $cmd] {
+ #lappend allcmds($cmd) $key $val
+ if {$key eq "-map"} {
+ #puts "$cmd $val"
+ dict lappend allcmds($cmd) maps {*}$val
+ }
+ # Recognise a snit class
+ if {$key eq "-unknown" && [string match ::snit::* $val]} {
+ #puts "SNIT? $cmd"
+ #lset allcmds($cmd) 0 snit
+ }
+ }
+ set thisround($cmd) 0
+ continue
+ }
+ }
+ # Namespace ensembles?
+ }
+
+ # Go through tcloo classes
+ set todoObj [list ::oo::object]
+ while {[llength $todoObj] != 0} {
+ set obj [lindex $todoObj 0]
+ set todoObj [lrange $todoObj 1 end]
+
+ dict set allcmds($obj) type class
+ dict set allcmds($obj) parent [Qualifiers $obj]
+ dict set allcmds($obj) name [namespace tail $obj]
+
+ foreach child [info class subclasses $obj] {
+ lappend todoObj $child
+ }
+ foreach m [info class methods $obj -private] {
+ set id [list $obj $m]
+ dict set allcmds($id) type method
+ dict set allcmds($id) parent $obj
+ dict set allcmds($id) name $m
+ }
+ }
+}
+
+# Debug of debug
+proc ::_PsDebug::DumpStuff {} {
+ try {
+ ::_PsDebug::CollectInfo
+ } on error {res i} {
+ puts $res
+ puts $i
+ after 1000
+ }
+
+ # Proc
+ parray ::_PsDebug::allcmds *updateColors*
+ parray ::_PsDebug::allcmds *cleanupAndExit
+ # Cmd
+ parray ::_PsDebug::allcmds *ttk::paned
+ parray ::_PsDebug::allcmds *llength
+ # OO class
+ parray ::_PsDebug::allcmds *Account*
+ # Snit class
+ parray ::_PsDebug::allcmds *eskilprint*
+ #
+ parray ::_PsDebug::allcmds *indexEntry*
+ exit
+}
+
+#-----------------------------------------------------------------------------
+# Test just to include an OO object in the code
+#-----------------------------------------------------------------------------
+catch {Account destroy}
+oo::class create Account {
+ constructor {{ownerName undisclosed}} {
+ my variable total overdrawLimit owner
+ set total 0
+ set overdrawLimit 10
+ set owner $ownerName
+ }
+ method deposit amount {
+ my variable total
+ set total [expr {$total + $amount}]
+ }
+ method withdraw amount {
+ my variable total overdrawLimit
+ if {($amount - $total) > $overdrawLimit} {
+ error "Can't overdraw - total: $total, limit: $overdrawLimit"
+ }
+ set total [expr {$total - $amount}]
+ }
+ method transfer {amount targetAccount} {
+ my variable total
+ my withdraw $amount
+ $targetAccount deposit $amount
+ set total
+ }
+ method dump {} {
+ #HoHA
+ }
+ destructor {
+ my variable total
+ if {$total} {puts "remaining $total will be given to charity"}
+ }
+}
ADDED eskil.vfs/lib/psmenu-1.1.tm
Index: eskil.vfs/lib/psmenu-1.1.tm
==================================================================
--- /dev/null
+++ eskil.vfs/lib/psmenu-1.1.tm
@@ -0,0 +1,379 @@
+#---------------------------------------------------------*-tcl-*------
+#
+# psmenu.tcl
+# Framework for building Tk menu structure
+#
+# Copyright (c) 2024, Peter Spjuth (peter.spjuth@gmail.com)
+#
+# Permission is granted to use this code under the same terms as
+# for the Tcl core code.
+#
+#----------------------------------------------------------------------
+# This is used as a Tcl Module. Use it like this:
+# ::tcl::tm::path add
+# package require psmenu
+# psmenu::psmenu . {
+# definitions...
+# }
+#----------------------------------------------------------------------
+
+package provide psmenu 1.1
+
+namespace eval psmenu {
+ namespace export psmenu
+}
+
+set psmenu::example {
+ # All definition blocks are lists.
+ # Thus \-newline are not strictly necessary.
+ # For compactness, options are kept short
+ # -ul for -underline
+ # "&File"-syntax supported for label
+ # -var for -variable
+ # Variable is initialised if not existing
+ # If used with cascade, store menu widget in var
+ # -cfgvar Store entryconfigure command in var
+ # -cmd for -command
+ # command part is put through "subst"
+ # -acc for -accelerator
+ # Will bind to command unless -accelerator
+ # -def for default value of -var
+ # checkbuttons default to default 0
+ # radiobuttons default to first value seen
+ # if/else commands can be included
+ package require psmenu
+ psmenu::psmenu . {
+ # Comments are ok
+ # If an argument looks like a "body" this is a cascade
+ "&File" {
+ "&Copy Solver URL" -cmd copySolverUrl
+ # Separator is --*
+ --------------------
+ "&Quit" -cmd exit
+ }
+ "&Config" {
+ "&Rules" -var ::mooa {
+ "Knight" -var ::ruleset(knight) -cmd changeRuleSet
+ "King" -var ::ruleset(king) -cmd changeRuleSet
+ "No Consecutive" -var ::ruleset(consecutive) -cmd changeRuleSet
+ "Grid Size" -var mooo {
+ # TBD allow loops?
+ # Define a bunch of radiobuttons at once.
+ # Without -value it is same as label string
+ _Radio -var ::ruleset(gridsize) -cmd newGame -def 9 {
+ "8" -value 8
+ "9" -value 9
+ "10"
+ }
+ # Individual example
+ "6" -value 6 -var ::ruleset(gridsize) -cmd newGame
+ }
+ }
+ # checkbutton has a -var and possibly -cmd, -onvalue, -offvalue
+ "Conflict Check" -var ::uiData(conflict) -cmd autoConflict
+ }
+ }
+ # More calls with more cascades work
+ psmenu::psmenu . {
+ "&Debug" {
+ "Reread &Source" -acc F1 -cmd _rs
+ }
+ }
+}
+
+##nagelfar syntax psmenu::PopEntry v
+##nagelfar syntax tk::AmpMenuArgs x*
+
+# Main call for psmenu. Some optional arguments are for internal use.
+# Canbe called with an existing menu, but then -top must be given.
+proc psmenu::psmenu {top args} {
+ set def [lindex $args end]
+ set args [lrange $args 0 end-1]
+
+ set opts(-top) ""
+ set opts(-level) ""
+ set opts(-level) ""
+ set opts(-recursive) 0
+ array set opts $args
+
+ # Is given arg a toplevel or menu?
+ if {$top eq "."} {
+ set m .m
+ } else {
+ if {[winfo class $top] ne "Menu"} {
+ set m $top.m
+ } else {
+ # A menu was given, assume -top
+ set m $top
+ set top $opts(-top)
+ }
+ }
+
+ if {$opts(-recursive)} {
+ # Locate a free window name for the menu, for internal call
+ while {[winfo exists $m]} {
+ if {[regexp {^(.*?)(\d+)$} $m -> prefix Index]} {
+ incr Index
+ } else {
+ set prefix $m
+ set Index 0
+ }
+ set m $prefix$Index
+ }
+ }
+ # It might exist for a second user call
+ if { ! [winfo exists $m]} {
+ # Create
+ menu $m -tearoff 0
+ }
+
+ if {$opts(-level) eq ""} {
+ # Store initial level to handle scope when recursing cascades
+ set opts(-level) [uplevel 1 info level]
+ }
+ if {$opts(-top) eq ""} {
+ set opts(-top) $top
+ $top configure -menu $m
+ }
+
+ # Comments in definition block
+ set def [regsub -all -line {^\s*#.*$} $def ""]
+
+ set state ""
+ while {[llength $def] > 0} {
+ #puts "Def length [llength $def]"; update
+ set entry [PopEntry def]
+ set label [lindex $entry 0]
+ if {$label eq "_Radio"} {
+ set options [lrange $entry 1 end-1]
+ set body [lindex $entry end]
+ set radioDef {}
+ for {set t 0} {$t < [llength $body]} {incr t} {
+ set label [lindex $body $t]
+ if {[lindex $body $t+1] eq "-value"} {
+ incr t 2
+ set value [lindex $body $t]
+ } else {
+ set value $label
+ }
+ lappend radioDef $label -value $value {*}$options
+ }
+ #puts "RADIO '$radioDef'"
+
+ # Prepend
+ set def [list {*}$radioDef {*}$def]
+ # TBD FIXA
+ continue
+ }
+
+ # Conditionals
+ if {$label eq "if"} {
+ # TBD support elseif
+ set ifExpr [lindex $entry 1]
+ set body [lindex $entry 2]
+ set elseBody [lindex $entry 4]
+ set cond [uplevel \#$opts(-level) [list expr $ifExpr]]
+ #puts "if expression '$ifExpr' = $cond"
+ if {$cond} {
+ # Prepend
+ set def [list {*}$body {*}$def]
+ } elseif {$elseBody ne ""} {
+ set def [list {*}$elseBody {*}$def]
+ }
+ continue
+ }
+
+ # Recognise Cascade by even args "Name ?opts? Def"
+ # An item will be "Name ?opts?", i.e odd
+ if {[llength $entry] % 2 == 0} {
+ # Cascade
+ set options [lrange $entry 1 end-1]
+ set body [lindex $entry end]
+ # Recurse cascade defintion
+ set cascade [psmenu $m {*}[array get opts] -recursive 1 $body]
+ # Since -menu is last, processing below can assume that.
+ lappend options -menu $cascade
+ } else {
+ set options [lrange $entry 1 end]
+ }
+ #puts "Label '$label'"
+ #puts "Options '$options'"
+ # Figure out type
+ if {[string match "-*" $label]} {
+ set type separator
+ set label ""
+ } elseif {[dict exists $options -menu]} {
+ set type "cascade"
+ } elseif {[dict exists $options -value]} {
+ set type radiobutton
+ } elseif {[dict exists $options -var]} {
+ set type checkbutton
+ } else {
+ set type command
+ }
+ # Process options
+ set newOptions {}
+ if {$label ne ""} {
+ lappend newOptions -label $label
+ }
+ set doBind ""
+ set command ""
+ set value ""
+ set variable ""
+ set cfgvar ""
+ set default 0
+ foreach {opt val} $options {
+ set val [uplevel \#$opts(-level) [list subst $val]]
+ switch -- $opt {
+ -ul - -underline {
+ lappend newOptions -underline $val
+ }
+ -var - -variable {
+ if {$type eq "cascade"} {
+ set variable $val
+ } else {
+ set variable $val
+ lappend newOptions -variable $val
+ }
+ }
+ -cfgvar {
+ set cfgvar $val
+ }
+ -cmd - -command {
+ set command $val
+ lappend newOptions -command $val
+ }
+ -acc {
+ lappend newOptions -accelerator $val
+ set doBind $val
+ }
+ -accelerator {
+ lappend newOptions -accelerator $val
+ }
+ -value {
+ lappend newOptions -value $val
+ set default $val
+ }
+ -offvalue {
+ lappend newOptions -offvalue $val
+ set default $val
+ }
+ -onvalue {
+ lappend newOptions -onvalue $val
+ }
+ -menu {
+ lappend newOptions -menu $val
+ if {$variable ne ""} {
+ uplevel \#$opts(-level) [list set $variable $val]
+ }
+ }
+ -def {
+ set default $val
+ }
+ default {
+ # Just let through
+ lappend newOptions $opt $val
+ }
+ }
+ }
+
+ if {$variable ne ""} {
+ ##nagelfar ignore Non constant level
+ upvar \#$opts(-level) $variable __vv
+ if { ! [info exists __vv]} {
+ set __vv $default
+ }
+ }
+
+ # TK helper to handle & in label
+ ::tk::AmpMenuArgs $m add $type {*}$newOptions
+
+ if {$cfgvar ne ""} {
+ set ix [$m index end]
+ set tmp [list $m entryconfigure $ix]
+ uplevel \#$opts(-level) [list set $cfgvar $tmp]
+ }
+
+ if {$doBind ne ""} {
+ if {[regexp {^(.*)-(.*)$} $doBind -> pre post]} {
+ if {$pre eq "Ctrl"} {
+ set pre "Control"
+ }
+ set doBind $pre-Key-$post
+ } else {
+ set doBind Key-$doBind
+ }
+ #puts "Binding '$doBind' '$command'"
+ bind $opts(-top) <$doBind> $command
+ }
+ }
+
+ return $m
+}
+
+# Extract one entry from definiton
+proc psmenu::PopEntry {defName} {
+ upvar 1 $defName def
+
+ set result {}
+
+ if {[lindex $def 0] eq "if"} {
+ # TBD support elseif
+ if {[lindex $def 0] eq "else"} {
+ set result [lrange $def 0 4]
+ set def [lrange $def 5 end]
+ } else {
+ set result [lrange $def 0 2]
+ set def [lrange $def 3 end]
+ }
+ return $result
+ }
+
+ set state "label"
+ set n -1
+ foreach arg $def {
+ incr n
+ switch $state {
+ "label" {
+ lappend result $arg
+ set state "option"
+ }
+ "option" {
+ if {[string match "--*" $arg]} {
+ incr n -1
+ break
+ } elseif {[string match "-*" $arg]} {
+ lappend result $arg
+ set state "value"
+ } elseif {[regexp {^\s+.*\s+$} $arg] || $arg eq ""} {
+ # recognise body somehow
+ lappend result $arg
+ break
+ } else {
+ # Must be next label
+ incr n -1
+ break
+ }
+ }
+ "value" {
+ lappend result $arg
+ set state "option"
+ }
+ }
+ }
+ incr n
+ set def [lrange $def $n end]
+ return $result
+}
+
+if 0 {
+ set mooo "Not set"
+ console show
+ package require Tk
+ update
+ wm geometry . 400x400
+ update
+ eval ${psmenu::example}
+ puts "mooo $mooo"
+ puts "mooa $mooa"
+}
ADDED eskil.vfs/lib/pstools-1.0.tm
Index: eskil.vfs/lib/pstools-1.0.tm
==================================================================
--- /dev/null
+++ eskil.vfs/lib/pstools-1.0.tm
@@ -0,0 +1,179 @@
+#---------------------------------------------------------*-tcl-*------
+#
+# pstools.tcl,
+# a package providing misc facilites
+#
+# Copyright (c) 2003, Peter Spjuth (peter.spjuth@gmail.com)
+#
+# Permission is granted to use this code under the same terms as
+# for the Tcl core code.
+#
+#----------------------------------------------------------------------
+# This is used as a Tcl Module. Use it like this:
+# ::tcl::tm::path add
+# package require pstools
+# namespace import pstools::*
+#----------------------------------------------------------------------
+
+package provide pstools 1.0
+#package require Tcl 8.4
+
+namespace eval pstools {
+ namespace export safeLoad commonYScroll locateTmp locateEditor
+
+ if {[info commands ::ttk::*] ne ""} {
+ catch {namespace path ::ttk}
+ }
+}
+
+##nagelfar syntax _ipexists l
+##nagelfar syntax _ipset v
+##nagelfar syntax _iparray s v
+
+# Load a preference file
+# Args lists the variables allowed to be set by the file
+# If -existing is given, only existing variables and elements may be set
+##nagelfar syntax pstools::safeLoad x o* v*
+proc pstools::safeLoad {file args} {
+
+ interp create -safe loadinterp
+ interp alias {} _ipexists loadinterp info exists
+ interp alias {} _ipset loadinterp set
+ interp alias {} _iparray loadinterp array
+
+ interp invokehidden loadinterp source $file
+
+ set existing 0
+ foreach arg $args {
+ if {$arg eq "-existing"} {
+ set existing 1
+ continue
+ }
+ ##nagelfar vartype arg varName
+ upvar 1 $arg TheVar
+ if {[_iparray exists $arg]} {
+ foreach {key val} [_iparray get $arg] {
+ if { ! $existing || [info exists TheVar($key)]} {
+ set TheVar($key) $val
+ }
+ }
+ } elseif {[_ipexists $arg]} {
+ if { ! $existing || [info exists TheVar]} {
+ set TheVar [_ipset $arg]
+ }
+ }
+ }
+
+ interp delete loadinterp
+}
+
+
+# Procedures for common y-scroll
+proc pstools::CommonYScroll_YView {sby args} {
+ variable yscroll
+ foreach w $yscroll($sby) {
+ eval [list $w yview] $args
+ }
+}
+
+proc pstools::CommonYScroll_YScroll {sby args} {
+ eval [list $sby set] $args
+ CommonYScroll_YView $sby moveto [lindex $args 0]
+}
+
+# Set up a common yscrollbar for a few scrollable widgets
+proc pstools::commonYScroll {sby args} {
+ variable yscroll
+
+ $sby configure -command [list pstools::CommonYScroll_YView $sby]
+ foreach w $args {
+ $w configure -yscrollcommand [list pstools::CommonYScroll_YScroll $sby]
+ }
+ set yscroll($sby) $args
+}
+
+# A simple window for displaying e.g. help.
+# Returns the frame where things can be put.
+proc pstools::helpWin {W title} {
+ destroy $W
+
+ toplevel $W -padx 2 -pady 2
+ wm title $W $title
+ bind $W [list destroy $W]
+ bind $W [list destroy $W]
+ frame $W.f
+ button $W.b -text "Close" -command [list destroy $W] -width 10 \
+ -default active
+ pack $W.b -side bottom -pady 2
+ pack $W.f -side top -expand y -fill both -padx 2 -pady 2
+ focus $W
+ return $W.f
+}
+
+# Figure out a place to store temporary files.
+proc pstools::locateTmp {globVar} {
+ upvar "#0" $globVar var
+
+ set candidates {}
+ if {[info exists ::env(TEMP)]} {
+ lappend candidates $::env(TEMP)
+ }
+ if {[info exists ::env(TMP)]} {
+ lappend candidates $::env(TMP)
+ }
+ lappend candidates /tmp . ~
+ foreach cand $candidates {
+ set cand [file normalize $cand]
+ if {[file isdirectory $cand] && [file writable $cand]} {
+ set var $cand
+ return
+ }
+ }
+ # Panic?
+ set var .
+}
+
+# This is called when an editor is needed to display a file.
+# It sets up the variable with the path, unless the var
+# already exists.
+proc pstools::locateEditor {globVar} {
+ upvar "#0" $globVar var
+
+ if {[info exists var]} return
+
+ set candidates {}
+ if {[info exists ::env(VISUAL)]} {
+ lappend candidates $::env(VISUAL)
+ }
+ if {[info exists ::env(EDITOR)]} {
+ lappend candidates $::env(EDITOR)
+ }
+ if {$::tcl_platform(platform) == "windows"} {
+ # Try to locate some common installation points for Emacs
+ set dirs [glob -nocomplain c:/apps/emacs*]
+ lappend dirs {*}[glob -nocomplain "C:/Program Files/emacs*"]
+ lappend dirs {*}[glob -nocomplain "C:/Program Files/emacs*/*"]
+ foreach dir [lsort -decreasing -dictionary $dirs] {
+ set em [file join $dir bin runemacs.exe]
+ set em [file normalize $em]
+ if {[file exists $em]} {
+ lappend candidates $em
+ break
+ }
+ }
+ lappend candidates runemacs wordpad
+ }
+ # What is a good value on Mac?
+
+ # Add some more for fallback
+ lappend candidates emacs gvim gedit kate
+
+ foreach cand $candidates {
+ if {[auto_execok $cand] ne ""} {
+ set var [list $cand]
+ return
+ }
+ }
+ # If we fall through here we are kind of lost...
+ set var "could_not_find_editor"
+}
DELETED eskil.vfs/lib/pstools/pkgIndex.tcl
Index: eskil.vfs/lib/pstools/pkgIndex.tcl
==================================================================
--- eskil.vfs/lib/pstools/pkgIndex.tcl
+++ /dev/null
@@ -1,11 +0,0 @@
-# Tcl package index file, version 1.1
-# This file is generated by the "pkg_mkIndex" command
-# and sourced either when an application starts up or
-# by a "package unknown" script. It invokes the
-# "package ifneeded" command to set up package-related
-# information so that packages will be loaded automatically
-# in response to "package require" commands. When this
-# script is sourced, the variable $dir must contain the
-# full path name of this file's directory.
-
-package ifneeded pstools 0.3 [list source [file join $dir pstools.tcl]]
DELETED eskil.vfs/lib/pstools/pstools.tcl
Index: eskil.vfs/lib/pstools/pstools.tcl
==================================================================
--- eskil.vfs/lib/pstools/pstools.tcl
+++ /dev/null
@@ -1,148 +0,0 @@
-#----------------------------------------------------------------------
-#
-# pstools.tcl,
-# a package providing misc facilites
-#
-# Copyright (c) 2003, Peter Spjuth (peter.spjuth@gmail.com)
-#
-# Permission is granted to use this code under the same terms as
-# for the Tcl core code.
-#
-#----------------------------------------------------------------------
-# $Revision: 1.6 $
-#----------------------------------------------------------------------
-
-package provide pstools 0.3
-package require Tcl 8.4
-
-namespace eval pstools {
- namespace export safeLoad commonYScroll locateTmp locateEditor
-
- if {[info commands ::ttk::*] ne ""} {
- catch {namespace path ::ttk}
- }
-}
-
-##nagelfar syntax _ipexists l
-##nagelfar syntax _ipset v
-##nagelfar syntax _iparray s v
-
-# Load a preference file
-# Args lists the variables allowed to be set by the file
-proc pstools::safeLoad {file args} {
-
- interp create -safe loadinterp
- interp alias {} _ipexists loadinterp info exists
- interp alias {} _ipset loadinterp set
- interp alias {} _iparray loadinterp array
-
- interp invokehidden loadinterp source $file
-
- foreach arg $args {
- upvar 1 $arg TheVar
- if {[_iparray exists $arg]} {
- foreach {key val} [_iparray get $arg] {
- if {[info exists TheVar($key)]} {
- set TheVar($key) $val
- }
- }
- } elseif {[_ipexists $arg]} {
- if {[info exists TheVar]} {
- set TheVar [_ipset $arg]
- }
- }
- }
-
- interp delete loadinterp
-}
-
-
-# Procedures for common y-scroll
-proc pstools::CommonYScroll_YView {sby args} {
- variable yscroll
- foreach w $yscroll($sby) {
- eval [list $w yview] $args
- }
-}
-
-proc pstools::CommonYScroll_YScroll {sby args} {
- eval [list $sby set] $args
- CommonYScroll_YView $sby moveto [lindex $args 0]
-}
-
-# Set up a common yscrollbar for a few scrollable widgets
-proc pstools::commonYScroll {sby args} {
- variable yscroll
-
- $sby configure -command [list pstools::CommonYScroll_YView $sby]
- foreach w $args {
- $w configure -yscrollcommand [list pstools::CommonYScroll_YScroll $sby]
- }
- set yscroll($sby) $args
-}
-
-# A simple window for displaying e.g. help.
-# Returns the frame where things can be put.
-proc pstools::helpWin {w title} {
- destroy $w
-
- toplevel $w -padx 2 -pady 2
- wm title $w $title
- bind $w [list destroy $w]
- bind $w [list destroy $w]
- frame $w.f
- button $w.b -text "Close" -command [list destroy $w] -width 10 \
- -default active
- pack $w.b -side bottom -pady 2
- pack $w.f -side top -expand y -fill both -padx 2 -pady 2
- focus $w
- return $w.f
-}
-
-# Figure out a place to store temporary files.
-proc pstools::locateTmp {globVar} {
- upvar "#0" $globVar var
-
- set candidates {}
- if {[info exists ::env(TEMP)]} {
- lappend candidates $::env(TEMP)
- }
- if {[info exists ::env(TMP)]} {
- lappend candidates $::env(TMP)
- }
- lappend candidates /tmp . ~
- foreach cand $candidates {
- set cand [file normalize $cand]
- if {[file isdirectory $cand] && [file writable $cand]} {
- set var $cand
- return
- }
- }
- # Panic?
- set var .
-}
-
-# This is called when an editor is needed to display a file.
-# It sets up the variable with the path, unless the var
-# already exists.
-proc pstools::locateEditor {globVar} {
- upvar "#0" $globVar var
-
- if {[info exists var]} return
-
- # What is a good value on Mac?
- if {$::tcl_platform(platform) == "unix"} {
- set var emacs
- } else {
- set var wordpad
- foreach dir [lsort -decreasing -dictionary \
- [glob -nocomplain c:/apps/emacs*]] {
- set em [file join $dir bin runemacs.exe]
- set em [file normalize $em]
- if {[file exists $em]} {
- set var $em
- break
- }
- }
- }
-}
Index: eskil.vfs/main.tcl
==================================================================
--- eskil.vfs/main.tcl
+++ eskil.vfs/main.tcl
@@ -1,3 +1,3 @@
package require starkit
starkit::startup
-source $::starkit::topdir/src/eskil.tcl
+source $::starkit::topdir/src/startup.tcl
DELETED eskil.vfs/plugins
Index: eskil.vfs/plugins
==================================================================
--- eskil.vfs/plugins
+++ /dev/null
@@ -1,1 +0,0 @@
-../plugins
DELETED eskil.vfs/src/clip.tcl
Index: eskil.vfs/src/clip.tcl
==================================================================
--- eskil.vfs/src/clip.tcl
+++ /dev/null
@@ -1,1 +0,0 @@
-../../src/clip.tcl
DELETED eskil.vfs/src/compare.tcl
Index: eskil.vfs/src/compare.tcl
==================================================================
--- eskil.vfs/src/compare.tcl
+++ /dev/null
@@ -1,1 +0,0 @@
-../../src/compare.tcl
DELETED eskil.vfs/src/dirdiff.tcl
Index: eskil.vfs/src/dirdiff.tcl
==================================================================
--- eskil.vfs/src/dirdiff.tcl
+++ /dev/null
@@ -1,1 +0,0 @@
-../../src/dirdiff.tcl
DELETED eskil.vfs/src/eskil.tcl
Index: eskil.vfs/src/eskil.tcl
==================================================================
--- eskil.vfs/src/eskil.tcl
+++ /dev/null
@@ -1,1 +0,0 @@
-../../src/eskil.tcl
DELETED eskil.vfs/src/help.tcl
Index: eskil.vfs/src/help.tcl
==================================================================
--- eskil.vfs/src/help.tcl
+++ /dev/null
@@ -1,1 +0,0 @@
-../../src/help.tcl
DELETED eskil.vfs/src/map.tcl
Index: eskil.vfs/src/map.tcl
==================================================================
--- eskil.vfs/src/map.tcl
+++ /dev/null
@@ -1,1 +0,0 @@
-../../src/map.tcl
DELETED eskil.vfs/src/merge.tcl
Index: eskil.vfs/src/merge.tcl
==================================================================
--- eskil.vfs/src/merge.tcl
+++ /dev/null
@@ -1,1 +0,0 @@
-../../src/merge.tcl
DELETED eskil.vfs/src/plugin.tcl
Index: eskil.vfs/src/plugin.tcl
==================================================================
--- eskil.vfs/src/plugin.tcl
+++ /dev/null
@@ -1,1 +0,0 @@
-../../src/plugin.tcl
DELETED eskil.vfs/src/print.tcl
Index: eskil.vfs/src/print.tcl
==================================================================
--- eskil.vfs/src/print.tcl
+++ /dev/null
@@ -1,1 +0,0 @@
-../../src/print.tcl
DELETED eskil.vfs/src/printobj.tcl
Index: eskil.vfs/src/printobj.tcl
==================================================================
--- eskil.vfs/src/printobj.tcl
+++ /dev/null
@@ -1,1 +0,0 @@
-../../src/printobj.tcl
DELETED eskil.vfs/src/registry.tcl
Index: eskil.vfs/src/registry.tcl
==================================================================
--- eskil.vfs/src/registry.tcl
+++ /dev/null
@@ -1,1 +0,0 @@
-../../src/registry.tcl
DELETED eskil.vfs/src/rev.tcl
Index: eskil.vfs/src/rev.tcl
==================================================================
--- eskil.vfs/src/rev.tcl
+++ /dev/null
@@ -1,1 +0,0 @@
-../../src/rev.tcl
ADDED eskil.vfs/tclkit.ico
Index: eskil.vfs/tclkit.ico
==================================================================
--- /dev/null
+++ eskil.vfs/tclkit.ico
cannot compute difference between binary files
ADDED eskil.vfs/tclkit.inf
Index: eskil.vfs/tclkit.inf
==================================================================
--- /dev/null
+++ eskil.vfs/tclkit.inf
@@ -0,0 +1,6 @@
+CompanyName "Peter Spjuth"
+LegalCopyright "Copyright (c) 1998-2021 Peter Spjuth et al."
+FileDescription "File difference viewer"
+ProductName "Eskil"
+ProductVersion "2.8.5"
+FileVersion "2.8.5"
ADDED examples/dir1/conflict.txt
Index: examples/dir1/conflict.txt
==================================================================
--- /dev/null
+++ examples/dir1/conflict.txt
@@ -0,0 +1,129 @@
+0
+1
+Added left
+x
+2
+3
+4
+Added right
+y
+5
+6
+7
+Changed same
+8a
+9
+10
+Changed different
+<<<<<<< HEAD
+12b
+=======
+12a
+>>>>>>> main
+13
+14
+Deleted left
+17
+18
+Deleted right
+20
+21
+Left: Add+change Right: change
+<<<<<<< HEAD
+22b
+23
+24
+Left: change Right add+change
+yy
+25b
+26
+27
+Left: Delete Right: change
+28a
+29
+30
+Left: change Right: delete
+=======
+xx
+22a
+23
+24
+Left: change Right add+change
+25a
+26
+27
+Left: Delete Right: change
+29
+30
+Left: change Right: delete
+31a
+>>>>>>> main
+32
+33
+Added same
+xxx
+34
+35
+36
+Deleted same
+38
+39
+Changed adjacent
+<<<<<<< HEAD
+40
+41a
+42
+Left: Add+change Right: change same
+=======
+40a
+41
+42
+Left: Add+change Right: change same
+xxxx
+>>>>>>> main
+43a
+44
+45
+Left: change same Right: add+change
+<<<<<<< HEAD
+yyyy
+=======
+>>>>>>> main
+46a
+47
+48
+Left: change Right: deleted block
+<<<<<<< HEAD
+52
+Added different
+yyyyy
+=======
+49
+50a
+51
+52
+Added different
+xxxxx
+>>>>>>> main
+53
+54
+55
+Left mixed change
+57x
+59
+60
+Right mixed change
+61x
+63x
+64
+65
+Both added multiple
+<<<<<<< HEAD
+yy1
+yy2
+=======
+xx1
+xx2
+>>>>>>> main
+66
+67
ADDED examples/dir1/csv1.txt
Index: examples/dir1/csv1.txt
==================================================================
--- /dev/null
+++ examples/dir1/csv1.txt
@@ -0,0 +1,32 @@
+head1,head2,head3,head4,head5,head6,head7,head8,head9,head10
+MCPM,JFPC,FJ9S9,J1J,CC3,72HJ,RN?I,O48,BH<<
+RKBO,@P:,GGG0,=8FNP,P6K,I@4,44H,48RG,1ODB:,SN:O?
+CM7,M75,PML7@,I1:,EMRL,KHK,J3IQ,N4:CJ,2H:F=,L;9I
+a,b,c,d,e,f,g,h,i,j
+9R6,MQPJA,BL1,0NCR,6BEH0,DC=,D@F,I9J19,L8M99,DQHEE
+GGK,OB?PM,I9S;K,060,AHO=8,JC46O,J>=,11?,QNEP,I1Q
+:9EA,3LPO,>27,BHA6,A3<,ODLH,01?L5,HLJ,KF>S=
+601,QK<26,1H>,PAQ,H2P,C@=,J?59<,;MG,E>8KF,BD6I
+M>SR,KA3L,PJG,HMF=G,<79I,B3;4<,1>D,JOPM,K:R7,HK<
+CK9NB,G;10O,K2;,S6>7,O12KG,@RM,QN>,=<1<,D?CJ
+PM2;K,JPQR?,<;7C3,H5SO,6M9,OL;@D,?4H>I,Q3F,E8ODJ,2P;2O,C7QN=
+F036,>FOG0,EI<91,2H5P1,AAPP?,N58HI,RRRN;,J?A6B,;:;C,19KL
+SG?H2,:<7,NLS@0,=7GA,5IJ,MLQO,4N0>=,9SRJ,7?PM,>P9E5,1O9,=5?,JCGB,A940,D;8MB,B2L
+E8Q2F,D12L,JL7ME,P0QPN,6@B,FEHI,QAF69,PIK,4KO,:C?
+G8:,J19EL,?2L,6EOBA,D:B,6N>,2G2,F6<,@B8,@BNC?
+ERG0J,:7R,DCD,QBBNQ,OBB1,G8@,9QNE,D3S,306,HCM?S
+4MJ,;C4,:72BJ,=M;5,64@,:73:3,3SO,?SRJO,59R,73HHF,4=2,?J?7,C0;
+KPG64,QI442,3OCQ,50C2K,M>9C,>9<,CNA1J,>9Q,@RJ4S,899
+3;RS,H3;@5,<:C,1OAL,J=85K,PI6,OIA,FQ4S,H?53P,;SBD4
+?==,<0A;,:3;Q,3FH,<3N,=D0,ASSH,>E1M,E44I,5S:
+RRHBE,0A1M:,DKLIA,NSN,KA:@,BG3,=193,6G;6E,H92,@,MS?BR
+KPFLI,A>LCB,Q:?C,,72P,EME
ADDED examples/dir1/csv2.txt
Index: examples/dir1/csv2.txt
==================================================================
--- /dev/null
+++ examples/dir1/csv2.txt
@@ -0,0 +1,32 @@
+head1 head2 head3 head4 head5 head6 head7 head8 head9 head10
+MCPM JFPC FJ9S9 J1J CC3 72HJ RN?I O48 BH<<
+RKBO @P: GGG0 =8FNP P6K I@4 44H 48RG 1ODB: SN:O?
+CM7 M75 PML7@ I1: EMRL KHK J3IQ N4:CJ 2H:F= L;9I
+a b c d e f g h i j
+9R6 MQPJA BL1 0NCR 6BEH0 DC= D@F I9J19 L8M99 DQHEE
+GGK OB?PM I9S;K 060 AHO=8 JC46O J>= 11? QNEP I1Q
+:9EA 3LPO >27 BHA6 A3< ODLH 01?L5 HLJ KF>S=
+601 QK<26 1H> PAQ H2P C@= J?59< ;MG E>8KF BD6I
+M>SR KA3L PJG HMF=G <79I B3;4< 1>D JOPM K:R7 HK<
+CK9NB G;10O K2; S6>7 O12KG @RM QN> =<1< D?CJ
+PM2;K JPQR? <;7C3 H5SO 6M9 OL;@D ?4H>I Q3F E8ODJ 2P;2O C7QN=
+F036 >FOG0 EI<91 2H5P1 AAPP? N58HI RRRN; J?A6B ;:;C 19KL
+SG?H2 :<7 NLS@0 =7GA 5IJ MLQO 4N0>= 9SRJ 7?PM >P9E5 1O9 =5? JCGB A940 D;8MB B2L
+E8Q2F D12L JL7ME P0QPN 6@B FEHI QAF69 PIK 4KO :C?
+G8: J19EL ?2L 6EOBA D:B 6N> 2G2 F6< @B8 @BNC?
+ERG0J :7R DCD QBBNQ OBB1 G8@ 9QNE D3S 306 HCM?S
+4MJ ;C4 :72BJ =M;5 64@ :73:3 3SO ?SRJO 59R 73HHF 4=2 ?J?7 C0;
+KPG64 QI442 3OCQ 50C2K M>9C >9< CNA1J >9Q @RJ4S 899
+3;RS H3;@5 <:C 1OAL J=85K PI6 OIA FQ4S H?53P ;SBD4
+?== <0A; :3;Q 3FH <3N =D0 ASSH >E1M E44I 5S:
+RRHBE 0A1M: DKLIA NSN KA:@ BG3 =193 6G;6E H92 @ MS?BR
+KPFLI A>LCB Q:?C 72P EME
Index: examples/dir1/keyword
==================================================================
--- examples/dir1/keyword
+++ examples/dir1/keyword
@@ -1,2 +1,2 @@
- A file with a keyword in it.
-$Revision$
+A file with a keyword in it.
+$Revision:abc$
Index: examples/dir1/longline.txt
==================================================================
--- examples/dir1/longline.txt
+++ examples/dir1/longline.txt
@@ -1,3 +1,3 @@
-abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäö
-hopp
-abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdef
+abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäö
+hopp
+abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzåäöabcdefghijklmnopqrstuvwxyzabcdef
ADDED examples/dir1/misc.txt
Index: examples/dir1/misc.txt
==================================================================
--- /dev/null
+++ examples/dir1/misc.txt
@@ -0,0 +1,42 @@
+Misc examples of diffs.
+A line with some inline changes.
+1
+11
+111
+One line against many.
+2
+22
+222
+Apa 1
+Bepa 1
+Cepa 1
+3
+33
+333
+The following is a real-life tricky case that currently do not show up well.
+ WrImmediate16 TME_TmEnCfg0 0563
+ WrImmediate16 TME_TmEnCfg1 0212
+ WrImmediate16 TME_TmIdCfg 0200
+ WrImmediate32 TME_Bat0 21323130
+ WrImmediate32 TME_Bat1 21323130
+ WrImmediate32 TME_Bat2 21323130
+ WrImmediate32 TME_Bat3 21323130
+ WrImmediate32 TME_VcCfgA 00400FCA
+ WrImmediate32 TME_VcCfgB 004007C1
+ WrImmediate32 TME_VcCfgC 004007C1
+4
+44
+444
+Apa 1
+Bepa 1
+Cepa 1
+5
+55
+555
+Apa 1
+Bepa 1
+Cepa 1
+Depa 1
+6
+66
+666
ADDED examples/dir2/csv1.txt
Index: examples/dir2/csv1.txt
==================================================================
--- /dev/null
+++ examples/dir2/csv1.txt
@@ -0,0 +1,32 @@
+head1,head2,head3,head4,head5,head6,head7,head8,head9,head10
+MCPM,JFPC,FJ9S9,J1J,CC3,72HJ,RN?I,O48,BH<<
+RKBO,@P:,GGG0,=8FNP,P6K,O@GJ>,44H,48RG,1ODB:,SN:O?
+CM7,M75,PML7@,I1:,EMRL,KHK,J3IQ,N4:CJ,2H:F=,L;9I
+9R6,MQPJA,BL1,0NCR,6BEH0,DC=,D@F,I9J19,L8M99,DQHEE
+GGK,OB?PM,I9S;K,060,AHO=8,JC46O,J>=,11?,QNEP,I1Q
+:9EA,3LPO,>27,BHA6,A3<,ODLH,01?L5,PN:R,SPR>J,KF>S=
+601,QK<26,1H>,PAQ,H2P,C@=,J?59<,;MG,E>8KF,BD6I
+M>SR,KA3L,PJG,HMF=G,<79I,B3;4<,1>D,JOPM,=AR,HK<
+CK9NB,G;10O,:4JG9,>K2;,S6>7,O12KG,@RM,QN>,=<1<,D?CJ
+PM2;K,JPQR?,7DI,H5SO,6SJA,OL;@D,?4H>I,Q3F,E8ODJ,2P;,C7QN=
+F036,>FOG0,EI<91,2H5P1,AAPP?,N58HI,RRRN;,J?A6B,;:;C,19KL
+0PPF@,:<7,NLS@0,=7GA,5IJ,MLQO,4N0>=,9SRJ,7?PM,>P9E5,72K5,=5?,JCGB,03I<,D;8MB,B2L
+E8Q2F,D12L,JL7ME,PH01C,:A21,FEHI,QAF69,PIK,4KO,SFPI
+G8:,F51,?2L,6EOBA,D:B,6N>,2G2,F6<,Q=7K,@BNC?
+ERG0J,:7R,DCD,QBBNQ,OBB1,G8@,9QNE,=4M:,306,HCM?S
+4MJ,;C4,:72BJ,=M;5,64@,?1A0D,3SO,A2C7,59R,73HHF,4=2,?J?7,C0;
+KPG64,QI442,3OCQ,50C2K,M>9C,>9<,CNA1J,>9Q,@RJ4S,899
+3;RS,H3;@5,<73,1OAL,J=85K,PI6,OIA,FQ4S,H?53P,;SBD4
+?==,<0A;,:3;Q,3FH,<3N,=D0,ASSH,:>M,E44I,5S:
+RRHBE,0A1M:,DKLIA,=DM,KA:@,66S6,=193,6G;6E,H92,@,MS?BR
+KPFLI,A>LCB,Q:?C,D49J?,KKCI,<@LM8,A06GB,?=R:>,72P,EME
ADDED examples/dir2/csv2.txt
Index: examples/dir2/csv2.txt
==================================================================
--- /dev/null
+++ examples/dir2/csv2.txt
@@ -0,0 +1,32 @@
+head1 head2 head3 head4 head5 head6 head7 head8 head9 head10
+MCPM JFPC FJ9S9 J1J CC3 72HJ RN?I O48 BH<<
+RKBO @P: GGG0 =8FNP P6K O@GJ> 44H 48RG 1ODB: SN:O?
+CM7 M75 PML7@ I1: EMRL KHK J3IQ N4:CJ 2H:F= L;9I
+9R6 MQPJA BL1 0NCR 6BEH0 DC= D@F I9J19 L8M99 DQHEE
+GGK OB?PM I9S;K 060 AHO=8 JC46O J>= 11? QNEP I1Q
+:9EA 3LPO >27 BHA6 A3< ODLH 01?L5 PN:R SPR>J KF>S=
+601 QK<26 1H> PAQ H2P C@= J?59< ;MG E>8KF BD6I
+M>SR KA3L PJG HMF=G <79I B3;4< 1>D JOPM =AR HK<
+CK9NB G;10O :4JG9 >K2; S6>7 O12KG @RM QN> =<1< D?CJ
+PM2;K JPQR? 7DI H5SO 6SJA OL;@D ?4H>I Q3F E8ODJ 2P; C7QN=
+F036 >FOG0 EI<91 2H5P1 AAPP? N58HI RRRN; J?A6B ;:;C 19KL
+0PPF@ :<7 NLS@0 =7GA 5IJ MLQO 4N0>= 9SRJ 7?PM >P9E5 72K5 =5? JCGB 03I< D;8MB B2L
+E8Q2F D12L JL7ME PH01C :A21 FEHI QAF69 PIK 4KO SFPI
+G8: F51 ?2L 6EOBA D:B 6N> 2G2 F6< Q=7K @BNC?
+ERG0J :7R DCD QBBNQ OBB1 G8@ 9QNE =4M: 306 HCM?S
+4MJ ;C4 :72BJ =M;5 64@ ?1A0D 3SO A2C7 59R 73HHF 4=2 ?J?7 C0;
+KPG64 QI442 3OCQ 50C2K M>9C >9< CNA1J >9Q @RJ4S 899
+3;RS H3;@5 <73 1OAL J=85K PI6 OIA FQ4S H?53P ;SBD4
+?== <0A; :3;Q 3FH <3N =D0 ASSH :>M E44I 5S:
+RRHBE 0A1M: DKLIA =DM KA:@ 66S6 =193 6G;6E H92 @ 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,251 @@
+Changes
+
+Upcoming changes (not yet released):
+
+ * TBW
+
+Changes in v2.8.5 (2023-04-27):
+
+ * Added -printLineSpace.
+ * Support -context/-w/-b for -review.
+ * Added gunzip plugin.
+ * Added -includedir and -includefile options for directory diff.
+ * Allow multiple pairs of files on the command line to open multiple windows.
+ * Added -subst command line, to access PreProcess Subst function.
+ * Better SVN commit, handling added directories.
+ * Ctrl-E to enable Edit Mode.
+ * Allow copying selected lines in Edit Mode.
+ * Allow deleting any line in Edit Mode.
+
+Changes in v2.8.4 (2019-02-06):
+
+ * Commit dialog includes a selection of files, for partial commit.
+ * Better support for multiple files and directories with -review.
+ * Added save-reload option in edit mode.
+ * Bug-fix with deleted files in GIT directory diff.
+
+Changes in v2.8.3 (2018-06-13):
+
+ * More features in Four-way diff.
+ * Better visibility that commit happened.
+ * Shortcuts in preprocess dialog for common patterns.
+
+Changes in v2.8.2 (2018-05-13):
+
+ * Added Four-way diff, for comparing changes.
+ * Bug-fix 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 choice 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 preferences 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,99 @@
+
+
+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.5 (2023-04-27)
+
+
Version 2.8.4 (2019-02-06)
+
+
Version 2.8.3
+
+
Version 2.8.2
+
+
Version 2.8.1
+
+
Version 2.8.0
+
+
Version 2.7.4
+
+
Version 2.7.3
+
+
Edit Mode
+Edit Mode
+
+The files on display may be edited if you turn on Edit Mode.
+This is done with the Tools->Edit Mode menu.
+Only real files may be edited. If you are comparing versions fetched from a
+[./revision.wiki|Revision Control] system, it cannot be edited.
+
+If an edited side has empty areas, i.e. lines that are not part of the file
+and only there to line up with the other side, those will be gray.
+
+Edit mode will not allow you to enter or remove newlines freely. Only by
+copying blocks from other side lines may change.
+
+By right clicking over a change's line numbers you get options to copy
+lines and blocks between the two sides, as well as the options to save a file.
+
+See also [./merge.wiki|Merge].
+
+
+
ADDED htdocs/eskil1.png
Index: htdocs/eskil1.png
==================================================================
--- /dev/null
+++ htdocs/eskil1.png
cannot compute difference between binary files
ADDED htdocs/eskil2.png
Index: htdocs/eskil2.png
==================================================================
--- /dev/null
+++ htdocs/eskil2.png
cannot compute difference between binary files
ADDED htdocs/eskil3.png
Index: htdocs/eskil3.png
==================================================================
--- /dev/null
+++ htdocs/eskil3.png
cannot compute difference between binary files
ADDED htdocs/fossil.wiki
Index: htdocs/fossil.wiki
==================================================================
--- /dev/null
+++ htdocs/fossil.wiki
@@ -0,0 +1,65 @@
+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.
+
Merge
+Merge
+
+The files on display may be merged and saved via the Tools->Merge menu.
+The Merge window will also appear if you open an Ancestor File (for three-way
+merge) or a Conflict File, via the File menu or command line.
+
+In the Merge window you can navigate between differences with up/down keys
+and select between left and right side with left/right keys. See the Goto
+menu for other navigation keys.
+
+With the toolbar buttons and menus you can also choose to keep both sides.
+There is All Left/Right commands in the menu to select for all differences.
+
+The text can be freely edited. Use escape key to get focus out of the text
+window to allow navigating as described above.
+
+The status bar show basic info about the selected difference. A conflict
+is marked with ***. Hover over the status line to get more info.
+
+When saving, if no output file has been previously been selected, you get the
+choice to overwrite either side or browse for another file.
+
+The following command line parameters are merge related:
+
+ -a : Ancestor file for three-way merge.
+
+ -o : Output file for merge result.
+
+ -fine : Use fine grained chunks. Left/right choice is made per line instead of per chunk.
+
+ -conflict : Treat input file as a file with merge conflict markers.
+
+See also [./editmode.wiki|Edit Mode], and [./revision.wiki|Revision Control Support].
ADDED htdocs/plugins.wiki
Index: htdocs/plugins.wiki
==================================================================
--- /dev/null
+++ htdocs/plugins.wiki
@@ -0,0 +1,119 @@
+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/print.wiki
Index: htdocs/print.wiki
==================================================================
--- /dev/null
+++ htdocs/print.wiki
@@ -0,0 +1,21 @@
+Print
+Print to PDF
+
+A PDF of the differences can be generated from the File->Print Pdf menu.
+
+The PDF will be generated from the current screens, so make sure any
+settings like context and ignore are done and you have regenerated the diff.
+
+The following choices are available (command line flag in parens):
+
+ * Header Size. Font size to use for page header. (-printHeaderSize, default 10)
+ * Paper size. Landscape will always be used. (-printPaper, default a4)
+ * Chars per line. See below. (-printCharsPerLine, default 80)
+ * RGB background values for diff display. Text is always black. (-printColor*)
+
+From the command line you can also give -printFont .
+See [./usage.wiki|Usage] for all command line flags.
+
+The font size is automatically scaled to fit the given characters per line.
+The GUI will give you choices that fit all or most lines in that line length.
+Longer lines will be wrapped.
ADDED htdocs/revision.wiki
Index: htdocs/revision.wiki
==================================================================
--- /dev/null
+++ htdocs/revision.wiki
@@ -0,0 +1,147 @@
+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. See also [./merge.wiki|Merge].
+
+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 zero or 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 :".
+If a revision is zero or a negative integer, the log is searched backwards for earlier versions.
+
+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
+
+See [./fossil.wiki|Fossil].
+
+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 htdocs/toc.wiki
Index: htdocs/toc.wiki
==================================================================
--- /dev/null
+++ htdocs/toc.wiki
@@ -0,0 +1,24 @@
+Documentation
+
+[./changes.wiki|Changes]
+
+[./editmode.wiki|Edit Mode]
+
+[./fossil.wiki|Fossil Support]
+
+[./merge.wiki|Merge]
+
+[./plugins.wiki|Plugins]
+
+[./print.wiki|Print]
+
+[./revision.wiki|Revision Control Support]
+
+[./starkit.wiki|Starkit compare]
+
+[./starpack.wiki|Starpack generation]
+
+[./table.wiki|Table diff]
+
+[./usage.wiki|Usage]
+
ADDED htdocs/usage.wiki
Index: htdocs/usage.wiki
==================================================================
--- /dev/null
+++ htdocs/usage.wiki
@@ -0,0 +1,88 @@
+Usage
+
+Command Line Usage
+
+
+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:
+- : Read patch file from standard input, to allow pipes
+-a : Give ancestor for three way merge
+-b : Ignore space changes (default)
+-block : Full block analysis. This can be slow if there are large change
+ blocks
+-browse : Bring up file dialog for missing files after starting
+-char : Character based change view (default)
+-clip : Start in clip diff mode. Ignores other args
+-close : Close any window with no changes
+-conflict : Treat file as a merge conflict file and enter merge mode
+-context : Show only differences, with lines of context
+-cvs : Detect CVS first, if multiple version systems are used
+-debug : Start in debug mode
+-dir : Start in directory diff mode. Ignores other args
+-excludedir : Exclude from directory diff
+-excludefile : Exclude from directory diff
+-fine : Use fine grained chunks. Useful for merging
+-foreach : Open one diff window per file listed
+-fourway : Start in fourway diff mode. Ignores other args
+-gz : Uncompress input files with gunzip
+-i : Ignore case changes
+-includedir : Include in directory diff
+-includefile : Include in directory diff
+-limit : Do not process more than lines
+-line : Line based block analysis
+-maxwidth : Limit column width in table mode
+-nocase : Ignore case changes
+-nocdiff : Disable C version of DiffUtil. For debug
+-nodiff : Do not run diff after startup
+-nodigit : Ignore digit changes
+-noempty : Ignore empty lines initially for matching
+-noignore : Don't ignore any whitespace
+-nokeyword : In directory diff, ignore $ Keywords: $
+-nonewline : Try to ignore newline changes
+-nonewline+ : Try to ignore newline changes, and don't display
+-noparse : No block analysis
+-o : Specify merge result output
+-patch : View patch file
+-pivot : Pivot setting for diff algorithm (10)
+-plugin : Preprocess files using plugin
+-pluginallow : Allow full access privilege for plugin
+-plugindump : Dump plugin source to stdout
+-plugininfo : Pass info to plugin (plugin specific)
+-pluginlist : List known plugins
+-prefix : Care mainly about words starting with
+-preprocess : The is a list of RE+Subst applied to each line
+ before compare
+-preprocessleft : Use only on left side
+-preprocessright : Use only on right side
+-print : Generate PDF and exit
+-printCharsPerLine : Adapt font size for this line length and wrap (80)
+-printColorChange : Color for change (1.0 0.7 0.7)
+-printColorNew : Color for new text (0.8 0.8 1.0)
+-printColorOld : Color for old text (0.7 1.0 0.7)
+-printFont : Select font to use in PDF, afm or ttf. If is
+ given as "Courier", PDF built in font is used
+-printHeaderSize : Font size for page header (10)
+-printPaper : Select paper size (a4)
+-r : Version info for version control mode
+-review : View revision control tree as a patch
+-sep : See char as separator between columns in files
+-server : Set up Eskil to be controllable from the outside
+-smallblock : Do block analysis on small blocks (default)
+-subst : The is a list of Left+Right, used for subst preprocessing
+-svn : Detect SVN first, if multiple version systems are used
+-table : Run in table mode
+-w : Ignore all spaces
+-word : Word based change view
+
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 main
+cp ../tests/left.txt a.txt
+git commit -am l
+git checkout b
+#git merge main
+#git mergetool
+#git commit -am m
ADDED nfplugin.tcl
Index: nfplugin.tcl
==================================================================
--- /dev/null
+++ nfplugin.tcl
@@ -0,0 +1,39 @@
+##Nagelfar Plugin : Check of Eskil's sources
+
+proc statementWords {words info} {
+ set caller [dict get $info caller]
+ set callee [lindex $words 0]
+ set res {}
+
+ # Rule: Space around initial "!" in expr.
+ # Reason: I find it more readable
+ if {$callee eq "if"} {
+ set e [lindex $words 1]
+ if {[regexp {\{(\s*)!(\s*)[\[$]} $e -> pre post]} {
+ if {$pre ne " " || $post ne " "} {
+ lappend res warning
+ lappend res "Not (!) should be surrounded by one space"
+ }
+ }
+ }
+ # Rule: Do not allow single letter variables as arguments.
+ # Reason: A lot of old unreadable code had them.
+ # Exception: Upper-case "W","x" and "y".
+ if {$callee eq "proc"} {
+ set argList [lindex $words 2]
+ foreach arg [lindex $argList 0] {
+ set arg [lindex $arg 0]
+
+ set lcArg [string tolower $arg]
+ if {[string length $arg] == 1 && $lcArg eq $arg} {
+ if {$arg ni {x y}} {
+ lappend res warning
+ lappend res "Single letter argument '$arg' is not allowed '$argList'"
+ }
+ }
+ }
+ }
+
+
+ return $res
+}
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/gz.tcl
Index: plugins/gz.tcl
==================================================================
--- /dev/null
+++ plugins/gz.tcl
@@ -0,0 +1,20 @@
+##Eskil Plugin : Compare gzip file
+#
+# This plugin unpacks input gzip file before comparing.
+
+# 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} {
+ zlib push gunzip $chi
+ chan copy $chi $cho
+
+ # 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,82 @@
+##Eskil Plugin : Compare text from PDF files. (needs pdftotext 4+)
+## Option -marginl : Left margin to pass to pdftotext
+## Option -marginr : Right margin to pass to pdftotext
+## Option -margint : Top margin to pass to pdftotext
+## Option -marginb : Bottom margin to pass to pdftotext
+## Option -pdftotext : Extra options to pass to pdftotext
+#
+# This plugin runs input through the external tool pdftotext.
+# Thus it must be run together with the -pluginallow flag.
+
+# 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 opts(-marginl) ""
+ set opts(-marginr) ""
+ set opts(-margint) ""
+ set opts(-marginb) ""
+ set opts(-pdftotext) ""
+ foreach opt {-marginl -marginr -margint -marginb -pdftotext} {
+ set i [lsearch -exact $::argv $opt]
+ if {$i >= 0} {
+ incr i
+ set opts($opt) [lindex $::argv $i]
+ }
+ }
+ 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
+ }
+ if {[catch {llength $opts(-pdftotext)}]} {
+ puts $cho "PDF plugin needs -pdftotext parameter to be a list"
+ return 1
+ }
+ # Pass options from -plugininfo as well.
+ set options [concat $::Info $opts(-pdftotext)]
+ foreach opt {-marginl -marginr -margint -marginb} {
+ if {$opts($opt) ne ""} {
+ lappend options $opt $opts($opt)
+ }
+ }
+ # Use source file with pdftotext since stdin is not reliable on e.g Windows
+ if {[catch {exec $cand {*}$options $::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,73 @@
+##Eskil Plugin : Compare files after sorting lines
+## Flag -sortwords : Sort words within each line first.
+## Flag -nospace : Ignore space
+#
+# 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 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(-sortwords) 0
+ set opts(-nospace) 0
+ set i [lsearch -exact $::argv "-sortwords"]
+ if {$i >= 0} {
+ set opts(-sortwords) 1
+ }
+ set i [lsearch -exact $::argv "-nospace"]
+ if {$i >= 0} {
+ set opts(-nospace) 1
+ }
+
+ 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]
+
+ if {$opts(-sortwords)} {
+ set newlines {}
+ foreach line $lines {
+ # Extract words
+ set words [regexp -all -inline {\w+} $line]
+ set words [lsort -dictionary $words]
+ lappend newlines [join $words]
+ }
+ set lines $newlines
+ }
+
+ if {$opts(-nospace)} {
+ set sortlines {}
+ foreach line $lines {
+ set nospace [regsub -all {\s+} $line ""]
+ lappend sortlines [list $nospace $line]
+ }
+ set sortlines [lsort -dictionary {*}$::Info -index 0 $sortlines]
+ set lines {}
+ foreach line $sortlines {
+ lappend lines [lindex $line 1]
+ }
+ } else {
+ # 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,16 +144,17 @@
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]
+ # Have the file menu in top frame to save space
ttk::frame $top.f
menubutton $top.f.mf -menu $top.f.mf.m -text "File" -underline 0
menu $top.f.mf.m
$top.f.mf.m add command -label "Close" -underline 0 \
-command [list cleanupAndExit $top]
@@ -181,13 +182,13 @@
-padx 4 -pady 2 -sticky "w"
grid $top.f.mf -sticky nw -pady 0 -padx 0
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}]} {
+ 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
}
Index: src/compare.tcl
==================================================================
--- src/compare.tcl
+++ src/compare.tcl
@@ -20,12 +20,12 @@
#
#----------------------------------------------------------------------
# $Revision$
#----------------------------------------------------------------------
-proc maxAbs {a b} {
- return [expr {abs($a) > abs($b) ? $a : $b}]
+proc maxAbs {v1 v2} {
+ return [expr {abs($v1) > abs($v2) ? $v1 : $v2}]
}
# Compare two lines and rate how much they resemble each other.
# This has never worked well. Some day I'll sit down, think this through,
# and come up with a better algorithm.
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,26 +36,25 @@
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
}
# Sort file names
-proc Fsort {l} {
- lsort -dictionary $l
+proc Fsort {lst} {
+ lsort -dictionary $lst
}
# 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,67 @@
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
+ if {$nocase} {
+ if { ! [string equal -nocase $f1 $f2]} {
+ set eq 0
+ }
+ } else {
+ if { ! [string equal $f1 $f2]} {
+ set eq 0
+ }
}
}
- while {$eq && ![eof $ch1] && ![eof $ch2]} {
+ while {$eq == 2 && ![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
+ }
+ }
+ # It has been observered that sometimes channels fail to
+ # signal eof. Maybe when they come from a pipe?
+ # Protect by noticing empty strings.
+ if {[string equal $f1 ""] || [string equal $f2 ""]} {
+ break
+ }
+ }
+ 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 +224,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
+ 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
+ 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 +307,44 @@
component vsb
option -leftdirvariable -default "" -configuremethod SetDirOption
option -rightdirvariable -default "" -configuremethod SetDirOption
option -statusvar -default ""
+ option -changelist -default ""
+ option -norun -default 0
+ # TODO: better name for experimental parameter
+ option -bepa -default 0
variable AfterId ""
+ variable DebugCh ""
+ variable DebugTime {}
variable PauseBgProcessing 0
variable ScheduledRestart 0
+ variable AfterTime 1
+ variable WorkTime 200
variable IdleQueue {}
variable IdleQueueArr
+ variable NodeStatus
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 +356,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
@@ -343,21 +392,21 @@
method SetDirOption {option value} {
set options($option) $value
if {$options(-leftdirvariable) eq ""} return
upvar \#0 $options(-leftdirvariable) left
- if {![info exists left]} return
- if {![file isdirectory $left]} return
+ if { ! [info exists left]} return
+ if { ! [file isdirectory $left]} return
if {$options(-rightdirvariable) eq ""} return
upvar \#0 $options(-rightdirvariable) right
- if {![info exists right]} return
- if {![file isdirectory $right]} return
+ if { ! [info exists right]} return
+ if { ! [file isdirectory $right]} return
set leftDir $left
set rightDir $right
- if {!$ScheduledRestart} {
+ if { ! $ScheduledRestart} {
set ScheduledRestart 1
after idle [mymethod ReStart]
}
}
method newTopDir {newLeft newRight} {
@@ -369,26 +418,61 @@
if {$newRight ne "" && [file isdirectory $newRight]} {
upvar \#0 $options(-rightdirvariable) right
set right $newRight
set rightDir $right
}
- if {!$ScheduledRestart} {
+ 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}
+
+ if {$options(-norun)} {
+ set options(-norun) 0
+ return
+ }
+
+ # 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,49 +479,114 @@
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
+ set NodeStatus($topIndex) ""
$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 {
- set status [$tree rowattrib $node status]
+ set status $NodeStatus($node)
if {$status eq "equal"} {
$tree delete $node
} else {
lappend todo {*}[$tree childkeys $node]
}
}
}
+ $self normalCursor
+ }
+ # Remove all empty dir nodes from tree
+ method PruneEmpty {} {
+ $self busyCursor
+ set redo 1
+ while {$redo} {
+ set redo 0
+ set todo [$tree childkeys root]
+ while {[llength $todo] > 0} {
+ set todoNow $todo
+ set todo {}
+ foreach node $todoNow {
+ set status $NodeStatus($node)
+ set children [$tree childkeys $node]
+ if {[llength $children] == 0} {
+ set type [$tree rowattrib $node type]
+ if {$type eq "directory"} {
+ $tree delete $node
+ set redo 1
+ }
+ } else {
+ lappend todo {*}$children
+ }
+ }
+ }
+ }
+ $self normalCursor
+ }
+
+ # Remove all nodes that are just on one side
+ method PruneAlone {} {
+ $self busyCursor
+ set todo [$tree childkeys root]
+ while {[llength $todo] > 0} {
+ set todoNow $todo
+ set todo {}
+ foreach node $todoNow {
+ set status $NodeStatus($node)
+ if {$status in {new old}} {
+ $tree delete $node
+ } 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 +594,103 @@
} 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} {
+ ##nagelfar vartype tree _obj,tablelist
+ 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"} {
+ "Copy\n$src\n\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
}
}
@@ -497,11 +697,12 @@
}
# React on double-click
method DoubleClick {W x y} {
foreach {W x y} [tablelist::convEventFields $W $x $y] break
- set node [$tree index @$x,$y]
+ set index [$tree index @$x,$y]
+ set node [$tree getfullkeys $index]
set lf [$tree rowattrib $node leftfull]
set rf [$tree rowattrib $node rightfull]
set type [$tree rowattrib $node type]
@@ -535,11 +736,12 @@
# Bring up a context menu on a file.
method ContextMenu {W x y X Y} {
foreach {W x y} [tablelist::convEventFields $W $x $y] break
- set node [$tree index @$x,$y]
+ set index [$tree index @$x,$y]
+ set node [$tree getfullkeys $index]
set col [$tree columnindex @$x,$y]
set colname [$tree columncget $col -name]
set lf [$tree rowattrib $node leftfull]
set rf [$tree rowattrib $node rightfull]
@@ -547,13 +749,15 @@
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 "Prune empty" -command [mymethod PruneEmpty]
+ $m add command -label "Prune alone" -command [mymethod PruneAlone]
$m add command -label "Expand all" -command [mymethod OpenAll]
$m add command -label "Collapse all" -command [mymethod OpenAll 0]
}
if {$type eq "file" && $lf ne "" && $rf ne ""} {
@@ -567,34 +771,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 +819,123 @@
$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 {} {
+ ##nagelfar vartype tree _obj,tablelist
+ $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
+ #puts "$pre $post [expr {$post - $pre}]"
+ if {($post - $pre) > $WorkTime} break
}
#if {($post - $pre) > 1000} {
#puts "[expr $post - $pre] ms for [$tree set $node leftfull]"
#}
@@ -651,38 +943,51 @@
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 leftfull [$tree rowattrib $node leftfull]
- set rightfull [$tree rowattrib $node rightfull]
- if {$leftfull ne ""} {
- set statusvar $leftfull
- } else {
- set statusvar $rightfull
- }
-
- set AfterId [after 1 [mymethod UpdateIdle]]
- } else {
+ set node [lindex $IdleQueue end]
+ set leftfull [$tree rowattrib $node "leftfull"]
+ set rightfull [$tree rowattrib $node "rightfull"]
+ if {$leftfull ne ""} {
+ set statusvar "$leftfull ($count)"
+ } else {
+ set statusvar "$rightfull ($count)"
+ }
+
+ $self Dlog Reschedule
+ set AfterId [after $AfterTime [mymethod UpdateIdle]]
+ } else {
+ $self Dlog DONE
set statusvar ""
set AfterId ""
}
}
method SetNodeStatus {node status} {
variable color
- $tree rowattrib $node status $status
+ set old $NodeStatus($node)
+ if {$old eq $status} return
+ set NodeStatus($node) $status
$tree rowconfigure $node -foreground $color($status) \
-selectforeground $color($status)
#puts "Set [$tree item $node -text] to $status"
# Loop through children to update parent
@@ -692,15 +997,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 {$NodeStatus($parent) eq "unknown2"} {
+ return
+ }
set pstatus equal
foreach child [$tree childkeys $parent] {
- set status [$tree rowattrib $child status]
+ set status $NodeStatus($child)
switch $status {
- unknown {
+ unknown - unknown2 {
set pstatus unknown
}
new - old - change {
set pstatus change
break
@@ -712,117 +1021,148 @@
method UpdateDirNode {node} {
if {[$tree rowattrib $node type] ne "directory"} {
return
}
- if {[$tree rowattrib $node status] ne "empty"} {
+ if {$NodeStatus($node) ne "empty"} {
#puts "Dir [$tree set $node leftfull] already done"
return
}
$tree delete [$tree childkeys $node]
set leftfull [$tree rowattrib $node leftfull]
set rightfull [$tree rowattrib $node rightfull]
+ #$self Dlog "UpdateDirNode $leftfull"
+ if {$options(-bepa)} {
+ if {$leftfull eq ""} {
+ $self SetNodeStatus $node new
+ return
+ }
+ if {$rightfull eq ""} {
+ $self SetNodeStatus $node old
+ return
+ }
+ }
$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}]} {
+ if {[catch {file lstat $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}]} {
+ if {[catch {file lstat $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 "type" $type
+ set NodeStatus($id) 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 {
$self SetNodeStatus $id unknown
$self AddNodeToIdle $id
}
- return [$tree rowattrib $id status]
+ return $NodeStatus($id)
}
method addCmdCol {tbl row col w} {
- set status [$tree rowattrib $row status]
+ variable widgets
+ set key [$tree getfullkeys $row]
+ set status $NodeStatus($key)
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 +1169,10 @@
}
}
# Compare two directories.
method CompareDirs {dir1 dir2 node} {
- global Pref
if {$dir1 eq ""} {
set files1 {}
} else {
set files1 [DirContents $dir1]
}
@@ -844,20 +1183,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 +1224,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
}
@@ -915,127 +1257,124 @@
snit::widget DirDiff {
hulltype toplevel
widgetclass Toplevel
component tree
variable statusVar
+ delegate option -norun to tree
+ delegate option -bepa to tree
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]
+ $self configurelist $args
+
+ if {[info exists ::dirdiff(localChanges)]} {
+ $tree configure -changelist $::dirdiff(localChanges)
+ }
ttk::frame $win.fe1
ttk::frame $win.fe2
- 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 "Compare" -underline 1 \
- -command [mymethod DoDirCompare] -accelerator "Alt-c"
- bind $win [mymethod DoDirCompare]
- $win.m.mf add separator
- $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.mo -label "Preferences" -underline 0
- 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 \
- -label "Do not check contents"
- $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 \
- -label "Exact compare"
- $win.m.mo.mc add checkbutton -variable Pref(dir,ignorekey) \
- -label "Ignore \$Keyword:\$"
-
- $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 \
- -command makeClipDiffWin
- if {$::tcl_platform(platform) eq "windows"} {
- if {![catch {package require registry}]} {
- $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 \
- -onvalue show -offvalue hide -command {console $consolestate}
- $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}
- }
-
- ttk::button $win.bu -image $img(upup) -command [mymethod UpDir] \
- -underline 0
- bind $win "$win.bu invoke"
-
- #catch {font delete myfont}
- #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]
- [mymethod DoDirCompare]"
- 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]
- [mymethod DoDirCompare]"
+ # Need to do this manually with snit
+ $hull configure -menu $win.m
+ psmenu::psmenu $win -top $win {
+ "&File" {
+ "C&ompare" -cmd "[mymethod DoDirCompare]" -acc "Alt-c"
+ ---
+ "&Close" -cmd "cleanupAndExit $win"
+ ---
+ "&Quit" -cmd "cleanupAndExit all"
+ }
+ "&Preferences" {
+ "Prefs..." -cmd makeDirDiffPrefWin
+ "Check" {
+ _Radio -var ::Pref(dir,comparelevel) {
+ "Do not check contents" -value 0
+ "Normal compare" -value 1
+ "Exact compare" -value 2
+ }
+ "Ignore \$Keyword:\$" -var ::Pref(dir,ignorekey)
+ }
+ "P&lugins..." -cmd "editPrefPlugins $win 1"
+ "Nice" {
+ _Radio -var ::Pref(dir,nice) -cmd "[mymethod DoNice]" {
+ 1 50 100 1000
+ }
+ }
+ ---
+ "Save default" -cmd "saveOptions $win"
+ }
+ "&Tools" {
+ "&New Diff Window" -cmd makeDiffWin
+ "&Clip Diff" -cmd makeClipDiffWin
+ if {$::tcl_platform(platform) eq "windows"} {
+ if { ! [catch {package require registry}]} {
+ ---
+ "Setup &Registry" -cmd makeRegistryWin
+ }
+ }
+ }
+ "&Help" {
+ "&Tutorial" -cmd makeTutorialWin
+ "&About" -cmd makeAboutWin
+ }
+ if {$::eskil(debug)} {
+ "&Debug" {
+ if {$::tcl_platform(platform) eq "windows"} {
+ "Console" -var consolestate \
+ -onvalue show -offvalue hide -cmd "console \\$consolestate"
+ ---
+ }
+ "&Reread Source" -cmd {EskilRereadSource}
+ ---
+ "Redraw Window" -cmd {makeDirDiffWin}
+ }
+ }
+ }
+
+ 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)
+
+ ttk::entryX $win.e1 -textvariable dirdiff(leftDir) -width 30
+ 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]
+ 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 +1381,24 @@
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 {} {
+ ##nagelfar vartype tree _obj,tablelist
+ $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 +1465,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 +1532,90 @@
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}} {
- if {![info exists ::dirdiff(leftDir)]} {
+proc makeDirDiffWin {{noautodiff 0}} {
+ if { ! [info exists ::dirdiff(leftDir)]} {
set ::dirdiff(leftDir) ""
}
- if {![info exists ::dirdiff(rightDir)]} {
+ 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 "" && ![string match *.kit $::dirdiff(leftDir)]} {
+ 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
+ # TODO: better name for experimental parameter, propagate to cmd line
+ DirDiff .dirdiff -norun $noautodiff -bepa 1
return .dirdiff
}
Index: src/eskil.syntax
==================================================================
--- src/eskil.syntax
+++ src/eskil.syntax
@@ -1,115 +1,137 @@
##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 syntax DiffUtil::diffStrings o* x x
+##nagelfar syntax DiffUtil::diffFiles 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 ::tk::dialog::file:: 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 syntax _obj,pdf4tcl s x*
+##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 syntax _obj,tablelist s x*
+##nagelfar subcmd _obj,tablelist parent rowattrib nice
+##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 option eskilprint -file -cpl -cpln -headsize -headleft -headright -headnpages -margin -paper -lnsp
##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 NodeStatus WorkTime
+
+##########################################################
+# 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,16 +63,16 @@
}
# 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"}
+ if { ! [string is integer -strict $lineNo]} {return "$lineNo\n"}
return [format "%3d: \n" $lineNo]
}
# Get a name for a temporary file
# A tail can be given to make the file more recognisable.
@@ -251,18 +84,18 @@
}
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
proc clearTmp {args} {
- if {![info exists ::tmpfiles]} {
+ if { ! [info exists ::tmpfiles]} {
set ::tmpfiles {}
return
}
if {[llength $args] > 0} {
foreach f $args {
@@ -272,61 +105,234 @@
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 side 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 word $words {
+ if {$side == 1} {
+ # TBD TABLE, r is faked here for now
+ dict set ::eskil($top,tablechanges) $id,$col w1 $word
+ 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 $word
+ 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 {}}} {
- $::widgets($top,wDiff$n) insert end "$text\n" $tag
- if {$linetag ne ""} {
- append tag " $linetag"
+proc insertLine {top side line text {tag {equal}} {linetag {}}} {
+ if {$::eskil($top,view) eq "table"} {
+ insertLineTable $top $side $line $text $tag
+ return
+ }
+ $::widgets($top,wDiff$side) insert end "$text\n" $tag
+ if {$linetag eq ""} {
+ set linetag $tag
}
if {$tag != "equal"} {
- set tag "hl$::HighLightCount $tag"
+ set linetag "hl$::HighLightCount $linetag"
}
- $::widgets($top,wLine$n) insert end [myFormL $line] $tag
+ $::widgets($top,wLine$side) insert end [myFormL $line] $linetag
}
# Insert an empty line on one side of the diff.
-proc emptyLine {top n {highlight 1}} {
+proc emptyLine {top side {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
+ $::widgets($top,wLine$side) insert end "\n" hl$::HighLightCount
} else {
- $::widgets($top,wLine$n) insert end "*****\n"
+ $::widgets($top,wLine$side) insert end "*****\n"
}
- $::widgets($top,wDiff$n) insert end "\n" padding
+ $::widgets($top,wDiff$side) 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
-
- # FIXA: fully implement filter
- if {$::diff(filter) != ""} {
- if {[regexp $::diff(filter) $line1]} {
- insertLine $top 1 $doingLine1 $line1
- insertLine $top 2 $doingLine2 $line2
- incr doingLine1
- incr doingLine2
- set ::diff(filterflag) 1
- return
- }
- set ::diff(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]
+ global doingLine1 doingLine2
+
+ if {$::eskil($top,view) eq "table"} {
+ insertMatchingLinesTable $top $line1 $line2
+ return
+ }
+
+ 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 +341,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 ""} {
@@ -399,11 +405,11 @@
if {$block1nostar eq $block2nostar} {
set equal 1
}
}
}
- if {!$equal} {
+ if { ! $equal} {
return 0
}
if {$visible} {
set tag change
@@ -448,24 +454,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,40 +541,40 @@
# 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
}
}
}
# Avoid fine grain if either side has no changes against ancestor
- if {!$leftChangeOrAdd || !$rightChangeOrAdd} {
+ if { ! $leftChangeOrAdd || !$rightChangeOrAdd} {
set finegrain 0
}
# Avoid fine grain if both sides have at most additions
- if {!$leftChange && !$rightChange} {
+ if { ! $leftChange && !$rightChange} {
set finegrain 0
}
}
set t1 0
@@ -533,59 +590,68 @@
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 $top 1 $doingLine1 $textline1 new1 change
+ insertLine $top 2 $doingLine2 $textline2 new2 change
+ 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
}
incr t2
}
}
- if {!$finegrain} {
+ if { ! $finegrain} {
if {$details} {
addChange $top [llength $apa] change $line1 $n1 $line2 $n2
nextHighlight $top
} else {
addMapLines $top [llength $apa]
@@ -599,59 +665,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 +733,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 +751,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,150 +769,121 @@
$::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)} {
- 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
- }
- }
+ addChange $top $n1 change $line1 $n1 $line2 $n2
+ nextHighlight $top
+ } else {
+ # 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
}
proc enableRedo {top} {
- $top.m.mf entryconfigure "Redo Diff" -state normal
- $top.m.mt entryconfigure "Merge" -state normal
+ {*}$::widgets($top,configureRedoDiffCmd) -state normal
+ {*}$::widgets($top,configureMergeCmd) -state normal
}
proc disableRedo {top} {
- $top.m.mf entryconfigure "Redo Diff" -state disabled
- $top.m.mt entryconfigure "Merge" -state disabled
+ {*}$::widgets($top,configureRedoDiffCmd) -state disabled
+ {*}$::widgets($top,configureMergeCmd) -state disabled
}
proc busyCursor {top} {
global oldcursor oldcursor2
- if {![info exists oldcursor]} {
+ 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
+ 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
+ set W $::widgets($top,$item)
+ $W config -cursor $oldcursor2
}
}
}
#####################################
# 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 ""
@@ -842,19 +890,24 @@
while {[gets $ch line] != -1} {
if {[string match <<<<<<* $line]} {
set state right
regexp {<*\s*(.*)} $line -> rightName
set start2 $rightLine
- } elseif {[string match ======* $line] && $state eq "right"} {
+ } elseif {[string match ======* $line] && $state in "right ancestor"} {
+ if {$state eq "right"} {
+ set end2 [expr {$rightLine - 1}]
+ }
set state left
- set end2 [expr {$rightLine - 1}]
set start1 $leftLine
+ } elseif {[string match ||||||* $line] && $state eq "right"} {
+ set end2 [expr {$rightLine - 1}]
+ set state ancestor
} 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
@@ -861,39 +914,38 @@
incr leftLine
incr rightLine
} elseif {$state eq "left"} {
puts $ch1 $line
incr leftLine
- } else {
+ } elseif {$state eq "right"} {
puts $ch2 $line
incr rightLine
}
}
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 +1043,30 @@
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"
+ set ::eskil($top,patchFilelist) {}
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,19 +1075,52 @@
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]} {
+ # Detect a new file or file name
+ # "diff *" handles at least GIT and HG output
+ # "Index:" and "=====*" handles at least FOSSIL and SVN output
+ set newFile 0
+ set newName ""
+ if {[string match ======* $line]} {
+ set newFile 1
+ } elseif {[string match "diff *" $line]} {
+ set newFile 1
+ # Extract the last non-space. Works reasonably well.
+ regexp {\S+\s*$} $line newName
+ } elseif {[string match "Index: *" $line]} {
+ set newName [string range $line 7 end]
+ }
+
+ if {$newFile} {
if {$state != "none"} {
displayOnePatch $top $leftLines $rightLines $leftLine $rightLine
}
set leftLines {}
set rightLines {}
set state none
+ }
+ if {$newName ne ""} {
+ # 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 $newName
+ }
+ if {$newFile || $newName ne ""} {
continue
}
# Detect the first line in a -c style diff
if {[regexp {^\*\*\* } $line]} {
if {$state eq "right"} {
@@ -1065,26 +1150,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
@@ -1133,93 +1223,161 @@
set rightLine $sub
}
set state right
continue
}
- if {![regexp {^[\s!+-]} $line]} continue
+ if { ! [regexp {^[\s!+-]} $line]} continue
lappend leftLines [list $leftLine \
[string trim [string range $line 0 1]] \
[string range $line 2 end]]
incr leftLine
continue
}
# We are in the right part of a -c style diff
if {$state eq "right"} {
- if {![regexp {^[\s!+-]} $line]} continue
+ if { ! [regexp {^[\s!+-]} $line]} continue
lappend rightLines [list $rightLine \
[string trim [string range $line 0 1]] \
[string range $line 2 end]]
incr rightLine
continue
}
# We are in a -u style diff
if {$state eq "both"} {
- if {![regexp {^[\s+-]} $line]} continue
+ 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
#####################################
+
+proc highlightTabs {top} {
+ foreach item {wDiff1 wDiff2} {
+ set W $::widgets($top,$item)
+ ##nagelfar vartype W _obj,text
+ set count {}
+ set x [$W search -regexp -all -count count {\t+} 1.0]
+ foreach si $x l $count {
+ $W tag add tab $si "$si + $l chars"
+ }
+ $W tag configure tab -background bisque
+ $W tag raise tab
+ }
+}
# 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 W $::widgets($top,wDiff1)
- set width [winfo width $w]
- set height [winfo height $w]
+ set width [winfo width $W]
+ set height [winfo height $W]
- set first [$w index @0,0]
- set last [$w index @[- $width 4],[- $height 4]]
+ set first [$W index @0,0]
+ set last [$W index @[- $width 4],[- $height 4]]
set first [lindex [split $first .] 0]
set last [lindex [split $last .] 0]
# Narrow it 5 lines since seeText will try to view 5 lines extra
@@ -1231,37 +1389,36 @@
doDiff $top
# Restore view
foreach item {wLine1 wDiff1 wLine2 wDiff2} {
- set w $::widgets($top,$item)
- seeText $w $first.0 $last.0
+ set W $::widgets($top,$item)
+ seeText $W $first.0 $last.0
}
}
# 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 +1425,22 @@
busyCursor $top
resetEdit $top
# Clear up everything before starting processing
- foreach item {wLine1 wDiff1 wLine2 wDiff2} {
- set w $::widgets($top,$item)
- $w configure -state normal
- $w delete 1.0 end
+ if {$::eskil($top,view) eq "table"} {
+ set W $::widgets($top,wTable)
+ # TBD TABLE
+ $W configure -state normal
+ $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 +1448,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
+ 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 +1538,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 +1604,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 +1627,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 +1653,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 +1671,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,58 +1713,60 @@
# 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} {
- $w see $ei
- $w see $si
- $w see $si-5lines
- $w see $ei+5lines
- if {[llength [$w bbox $si]] == 0} {
- $w yview $si-5lines
- }
- if {[llength [$w bbox $ei]] == 0} {
- $w yview $si
+proc seeText {W si ei} {
+ $W see $ei
+ $W see $si
+ $W see $si-5lines
+ $W see $ei+5lines
+ if {[llength [$W bbox $si]] == 0} {
+ $W yview $si-5lines
+ }
+ if {[llength [$W bbox $ei]] == 0} {
+ $W yview $si
}
}
# 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) \
+proc highLightChange {top changeIndex} {
+ 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) $changeIndex
+ 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} {
- highLightChange $top $num
+proc showDiff {top changeIndex} {
+ # TBD TABLE
+ if {$::eskil($top,view) eq "table"} return
+ highLightChange $top $changeIndex
- 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
@@ -1553,64 +1776,84 @@
set line1 $line1.0
set line2 $line2.0
}
foreach item {wLine1 wDiff1 wLine2 wDiff2} {
- set w $::widgets($top,$item)
- seeText $w $line1 $line2
+ set W $::widgets($top,$item)
+ seeText $W $line1 $line2
}
}
#####################################
# 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
- $top.m.mt entryconfigure "Edit Mode" -state normal
+ set ::eskil($top,leftEdit) 0
+ set ::eskil($top,rightEdit) 0
+ {*}$::widgets($top,configureEditModeCmd) -state normal
+ if {$::eskil($top,view) eq "table"} {
+ return
+ }
resetEditW $::widgets($top,wDiff1)
resetEditW $::widgets($top,wDiff2)
}
# Clear Editing state for a Text widget
-proc resetEditW {w} {
- $w tag configure padding -background {}
- $w edit reset
- $w configure -undo 0
-
- set ::diff($w,allowChange) all
-
- wcb::callback $w before insert {}
- wcb::callback $w before delete {}
+proc resetEditW {W} {
+ $W tag configure padding -background {}
+ $W edit reset
+ $W configure -undo 0
+
+ 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
+proc noEditW {W} {
+ set ::eskil($W,allowChange) none
- wcb::callback $w before insert [list TextInterceptInsert $w]
- wcb::callback $w before delete [list TextInterceptDelete $w]
+ 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"} {
+proc TextInterceptInsert {W oW index str args} {
+ 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
@@ -1624,92 +1867,92 @@
return
}
}
}
-proc TextInterceptDelete {w ow from {to {}}} {
- if {$::diff($w,allowChange) eq "none"} {
+proc TextInterceptDelete {W oW from {to {}}} {
+ 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]
+ set text [$oW get $from $to]
# Disallow all new lines
if {[string first "\n" $text] >= 0} {
wcb::cancel
return
}
}
# Turn on editing for a Text widget
-proc turnOnEdit {w} {
- $w tag configure padding -background \#f0f0f0
- $w configure -undo 1
+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
+ {*}$::widgets($top,configureEditModeCmd) -state disable
+ 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} {
- $top.m.mt entryconfigure "Edit Mode" -state disabled
+ if {$::eskil($top,leftEdit) == -1 && $::eskil($top,rightEdit) == -1} {
+ {*}$::widgets($top,configureEditModeCmd) -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
+ 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
+ foreach W $args {
+ $W configure -autoseparators 1
+ $W edit separator
+ set ::eskil($W,allowChange) line
}
}
# Copy a block
proc copyBlock {top from first last} {
- set to [expr {3 - $from}]
+ set to [expr {$from == 1 ? 2 : 1}]
set wfrom $::widgets($top,wDiff$from)
set wto $::widgets($top,wDiff$to)
set tags ""
@@ -1741,11 +1984,11 @@
endUndoBlock $wfrom $wto
}
# Copy a row between text widgets
proc copyRow {top from row} {
- set to [expr {3 - $from}]
+ set to [expr {$from == 1 ? 2 : 1}]
set wfrom $::widgets($top,wDiff$from)
set wto $::widgets($top,wDiff$to)
set text [$wfrom get $row.0 $row.end+1c]
@@ -1761,76 +2004,102 @@
endUndoBlock $wfrom $wto
}
# Delete a row filling it with padding
proc deleteBlock {top side from {to {}}} {
- set w $::widgets($top,wDiff$side)
+ set W $::widgets($top,wDiff$side)
if {$to eq ""} {set to $from}
- startUndoBlock $w
- $w delete $from.0 $to.end+1c
- $w insert $from.0 [string repeat \n [expr {$to - $from + 1}]] padding
- endUndoBlock $w
+ startUndoBlock $W
+ $W delete $from.0 $to.end+1c
+ $W insert $from.0 [string repeat \n [expr {$to - $from + 1}]] padding
+ endUndoBlock $W
}
# Get the lines involved in the display
-proc getLinesFromRange {w range} {
+proc getLinesFromRange {W range} {
set from [lindex $range 0]
set to [lindex $range 1]
lassign [split $from "."] fromr fromi
lassign [split $to "."] tor toi
if {$toi == 0} {incr tor -1}
# Get the corresponding lines in the file
- set t [$w get $fromr.0 $tor.end]
+ set t [$W get $fromr.0 $tor.end]
set lines [lsort -integer [regexp -all -inline {\d+} $t]]
set froml [lindex $lines 0]
set tol [lindex $lines end]
return [list $fromr $tor $froml $tol]
}
# Called by popup menus over row numbers to add commands for editing.
# Returns 1 if nothing was added.
-proc editMenu {m top n hl x y} {
-
- if {![mayEdit $top $n]} {return 1}
-
- # Only copy when in a change block
- if {$hl ne ""} {
- set o [expr {3 - $n}]
- set editOther [mayEdit $top $o]
-
- set w $::widgets($top,wLine$n)
- set wo $::widgets($top,wLine$o)
-
+proc editMenu {mW top side changeIndex x y} {
+
+ if { ! [mayEdit $top $side]} {return 1}
+
+ set other [expr {$side == 1 ? 2 : 1}]
+ set editOther [mayEdit $top $other]
+
+ set dW $::widgets($top,wDiff$side)
+ set lW $::widgets($top,wLine$side)
+ set oW $::widgets($top,wLine$other)
+
+ set changed 1
+
+ if {$changeIndex eq "_"} {
+ # The popup is on unchanged line numbers
+ set changed 0
+ # Get the row that was clicked
+ set index [$lW index @$x,$y]
+ set row [lindex [split $index "."] 0]
+ # Range is that row
+ set range [list $row.0 $row.end]
+ set rangeo [list $row.0 $row.end]
+ } elseif {$changeIndex eq ""} {
+ # The popup is on selected text.
# Get the row that was clicked
- set index [$w index @$x,$y]
+ set index [$dW index @$x,$y]
set row [lindex [split $index "."] 0]
-
- set line [regexp -inline {\d+} [$w get $row.0 $row.end]]
- set lineo [regexp -inline {\d+} [$wo get $row.0 $row.end]]
-
- # Row copy
- if {$lineo ne ""} {
- $m add command -label "Copy Row from other side" \
- -command [list copyRow $top $o $row]
- } else {
- $m add command -label "Delete Row" \
- -command [list deleteBlock $top $n $row]
- }
- if {$line ne "" && $editOther} {
- $m add command -label "Copy Row to other side" \
- -command [list copyRow $top $n $row]
- }
-
+ # Figure out the rows involved in the selection.
+ set range [$dW tag ranges sel]
+ set from [lindex $range 0]
+ set to [lindex $range 1]
+ lassign [split $from "."] froml fromi
+ lassign [split $to "."] tol toi
+ if {$toi == 0} {incr tol -1}
+ set range [list $froml.0 $tol.end]
+ set rangeo [list $froml.0 $tol.end]
+ } else {
+ # The popup is on a change block in line numbers
+ # Get the row that was clicked
+ set index [$lW index @$x,$y]
+ set row [lindex [split $index "."] 0]
# Get ranges for the change block
- set range [$w tag ranges hl$hl]
- set rangeo [$wo tag ranges hl$hl]
+ set range [$lW tag ranges hl$changeIndex]
+ set rangeo [$oW tag ranges hl$changeIndex]
+ }
+ set line [regexp -inline {\d+} [$lW get $row.0 $row.end]]
+ set lineo [regexp -inline {\d+} [$oW get $row.0 $row.end]]
+
+ # Row copy
+ if {$lineo ne ""} {
+ $mW add command -label "Copy Row from other side" \
+ -command [list copyRow $top $other $row]
+ }
+ $mW add command -label "Delete Row" \
+ -command [list deleteBlock $top $side $row]
+ if {$line ne "" && $editOther && $changed} {
+ $mW add command -label "Copy Row to other side" \
+ -command [list copyRow $top $side $row]
+ }
+
+ if {$changed} {
# Get the lines involved in the block
- lassign [getLinesFromRange $w $range ] from to froml tol
- lassign [getLinesFromRange $wo $rangeo] fromo too fromlo tolo
+ lassign [getLinesFromRange $lW $range ] from to froml tol
+ lassign [getLinesFromRange $oW $rangeo] fromo too fromlo tolo
# More than one line in the block?
set thisSize 0
set otherSize 0
if {$froml ne "" && $tol ne ""} {
@@ -1839,44 +2108,50 @@
if {$fromlo ne "" && $tolo ne ""} {
set otherSize [expr {$tolo - $fromlo + 1}]
}
if {$thisSize > 1 || $otherSize > 1} {
if {$otherSize > 0} {
- $m add command -label "Copy Block from other side" \
- -command [list copyBlock $top $o $fromo $too]
+ $mW add command -label "Copy Block from other side" \
+ -command [list copyBlock $top $other $fromo $too]
} else {
- $m add command -label "Delete Block" \
- -command [list deleteBlock $top $n $from $to]
+ $mW add command -label "Delete Block" \
+ -command [list deleteBlock $top $side $from $to]
}
if {$editOther && $thisSize > 0} {
- $m add command -label "Copy Block to other side" \
- -command [list copyBlock $top $n $from $to]
+ $mW add command -label "Copy Block to other side" \
+ -command [list copyBlock $top $side $from $to]
}
}
}
- $m add command -label "Save File" -command [list saveFile $top $n]
+ $mW add command -label "Save File" -command [list saveFile $top $side]
+ $mW add command -label "Save File, Reload" -command [list saveFileR $top $side]
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)
+ set W $::widgets($top,wDiff$side)
# Confirm dialog
- set apa [tk_messageBox -parent $top -icon question \
- -title "Overwrite file" -type yesnocancel -message \
- "Overwriting file [file tail $fileName]\nDo you want to\
- create a backup copy ?"]
+ set apa no
+ if {$::Pref(askOverwrite)} {
+ set apa [tk_messageBox -parent $top -icon question \
+ -title "Overwrite file" -type yesnocancel -message \
+ "Overwriting file [file tail $fileName]\nDo you want to\
+ create a backup copy ?"]
+ }
if {$apa eq "yes"} {
set backup [file rootname $fileName].bak
if {[catch {file copy -force $fileName $backup} result]} {
tk_messageBox -parent $top -icon error \
-title "File error" -type ok -message \
@@ -1886,12 +2161,15 @@
} 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] {
+ foreach {key value index} [$W dump -all 1.0 end-1c] {
switch -- $key {
text {
if {$save} {
puts -nonewline $ch $value
}
@@ -1908,10 +2186,18 @@
}
}
}
close $ch
}
+
+# Save file and reload
+proc saveFileR {top side} {
+ saveFile $top $side
+ # Redo
+ redoDiff $top
+ allowEdit $top
+}
#####################################
# File dialog stuff
#####################################
@@ -1920,111 +2206,120 @@
# Skip directories
if {[file isdirectory $file]} {return 1}
# This detects .kit but how to detect starpacks?
if {[file extension $file] eq ".kit" || $kitcheck} {
- if {![catch {package require vfs::mk4}]} {
- if {![catch {vfs::mk4::Mount $file $file -readonly}]} {
+ if { ! [catch {package require vfs::mk4}]} {
+ if { ! [catch {vfs::mk4::Mount $file $file -readonly}]} {
# 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]}]} {
+ if { ! [catch {set res [::tk::dialog::file:: open {*}$args]}]} {
return $res
}
}
}
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,67 +2328,67 @@
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.
proc doPastePatch {top} {
if {[catch {::tk::GetSelection $top CLIPBOARD} sel]} {
- tk_messageBox -icon error -title "Eskil Error" -parent $top \
- -message "Could not retreive clipboard" -type ok
+ tk_messageBox -parent $top -icon error \
+ -title "Eskil Error" -type ok \
+ -message "Could not retreive clipboard"
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 \
+ tk_messageBox -parent $top -icon error \
+ -title "Eskil Error" -type ok -message \
"Could not figure out which revison control system\
- \"$::diff($top,rightFile)\" is under." -type ok
+ \"$::eskil($top,rightFile)\" is under."
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,45 +2397,58 @@
# 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
}
}
#####################################
# GUI stuff
#####################################
-# A little helper to make a scrolled window
+# A little helper to make a window with scrollbars
# It returns the name of the scrolled window
-proc Scroll {dir class w args} {
+proc Scroll {dir class W args} {
switch -- $dir {
both {
set scrollx 1
set scrolly 1
}
@@ -2155,157 +2463,337 @@
default {
return -code error "Bad scrolldirection \"$dir\""
}
}
- ttk::frame $w
- $class $w.s {*}$args
+ ttk::frame $W
+ $class $W.s {*}$args
# Move border properties to frame
- set bw [$w.s cget -borderwidth]
- set relief [$w.s cget -relief]
- $w configure -relief $relief -borderwidth $bw
- $w.s configure -borderwidth 0
+ set bw [$W.s cget -borderwidth]
+ set relief [$W.s cget -relief]
+ $W configure -relief $relief -borderwidth $bw
+ $W.s configure -borderwidth 0
- grid $w.s -sticky news
+ 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]
- grid $w.sbx -row 1 -sticky we
+ $W.s configure -xscrollcommand [list $W.sbx set]
+ 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]
- grid $w.sby -row 0 -column 1 -sticky ns
- }
- grid columnconfigure $w 0 -weight 1
- grid rowconfigure $w 0 -weight 1
-
- return $w.s
+ $W.s configure -yscrollcommand [list $W.sby set]
+ 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
+
+ return $W.s
+}
+
+# Rearrange a dynamic grid to a specified number of columns
+proc DynGridRearrange {W cols} {
+ # Go down columns first. Thus we must know how many rows there will be.
+ set children [grid slaves $W._dyn]
+ set rows [expr {([llength $children] + $cols - 1) / $cols}]
+ set row 0
+ set col 0
+ foreach child $children {
+ grid $child -row $row -column $col
+ grid columnconfigure $W._dyn $col -uniform a
+ incr row
+ if {$row >= $rows} {
+ incr col
+ set row 0
+ }
+ }
+ # Clear other columns from uniform in case we shrunk
+ if {$row != 0} {
+ incr col
+ }
+ for {} {$col < 15} {incr col} {
+ grid columnconfigure $W._dyn $col -uniform ""
+ }
+ # Recalculate
+ update idletasks
+ # Propagate Height
+ set height [winfo reqheight $W._dyn]
+ $W configure -width 100 -height $height
+}
+
+# Update dynamic grid on configure event
+proc DynGridRedo {W} {
+ set maxW 0
+ set children [grid slaves $W._dyn]
+ foreach child $children {
+ set maxW [expr {max($maxW,[winfo reqwidth $child])}]
+ }
+ set fW [winfo width $W]
+ set cols [expr {max(1,$fW / $maxW)}]
+ # Rerrange if needed
+ lassign [grid size $W._dyn] mCols mRows
+ if {$mCols != $cols} {
+ DynGridRearrange $W $cols
+ }
+}
+
+# Ask for widget to have its children managed by dynGrid.
+proc dynGridManage {W} {
+ # Limit its inital requirements
+ pack propagate $W 0
+ $W configure -width 100 -height 10
+ set children [winfo children $W]
+ # Add an inner frame
+ ttk::frame $W._dyn
+ lower $W._dyn
+ pack $W._dyn -fill both -expand 1
+ # Get all children managed
+ grid {*}$children -in $W._dyn -padx 3 -pady 3 -sticky w
+ # React
+ bind $W "DynGridRedo $W"
}
################
# Align function
################
proc enableAlign {top} {
- eval $::widgets($top,enableAlignCmd)
+ {*}$::widgets($top,configureAlignCmd) -state normal
}
proc disableAlign {top} {
- eval $::widgets($top,disableAlignCmd)
+ {*}$::widgets($top,configureAlignCmd) -state disabled
}
# 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
-
- if {[info exists ::diff($top,align1)] && [info exists ::diff($top,align2)]} {
- set level 2
- if {![string equal $::diff($top,aligntext1) $::diff($top,aligntext2)]} {
- set apa [tk_messageBox -icon question -title "Align" -type yesno \
- -message "Those lines are not equal.\nReally align them?"]
+proc markAlign {top side line text} {
+ set ::eskil($top,align$side) $line
+ set ::eskil($top,aligntext$side) $text
+
+ if {[info exists ::eskil($top,align1)] && [info exists ::eskil($top,align2)]} {
+ if { ! [string equal $::eskil($top,aligntext1) $::eskil($top,aligntext2)]} {
+ set apa [tk_messageBox -parent $top -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} {
+proc alignMenu {mW top side x y} {
# Get the row that was clicked
- set w $::widgets($top,wLine$n)
- set index [$w index @$x,$y]
+ set W $::widgets($top,wLine$side)
+ set index [$W index @$x,$y]
set row [lindex [split $index "."] 0]
- set data [$w get $row.0 $row.end]
- if {![regexp {\d+} $data line]} {
+ 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 text [$::widgets($top,wDiff$side) 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)]} {
+ set other [expr {$side == 1 ? 2 : 1}]
+ set cmd [list markAlign $top $side $line $text]
+ 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 {$n == 1 && $line == $align1} {
+ if {[info exists ::eskil($top,aligns)]} {
+ foreach {align1 align2} $::eskil($top,aligns) {
+ if {$side == 1 && $line == $align1} {
set label "Remove alignment with line $align2"
set cmd [list clearAlign $top $align1]
- } elseif {$n == 2 && $line == $align2} {
+ } elseif {$side == 2 && $line == $align2} {
set label "Remove alignment with line $align1"
set cmd [list clearAlign $top $align1]
}
}
}
- $m add command -label $label -command $cmd
+ $mW 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 side x y X Y} {
+ # Get the row that was clicked
+ set W $::widgets($top,wLine$side)
+ 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$side) get $row.0 $row.end]
+ set other [expr {$side == 1 ? 2 : 1}]
+ set ::eskil($top,alignDrag,X) $X
+ set ::eskil($top,alignDrag,Y) $Y
+ set ::eskil($top,alignDrag,from) $side
+ set ::eskil($top,alignDrag,line$side) $line
+ set ::eskil($top,alignDrag,text$side) $text
+ set ::eskil($top,alignDrag,line$other) "?"
+ set ::eskil($top,alignDrag,state) press
+}
+
+# Mouse moves with button down
+proc motionAlignDrag {top side 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 {$side == 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 side 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
###################
-proc hlSelect {top hl} {
- highLightChange $top $hl
+proc hlSelect {top changeIndex} {
+ highLightChange $top $changeIndex
}
-proc hlSeparate {top n hl} {
- set ::diff($top,separate$n) $hl
- set wd $::widgets($top,wDiff$n)
- set wl $::widgets($top,wLine$n)
+proc hlSeparate {top side changeIndex} {
+ set ::eskil($top,separate$side) $changeIndex
+ set wd $::widgets($top,wDiff$side)
+ set wl $::widgets($top,wLine$side)
- if {$hl eq ""} {
+ if {$changeIndex 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$side)]
}
set text [$wd get {*}$range]
- set ::diff($top,separatetext$n) $text
+ set ::eskil($top,separatetext$side) $text
# Get the lines involved in the display
set from [lindex $range 0]
set to [lindex $range 1]
lassign [split $from "."] froml fromi
@@ -2314,114 +2802,108 @@
# 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)
- }
-}
-
-proc hlPopup {top n hl X Y x y} {
- if {[info exists ::diff($top,nopopup)] && $::diff($top,nopopup)} return
+ set ::eskil($top,separatelines$side) [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)
+ }
+}
+
+# No changeIndex means that the popup is over selected text rather than
+# line numbers.
+proc hlPopup {top side changeIndex X Y x y} {
+ if {[info exists ::eskil($top,nopopup)] && $::eskil($top,nopopup)} return
destroy .lpm
menu .lpm
- if {![editMenu .lpm $top $n $hl $x $y]} {
+ if { ! [editMenu .lpm $top $side $changeIndex $x $y]} {
.lpm add separator
}
- if {$hl != ""} {
+ if {$changeIndex != ""} {
.lpm add command -label "Select" \
- -command [list hlSelect $top $hl]
+ -command [list hlSelect $top $changeIndex]
}
- set other [expr {$n == 1 ? 2 : 1}]
- if {![info exists ::diff($top,separate$other)]} {
+ set other [expr {$side == 1 ? 2 : 1}]
+ 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
+ .lpm add command -label $label -command [list hlSeparate $top $side $changeIndex]
+ alignMenu .lpm $top $side $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
+proc rowPopup {W X Y x y} {
+ set top [winfo toplevel $W]
+ 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]
- if {!$tmp1} {.lpm add separator}
- set tmp2 [alignMenu .lpm $top $n $x $y]
+ regexp {(\d+)\D*$} $W -> side
+ set tmp1 [editMenu .lpm $top $side "_" $x $y]
+ if { ! $tmp1} {.lpm add separator}
+ set tmp2 [alignMenu .lpm $top $side $x $y]
if {$tmp1 && $tmp2} {
# Nothing in the menu
return
}
- if {!$tmp1 && $tmp2} {.lpm delete last}
+ 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 \
+ foreach side {1 2} {
+ set W $::widgets($top,wLine$side)
+ ##nagelfar vartype W _obj,text
+ $W tag bind $tag \
+ "hlPopup $top $side $::HighLightCount %X %Y %x %y ; break"
+ $W tag bind $tag \
"hlSelect $top $::HighLightCount"
}
incr ::HighLightCount
}
#########
# Zooming
#########
-proc zoomRow {w X Y x y} {
- global Pref
- set top [winfo toplevel $w]
+proc zoomRow {W X Y x y} {
+ set top [winfo toplevel $W]
# Get the row that was clicked
- set index [$w index @$x,$y]
+ set index [$W index @$x,$y]
set row [lindex [split $index "."] 0]
# Check if it is selected
- if {[lsearch [$w tag names $index] sel] >= 0} {
- regexp {(\d+)\D*$} $w -> n
- hlPopup $top $n "" $X $Y $x $y
+ if {[lsearch [$W tag names $index] sel] >= 0} {
+ regexp {(\d+)\D*$} $W -> side
+ hlPopup $top $side "" $X $Y $x $y
return
}
# Extract the data
set data(1) [$::widgets($top,wDiff1) dump -tag -text $row.0 $row.end]
@@ -2435,22 +2917,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 +2953,29 @@
# 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])}]
+ # Adjust ScreenWidth a bit to accomodate for padding.
+ set rows [expr {ceil(double($rWidth) / ([winfo screenwidth $top]-10))}]
# Add rows and fill screen width
$top.balloon.t1 configure -height $rows
$top.balloon.t2 configure -height $rows
# Let geometry requests propagate
update idletasks
@@ -2503,116 +2985,182 @@
}
wm geometry $top.balloon +$wx+$wy
wm deiconify $top.balloon
}
-proc unzoomRow {w} {
- set top [winfo toplevel $w]
+proc unzoomRow {W} {
+ set top [winfo toplevel $W]
destroy $top.balloon
}
+
+# Helper for fillWindowX
+proc FillWindowX {W widthName newXName} {
+ upvar 1 $widthName width $newXName newX
+ set x [winfo rootx $W]
+ set widths [::psballoon::FigureOutScreenWidths $W]
+ set nScreen [expr {[llength $widths] / 2}]
+ if {$nScreen <= 1} {
+ set width [winfo screenwidth $W]
+ set newX 0
+ return
+ }
+ if {$nScreen == 2} {
+ set minX [lindex $widths 0]
+ set maxX [lindex $widths end]
+ set width [expr {$maxX - $minX}]
+ set newX $minX
+ return
+ }
+ set widthList {}
+ set i -1
+ foreach {minX maxX} $widths {
+ incr i
+ lappend widthList [expr {$maxX - $minX}]
+ if {$minX <= $x && $x < $maxX} {
+ set screenI $i
+ }
+ }
+ if {$screenI == 0} {
+ set minX [lindex $widths 0]
+ set maxX [lindex $widths 3]
+ set width [expr {$maxX - $minX}]
+ set newX $minX
+ return
+ }
+ if {$screenI >= $nScreen-1} {
+ set minX [lindex $widths end-3]
+ set maxX [lindex $widths end]
+ set width [expr {$maxX - $minX}]
+ set newX $minX
+ return
+ }
+ set widthL [expr {[lindex $widthList $screenI] + [lindex $widthList $screenI-1]}]
+ set widthR [expr {[lindex $widthList $screenI] + [lindex $widthList $screenI+1]}]
+ if {$widthL >= $widthR} {
+ incr screenI -1
+ }
+ set minX [lindex $widths [* $screenI 2]]
+ set maxX [lindex $widths [expr {$screenI * 2 + 3}]]
+ set width [expr {$maxX - $minX}]
+ set newX $minX
+}
+
+# Maximize window in X direction, trying to fill two screens
+proc fillWindowX {W} {
+ FillWindowX $W width newX
+ set newY [winfo rooty $W]
+ set height [winfo height $W]
+ puts "$W [wm geometry $W]"
+ puts "$W X $newX Y $newY W $width H $height"
+ wm geometry $W ${width}x$height+$newX+$newY
+}
# 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)
+ 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)
}
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
# 2 : Justfify text to the left if there is enough room.
# 3 : Does not try to allocate space according to its contents
-proc fileLabel {w args} {
- ttk::entryX $w -style TLabel
- $w configure {*}$args
+proc fileLabel {W args} {
+ ttk::entryX $W -style TLabel
+ $W configure {*}$args
- $w configure -takefocus 0 -state readonly ;#-readonlybackground $bg
+ $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,250 +3167,234 @@
}
# 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} {
- append ::eskil(backdoor) $a
+proc backDoor {top aVal} {
+ append ::eskil(backdoor) $aVal
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 \
+ "$::widgets($top,wDiff1) configure -wrap \$wrapstate ;\
+ $::widgets($top,wDiff2) configure -wrap \$wrapstate"
+
+ psmenu::psmenu $dMenu -top $top {
+ ---
+ "&Reread Source" -cmd EskilRereadSource
+ ---
+ "Normal Cursor" -cmd "normalCursor $top"
+ "Fill X" -cmd "fillWindowX $top"
+ ---
+ # Runtime disable of C version of DiffUtil
+ "Tcl DiffUtil" -cmd DisableDiffUtilC
+ "Evalstats" -cmd {evalstats}
+ "_stats" -cmd {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)} {
+ if { ! $::Pref(toolbar)} {
grid remove $top.f
}
- menu $top.m
- $top configure -menu $top.m
-
- $top.m add cascade -label "File" -underline 0 -menu $top.m.mf
- menu $top.m.mf
- $top.m.mf add command -label "Redo Diff" -underline 5 \
- -command [list redoDiff $top] -state disabled
- if {$::eskil(debug) == 1} {
- $top.m.mf entryconfigure "Redo Diff" -state normal
- }
- $top.m.mf add separator
- $top.m.mf add command -label "Open Both..." -underline 0 \
- -command [list openBoth $top 0]
- $top.m.mf add command -label "Open Both (forget)..." \
- -command [list openBoth $top 1]
- $top.m.mf add command -label "Open Left File..." \
- -command [list openLeft $top]
- $top.m.mf add command -label "Open Right File..." \
- -command [list openRight $top]
- $top.m.mf add separator
- $top.m.mf add command -label "Open Ancestor File..." \
- -command [list openAncestor $top]
- $top.m.mf add command -label "Open Conflict File..." \
- -command [list openConflict $top]
- $top.m.mf add command -label "Open Patch File..." \
- -command [list openPatch $top]
- $top.m.mf add command -label "Revision Diff..." -underline 0 \
- -command [list openRev $top]
- $top.m.mf add separator
- $top.m.mf add command -label "Print Pdf..." -underline 0 \
- -command [list doPrint $top]
- $top.m.mf add separator
- $top.m.mf add command -label "Close" -underline 0 \
- -command [list cleanupAndExit $top]
- $top.m.mf add separator
- $top.m.mf add command -label "Quit" -underline 0 \
- -command {cleanupAndExit all}
-
- $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]
- $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 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 \
- -command chFont
-
- menu $top.m.mo.i
- $top.m.mo.i add radiobutton -label "No spaces" \
- -variable Pref(ignore) -value " "
- $top.m.mo.i add radiobutton -label "Space changes (-b)" \
- -variable Pref(ignore) -value "-b"
- $top.m.mo.i add radiobutton -label "All spaces (-w)" \
- -variable Pref(ignore) -value "-w"
- $top.m.mo.i add separator
- $top.m.mo.i add checkbutton -label "Case (-i)" \
- -variable Pref(nocase)
- $top.m.mo.i add checkbutton -label "Empty" \
- -variable Pref(noempty)
- $top.m.mo.i add checkbutton -label "Digits" \
- -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) \
- -value 2
- $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"
- $top.m.mo.p add radiobutton -label "Words" \
- -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 separator
- $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" \
- -variable ::Pref(context) -value 0
- $top.m.mo.c add separator
- $top.m.mo.c add radiobutton -label "Context 2 lines" \
- -variable ::Pref(context) -value 2
- $top.m.mo.c add radiobutton -label "Context 5 lines" \
- -variable ::Pref(context) -value 5
- $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
-
- $top.m add cascade -label "Search" -underline 0 -menu $top.m.ms
- menu $top.m.ms
+ set redoState [expr {$::eskil(debug) == 1 ? "normal" : "disabled"}]
+
+ psmenu::psmenu $top {
+ "&File" {
+ "Redo &Diff" -cmd "redoDiff $top" -state $redoState \
+ -cfgvar ::widgets($top,configureRedoDiffCmd)
+ ---
+ "&Open Both..." -cmd "openBoth $top 0"
+ "Open Both (forget)..." -cmd "openBoth $top 1"
+ "Open Left File..." -cmd "openLeft $top"
+ "Open Right File..." -cmd "openRight $top"
+ ---
+ "Open Ancestor File..." -cmd "openAncestor $top"
+ "Open Conflict File..." -cmd "openConflict $top"
+ "Open Patch File..." -cmd "openPatch $top"
+ "&Revision Diff..." -cmd "openRev $top"
+ ---
+ "&Print Pdf..." -cmd "doPrint $top"
+ ---
+ "&Close" -cmd "list cleanupAndExit $top"
+ ---
+ "&Quit" -cmd "cleanupAndExit all"
+ }
+ "&Options" {
+ "&Font" {
+ "&Select..." -command makeFontWin
+ _Radio -var ::Pref(fontsize) -command chFont {
+ 6 7 8 9 10
+ }
+ }
+ "&Ignore" {
+ "No spaces" -var ::Pref(ignore) -value " "
+ "Space changes (-b)" -var ::Pref(ignore) -value "-b"
+ "All spaces (-w)" -var ::Pref(ignore) -value "-w"
+ ---
+ "Case (-i)" -var ::Pref(nocase)
+ "Empty" -var ::Pref(noempty)
+ "Digits" -var ::Pref(nodigit)
+ }
+ "&Preprocess..." -cmd "EditPrefPreprocess $top"
+ "P&lugins..." -cmd "editPrefPlugins $top"
+ "P&arse" {
+ "Nothing" -var ::Pref(parse) -value 0
+ "Lines" -var ::Pref(parse) -value 1
+ "Blocks (small)" -var ::Pref(parse) -value 2
+ "Blocks" -var ::Pref(parse) -value 3
+ ---
+ "Characters" -var ::Pref(lineparsewords) -value "0"
+ "Words" -var ::Pref(lineparsewords) -value "1"
+ ---
+ "Fine chunks" -var ::Pref(finegrainchunks)
+ ---
+ "Mark last" -var ::Pref(marklast)
+ }
+ "&Colours..." -cmd makePrefWin
+ "C&ontext" {
+ "Show all lines" -var ::Pref(context) -value -1
+ "Show only diffs" -var ::Pref(context) -value 0
+ ---
+ "Context 2 lines" -var ::Pref(context) -value 2
+ "Context 5 lines" -var ::Pref(context) -value 5
+ "Context 10 lines" -var ::Pref(context) -value 10
+ "Context 20 lines" -var ::Pref(context) -value 20
+ }
+ "Pi&vot" {
+ "1" -var ::Pref(pivot) -value 1
+ "10" -var ::Pref(pivot) -value 10
+ "100" -var ::Pref(pivot) -value 100
+ "1000" -var ::Pref(pivot) -value 1000
+ "Max" -var ::Pref(pivot) -value 2000000000
+ }
+ ---
+ "Toolbar" -var ::Pref(toolbar)
+ ---
+ "Save default" -cmd "saveOptions $top"
+ }
+ "&Search" -var searchMenu {
+ # Added below
+ }
+ "&Tools" {
+ "&New Diff Window" -cmd "makeDiffWin $top"
+ "&Directory Diff" -cmd makeDirDiffWin
+ "&Clip Diff" -cmd makeClipDiffWin
+ "&Fourway Diff" -cmd makeFourWayWin
+ "&Table Diff" -cmd "makeDiffWin $top -table"
+ "&Merge" -cmd "makeMergeWin $top" -state disabled \
+ -cfgvar ::widgets($top,configureMergeCmd)
+ "&Edit Mode" -cmd "allowEdit $top" -acc Ctrl-E -state disabled \
+ -cfgvar ::widgets($top,configureEditModeCmd)
+ "&Paste Patch" -cmd "doPastePatch $top"
+ "Clear Align" -cmd "clearAlign $top" -state disabled \
+ -cfgvar ::widgets($top,configureAlignCmd)
+ "Highlight tabs" -cmd "highlightTabs $top"
+ if {$::tcl_platform(platform) eq "windows"} {
+ if { ! [catch {package require registry}]} {
+ ---
+ "Setup &Registry" -cmd makeRegistryWin
+ }
+ }
+ }
+ "&Help" {
+ "&General" -cmd makeHelpWin
+ "&Tutorial" -cmd makeTutorialWin
+ "&Revision Control" -cmd "makeDocWin revision.txt"
+ "&Edit Mode" -cmd "makeDocWin editmode.txt"
+ "&Plugins" -cmd "makeDocWin plugins.txt"
+ ---
+ "&About" -cmd makeAboutWin
+ }
+ }
if {[info procs textSearch::searchMenu] != ""} {
- textSearch::searchMenu $top.m.ms
+ textSearch::searchMenu $searchMenu
} else {
- $top.m.ms add command -label "Text search not available" \
- -state disabled
- }
-
- $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
- $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 "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 \
- -command [list doPastePatch $top]
- $top.m.mt add command -label "Clear Align" \
- -command [list clearAlign $top] -state disabled
- set ::widgets($top,enableAlignCmd) [list \
- $top.m.mt entryconfigure "Clear Align" -state normal]
- set ::widgets($top,disableAlignCmd) [list \
- $top.m.mt entryconfigure "Clear Align" -state disabled]
-
- if {$::tcl_platform(platform) eq "windows"} {
- if {![catch {package require registry}]} {
- $top.m.mt add separator
- $top.m.mt add command -label "Setup Registry" -underline 6 \
- -command makeRegistryWin
- }
- }
-
- $top.m add cascade -label "Help" -underline 0 -menu $top.m.help
- menu $top.m.help
- $top.m.help add command -label "General" -command makeHelpWin -underline 0
- $top.m.help add command -label "Tutorial" -command makeTutorialWin \
- -underline 0
- foreach label {{Revision Control} {Edit Mode} {Plugins}} \
- file {revision.txt editmode.txt plugins.txt} {
- $top.m.help add command -label $label \
- -command [list makeDocWin $file] -underline 0
- }
- $top.m.help add separator
- $top.m.help add command -label "About" -command makeAboutWin -underline 0
-
+ $searchMenu add command -label "Text search not available" -state disabled
+ }
+
+ # 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 +3405,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 +3672,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 +3696,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 +3736,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 +3771,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,36 +3784,36 @@
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"
- if {![info exists FontCache]} {
+ if { ! [info exists FontCache]} {
set fam [lsort -dictionary [font families]]
font create testfont
foreach f $fam {
- if {![string equal $f ""]} {
+ if { ! [string equal $f ""]} {
font configure testfont -family $f
lappend FontCache $f [font metrics testfont -fixed]
}
}
font delete testfont
@@ -3246,890 +3832,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,98 +20,94 @@
#
#----------------------------------------------------------------------
# $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
-
- toplevel $w -padx 2 -pady 2
- wm title $w $title
- bind $w [list destroy $w]
- bind $w [list destroy $w]
- ttk::frame $w.f
- ttk::button $w.b -text "Close" -command [list destroy $w] -width 10 \
+proc helpWin {W title} {
+ destroy $W
+
+ toplevel $W -padx 2 -pady 2
+ wm title $W $title
+ bind $W [list destroy $W]
+ bind $W [list destroy $W]
+ ttk::frame $W.f
+ ttk::button $W.b -text "Close" -command [list destroy $W] -width 10 \
-default active
- pack $w.b -side bottom -pady 2
- pack $w.f -side top -expand y -fill both -padx 2 -pady 2
- focus $w
- return $w.f
+ pack $W.b -side bottom -pady 2
+ pack $W.f -side top -expand y -fill both -padx 2 -pady 2
+ focus $W
+ return $W.f
}
proc makeAboutWin {} {
- set w [helpWin .ab "About Eskil"]
+ set W [helpWin .ab "About Eskil"]
set bg [ttk::style configure . -background]
- text $w.t -width 45 -height 11 -wrap none -relief flat \
+ text $W.t -width 45 -height 11 -wrap none -relief flat \
-background $bg
- pack $w.t -side top -expand y -fill both
-
- $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 "\nTcl version: [info patchlevel]\n"
+ pack $W.t -side top -expand y -fill both
+
+ $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.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"
- $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]
- $w.t configure -height $last
- $w.t configure -state disabled
+ $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]
+ $W.t configure -height $last
+ $W.t configure -state disabled
}
# Insert a text file into a text widget.
# Any XML-style tags in the file are used as tags in the text window.
-proc insertTaggedText {w file} {
+proc insertTaggedText {W file} {
set ch [open $file r]
set data [read $ch]
close $ch
set tags {}
while {$data != ""} {
if {[regexp {^([^<]*)<(/?)([^>]+)>(.*)$} $data -> pre sl tag post]} {
- $w insert end [subst -nocommands -novariables $pre] $tags
+ $W insert end [subst -nocommands -novariables $pre] $tags
set i [lsearch $tags $tag]
if {$sl != ""} {
# Remove tag
if {$i >= 0} {
set tags [lreplace $tags $i $i]
@@ -120,35 +116,33 @@
# Add tag
lappend tags $tag
}
set data $post
} else {
- $w insert end [subst -nocommands -novariables $data] $tags
+ $W insert end [subst -nocommands -novariables $data] $tags
set data ""
}
}
}
proc makeHelpWin {} {
- global Pref
-
set doc [file join $::eskil(thisDir) .. doc/eskil.txt]
- if {![file exists $doc]} return
+ if { ! [file exists $doc]} return
- set w [helpWin .he "Eskil Help"]
- set t [Scroll y text $w.t -width 85 -height 35]
- pack $w.t -side top -expand 1 -fill both
+ set W [helpWin .he "Eskil Help"]
+ set t [Scroll y text $W.t -width 85 -height 35]
+ 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}]]
@@ -172,32 +166,32 @@
if {[font metrics docFontP -linespace] >= $h} break
}
}
# Configure a text window as Doc viewer
-proc configureDocWin {w} {
+proc configureDocWin {W} {
createDocFonts
- $w configure -font docFont -wrap word
- $w tag configure ul -underline 1
- $w tag configure b -font docFontB
- $w tag configure bullet -tabs "1c" -lmargin2 "1c"
- $w tag configure pre -font docFontP
+ $W configure -font docFont -wrap word
+ $W tag configure ul -underline 1
+ $W tag configure b -font docFontB
+ $W tag configure bullet -tabs "1c" -lmargin2 "1c"
+ $W tag configure pre -font docFontP
- set top [winfo toplevel $w]
+ set top [winfo toplevel $W]
foreach event { } {
- bind $top $event [string map [list "%W" $w] [bind Text $event]]
+ bind $top $event [string map [list "%W" $W] [bind Text $event]]
}
}
proc makeDocWin {fileName} {
- set w [helpWin .doc "Eskil Help"]
- set t [Scroll y text $w.t -width 80 -height 25]
- pack $w.t -side top -expand 1 -fill both
+ set W [helpWin .doc "Eskil Help"]
+ set t [Scroll y text $W.t -width 80 -height 25]
+ pack $W.t -side top -expand 1 -fill both
configureDocWin $t
- if {![file exists $::eskil(thisDir)/../doc/$fileName]} {
+ if { ! [file exists $::eskil(thisDir)/../doc/$fileName]} {
$t insert end "ERROR: Could not find doc file "
$t insert end \"$fileName\"
return
}
insertTaggedText $t $::eskil(thisDir)/../doc/$fileName
@@ -205,41 +199,38 @@
#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 { ! [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"
- pack $w.sb -side right -fill y
- pack $w.t -side left -expand 1 -fill both
-
- configureDocWin $w.t
+ set W [helpWin .ht "Eskil Tutorial"]
+
+ text $W.t -width 82 -height 35 -yscrollcommand "$W.sb set"
+ 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
# Move border properties to frame
- set bw [$w.t cget -borderwidth]
- set relief [$w.t cget -relief]
- $w configure -relief $relief -borderwidth $bw
- $w.t configure -borderwidth 0
+ set bw [$W.t cget -borderwidth]
+ set relief [$W.t cget -relief]
+ $W configure -relief $relief -borderwidth $bw
+ $W.t configure -borderwidth 0
- insertTaggedText $w.t $doc
- $w.t configure -state disabled
+ insertTaggedText $W.t $doc
+ $W.t configure -state disabled
}
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
}
-proc addChange {top n tag line1 n1 line2 n2} {
- if {$tag ne ""} {
- lappend ::diff($top,changes) [list $::diff($top,mapMax) $n \
+# Temporarily ignore changes added by addChange.
+proc mapNoChange {top value} {
+ set ::eskil($top,mapNoChange) $value
+}
+
+proc addChange {top nLines tag line1 n1 line2 n2} {
+ if {$tag ne "" && $::eskil($top,mapNoChange) == 0} {
+ lappend ::eskil($top,changes) [list $::eskil($top,mapMax) $nLines \
$tag $line1 $n1 $line2 $n2]
}
- incr ::diff($top,mapMax) $n
+ incr ::eskil($top,mapMax) $nLines
+}
+
+proc addMapLines {top nLines} {
+ incr ::eskil($top,mapMax) $nLines
}
-proc addMapLines {top n} {
- incr ::diff($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}]
- if {!$y0} { set y0 $y1 } ;# Record first occurance
+ 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,44 @@
}
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
+ ##nagelfar vartype w _obj,text
$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 +146,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 +250,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,177 +270,173 @@
# 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]} {
+ 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
- $w.m add cascade -label "File" -underline 0 -menu $w.m.mf
- menu $w.m.mf
- $w.m.mf add command -label "Save" -underline 0 -command "saveMerge $top"
- $w.m.mf add separator
- $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"
- $w.m.ms add radiobutton -label "Left" -underline 0 -value 1 \
- -variable diff($top,curMergeSel) -command "selectMerge $top"
- $w.m.ms add radiobutton -label "Right" -underline 0 -value 2 \
- -variable diff($top,curMergeSel) -command "selectMerge $top"
- $w.m.ms add radiobutton -label "Right+Left" -value 21 \
- -variable diff($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 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 separator
- $w.m.mc add checkbutton -label "Pure" -variable diff($top,modetype) \
- -onvalue "Pure" -offvalue "" -command {doDiff}
+ psmenu::psmenu $w {
+ "&File" {
+ "&Save" -cmd "saveMerge $top"
+ ----
+ "&Close" -cmd "closeMerge $top"
+ }
+ "&Select" {
+ _Radio -var ::eskil($top,curMergeSel) -cmd "selectMerge $top" {
+ "Left+Right" -value 12
+ "&Left" -value 1
+ "&Right" -value 2
+ "Right+Left" -value 21
+ }
+ ---
+ "All Left" -cmd "selectMergeAll $top 1"
+ "All Right" -cmd "selectMergeAll $top 2"
+ }
+ "&Goto" {
+ "Previous" -accelerator "Up" -cmd "nextMerge $top -1"
+ "Next" -accelerator "Down" -cmd "nextMerge $top 1"
+ if {$anyC} {
+ "Previous Conflict" -accelerator "Ctrl-Up" -cmd "nextMerge $top -1000"
+ "Next Conflict" -accelerator "Ctrl-Down" -cmd "nextMerge $top 1000"
+ }
+ "Previous 10" -accelerator "Shift-Up" -cmd "nextMerge $top -10"
+ "Next 10" -accelerator "Shift-Down" -cmd "nextMerge $top 10"
+ }
+ }
+ # Test how to add more cascade in more calls
+ psmenu::psmenu $w {
+ "&Config" {
+ "Line end LF" -value lf -var ::eskil($top,mergetranslation)
+ "Line end CRLF" -value crlf -var ::eskil($top,mergetranslation)
+ if {$::eskil($top,mode) eq "conflict"} {
+ ----
+ "Pure" -var ::eskil($top,modetype) \
+ -onvalue "Pure" -offvalue "" -cmd "doDiff $top"
+ }
+ }
}
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,34 +443,37 @@
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"
grid $w.f.rb1 $w.f.rb2 $w.f.rb3 $w.f.rb4 x $w.f.b1 $w.f.b2 x \
$w.f.bl $w.f.br x $w.f.bs $w.f.bq -sticky we -padx 1
- if {!$anyC} {
+ if { ! $anyC} {
grid forget $w.f.bl $w.f.br
}
grid columnconfigure $w.f {4 7 10} -minsize 10
grid columnconfigure $w.f 10 -weight 1
grid columnconfigure $w.f {0 1 2 3} -uniform a
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"
+ -yscrollcommand "$w.sby set" -font myfont -tabstyle wordprocessor
+ 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 +492,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,*
- set differrA1 [catch {DiffUtil::diffFiles {*}$opts \
- $::diff($top,ancestorFile) $dFile1} diffresA1]
- set differrA2 [catch {DiffUtil::diffFiles {*}$opts \
- $::diff($top,ancestorFile) $dFile2} diffresA2]
+ detectLineEnd $top $::eskil($top,ancestorFile) mergetranslation lf
+ }
+ array unset ::eskil $top,ancestorLeft,*
+ array unset ::eskil $top,ancestorRight,*
+ set differrA1 [catch {DiffUtil::diffFiles {*}$opts \
+ $::eskil($top,ancestorFile) $dFile1} diffresA1]
+ set differrA2 [catch {DiffUtil::diffFiles {*}$opts \
+ $::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 +636,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 +653,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 +670,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,219 +28,717 @@
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
+# Data structure in this return dict:
+# name: Plugin name.
+# file: Source file name. "_" for a runtime plugin.
+# data: Source code.
+# opts: Options accepted by plugin.
proc LocatePlugin {plugin} {
- set src ""
- set dirs [PluginSearchPath]
-
- foreach dir $dirs {
- set files {}
- lappend files [file join $dir $plugin]
- lappend files [file join $dir $plugin.tcl]
- foreach file $files {
- if {![file exists $file]} continue
- if {![file isfile $file]} continue
- 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
- break
- }
- }
- if {$src ne ""} break
- }
- return $src
-}
-
-proc createPluginInterp {plugin info} {
- set src [LocatePlugin $plugin]
-
- if {$src eq ""} {
+ set res [dict create name "" file "" opts "" data ""]
+ set fSrc ""
+ set code ""
+
+ # Search runtime plugins first
+ foreach name [dict keys $::eskil(plugins)] {
+ if {$name eq $plugin} {
+ set fSrc "_"
+ set code [dict get $::eskil(plugins) $name data]
+ }
+ }
+
+ if {$fSrc eq ""} {
+ foreach dir [PluginSearchPath] {
+ 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
+ if { ! [file isfile $file]} continue
+ if { ! [file readable $file]} continue
+ set ch [open $file r]
+ set code [read $ch 20]
+ close $ch
+ # Magic pattern to identify a plugin
+ if {[string match "##Eskil Plugin*" $code]} {
+ set fSrc $file
+ break
+ }
+ }
+ if {$fSrc ne ""} break
+ }
+ }
+
+ if {$fSrc eq "_"} {
+ dict set res "name" $plugin
+ dict set res "file" $fSrc
+ dict set res "data" $code
+ } elseif {$fSrc ne ""} {
+ dict set res "name" $plugin
+ dict set res "file" $fSrc
+ # Plugin source is reloaded each time to facilitate debug/rerun.
+ set ch [open $fSrc r]
+ set code [read $ch]
+ close $ch
+ dict set res "data" $code
+ }
+
+ # Look for declarations of command line options
+ foreach line [split $code \n] {
+ # 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 " :"]
+ }
+ }
+
+ return $res
+}
+
+# Return value: Handle to interpreter
+#
+# pinfo dict structure:
+# file : File plugin
+# dir : Directory plugin
+# allow: Raised privileges
+proc createPluginInterp {plugin info allow pinfoName} {
+ upvar 1 $pinfoName pinfo
+ set res [LocatePlugin $plugin]
+ set code [dict get $res data]
+ set fSrc [dict get $res file]
+
+ if {$code eq ""} {
return ""
}
- # Create interpreter
- set pi [interp create -safe]
+ # Create interpreter and load source
+ if {$allow} {
+ set pi [interp create]
+ $pi eval $code
+ } else {
+ set pi [interp create -safe]
+ $pi eval $code
+ }
- # Load source
- $pi invokehidden -global source $src
- $pi eval [list set ::WhoAmI [file rootname [file tail $src]]]
+ # Setup info
+ $pi eval [list set ::WhoAmI [file rootname [file tail $fSrc]]]
+ $pi eval [list set ::WhoAmIFull [file normalize $fSrc]]
$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]
- if {$src eq ""} {
+proc printPlugin {plugin {short 0}} {
+ set res [LocatePlugin $plugin]
+ set fSrc [dict get $res file]
+ if {$fSrc eq ""} {
printPlugins
return
}
- set ch [open $src]
- puts -nonewline [read $ch]
- close $ch
+ foreach line [split [dict get $res data] \n] {
+ set lineT [string trim $line]
+ if {$short} {
+ if { ! [string match "#*" $lineT]} {
+ break
+ }
+ }
+ puts $line
+ }
}
proc listPlugins {} {
set dirs [PluginSearchPath]
+ set result {}
+
+ foreach name [dict keys $::eskil(plugins)] {
+ dict set result $name [dict get $::eskil(plugins) $name]
+ }
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
- if {![file isfile $file]} continue
- if {![file readable $file]} continue
+ if { ! [file exists $file]} continue
+ if { ! [file isfile $file]} continue
+ 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 code [read $ch 200]
+ if {[regexp {^\#\#Eskil Plugin :(.*?)(\n|$)} $code -> 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 code [read $ch]
+ dict set result $root "data" $code
}
}
}
- return [array get result]
+ foreach root [dict keys $result] {
+ set code [dict get $result $root data]
+ if {[regexp {^\#\#Eskil Plugin :(.*?)(\n|$)} $code -> descr]} {
+ dict set result $root "descr" $descr
+ }
+ if {[string first "proc PreProcess " $code] >= 0} {
+ dict set result $root "file" 1
+ }
+ if {[string first "proc FileCompare " $code] >= 0} {
+ dict set result $root "dir" 1
+ }
+ }
+
+ 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
}
+ # Longest name?
+ set w 0
+ foreach {plugin info} $plugins {
+ if {[string length $plugin] > $w} {
+ set w [string length $plugin]
+ }
+ }
+ # Room for quote marks in output
+ 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"
}
}
+# Handle plugins for a diff session that uses plugins.
+# Returns true if something has been done that needs cleanup.
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 pI [lindex [split $item ","] end]
+
+ set allow [dict get $::eskil($top,pluginpinfo,$pI) allow]
+ # Pass ::argv to plugin
+ set pArgv $::eskil(argv)
+ if {[info exists ::eskil($top,pluginargv,$pI)]} {
+ lappend pArgv {*}$::eskil($top,pluginargv,$pI)
+ }
+ $::eskil($top,plugin,$pI) eval [list set ::argv $pArgv]
+ # Pass ::Pref to plugin
+ $::eskil($top,plugin,$pI) eval [list array set ::Pref [array get ::Pref]]
+ # Pass File info to plugin
+ $::eskil($top,plugin,$pI) eval [list set ::File(left) $::eskil($top,leftFile)]
+ $::eskil($top,plugin,$pI) 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,$pI)
+ interp share {} $cho $::eskil($top,plugin,$pI)
+ interp share {} $chi2 $::eskil($top,plugin,$pI)
+ interp share {} $cho2 $::eskil($top,plugin,$pI)
+
+ 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,$pI) eval $cmd1]
+ set usenew2 [$::eskil($top,plugin,$pI) eval $cmd2]
+ interp alias {} pnw $::eskil($top,plugin,$pI) namespace which
+ while {[pnw $c1] ne {} || [pnw $c2] ne {}} {
+ if {[pnw $c1] ne {}} {
+ set usenew1 [$::eskil($top,plugin,$pI) eval $c1]
+ }
+ if {[pnw $c2] ne {}} {
+ set usenew2 [$::eskil($top,plugin,$pI) eval $c2]
+ }
+ }
+ } else {
+ set usenew1 [$::eskil($top,plugin,$pI) eval $cmd1]
+ set usenew2 [$::eskil($top,plugin,$pI) eval $cmd2]
+ }
+
+ if {$allow} {
+ $::eskil($top,plugin,$pI) eval close $chi
+ $::eskil($top,plugin,$pI) eval close $cho
+ $::eskil($top,plugin,$pI) eval close $chi2
+ $::eskil($top,plugin,$pI) eval close $cho2
+ } else {
+ $::eskil($top,plugin,$pI) invokehidden close $chi
+ $::eskil($top,plugin,$pI) invokehidden close $cho
+ $::eskil($top,plugin,$pI) invokehidden close $chi2
+ $::eskil($top,plugin,$pI) 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
+}
+
+# After diff is done, this is called if preparePlugin returned true.
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 pI [$wt index end]
+ if {$pos eq "" || $pos >= ($pI - 1)} {
+ # Since the "+" tab is last, the index is n for any new one
+ set pos [expr {$pI - 1}]
+ }
+ ttk::frame $wt.f,$pI
+ $wt insert $pos $wt.f,$pI -text "Plugin"
+
+ set wt $wt.f,$pI
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,$pI)]} {
+ set ::eskil($top,pluginname,$pI) ""
+ }
+ if { ! [info exists ::eskil($top,plugininfo,$pI)]} {
+ set ::eskil($top,plugininfo,$pI) ""
+ }
+ if { ! [info exists ::eskil($top,pluginallow,$pI)]} {
+ set ::eskil($top,pluginallow,$pI) 0
+ }
+ set ::eskil($top,edit,pluginname,$pI) $::eskil($top,pluginname,$pI)
+ set ::eskil($top,edit,plugininfo,$pI) $::eskil($top,plugininfo,$pI)
+ set ::eskil($top,edit,pluginallow,$pI) $::eskil($top,pluginallow,$pI)
+
+ 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,$pI) \
+ -value $plugin -text $plugin -command "SelectPlugin $top $pI $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,$pI) \
+ -value "" -text "No Plugin" -command "SelectPlugin $top $pI $plugin"
+ ttk::button $wt.bs -text "Show" -state disable \
+ -command "ShowPlugin $wt \$::eskil($top,edit,pluginname,$pI)"
+ addBalloon $wt.bs "Show plugin source code."
+ ttk::button $wt.bc -text "Clone" -state disable \
+ -command "ClonePlugin $wt \$::eskil($top,edit,pluginname,$pI)"
+ addBalloon $wt.bc "Clone to a runtime plugin."
+ ttk::button $wt.be -text "Edit" -state disable \
+ -command "EditPlugin $wt \$::eskil($top,edit,pluginname,$pI)"
+ set ::eskil($top,edit,showW,$pI) $wt.bs
+ set ::eskil($top,edit,cloneW,$pI) $wt.bc
+ set ::eskil($top,edit,editW,$pI) $wt.be
+ addBalloon $wt.be "Edit a runtime plugin."
+ SelectPlugin $top $pI $::eskil($top,edit,pluginname,$pI)
+
+ grid $wt.rb$t $wt.be $wt.bc $wt.bs -in $wt.lfs -sticky we -padx 3 -pady 3
+ grid $wt.bs $wt.bc $wt.be -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,$pI)
+ 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,$pI)
+ 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,$pI) $wt.lfsc
+ trace add variable ::eskil($top,edit,pluginname,$pI) write \
+ [list UpdateSpecificPluginConf $top $pI]
+ UpdateSpecificPluginConf $top $pI
+
+ 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 pI args} {
+ set w $::widgets($top,prefPluginsSpec,$pI)
+ # 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,$pI)
+ 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,$pI)]} {
+ lappend pArgv {*}$::eskil($top,pluginargv,$pI)
+ }
+ # 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,$pI) $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,$pI) 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,$pI) $name
+ }
+ }
+ ttk::checkbutton $w.s$t -text "On" \
+ -variable ::eskil($top,edit,$name,$pI)
+ 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,$pI) [lindex $pArgv $ix+1]
+ # Move responsibility from global argv
+ set ix [lsearch -exact $::eskil(argv) $name]
+ if {$ix >= 0} {
+ lappend ::eskil($top,pluginargv,$pI) $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,$pI)
+ 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 pI [lindex [split $win ","] end]
+ if { ! [string is integer -strict $pI]} continue
+ # Find all used.
+ if {$::eskil($top,edit,pluginname,$pI) ne ""} {
+ lappend allN $pI
+ }
+ }
+ 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 pI $allN {
+ set ::eskil($top,pluginname,$t) $::eskil($top,edit,pluginname,$pI)
+ set ::eskil($top,plugininfo,$t) $::eskil($top,edit,plugininfo,$pI)
+ set ::eskil($top,pluginallow,$t) $::eskil($top,edit,pluginallow,$pI)
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 pI [lindex [split $item ","] end]
+ if {$pI >= $t} {
+ unset ::eskil($top,pluginname,$pI)
+ set ::eskil($top,plugininfo,$pI) ""
+ set ::eskil($top,pluginallow,$pI) 0
+ }
+ }
+
+ # Handle all plugins
+ foreach item [array names ::eskil $top,pluginname,*] {
+ set pI [lindex [split $item ","] end]
+ if {$::eskil($top,pluginname,$pI) ne ""} {
+ set pinterp [createPluginInterp $::eskil($top,pluginname,$pI) \
+ $::eskil($top,plugininfo,$pI) \
+ $::eskil($top,pluginallow,$pI) pinfo]
+ } else {
+ set pinterp ""
+ set pinfo ""
+ }
+ set ::eskil($top,plugin,$pI) $pinterp
+ set ::eskil($top,pluginpinfo,$pI) $pinfo
+ set ::eskil($top,pluginargv,$pI) {}
+ foreach {name flag doc} $::eskil($top,edit,opts,$pI) {
+ if {$flag} {
+ if {[info exists ::eskil($top,edit,$name,$pI)] && \
+ $::eskil($top,edit,$name,$pI)} {
+ lappend ::eskil($top,pluginargv,$pI) $name
+ }
+ } else {
+ if {[info exists ::eskil($top,edit,$name,$pI)] && \
+ $::eskil($top,edit,$name,$pI) ne ""} {
+ lappend ::eskil($top,pluginargv,$pI) $name \
+ $::eskil($top,edit,$name,$pI)
+ }
+ }
+ }
+ }
+}
+
+# Put Tcl code in a text widget, with some syntax highlighting
+proc TextViewTcl {tW data} {
+ $tW tag configure comment -foreground "#b22222"
+ foreach line [split $data \n] {
+ if {[regexp {^\s*#} $line]} {
+ $tW insert end $line\n comment
+ } elseif {[regexp {^(.*;\s*)(#.*)$} $line -> pre post]} {
+ $tW insert end $pre
+ $tW insert end $post\n comment
+ } else {
+ $tW insert end $line\n
+ }
+ }
+}
+
+proc SelectPlugin {top pI plugin} {
+ $::eskil($top,edit,showW,$pI) configure -state disable
+ $::eskil($top,edit,cloneW,$pI) configure -state disable
+ $::eskil($top,edit,editW,$pI) configure -state disable
+ if {$plugin eq ""} {
+ return
+ }
+
+ $::eskil($top,edit,showW,$pI) configure -state normal
+ # TODO: Enable when this works.
+ #$::eskil($top,edit,cloneW,$pI) configure -state normal
+ foreach name [dict keys $::eskil(plugins)] {
+ if {$name eq $plugin} {
+ # TODO: Enable when this works.
+ #$::eskil($top,edit,editW,$pI) configure -state normal
+ }
+ }
+}
+
+proc EditPlugin {parent plugin} {
+ # TODO
+}
+
+proc ClonePlugin {parent plugin} {
+ set res [LocatePlugin $plugin]
+ dict set res name clone_$plugin
+ dict set ::eskil(plugins) clone_$plugin $res
+}
+
+# Show plugin source
+proc ShowPlugin {parent plugin} {
+ set res [LocatePlugin $plugin]
+ set data [dict get $res data]
+ if {$data eq ""} return
+
+ 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,520 @@
+#---------------------------------------------------------- -*- 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 {rI} {
+ #puts EditPrefPreUp$rI
+ # Sanity check
+ if {$rI <= 1 || $rI > $::TmpPref(preprocess,n)} {
+ return
+ }
+ set pI [expr {$rI - 1}]
+ foreach item {name active save re} {
+ set tmp $::TmpPref(preprocess,$item,$rI)
+ set ::TmpPref(preprocess,$item,$rI) $::TmpPref(preprocess,$item,$pI)
+ set ::TmpPref(preprocess,$item,$pI) $tmp
+ }
+}
+
+proc EditPrefPreprocessAddItem {W autoEdit} {
+ 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"
+ if {$autoEdit} {
+ after idle [list after 50 [list $W.fp.be$r invoke]]
+ }
+ 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
+ set autoEdit 0
+ if {$r == 0} {
+ set autoEdit 1
+ 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 $autoEdit
+ }
+
+ # Frame for action buttons
+ ttk::frame $W.fa -padding 3
+ ttk::button $W.fa.b1 -text "Add" \
+ -command [list EditPrefPreprocessAddItem $W 1]
+ 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
@@ -40,12 +40,12 @@
return $res
}
# Process the line numbers from the line number widget into a list
# of "linestarters"
-proc ProcessLineno {w maxlen} {
- set tdump [$w dump -tag -text 1.0 end]
+proc ProcessLineno {W maxlen} {
+ set tdump [$W dump -tag -text 1.0 end]
set tag ""
set line ""
set lines {}
foreach {key value index} $tdump {
if {$key eq "tagon"} {
@@ -94,13 +94,17 @@
}
return $text
}
# Find the lastnumber in a text widget
-proc FindLastNumber {w} {
- set index [$w search -backwards -regexp {\d} end]
- set line [$w get "$index linestart" "$index lineend"]
+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,42 +232,71 @@
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 \
- -headleft $lfile -headright $rfile -headsize 10]
+ -headleft $lfile -headright $rfile \
+ -lnsp $::Pref(printLineSpace) \
+ -headsize $::Pref(printHeaderSize)]
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,38 +318,140 @@
$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} {
+proc AccumulateMax {top 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($top,currentCharsPerLine) $len
}
}
# Count the longest line length in the current display
proc CountCharsPerLine {top} {
- set ::diff(currentCharsPerLine) 0
- $::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($top,currentCharsPerLine) {}
+ $::widgets($top,wDiff1) dump -text -command [list AccumulateMax $top] 1.0 end
+ $::widgets($top,wDiff2) dump -text -command [list AccumulateMax $top] 1.0 end
+ set ::eskil($top,currentCharsPerLine) \
+ [lsort -integer $::eskil($top,currentCharsPerLine)]
+ return [lindex $::eskil($top,currentCharsPerLine) end]
+}
+
+# In a sorted list of integers, figure out where val fits
+# In 8.6 this could use lsearch -bisect
+proc FindPercentile {lst val} {
+ set len [llength $lst]
+ # No elements, so all are covered in a way
+ if {$len == 0} { return 100 }
+ # Above range, so 100%
+ if {[lindex $lst end] <= $val} { return 100 }
+ # Under range, so 0%
+ if {[lindex $lst 0] > $val} { return 0 }
+ # Single element should not slip through...
+ if {$len <= 1} { return 0 }
+
+ set i [lsearch -integer -all $lst $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 $lst $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
+ }
+ # Include previous selection
+ if {[string is digit -strict $::Pref(printCharsPerLine)]} {
+ lappend values $::Pref(printCharsPerLine)
+ }
+ # Include 90% if reasonable
+ set len [llength $::eskil($top,currentCharsPerLine)]
+ set cpl [lindex $::eskil($top,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($top,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
+}
+
+proc PrintTracePrefs {W args} {
+ 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)]
+
+ if { ! [winfo exists $W.cf.l1e]} return
+ foreach num {1 2 3} p {ch n1 n2} {
+ set r [expr {int(255*$::TmpPref(${p}r))}]
+ set g [expr {int(255*$::TmpPref(${p}g))}]
+ set b [expr {int(255*$::TmpPref(${p}b))}]
+ set col [format \#%02X%02X%02X $r $g $b]
+ $W.cf.l${num}e configure -background $col
}
}
# Create a print dialog for PDF.
proc doPrint {top {quiet 0}} {
@@ -323,110 +458,120 @@
if {$quiet} {
PrintDiffs $top 1
return
}
- destroy .pr
- toplevel .pr -padx 3 -pady 3
- 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
-
- 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 {
- ttk::radiobutton .pr.clf.$value -variable ::Pref(printCharsPerLine) \
- -value $value -text $value
- pack .pr.clf.$value -side left -padx 3 -pady 3
+ set W $top.pr
+ destroy $W
+ ttk::toplevel $W -padx 3 -pady 3
+ wm title $W "Print diffs to PDF"
+
+ # Layout settings
+ ttk::labelframe $W.lfs -text "Settings" -padding 3
+
+ ttk::label $W.lfs.hsl -anchor w -text "Header Size"
+ addBalloon $W.lfs.hsl "Font size for page header"
+ MySpinBox $W.lfs.hss -textvariable ::Pref(printHeaderSize) \
+ -from 5 -to 16 -width 3 -format %.0f
+
+ ttk::label $W.lfs.cll -anchor w -text "Chars per line"
+ addBalloon $W.lfs.cll "Font size is scaled to fit this"
+ ttk::entryX $W.lfs.cle -textvariable ::Pref(printCharsPerLine) -width 4
+ ttk::frame $W.lfs.clf
+
+ set values [CharsPerLineOptions $top]
+ foreach {value label balloon} $values {
+ ttk::radiobutton $W.lfs.clf.$value -variable ::Pref(printCharsPerLine) \
+ -value $value -text $label
+ addBalloon $W.lfs.clf.$value $balloon
+ pack $W.lfs.clf.$value -side left -padx 3 -pady 3
}
# Select paper size
set paperlist [lsort -dictionary [pdf4tcl::getPaperSizeList]]
- ttk::label .pr.psl -anchor w -text "Paper Size"
- ttk::combobox .pr.psc -values $paperlist -textvariable ::Pref(printPaper) \
+ ttk::label $W.lfs.psl -anchor w -text "Paper Size"
+ ttk::combobox $W.lfs.psc -values $paperlist -textvariable ::Pref(printPaper) \
-width 6 -state readonly
-
+
+ grid $W.lfs.hsl $W.lfs.hss -sticky we -padx 3 -pady 3
+ grid $W.lfs.psl $W.lfs.psc -sticky we -padx 3 -pady 3
+ grid $W.lfs.cll $W.lfs.cle $W.lfs.clf - -sticky we -padx 3 -pady 3
+ grid columnconfigure $W.lfs 1 -weight 1
+
# Color
foreach {::TmpPref(chr) ::TmpPref(chg) ::TmpPref(chb)} \
$::Pref(printColorChange) break
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)]
- list}
-
- ttk::labelframe .pr.cf -text "Color" -padding 3
-
- ttk::label .pr.cf.l1 -text "Change"
- tk::spinbox .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 \
- -width 4 -textvariable ::TmpPref(chg)
- tk::spinbox .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 \
- -width 4 -textvariable ::TmpPref(n1r)
- tk::spinbox .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 \
- -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 \
- -width 4 -textvariable ::TmpPref(n2r)
- tk::spinbox .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 \
- -width 4 -textvariable ::TmpPref(n2b)
-
- 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
+
+ ttk::labelframe $W.cf -text "Background Color" -padding 3
+
+ ttk::label $W.cf.hr -text "Red"
+ ttk::label $W.cf.hg -text "Green"
+ ttk::label $W.cf.hb -text "Blue"
+
+ ttk::label $W.cf.l1 -text "Change"
+ MySpinBox $W.cf.s1r -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
+ -width 5 -textvariable ::TmpPref(chr)
+ MySpinBox $W.cf.s1g -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
+ -width 5 -textvariable ::TmpPref(chg)
+ MySpinBox $W.cf.s1b -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
+ -width 5 -textvariable ::TmpPref(chb)
+ ttk::label $W.cf.l1e -text "Example"
+ addBalloon $W.cf.l1e "Screen approximation of print color"
+
+ ttk::label $W.cf.l2 -text "Old"
+ MySpinBox $W.cf.s2r -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
+ -width 5 -textvariable ::TmpPref(n1r)
+ MySpinBox $W.cf.s2g -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
+ -width 5 -textvariable ::TmpPref(n1g)
+ MySpinBox $W.cf.s2b -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
+ -width 5 -textvariable ::TmpPref(n1b)
+ ttk::label $W.cf.l2e -text "Example"
+
+ ttk::label $W.cf.l3 -text "New"
+ MySpinBox $W.cf.s3r -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
+ -width 5 -textvariable ::TmpPref(n2r)
+ MySpinBox $W.cf.s3g -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
+ -width 5 -textvariable ::TmpPref(n2g)
+ MySpinBox $W.cf.s3b -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
+ -width 5 -textvariable ::TmpPref(n2b)
+ ttk::label $W.cf.l3e -text "Example"
+
+ grid x $W.cf.hr $W.cf.hg $W.cf.hb -pady 1
+ grid $W.cf.l1 $W.cf.s1r $W.cf.s1g $W.cf.s1b $W.cf.l1e -sticky w -padx 3 -pady 3
+ grid $W.cf.l2 $W.cf.s2r $W.cf.s2g $W.cf.s2b $W.cf.l2e -sticky w -padx 3 -pady 3
+ grid $W.cf.l3 $W.cf.s3r $W.cf.s3g $W.cf.s3b $W.cf.l3e -sticky w -padx 3 -pady 3
+
+ trace add variable ::TmpPref write [list PrintTracePrefs $W]
+ PrintTracePrefs $W
# File
-
- ttk::label .pr.fnl -anchor w -text "File name"
- ttk::entryX .pr.fne -textvariable ::diff($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"
- }
-
- ttk::frame .pr.fb
- ttk::button .pr.b1 -text "Print to File" \
- -command "destroy .pr; update; PrintDiffs $top"
- ttk::button .pr.b2 -text "Cancel" -command {destroy .pr}
- pack .pr.b1 -in .pr.fb -side left -padx 3 -pady 3 -ipadx 5
- pack .pr.b2 -in .pr.fb -side right -padx 3 -pady 3 -ipadx 5
-
- grid .pr.hsl .pr.hss -sticky we -padx 3 -pady 3
- grid .pr.psl .pr.psc -sticky we -padx 3 -pady 3
- grid .pr.cll .pr.cle .pr.clf -sticky we -padx 3 -pady 3
- grid .pr.cf - - - -sticky w -padx 3 -pady 3
- grid .pr.fnl .pr.fne - .pr.fnb -sticky we -padx 3 -pady 3
- grid .pr.fb - - - -sticky we -padx 3 -pady 3
-
- grid columnconfigure .pr 2 -weight 1
-}
-
+ ttk::labelframe $W.lff -text "Output File" -padding 3
+ ttk::entryX $W.lff.fne -textvariable ::eskil($top,printFile) -width 30
+ ttk::button $W.lff.fnb -text "Browse" \
+ -command [list BrowsePrintFileName $top $W.lff.fne]
+ grid $W.lff.fne $W.lff.fnb -sticky we -padx 3 -pady 3
+ grid columnconfigure $W.lff 0 -weight 1
+
+ if {$::eskil($top,printFile) eq ""} {
+ set ::eskil($top,printFile) "~/eskil.pdf"
+ }
+
+ ttk::frame $W.fb
+ ttk::button $W.b1 -text "Print to File" \
+ -command "destroy $W; update; PrintDiffs $top"
+ ttk::button $W.b2 -text "Cancel" -command "destroy $W"
+ pack $W.b1 -in $W.fb -side left -padx {0 3} -pady 3 -ipadx 5
+ pack $W.b2 -in $W.fb -side right -padx {3 0} -pady 3 -ipadx 5
+
+ # Top Layout
+ grid $W.lfs -sticky we -padx 3 -pady 3
+ grid $W.cf -sticky we -padx 3 -pady 3
+ grid $W.lff -sticky we -padx 3 -pady 3
+ grid $W.fb -sticky swe -padx 3 -pady 3
+
+ grid columnconfigure $W 0 -weight 1
+ grid rowconfigure $W $W.fb -weight 1
+}
Index: src/printobj.tcl
==================================================================
--- src/printobj.tcl
+++ src/printobj.tcl
@@ -32,10 +32,11 @@
delegate option -margin to pdf
delegate option -paper to pdf
option -cpl -default 80
option -cpln -default 5
+ option -lnsp -default 1.0
option -headsize -default 8
option -headleft -default "Header Text Left"
option -headright -default "Header Text Right"
option -headnpages -default 10
option -file -default exp.pdf
@@ -52,11 +53,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 +67,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 +78,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 [expr {[$pdf getFontMetric "height"] * $options(-lnsp)}]
+ 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 +117,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
@@ -20,15 +20,15 @@
#
#----------------------------------------------------------------------
# $Revision$
#----------------------------------------------------------------------
-proc MakeRegistryFrame {w label key newvalue} {
+proc MakeRegistryFrame {W label key newvalue} {
set old {}
catch {set old [registry get $key {}]}
- set l [ttk::labelframe $w -text $label -padding 4]
+ set l [ttk::labelframe $W -text $label -padding 4]
ttk::label $l.key1 -text "Key:"
ttk::label $l.key2 -text $key
ttk::label $l.old1 -text "Old value:"
ttk::label $l.old2 -text $old
@@ -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}
@@ -45,28 +45,49 @@
#
# Get a revision of a file and place it in outfile.
# rev is in any format understood by this system, and
# should be retrieved from ParseRevs
-# eskil::rev::XXX::getPatch {revs {files {}}}
+# eskil::rev::XXX::getPatch {revs files {fileListName {}}}
#
# 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.
+# If files is non-empty it is a list of files that should be included.
+# If fileListName is given, it is a variable name where to place the
+# list of files affected by the patch. The list should be cleaned
+# through lsort -dictionary -unique.
+# 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 +97,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 +111,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
@@ -154,47 +157,30 @@
set dir [file dirname $file]
}
if {[auto_execok cleartool] != ""} {
set old [pwd]
cd $dir
- if {![catch {exec cleartool pwv -s} view] && $view != "** NONE **"} {
+ if { ! [catch {exec cleartool pwv -s} view] && $view != "** NONE **"} {
cd $old
return 1
}
cd $old
}
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 +191,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]
@@ -223,11 +268,11 @@
if {$rev != ""} {
lappend cmd -r $rev
}
lappend cmd [file nativename $filename] > $outfile
if {[catch {eval $cmd} res]} {
- if {![string match "*Checking out*" $res]} {
+ if { ! [string match "*Checking out*" $res]} {
tk_messageBox -icon error -title "CVS error" -message $res
}
}
if {$old != ""} {
@@ -234,11 +279,11 @@
cd $old
}
}
# Get a CVS patch
-proc eskil::rev::CVS::getPatch {revs {files {}}} {
+proc eskil::rev::CVS::getPatch {revs files {fileListName {}}} {
if {$::Pref(context) > 0} {
set context $::Pref(context)
} else {
set context 5
}
@@ -247,17 +292,22 @@
foreach rev $revs {
lappend cmd -r $rev
}
if {[catch {eval $cmd} res]} {
- if {![string match "*=========*" $res]} {
+ if { ! [string match "*=========*" $res]} {
tk_messageBox -icon error -title "CVS error" -message $res
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,39 +317,151 @@
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]} {
+ if { ! [string match "*Checking out*" $res]} {
tk_messageBox -icon error -title "SVN error" -message $res
}
}
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
+}
+
+# Common helper for SVN revisions
+proc eskil::rev::SVN::RevsToCmd {revs} {
+ set cmd {}
+ 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 :]
+ }
+ return $cmd
+}
# Get a SVN patch
-proc eskil::rev::SVN::getPatch {revs {files {}}} {
+proc eskil::rev::SVN::getPatch {revs files {fileListName {}}} {
set cmd [list exec svn diff]
- foreach rev $revs {
- lappend cmd -r $rev
+ lappend cmd {*}[RevsToCmd $revs]
+ set ext {}
+ if {$::Pref(context) >= 0} {
+ lappend ext --context $::Pref(context)
+ }
+ if {$::Pref(ignore) in "-w -b"} {
+ lappend ext $::Pref(ignore)
+ }
+ if {[llength $ext] > 0} {
+ lappend cmd -x $ext
}
lappend cmd {*}$files
if {[catch {eval $cmd} res]} {
tk_messageBox -icon error -title "SVN error" -message $res
return ""
}
+ if {$fileListName ne ""} {
+ upvar 1 $fileListName fileList
+ set fileList {}
+ # SVN will have lines like this to show files:
+ #Index: dir1/f11
+ foreach line [lsearch -all -inline -regexp [split $res \n] {^Index: }] {
+ if {[regexp {Index: (.*)} $line -> fn]} {
+ lappend fileList $fn
+ }
+ }
+ set fileList [lsort -dictionary -unique $fileList]
+ }
+
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]
+ lappend cmd {*}[RevsToCmd $revs]
+
+ 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]
@@ -325,22 +487,58 @@
cd $old
}
}
# Get a HG patch
-proc eskil::rev::HG::getPatch {revs {files {}}} {
- # TODO: support files
+proc eskil::rev::HG::getPatch {revs files {fileListName {}}} {
set cmd [list exec hg diff]
foreach rev $revs {
lappend cmd -r $rev
+ }
+ lappend cmd "--" {*}$files
+
+ if {[catch {eval $cmd} res]} {
+ tk_messageBox -icon error -title "HG error" -message $res
+ return ""
+ }
+ if {$fileListName ne ""} {
+ upvar 1 $fileListName fileList
+ set fileList {}
+ # HG will have lines like this to show files:
+ #diff -r 533b1d848a1c dir1/f12
+ #diff -r 0dba7b280f8f -r 2e84355cc419 f1
+ foreach line [lsearch -all -inline -regexp [split $res \n] {^diff -}] {
+ if {[regexp {diff (?:-r \w+\s+)*(.*)$} $line -> fn]} {
+ lappend fileList $fn
+ }
+ }
+ set fileList [lsort -dictionary -unique $fileList]
+ }
+
+ 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 ""
}
- return $res
+ # 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 ""
@@ -367,80 +565,76 @@
cd $old
}
}
# Get a BZR patch
-proc eskil::rev::BZR::getPatch {revs {files {}}} {
+proc eskil::rev::BZR::getPatch {revs files {fileListName {}}} {
# TODO: support files
set cmd [list exec bzr diff]
if {[llength $revs] == 2} {
lappend cmd -r [lindex $revs 0]..[lindex $revs 1]
} elseif {[llength $revs] == 1} {
lappend cmd -r [lindex $revs 0]
}
if {[catch {eval $cmd} res]} {
- if {![string match "*===*" $res]} {
+ if { ! [string match "*===*" $res]} {
tk_messageBox -icon error -title "BZR error" -message $res
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}
}
# Get a RCS patch
-proc eskil::rev::RCS::getPatch {revs {files {}}} {
+proc eskil::rev::RCS::getPatch {revs files {fileListName {}}} {
+ # 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 {}}} {
+proc eskil::rev::GIT::getPatch {revs files {fileListName {}}} {
set cmd [list exec git diff -p]
+ if {$::Pref(context) >= 0} {
+ lappend cmd -U$::Pref(context)
+ }
+ if {$::Pref(ignore) in "-w -b"} {
+ lappend cmd $::Pref(ignore)
+ }
if {[llength $revs] == 0} {
# Always default to HEAD to see changes regardless of index
lappend cmd HEAD
} else {
foreach rev $revs {
@@ -451,64 +645,127 @@
if {[catch {eval $cmd} res]} {
tk_messageBox -icon error -title "GIT error" -message $res
return ""
}
+ if {$fileListName ne ""} {
+ upvar 1 $fileListName fileList
+ set fileList {}
+ # GIT will have lines like this to show files:
+ #diff --git a/dir1/f12 b/dir1/f12
+ foreach line [lsearch -all -inline -regexp [split $res \n] {^diff -}] {
+ if {[regexp { a/(.*) b/} $line -> fn]} {
+ lappend fileList $fn
+ }
+ }
+ set fileList [lsort -dictionary -unique $fileList]
+ }
+
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 {}}} {
+proc eskil::rev::FOSSIL::getPatch {revs files {fileListName {}}} {
set cmd [list exec fossil diff]
if {[llength $revs] >= 1} {
lappend cmd --from [lindex $revs 0]
}
if {[llength $revs] >= 2} {
lappend cmd --to [lindex $revs 1]
}
- if {[llength $files] > 0} {
- # 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]} {
- tk_messageBox -icon error -title "FOSSIL error" -message $fres
- return ""
- }
- append res $fres
- }
- } else {
- if {[catch {eval $cmd} res]} {
- tk_messageBox -icon error -title "FOSSIL error" -message $res
- return ""
- }
+ # Include added files contents
+ lappend cmd -N
+
+ if {$::Pref(context) >= 0} {
+ lappend cmd --context $::Pref(context)
+ }
+ if {$::Pref(ignore) in "-w -b"} {
+ lappend cmd -w
+ }
+
+ lappend cmd {*}$files
+
+ if {[catch {eval $cmd} res]} {
+ tk_messageBox -icon error -title "FOSSIL error" -message $res
+ return ""
+ }
+ if {$fileListName ne ""} {
+ upvar 1 $fileListName fileList
+ set fileList {}
+ # FOSSIL will have lines like this to show files:
+ #Index: dir1/f11
+ foreach line [lsearch -all -inline -regexp [split $res \n] {^Index: }] {
+ if {[regexp {Index: (.*)} $line -> fn]} {
+ lappend fileList $fn
+ }
+ }
+ set fileList [lsort -dictionary -unique $fileList]
}
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]} {
@@ -516,11 +773,16 @@
return
}
}
# Get a CT patch
-proc eskil::rev::CT::getPatch {revs {files {}}} {
+proc eskil::rev::CT::getPatch {revs files {fileListName {}}} {
+ # Not supported yet
+ return ""
+}
+
+proc eskil::rev::CT::getChangedFiles {dir revs} {
# Not supported yet
return ""
}
# Get a P4 revision
@@ -545,11 +807,11 @@
set cmd [list exec cvs -n status [file nativename $filename]]
if {[catch {eval $cmd} res]} {
# What to do here?
set rev "1.1"
} else {
- if {![regexp {Working revision:\s+(\d\S*)} $res -> rev]} {
+ if { ! [regexp {Working revision:\s+(\d\S*)} $res -> rev]} {
set rev "1.1"
}
}
if {$old != ""} {
@@ -557,11 +819,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 +836,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]} {
+ 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 +876,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 +1002,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 +1098,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]
+ }
+ }
+ if {$Url ne ""} {
+ if {$rev ne ""} {
+ append Url @$rev
}
+ lappend result $Url
+ } else {
+ lappend result $rev
}
- lappend result $rev
}
return $result
}
# Figure out ClearCase revision from arguments
@@ -737,11 +1220,11 @@
return [exec cleartool describe -fmt %PSn $filename]
}
set rev [file dirname $rev]
}
# If the argument is of the form "name/rev", look for a fitting one
- if {![string is integer $rev] && [regexp {^[^/.]+(/\d+)?$} $rev]} {
+ if { ! [string is integer $rev] && [regexp {^[^/.]+(/\d+)?$} $rev]} {
if {[catch {exec cleartool lshistory -short $filename} allrevs]} {#
tk_messageBox -icon error -title "Cleartool error" \
-message $allrevs
return
}
@@ -752,12 +1235,12 @@
set rev [lindex [split [lindex $allrevs $i] "@"] end]
}
}
set rev [file normalize [file join $stream $rev]]
# If we don't have a version number, try to find the latest
- if {![string is integer [file tail $rev]]} {
- if {![info exists allrevs]} {
+ if { ! [string is integer [file tail $rev]]} {
+ if { ! [info exists allrevs]} {
if {[catch {exec cleartool lshistory -short $filename} allrevs]} {#
tk_messageBox -icon error -title "Cleartool error" \
-message $allrevs
return
}
@@ -806,15 +1289,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 +1303,46 @@
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}
+ }
+ # Any explict dirs mentioned should not recurse.
+ set precmd [list svn -q commit --depth=empty -m]
+ set postcmd $args
+ CommitDialog $top $target SVN "" $precmd $postcmd
+}
+
+# Does anything else needs to be committed with this file?
+# Typically that would be added directories in SVN.
+proc eskil::rev::SVN::commitFileDependency {filename} {
+ set dir [file dirname $filename]
+ set result {}
+ while {$dir ni {. /}} {
+ set s [exec svn status --depth=empty $dir]
+ if {[string match "A*" $s]} {
+ lappend result $dir
+ } else {
+ break
+ }
+ set dir [file dirname $dir]
+ }
+ return $result
+}
+
+# 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 +1349,23 @@
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]
+ }
+ GetTopDir [pwd] topdir _
+ set postcmd $args
+ set gitmsg [CommitDialog $top $target GIT $topdir $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 +1373,135 @@
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 -no-prompt -m]
+ set postcmd $args
+ GetTopDir [pwd] topdir _
+ # Files to commit might be relative to topdir, take care of that.
+ # This can happen with -review in a subdir.
+ set usetopdir ""
+ foreach f $args {
+ if { ! [file exists $f]} {
+ if {[file exists [file join $topdir $f]]} {
+ set usetopdir $topdir
+ }
+ }
+ }
+ CommitDialog $top $target Fossil $usetopdir $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]
@@ -891,19 +1529,61 @@
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
+}
+
+proc eskil::rev::FOSSIL::viewLog {top filename revs} {
+ set cmd [list exec fossil timeline]
+ foreach rev $revs {
+ lappend cmd after $rev
+ # Only support for one at this point.
+ break
+ }
+ lappend cmd --limit 0 --path $filename
+ if {[catch {eval $cmd} result]} {
+ #return
+ }
+ ViewLog $top $filename $result
+}
proc eskil::rev::CT::current {filename} {
# Figure out stream and current version
if {[catch {exec cleartool ls $filename} info]} {
tk_messageBox -icon error -title "Cleartool error" -message $info
return
}
set currV {}
- if {![regexp {@@(\S+)\s+from (\S+)\s+Rule} $info -> dummy currV]} {
+ if { ! [regexp {@@(\S+)\s+from (\S+)\s+Rule} $info -> dummy currV]} {
regexp {@@(\S+)} $info -> currV
}
set stream [file dirname $currV]
set latest [file tail $currV]
return [list $stream $latest]
@@ -917,17 +1597,17 @@
# Returns name of rev system if detected, or "" if none.
proc detectRevSystem {file {preference GIT}} {
variable eskil::rev::cache
if {$file ne ""} {
- if {![file exists $file]} { return "" }
+ if { ! [file exists $file]} { return "" }
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 +1621,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 +1669,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 +1709,68 @@
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"} {
+ if {[llength $::eskil($top,patchFilelist)] != 0} {
+ # Use the list extracted from patch
+ set files $::eskil($top,patchFilelist)
+ } else {
+ # Use the list given by user
+ 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 +1779,63 @@
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]
+ set fileList {}
+ set patch [eskil::rev::${type}::getPatch $revs $files fileList]
+ set ::eskil($top,patchFilelist) $fileList
+ return $patch
}
##############################################################################
# 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 +1844,133 @@
} else {
return [file join $penultimate $last]
}
}
-# Dialog for log message
-proc LogDialog {top target {clean 0}} {
+# Dialog for commit, getting log message
+# target: String shown in dialog
+# system: Rev System
+# topdir: Directory to execute commit in, if given.
+# precmd: Command part before message
+# postcmd: Command part after message. Assumed to be files.
+# useSts: Use status from exec rather than message to recognise error.
+proc CommitDialog {top target system topdir 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
+
+ if {[llength $postcmd] > 1} {
+ # TODO: Scrolled frame maybe? Is dynamic grid enough?
+ ttk::frame $w.f -padding 1
+ grid $w.f - -sticky news -padx 3 -pady 3
+
+ set t 0
+ foreach fileName $postcmd {
+ set ::eskil($top,commit,fileselect$t) 1
+ ttk::checkbutton $w.f.cb$t -text $fileName \
+ -variable ::eskil($top,commit,fileselect$t)
+ incr t
+ }
+ dynGridManage $w.f
+ }
+
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
+
+ set todo $postcmd
+ if {[llength $postcmd] > 1} {
+ # Look through checkbuttons
+ set todo {}
+ set t 0
+ foreach fileName $postcmd {
+ if {$::eskil($top,commit,fileselect$t)} {
+ lappend todo $fileName
+ }
+ incr t
+ }
+ # None left means ignore.
+ if {[llength $todo] == 0} {
+ return
+ }
+ }
+
+ if {[info commands eskil::rev::${system}::commitFileDependency] ne ""} {
+ foreach filename $todo {
+ lappend todo {*}[eskil::rev::${system}::commitFileDependency $filename]
+ }
+ }
+
+ # 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 {*}$todo]
+ if {$topdir ne ""} {
+ set sts [catch {execDir $topdir {*}$cmd} msg]
+ } else {
+ 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 +1977,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,1382 @@
+#!/bin/sh
+#---------------------------------------------------------- -*- tcl -*-
+#
+# Eskil, a Graphical frontend to diff
+#
+# Copyright (c) 1998-2015, Peter Spjuth (peter.spjuth@gmail.com)
+#
+# Usage
+# Do 'eskil' for interactive mode
+# Do 'eskil --help' for command line usage
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; see the file COPYING. If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+# Boston, MA 02111-1307, USA.
+#
+#----------------------------------------------------------------------
+# the next line restarts using tclsh \
+exec tclsh "$0" "$@"
+
+package require Tcl 8.6-
+
+# Stop Tk from meddling with the command line by copying it first.
+set ::eskil(argv) $::argv
+set ::eskil(argc) $::argc
+set ::argv {}
+set ::argc 0
+
+set ::eskil(debug) 0
+
+namespace import tcl::mathop::+
+namespace import tcl::mathop::-
+namespace import tcl::mathop::*
+namespace import tcl::mathop::/
+
+# Do initalisations for needed packages and globals.
+# This is not run until needed to speed up command line error reporting.
+proc Init {} {
+ if {[info exists ::eskil(initHasRun)]} {
+ return
+ }
+ set ::eskil(initHasRun) 1
+
+ package require Tk 8.6-
+ catch {package require textSearch}
+ package require wcb
+ package require snit
+ package require tablelist_tile
+ package require psmenu
+ package require psdebug
+ namespace import ::_PsDebug::*
+
+ if {[catch {package require psballoon}]} {
+ # Add a dummy if it does not exist.
+ proc addBalloon {args} {}
+ } else {
+ namespace import -force psballoon::addBalloon
+ }
+
+ if {[file exists $::eskil(thisDir)/../version.txt]} {
+ set ch [open $::eskil(thisDir)/../version.txt]
+ set ::eskil(diffver) [string trim [read $ch 100]]
+ close $ch
+ }
+
+ # Get all other source files
+ InitReSource
+
+ # Diff functionality is in the DiffUtil package.
+ package require DiffUtil 0.4
+ # Help DiffUtil to find a diff executable, if needed
+ catch {DiffUtil::LocateDiffExe $::eskil(thisScript)}
+
+ # Create font for PDF
+ if {$::Pref(printFont) eq ""} {
+ set fontfile $::eskil(thisDir)/embedfont.ttf
+ } else {
+ set fontfile $::Pref(printFont)
+ }
+ # Allow fallback to PDF-builtin Courier
+ if {$fontfile eq "Courier"} {
+ set ::eskil(printFont) Courier
+ } else {
+ set ext [file extension $fontfile]
+ if {$ext eq ".afm"} {
+ pdf4tcl::loadBaseType1Font EskilBase $fontfile \
+ [file rootname $fontfile].pfb
+ } else {
+ pdf4tcl::loadBaseTrueTypeFont EskilBase $fontfile 1
+ }
+
+ pdf4tcl::createFont EskilBase EskilFont cp1252
+ set ::eskil(printFont) EskilFont
+ }
+
+ # Figure out a place to store temporary files.
+ locateTmp ::eskil(tmpdir)
+
+ if {$::tcl_platform(platform) eq "windows"} {
+ # Locate CVS if it is in c:/bin
+ if {[auto_execok cvs] eq "" && [file exists "c:/bin/cvs.exe"]} {
+ set ::env(PATH) "$::env(PATH);c:\\bin"
+ auto_reset
+ }
+ }
+ defaultGuiOptions
+ if {0 && [bind all ] 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.
+ # Fixed 2013-06-05, bug 3613750. 8.5.16 and 8.6.2.
+ method xview {args} {
+ if {[llength $args] == 1} {
+ set ix [lindex $args 0]
+ $hull xview [$hull index $ix]
+ } else {
+ $hull xview {*}$args
+ }
+ }
+ }
+
+ interp alias {} toplevel {} ttk::toplevel
+
+ # Use demo images from Tablelist
+ set dir $::eskil(thisDir)/../lib/tablelist/demos
+ if {[catch {
+ set ::img(clsd) [image create photo -file [file join $dir clsdFolder.gif]]
+ set ::img(open) [image create photo -file [file join $dir openFolder.gif]]
+ set ::img(file) [image create photo -file [file join $dir file.gif]]
+ }]} then {
+ set ::img(clsd) ""
+ set ::img(open) ""
+ set ::img(file) ""
+ }
+ # Local images
+ set dir $::eskil(thisDir)/images
+ set ::img(link) [image create photo -file [file join $dir link.gif]]
+ set ::img(left) [image create photo -file [file join $dir arrow_left.gif]]
+ set ::img(right) [image create photo -file [file join $dir arrow_right.gif]]
+ set ::img(browse) [image create photo -file [file join $dir folderopen1.gif]]
+ set ::img(up) [image create photo -file [file join $dir arrow_up.gif]]
+ # Create a double up arrow
+ set ih [image height $::img(up)]
+ set iw [image width $::img(up)]
+ set ::img(upup) [image create photo -height $ih -width [expr {2 * $iw}]]
+ $::img(upup) copy $::img(up) -to 0 0 [expr {2 * $iw - 1}] [expr {$ih - 1}]
+
+ EskilThemeInit
+}
+
+# Load sources needed early, during command line handling
+proc InitSourceEarly {{srcdir {}}} {
+ if {$srcdir eq ""} {
+ set srcdir $::eskil(thisDir)
+ }
+ source $srcdir/preprocess.tcl
+}
+
+proc InitReSource {{srcdir {}}} {
+ if {$srcdir eq ""} {
+ set srcdir $::eskil(thisDir)
+ }
+
+ InitSourceEarly $srcdir
+ # Get all other source files
+ source $srcdir/eskil.tcl
+ source $srcdir/clip.tcl
+ source $srcdir/compare.tcl
+ source $srcdir/map.tcl
+ source $srcdir/merge.tcl
+ source $srcdir/registry.tcl
+ source $srcdir/dirdiff.tcl
+ source $srcdir/fourway.tcl
+ source $srcdir/help.tcl
+ source $srcdir/plugin.tcl
+ source $srcdir/printobj.tcl
+ source $srcdir/print.tcl
+ source $srcdir/rev.tcl
+
+ # Only load vcsvfs if vfs is present
+ if { ! [catch {package require vfs}]} {
+ source $srcdir/vcsvfs.tcl
+ }
+}
+
+# Debug function to be able to reread the source even when wrapped in a kit.
+proc EskilRereadSource {} {
+ set this $::eskil(thisScript)
+
+ # FIXA: Better detection of starkit?
+ # Maybe look at ::starkit::topdir ?
+
+ #if {[info exists ::starkit::topdir]} {
+ # puts "Topdir: $::starkit::topdir"
+ #}
+
+ # Are we in a Starkit?
+ if {[regexp {^(.*eskil)((?:\.[^/]+)?)(/src/.*)$} $this -> \
+ pre ext post]} {
+ if {$ext ne ".vfs"} {
+ # If the unpacked vfs directory is available, read from that
+ # instead.
+ set src $pre.vfs$post
+ if {[file readable $src]} {
+ set this $src
+ }
+ }
+ }
+ puts "Resourcing $this"
+ uplevel \#0 [list source $this]
+ # Get all other source files
+ InitReSource [file dirname $this]
+}
+
+# Initialize Ttk style settings
+proc EskilThemeInit {} {
+ # Import the 'default' theme border element.
+ catch { ttk::style element create plain.border from default }
+ catch { ttk::style element create plain.padding from default }
+ catch { ttk::style element create plain.label from default }
+
+ # Create a new style using the imported element.
+ ttk::style layout My.Toolbutton {
+ My.Toolbutton.plain.border -sticky nswe -children {
+ My.Toolbutton.padding -sticky nswe -children {
+ My.Toolbutton.label -sticky nswe
+ }
+ }
+ }
+ # Configure our new style.
+ ttk::style configure My.Toolbutton {*}[ttk::style configure Toolbutton] \
+ -padding {1 1}
+ ttk::style map My.Toolbutton {*}[ttk::style map Toolbutton] \
+ -relief {disabled flat selected sunken pressed sunken active raised}
+ # Re-do if the user changes theme.
+ if {[lsearch -exact [bind . <>] 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 {} {
+ set usageStr {Usage: eskil [options] [files...]
+ [options] See below.
+ [files...] Files to be compared
+ %v%
+ If no files are given, the program is started anyway and you can select
+ files from within. If only one file is given, the program looks for version
+ control of the file, and if found, runs in version control mode.
+ If directories are given, Eskil starts in directory diff.
+
+ To list all options matching a prefix, run 'eskil --query prefix'.
+ In tcsh use this line to get option completion:
+ complete eskil 'C/-/`eskil --query -`/'
+
+ Options:}
+
+ set versionStr ""
+ if {[file exists $::eskil(thisDir)/../version.txt]} {
+ set ch [open $::eskil(thisDir)/../version.txt]
+ set versionStr [string trim [read $ch 100]]
+ close $ch
+ set versionStr "$versionStr\n"
+ }
+
+ set usageStr [string map [list "%v%" $versionStr] $usageStr]
+ puts $usageStr
+
+ # Dump option info
+ foreach name [lsort -dictionary [dict keys $::eskil(opts,info)]] {
+ set outName $name
+ if { ! [dict exists $::eskil(opts,info) $name flag]} {
+ puts "Internal Error: BOHOHOHO $name"
+ break
+ }
+ if { ! [dict get $::eskil(opts,info) $name flag]} {
+ set valueName v
+ # Detect a reference in short description
+ set short [dict get $::eskil(opts,info) $name shortdescr]
+ if {[regexp {<(.*?)>} $short -> var] } {
+ set valueName $var
+ }
+ append outName " <$valueName>"
+ }
+ # Line up shorter ones
+ if {[string length $outName] < 12} {
+ set outName [format %-12s $outName]
+ }
+ set outName "$outName : "
+ set indent [string length $outName]
+ set len [expr {80 - $indent}]
+ set d [dict get $::eskil(opts,info) $name shortdescr]
+ if {$d eq "_"} continue
+ while {$d ne ""} {
+ if {[string length $d] <= $len} {
+ set chunk $d
+ set d ""
+ } else {
+ set ci $len
+ while {[string index $d $ci] ne " " && $ci > 40} {
+ incr ci -1
+ }
+ set chunk [string range $d 0 $ci-1]
+ set d [string trim [string range $d $ci end]]
+ }
+ puts "$outName$chunk"
+ set outName [format %*s $indent ""]
+ }
+ }
+ # Dump any plugin that has options defined
+ foreach {plugin _} $::eskil(opts,src) {
+ puts ""
+ printPlugin $plugin 1
+ }
+}
+
+#####################################
+# Option/flag handling helpers
+#####################################
+# Validators
+proc optValidatePdfColor {opt arg} {
+ set fail 0
+ if { ! [string is list $arg] || [llength $arg] != 3} {
+ set fail 1
+ } else {
+ foreach val $arg {
+ if { ! [string is double -strict $val] || $val < 0.0 || $val > 1.0} {
+ set fail 1
+ }
+ }
+ }
+ if {$fail} {
+ puts "Argument $opt must be a list of RBG values from 0.0 to 1.0"
+ exit
+ }
+}
+proc optValidatePositive {opt arg} {
+ if { ! [string is double -strict $arg] || $arg <= 0} {
+ puts "Argument $opt must be a positive number"
+ exit
+ }
+}
+proc optValidateNatural {opt arg} {
+ if { ! [string is integer -strict $arg] || $arg < 0} {
+ puts "Argument $opt must be a natural number"
+ exit
+ }
+}
+proc optValidatePaper {opt arg} {
+ package require pdf4tcl
+ if {[llength [pdf4tcl::getPaperSize $arg]] != 2} {
+ puts "Argument $opt must be a valid paper size"
+ puts "Valid paper sizes:"
+ puts [join [lsort -dictionary [pdf4tcl::getPaperSizeList]] \n]
+ exit
+ }
+}
+proc optValidatePlugin {opt arg} {
+ # We must start up completely to check a plugin
+ Init
+ set res [LocatePlugin $arg]
+ set src [dict get $res file]
+ if {$src eq ""} {
+ puts "Bad plugin: $arg"
+ printPlugins
+ exit
+ }
+ # Look for declarations of command line options
+ foreach {name flag doc} [dict get $res opts] {
+ if {$flag} {
+ addFlags $name
+ } else {
+ addOpt $name
+ }
+ docFlag $name "Plugin $arg : $doc"
+ addSource $name $arg
+ }
+ # Special:
+ # If a -plugin is given and plugininfo and pluginallow is not
+ # balanced, extend them.
+ set n [llength [dict get $::eskil(opts) -plugin]]
+ # Validator is called after this -plugin was added.
+ incr n -1
+ while {[llength [dict get $::eskil(opts) -plugininfo]] < $n} {
+ dict lappend ::eskil(opts) -plugininfo ""
+ }
+ while {[llength [dict get $::eskil(opts) -pluginallow]] < $n} {
+ dict lappend ::eskil(opts) -pluginallow 0
+ }
+}
+
+# Option database setup
+proc initOpts {} {
+ set ::eskil(opts) {}
+ set ::eskil(opts,info) {}
+ set ::eskil(opts,src) {}
+ set ::eskil(defoptinfo) {
+ flag 0
+ given 0
+ multi 0
+ type ""
+ validator ""
+ filter ""
+ sideeffect ""
+ shortdescr ""
+ longdescr ""
+ source ""
+ }
+}
+# Add a command line flag that do not take a value
+proc addFlags {args} {
+ foreach name $args {
+ dict set ::eskil(opts) $name 0
+ dict set ::eskil(opts,info) $name $::eskil(defoptinfo)
+ dict set ::eskil(opts,info) $name flag 1
+ }
+}
+# Add a command line flag that do not take a value, but can be given multiple
+proc addMultFlags {args} {
+ foreach name $args {
+ dict set ::eskil(opts) $name {}
+ dict set ::eskil(opts,info) $name $::eskil(defoptinfo)
+ dict set ::eskil(opts,info) $name flag 1
+ dict set ::eskil(opts,info) $name multi 1
+ }
+}
+# Document a flag or option
+proc docFlag {name short {long {}}} {
+ dict set ::eskil(opts,info) $name shortdescr $short
+ dict set ::eskil(opts,info) $name longdescr $long
+}
+
+# Flag that affects Pref
+proc addPrefFlag {name elem {value 1}} {
+ dict set ::eskil(opts) $name 0
+ dict set ::eskil(opts,info) $name $::eskil(defoptinfo)
+ dict set ::eskil(opts,info) $name flag 1
+ dict set ::eskil(opts,info) $name type Pref
+ dict set ::eskil(opts,info) $name "elem" $elem
+ dict set ::eskil(opts,info) $name "value" $value
+}
+# Flag that affects local opts
+proc addOptsFlag {name elem {value 1}} {
+ dict set ::eskil(opts) $name 0
+ dict set ::eskil(opts,info) $name $::eskil(defoptinfo)
+ dict set ::eskil(opts,info) $name flag 1
+ dict set ::eskil(opts,info) $name type Opts
+ dict set ::eskil(opts,info) $name "elem" $elem
+ dict set ::eskil(opts,info) $name "value" $value
+}
+# Add a command line option that takes a value
+proc addOpt {name {def ""}} {
+ dict set ::eskil(opts) $name $def
+ dict set ::eskil(opts,info) $name $::eskil(defoptinfo)
+}
+# Add a command line option that takes a value and stores in Pref
+proc addPrefOpt {name elem {validator ""}} {
+ dict set ::eskil(opts) $name ""
+ dict set ::eskil(opts,info) $name $::eskil(defoptinfo)
+ dict set ::eskil(opts,info) $name type Pref
+ dict set ::eskil(opts,info) $name "elem" $elem
+ dict set ::eskil(opts,info) $name "validator" $validator
+}
+# Add a command line option that takes multiple values and stores in Pref
+proc addPrefMultOpt {name elem {validator ""}} {
+ dict set ::eskil(opts) $name ""
+ dict set ::eskil(opts,info) $name $::eskil(defoptinfo)
+ dict set ::eskil(opts,info) $name type Pref
+ dict set ::eskil(opts,info) $name "elem" $elem
+ dict set ::eskil(opts,info) $name "validator" $validator
+ dict set ::eskil(opts,info) $name multi 1
+}
+# Add a vaildator command to an Opt
+proc addValidator {name cmd} {
+ dict set ::eskil(opts,info) $name validator $cmd
+}
+# Add a filter command prefix to an Opt
+proc addFilter {name cmd} {
+ dict set ::eskil(opts,info) $name filter $cmd
+}
+# Add a source reference to an Opt
+proc addSource {name src} {
+ # Remember them if needed for -help
+ dict set ::eskil(opts,src) $src 1
+ # This points to the plugin the Opt belongs to.
+ dict set ::eskil(opts,info) $name source $src
+}
+# Add a sideeffect to an Opt
+##nagelfar syntax addSideEffect x c
+proc addSideEffect {name script} {
+ dict set ::eskil(opts,info) $name sideeffect $script
+}
+# Add a command line option that takes a value and stores in local opts
+proc addOptsOpt {name elem {validator ""}} {
+ dict set ::eskil(opts) $name ""
+ dict set ::eskil(opts,info) $name $::eskil(defoptinfo)
+ dict set ::eskil(opts,info) $name type Opts
+ dict set ::eskil(opts,info) $name "elem" $elem
+ dict set ::eskil(opts,info) $name "validator" $validator
+}
+# Add a command line option that takes multiple values
+proc addMultOpt {name} {
+ dict set ::eskil(opts) $name {}
+ dict set ::eskil(opts,info) $name $::eskil(defoptinfo)
+ dict set ::eskil(opts,info) $name multi 1
+}
+# List all known options
+proc allOpts {{pat *}} {
+ return [dict keys $::eskil(opts) $pat]
+}
+proc optIsFlag {arg} {
+ return [dict get $::eskil(opts,info) $arg flag]
+}
+proc optIsGiven {arg valName} {
+ upvar 1 $valName val
+ set val [dict get $::eskil(opts) $arg]
+ return [dict get $::eskil(opts,info) $arg given]
+}
+proc optSet {arg val} {
+ if {[dict get $::eskil(opts,info) $arg multi]} {
+ dict lappend ::eskil(opts) $arg $val
+ } else {
+ dict set ::eskil(opts) $arg $val
+ }
+ # If it is a flag, the value can come from the settings
+ if {[dict exists $::eskil(opts,info) $arg value]} {
+ set val [dict get $::eskil(opts,info) $arg value]
+ }
+ # Any validator?
+ set cmd [dict get $::eskil(opts,info) $arg validator]
+ if {$cmd ne ""} {
+ # The validator will exit if it fails
+ $cmd $arg $val
+ }
+ # Any filter?
+ set cmd [dict get $::eskil(opts,info) $arg filter]
+ if {$cmd ne ""} {
+ set val [{*}$cmd $val]
+ }
+ # Any side effect?
+ set cmd [dict get $::eskil(opts,info) $arg sideeffect]
+ if {$cmd ne ""} {
+ uplevel 1 $cmd
+ }
+
+ set type [dict get $::eskil(opts,info) $arg type]
+ switch $type {
+ Pref {
+ if {[dict get $::eskil(opts,info) $arg multi]} {
+ lappend ::Pref([dict get $::eskil(opts,info) $arg elem]) $val
+ } else {
+ set ::Pref([dict get $::eskil(opts,info) $arg elem]) $val
+ }
+ }
+ Opts {
+ # Does not support multi yet
+ upvar 1 opts _xx
+ set _xx([dict get $::eskil(opts,info) $arg elem]) $val
+ }
+ }
+ dict set ::eskil(opts,info) $arg given 1
+}
+proc optGet {arg} {
+ return [dict get $::eskil(opts) $arg]
+}
+
+# Helper to add a file argument to list of files
+proc cmdLineAddFile {filesName arg} {
+ upvar 1 $filesName files
+ set apa [file normalize [file join [pwd] $arg]]
+ if { ! [file exists $apa]} {
+ if {[string length $arg] <= 2 && [string match *M* $arg]} {
+ puts "Ignoring argument: $arg"
+ } else {
+ puts "Bad argument: $arg"
+ exit
+ }
+ } else {
+ lappend files $apa
+ }
+}
+
+# Go through all command line arguments and start the appropriate
+# diff window.
+# Returns the created toplevel.
+# This can be used as an entry point if embedding eskil.
+# In that case fill in ::eskil(argv) and ::eskil(argc) before calling.
+proc parseCommandLine {} {
+ global dirdiff
+
+ set ::eskil(autoclose) 0
+ set ::eskil(ignorenewline) 0
+ set ::eskil(defaultopts) {}
+
+ if {$::eskil(argc) == 0} {
+ Init
+ return [makeDiffWin]
+ }
+
+ # Set up all options info
+ initOpts
+ addFlags --help -help
+
+ addPrefFlag -w ignore -w
+ addPrefFlag -b ignore -b
+ addPrefFlag -noignore ignore " "
+ docFlag -w "Ignore all spaces"
+ docFlag -b "Ignore space changes (default)"
+ docFlag -noignore "Don't ignore any whitespace"
+ addPrefFlag -noparse parse 0
+ addPrefFlag -line parse 1
+ addPrefFlag -smallblock parse 2
+ addPrefFlag -block parse 3
+ docFlag -noparse "No block analysis"
+ docFlag -line "Line based block analysis"
+ docFlag -smallblock "Do block analysis on small blocks (default)"
+ docFlag -block "Full block analysis. This can be slow if there are large change blocks"
+
+ addPrefFlag -char lineparsewords 0
+ addPrefFlag -word lineparsewords 1
+ docFlag -char "Character based change view (default)"
+ docFlag -word "Word based change view"
+ addPrefFlag -i nocase
+ addPrefFlag -nocase nocase
+ docFlag -i "Ignore case changes"
+ docFlag -nocase "Ignore case changes"
+ addPrefFlag -nodigit nodigit
+ docFlag -nodigit "Ignore digit changes"
+ addPrefFlag -nokeyword dir,ignorekey
+ docFlag -nokeyword "In directory diff, ignore \$ Keywords: \$"
+ addPrefFlag -noempty noempty
+ docFlag -noempty "Ignore empty lines initially for matching"
+ addPrefFlag -fine finegrainchunks
+ docFlag -fine "Use fine grained chunks. Useful for merging"
+ addOptsFlag -table view table
+ docFlag -table "Run in table mode"
+ addOptsFlag -conflict mode conflict
+ docFlag -conflict "Treat file as a merge conflict file and enter merge mode"
+ # Conflict implies foreach
+ addSideEffect -conflict {
+ optSet -foreach 1
+ }
+ addFlags -dir -clip -fourway -patch -review -
+ docFlag -dir "Start in directory diff mode. Ignores other args"
+ docFlag -clip "Start in clip diff mode. Ignores other args"
+ docFlag -fourway "Start in fourway diff mode. Ignores other args"
+ docFlag -patch "View patch file"
+ docFlag - "Read patch file from standard input, to allow pipes"
+ docFlag -review "View revision control tree as a patch"
+ addSideEffect -review {
+ optSet -noignore 1
+ }
+ addFlags -browse -nodiff
+ docFlag -browse "Bring up file dialog for missing files after starting"
+ docFlag -nodiff "Do not run diff after startup"
+ addFlags -server -cvs -svn -debug
+ docFlag -server "Set up Eskil to be controllable from the outside"
+ docFlag -cvs "Detect CVS first, if multiple version systems are used"
+ docFlag -svn "Detect SVN first, if multiple version systems are used"
+ docFlag -debug "Start in debug mode"
+ addFlags -foreach -close
+ docFlag -foreach "Open one diff window per file listed"
+ docFlag -close "Close any window with no changes"
+ addFlags -nonewline -nonewline+ -nocdiff
+ docFlag -nonewline "Try to ignore newline changes"
+ docFlag -nonewline+ "Try to ignore newline changes, and don't display"
+ docFlag -nocdiff "Disable C version of DiffUtil. For debug"
+ addFlags -pluginlist
+ addMultFlags -pluginallow
+ docFlag -pluginlist "List known plugins"
+ docFlag -pluginallow "Allow full access privilege for plugin"
+ # Options that take values
+ addMultOpt -plugin
+ docFlag -plugin "Preprocess files using plugin"
+ addValidator -plugin optValidatePlugin
+ addMultOpt -plugininfo
+ docFlag -plugininfo "Pass info to plugin (plugin specific)"
+ addOpt -plugindump
+ docFlag -plugindump "Dump plugin source to stdout"
+ # These options affect Pref
+ addPrefOpt -pivot pivot optValidatePositive
+ docFlag -pivot "Pivot setting for diff algorithm (10)"
+ addPrefOpt -context context optValidateNatural
+ docFlag -context "Show only differences, with lines of context"
+ addPrefOpt -printHeaderSize printHeaderSize optValidatePositive
+ addPrefOpt -printLineSpace printLineSpace optValidatePositive
+ addPrefOpt -printCharsPerLine printCharsPerLine optValidatePositive
+ addPrefOpt -printPaper printPaper optValidatePaper
+ addPrefOpt -printColorChange printColorChange optValidatePdfColor
+ addPrefOpt -printColorOld printColorOld optValidatePdfColor
+ addPrefOpt -printColorNew printColorNew optValidatePdfColor
+ addPrefOpt -printFont printFont
+ docFlag -printHeaderSize "Font size for page header (10)"
+ docFlag -printLineSpace "Line spacing (1.0)"
+ docFlag -printCharsPerLine "Adapt font size for this line length and wrap (80)"
+ docFlag -printPaper "Select paper size (a4)"
+ docFlag -printColorChange "Color for change (1.0 0.7 0.7)"
+ docFlag -printColorOld "Color for old text (0.7 1.0 0.7)"
+ docFlag -printColorNew "Color for new text (0.8 0.8 1.0)"
+ docFlag -printFont "Select font to use in PDF, afm or ttf. If is given as \"Courier\", PDF built in font is used"
+ addPrefMultOpt -excludedir dir,exdirs
+ docFlag -excludedir "Exclude from directory diff"
+ addPrefMultOpt -excludefile dir,exfiles
+ docFlag -excludefile "Exclude from directory diff"
+ addPrefMultOpt -includedir dir,incdirs
+ docFlag -includedir "Include in directory diff"
+ addPrefMultOpt -includefile dir,incfiles
+ docFlag -includefile "Include in directory diff"
+ # These affect Pref but via special processing later
+ addMultOpt -prefix
+ docFlag -prefix "Care mainly about words starting with "
+ addMultOpt -subst
+ docFlag -subst "The is a list of Left+Right, used for subst preprocessing"
+ addMultOpt -preprocess
+ addMultOpt -preprocessleft
+ addMultOpt -preprocessright
+ docFlag -preprocess "The is a list of RE+Subst applied to each line before compare"
+ docFlag -preprocessleft "Use only on left side"
+ docFlag -preprocessright "Use only on right side"
+ # 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 "
+ addFilter -o [list file join [pwd]]
+ addOptsOpt -a ancestorFile
+ docFlag -a "Give ancestor 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 foreachOpt [optGet -foreach]
+ set preferedRev "GIT"
+ if {[optGet -svn]} {
+ set preferedRev "SVN"
+ } elseif {[optGet -cvs]} {
+ set preferedRev "CVS"
+ }
+
+ # These directly correspond to ::eskil settings
+ set apa {
+ -nonewline ignorenewline 1
+ -nonewline+ ignorenewline 2
+ -close autoclose 1
+ -debug debug 1
+ }
+ foreach {opt elem val} $apa {
+ if {[optIsGiven $opt arg]} {
+ set ::eskil($elem) $val
+ }
+ }
+
+ # Options that need individual checking/processing
+ if {[optIsGiven -prefix arg]} {
+ foreach apa $arg {
+ set RE [string map [list % $apa] {^.*?\m(%\w+).*$}]
+ if {$::Pref(nocase)} {
+ set RE "(?i)$RE"
+ }
+ addPreprocess prefix $RE {\1} ""
+ }
+ }
+ if {[optIsGiven -subst arg]} {
+ # FIXA: better validity check
+ foreach apa $arg {
+ foreach {left right} $apa {
+ if {$::Pref(nocase)} {
+ set left "(?i)$left"
+ set right "(?i)$right"
+ }
+ addPreprocess subst $left $right Subst
+ }
+ }
+ }
+ if {[optIsGiven -preprocess arg]} {
+ # FIXA: better validity check
+ foreach apa $arg {
+ foreach {RE sub} $apa {
+ addPreprocess cmdline $RE $sub ""
+ }
+ }
+ }
+ if {[optIsGiven -preprocessleft arg]} {
+ # FIXA: better validity check
+ foreach apa $arg {
+ foreach {RE sub} $apa {
+ addPreprocess cmdline $RE $sub "left"
+ }
+ }
+ }
+ if {[optIsGiven -preprocessright arg]} {
+ # FIXA: better validity check
+ foreach apa $arg {
+ foreach {RE sub} $apa {
+ addPreprocess cmdline $RE $sub "right"
+ }
+ }
+ }
+ # Handle list of revisions
+ if {[optIsGiven -r arg]} {
+ set revNo 1
+ foreach rev $arg {
+ set opts(doptrev$revNo) $rev
+ incr revNo
+ }
+ }
+ if {[optGet -server]} {
+ if {$::tcl_platform(platform) eq "windows"} {
+ catch {
+ package require dde
+ dde servername Eskil
+ }
+ } else {
+ package require Tk
+ tk appname Eskil
+ }
+ }
+
+ # Option handling done. Lets get started.
+
+ Init
+
+ if {$nocdiff} {
+ DisableDiffUtilC
+ }
+
+ if {$pluginlist} {
+ printPlugins
+ exit
+ }
+ if {$plugindump ne ""} {
+ printPlugin $plugindump
+ exit
+ }
+ set t 0
+ foreach plugin $pluginL {
+ set plugininfo [lindex $plugininfoL $t]
+ set pluginallow [lindex $pluginallowL $t]
+ # If pluginallow list is too short
+ if {$pluginallow eq ""} { set pluginallow 0 }
+ incr t
+ set pinterp [createPluginInterp $plugin $plugininfo $pluginallow pinfo]
+ if {$pinterp eq ""} {
+ # This should not happen since the validator should handle it
+ puts "Bad plugin: $plugin"
+ printPlugins
+ exit
+ }
+ set opts(plugin,$t) $pinterp
+ set opts(pluginname,$t) $plugin
+ set opts(pluginallow,$t) $pluginallow
+ set opts(plugininfo,$t) $plugininfo
+ set opts(pluginpinfo,$t) $pinfo
+ }
+
+ # Store the command line given opts
+ set ::eskil(defaultopts) [array get opts]
+
+ # Do we start in clip diff mode?
+ if {$doclip} {
+ return [makeClipDiffWin]
+ }
+
+ # Do we start in fourway diff mode?
+ if {$dofourway} {
+ return [makeFourWayWin]
+ }
+
+ # Figure out if we start in a diff or dirdiff window.
+ set len [llength $files]
+
+ if {$len == 0 && $dodir} {
+ set dirdiff(leftDir) ""
+ set dirdiff(rightDir) ""
+ return [makeDirDiffWin $noautodiff]
+ }
+ if { ! $doreview && $len == 1} {
+ set fullname [lindex $files 0]
+ if {[FileIsDirectory $fullname 1]} {
+ set dirdiff(leftDir) $fullname
+ set dirdiff(rightDir) $dirdiff(leftDir)
+ return [makeDirDiffWin $noautodiff]
+ }
+ } elseif { ! $doreview && $len >= 2} {
+ set fullname1 [lindex $files 0]
+ set fullname2 [lindex $files 1]
+ if {[FileIsDirectory $fullname1 1] && [FileIsDirectory $fullname2 1]} {
+ set dirdiff(leftDir) $fullname1
+ set dirdiff(rightDir) $fullname2
+ return [makeDirDiffWin $noautodiff]
+ }
+ }
+
+ # Ok, we have a normal diff
+ set top [makeDiffWin]
+ update
+
+ # It is preferable to see the end if the rev string is too long
+ $::widgets($top,rev1) xview end
+ $::widgets($top,rev2) xview end
+
+ if {$doreview} {
+ set rev [detectRevSystem "" $preferedRev]
+ set ::eskil($top,modetype) $rev
+ set ::eskil($top,mode) "patch"
+ set ::eskil($top,patchFile) ""
+ set ::eskil($top,patchData) ""
+ set ::eskil($top,reviewFiles) $files
+ set ::Pref(toolbar) 1
+ after idle [list doDiff $top]
+ return $top
+ }
+ if {$len == 1 || $foreachOpt} {
+ set ReturnAfterLoop 0
+ set first 1
+ foreach file $files {
+ if {$first} {
+ set first 0
+ } else {
+ # Create new window for other files
+ set top [makeDiffWin $top]
+ update
+ # It is preferable to see the end if the rev string is too long
+ $::widgets($top,rev1) xview end
+ $::widgets($top,rev2) xview end
+ }
+ set fullname $file
+ set fulldir [file dirname $fullname]
+ if {$::eskil($top,mode) eq "conflict"} {
+ startConflictDiff $top $fullname
+ after idle [list doDiff $top]
+ set ReturnAfterLoop 1
+ continue
+ }
+ if { ! $dopatch} {
+ # Check for revision control
+ set rev [detectRevSystem $fullname $preferedRev]
+ if {$rev ne ""} {
+ startRevMode $top $rev $fullname
+ if {$noautodiff} {
+ enableRedo $top
+ } else {
+ after idle [list doDiff $top]
+ }
+ set ReturnAfterLoop 1
+ continue
+ }
+ }
+ # No revision control. Is it a patch file?
+ set ::eskil($top,leftDir) $fulldir
+ set ::eskil($top,leftFile) $fullname
+ set ::eskil($top,leftLabel) $fullname
+ set ::eskil($top,leftOK) 1
+ if {$dopatch || \
+ [regexp {\.(diff|patch)$} $fullname] || \
+ $fullname eq "-"} {
+ set ::eskil($top,mode) "patch"
+ set ::eskil($top,patchFile) $fullname
+ set ::eskil($top,patchData) ""
+ set autobrowse 0
+ if {$noautodiff} {
+ enableRedo $top
+ } else {
+ after idle [list doDiff $top]
+ }
+ set ReturnAfterLoop 1
+ continue
+ }
+ }
+ if {$ReturnAfterLoop} {return $top}
+ } elseif {$len >= 2} {
+ if {$len % 2 != 0} {
+ puts "I see $len files. It must an even number."
+ exit
+ }
+ set first 1
+ foreach {file1 file2} $files {
+ if {$first} {
+ set first 0
+ } else {
+ # Create new window for other files
+ set top [makeDiffWin $top]
+ update
+ }
+
+ set fullname [file join [pwd] $file1]
+ set fulldir [file dirname $fullname]
+ set ::eskil($top,leftDir) $fulldir
+ set ::eskil($top,leftFile) $fullname
+ set ::eskil($top,leftLabel) $fullname
+ set ::eskil($top,leftOK) 1
+ set fullname [file join [pwd] $file2]
+ set fulldir [file dirname $fullname]
+ set ::eskil($top,rightDir) $fulldir
+ set ::eskil($top,rightFile) $fullname
+ set ::eskil($top,rightLabel) $fullname
+ set ::eskil($top,rightOK) 1
+ if {$noautodiff} {
+ enableRedo $top
+ } else {
+ after idle [list doDiff $top]
+ }
+ }
+ }
+ if {$autobrowse && (!$::eskil($top,leftOK) || !$::eskil($top,rightOK))} {
+ if { ! $::eskil($top,leftOK) && !$::eskil($top,rightOK)} {
+ openBoth $top 0
+ } elseif { ! $::eskil($top,leftOK)} {
+ openLeft $top
+ } elseif { ! $::eskil($top,rightOK)} {
+ openRight $top
+ }
+ # If we cancel the second file and detect CVS, ask about it.
+ # TBD: Extend this to all VCS:s?
+ if {$::eskil($top,leftOK) && !$::eskil($top,rightOK) && \
+ [llength [glob -nocomplain [file join $fulldir CVS]]]} {
+
+ if {[tk_messageBox -title Diff -icon question \
+ -message "Do CVS diff?" -type yesno] eq "yes"} {
+ set fullname $::eskil($top,leftFile)
+ set ::eskil($top,leftOK) 0
+ startRevMode $top "CVS" $fullname
+ after idle [list doDiff $top]
+ }
+ }
+ }
+ return $top
+}
+
+# Save options to file ~/.eskilrc
+proc saveOptions {top} {
+ # Is this a diff win or some other win?
+ if {[info exists ::widgets($top,wDiff1)]} {
+ # Check if the window size has changed
+ set w $::widgets($top,wDiff1)
+ if {[winfo reqwidth $w] != [winfo width $w] || \
+ [winfo reqheight $w] != [winfo height $w]} {
+ set dx [expr {[winfo width $w] - [winfo reqwidth $w]}]
+ set dy [expr {[winfo height $w] - [winfo reqheight $w]}]
+ set cx [font measure myfont 0]
+ set cy [font metrics myfont -linespace]
+ set neww [expr {[$w cget -width] + $dx / $cx}]
+ set newh [expr {[$w cget -height] + $dy / $cy}]
+ if {$neww != $::Pref(linewidth) || $newh != $::Pref(lines)} {
+ set msg "Should I save the current window\
+ size with the preferences?\nCurrent: $neww x $newh Old:\
+ $::Pref(linewidth) x $::Pref(lines)"
+ set apa [tk_messageBox -title "Save Preferences" \
+ -icon question -type yesno -message $msg]
+ if {$apa == "yes"} {
+ set ::Pref(linewidth) $neww
+ set ::Pref(lines) $newh
+ }
+ }
+ }
+ }
+
+ set rcfile "~/.eskilrc"
+ if {[catch {set ch [open $rcfile "w"]} err]} {
+ tk_messageBox -icon error -title "File error" -message \
+ "Error when trying to save preferences:\n$err"
+ return
+ }
+
+ foreach i [array names ::Pref] {
+ set value $::Pref($i)
+ # Special handling for preprocess
+ if {$i eq "preprocessn"} {
+ set value [getPreprocessSave]
+ }
+ # Skip unchanged options.
+ if {[info exists ::DefaultPref($i)]} {
+ if {$::DefaultPref($i) eq $value} {
+ continue
+ }
+ puts $ch "# $i default : $::DefaultPref($i)"
+ }
+ puts $ch [list set "::Pref($i)" $value]
+ }
+ close $ch
+
+ tk_messageBox -icon info -title "Saved" -message \
+ "Preferences saved to:\n[file nativename $rcfile]"
+}
+
+proc getOptions {} {
+ if {$::tcl_platform(os) eq "Darwin"} {
+ set ::DefaultPref(fontsize) 10
+ } else {
+ set ::DefaultPref(fontsize) 8
+ }
+ # Maybe base default font on TkFixedFont ?
+ set ::DefaultPref(fontfamily) Courier
+ set ::DefaultPref(ignore) "-b"
+ set ::DefaultPref(nocase) 0
+ set ::DefaultPref(noempty) 0
+ set ::DefaultPref(pivot) 10
+ set ::DefaultPref(nodigit) 0
+ set ::DefaultPref(parse) 2
+ set ::DefaultPref(lineparsewords) 0
+ set ::DefaultPref(colorequal) ""
+ set ::DefaultPref(colorchange) red
+ set ::DefaultPref(colornew1) darkgreen
+ set ::DefaultPref(colornew2) blue
+ set ::DefaultPref(bgequal) ""
+ set ::DefaultPref(bgchange) \#ffe0e0
+ set ::DefaultPref(bgnew1) \#a0ffa0
+ set ::DefaultPref(bgnew2) \#e0e0ff
+ set ::DefaultPref(context) -1
+ set ::DefaultPref(finegrainchunks) 0
+ set ::DefaultPref(marklast) 1
+ set ::DefaultPref(linewidth) 80
+ set ::DefaultPref(lines) 60
+ set ::DefaultPref(editor) "" ;# Not settable in GUI yet
+ set ::DefaultPref(preprocessn) {}
+ set ::DefaultPref(toolbar) 0
+ set ::DefaultPref(wideMap) 0 ;# Not settable in GUI yet
+ set ::DefaultPref(askOverwrite) 0 ;# Not settable in GUI yet
+
+ # Print options
+ set ::DefaultPref(printHeaderSize) 10
+ set ::DefaultPref(printLineSpace) 1.0
+ set ::DefaultPref(printCharsPerLine) 80
+ set ::DefaultPref(printPaper) a4
+ set ::DefaultPref(printColorChange) "1.0 0.7 0.7"
+ set ::DefaultPref(printColorNew1) "0.7 1.0 0.7"
+ set ::DefaultPref(printColorNew2) "0.8 0.8 1.0"
+ set ::DefaultPref(printFont) "" ;# Not settable in GUI yet (-printFont)
+
+ # Directory diff options
+ set ::DefaultPref(dir,comparelevel) 1
+ set ::DefaultPref(dir,ignorekey) 0
+ set ::DefaultPref(dir,incfiles) ""
+ set ::DefaultPref(dir,exfiles) "*.o"
+ set ::DefaultPref(dir,incdirs) ""
+ set ::DefaultPref(dir,exdirs) "RCS CVS .git .svn .hg"
+ set ::DefaultPref(dir,onlyrev) 0
+ set ::DefaultPref(dir,nice) 1
+
+ # Start with default preferences, before loading setup file
+ array set ::Pref [array get ::DefaultPref]
+
+ # Handle old option
+ set ::Pref(preprocess) {}
+
+ # TODO: implement filter option fully
+ set ::eskil(filter) ""
+
+ if { ! [info exists ::eskil_testsuite] && [file exists "~/.eskilrc"]} {
+ safeLoad "~/.eskilrc" ::Pref
+ }
+
+ if {$::Pref(editor) ne ""} {
+ set ::util(editor) $::Pref(editor)
+ }
+
+ # If the user's file has this old option, translate it to the new
+ if {$::Pref(preprocess) ne ""} {
+ lappend ::Pref(preprocessn) "old"
+ lappend ::Pref(preprocessn) \
+ [dict create preprocess $::Pref(preprocess) \
+ active 1 save 1]
+ }
+ array unset ::Pref preprocess
+
+ # Set up reactions to some Pref settings
+ if { ! [info exists ::widgets(toolbars)]} {
+ set ::widgets(toolbars) {}
+ }
+ trace add variable ::Pref(toolbar) write TraceToolbar
+}
+
+proc TraceToolbar {args} {
+ # FIXA: Handle destroyed windows ?
+ foreach __ $::widgets(toolbars) {
+ if {$::Pref(toolbar)} {
+ grid configure $__
+ } else {
+ grid remove $__
+ }
+ }
+}
+
+# Global code is only run the first time to be able to reread source
+if { ! [info exists ::eskil(gurkmeja)]} {
+ set ::eskil(gurkmeja) 1
+ set ::eskil(plugins) {}
+
+ # Version string is loaded from version.txt later
+ set ::eskil(diffver) "Version Unknown"
+ set ::eskil(thisScript) [file join [pwd] [info script]]
+ set ::eskil(thisDir) [file dirname $::eskil(thisScript)]
+
+ # Follow any link
+ set tmplink $::eskil(thisScript)
+ while {[file type $tmplink] eq "link"} {
+ set tmplink [file readlink $tmplink]
+ set tmplink [file normalize [file join $::eskil(thisDir) $tmplink]]
+ set ::eskil(thisDir) [file dirname $tmplink]
+ }
+
+ set libDir [file join $::eskil(thisDir) .. lib]
+ if { ! [file isdirectory $libDir]} {
+ # Try the local file from devel
+ set libDir [file join $::eskil(thisDir) .. eskil.vfs lib]
+ }
+ ::tcl::tm::path add $libDir
+
+ package require pstools
+ namespace import -force pstools::*
+ getOptions
+ if { ! [info exists ::eskil_testsuite]} {
+ InitSourceEarly
+ parseCommandLine
+ }
+}
ADDED src/vcsvfs.tcl
Index: src/vcsvfs.tcl
==================================================================
--- /dev/null
+++ src/vcsvfs.tcl
@@ -0,0 +1,879 @@
+#----------------------------------------------------------------------
+# 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 command which when eval'd recreates known file systems
+proc vcsvfs::serialize {} {
+ variable ::vcsvfs::mpoints
+ return [list vcsvfs::deserialize $mpoints]
+}
+
+# Pick up the command created by serialize
+proc vcsvfs::deserialize {data} {
+ variable ::vcsvfs::mpoints
+ dict for {key value} $data {
+ dict set mpoints $key $value
+ # Handle if this is done again, do not mount it twice
+ if {[string match *vcsvfs* [file system $key]]} {
+ continue
+ }
+ vfs::filesystem mount $key [list vcsvfs::Vfs]
+ }
+}
+
+# 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 $rev -- $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,12 +1,10 @@
#------------------------------------------------------------*- tcl -*-
# Tests for GUI
#----------------------------------------------------------------------
-# $Revision$
-#----------------------------------------------------------------------
-lappend ::auto_path /home/peter/src/TkTest
+lappend ::auto_path /home/$::env(USER)/src/TkTest
package require TkTest
wm withdraw .
proc XauthSecure {} {
global tcl_platform
@@ -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,233 @@
}
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 Fill4 {} {
+ cd $::work
+ exec echo Musse > dir1/f11
+ exec echo Pigg > dir1/f12
+ exec echo Mimmi >> dir2/f21
+ exec echo Pluto >> f2
+}
+
+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"
+ # Local changes
+ Fill4
+
+ # Any cleanup?
+ switch $type {
+ SVN { exec svn update }
+ FOSSIL {exec fossil status --sha1sum}
+ }
+}
+
+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 {
+ puts "------------------- $type --------------------"
+ puts "--- $::work"
+ switch $type {
+ FOSSIL { puts [exec fossil timeline -v] }
+ GIT { puts [exec git log --name-only] }
+ SVN { puts [exec svn log --verbose] }
+ HG { puts [exec hg 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$}
+
+ test rev-4.$type.16 {
+ getPatch, list of files
+ } -body {
+ # getPatch needs to be in the checkout
+ cd $::work
+ set files [list $::work/dir1 $::work/f1 $::work/f2]
+ if {$type in "SVN"} {
+ # SVN gives full paths when given full paths
+ set expect [list $::work/dir1/f11 $::work/dir1/f12 $::work/f2]
+ } else {
+ set expect [list dir1/f11 dir1/f12 f2]
+ }
+ set expect [lsort -dictionary $expect]
+ set patch [eskil::rev::${type}::getPatch {} $files outFileList]
+ if {$outFileList ne $expect} {
+ return $outFileList ;#$patch
+ } else {
+ return 1
+ }
+ } -result 1
+
+ test rev-4.$type.7 {
+ getPatch, list of files
+ } -body {
+ # getPatch needs to be in the checkout
+ cd $::work
+ set files [list dir1 f1 f2]
+ set expect [list dir1/f11 dir1/f12 f2]
+ set expect [lsort -dictionary $expect]
+ set patch [eskil::rev::${type}::getPatch {} $files outFileList]
+ if {$outFileList ne $expect} {
+ return $outFileList ;#$patch
+ } else {
+ return 1
+ }
+ } -result 1
+
+ test rev-4.$type.8 {
+ getPatch, list of files
+ } -body {
+ # getPatch needs to be in the checkout
+ cd $::work
+ set f f1
+ set revs [eskil::rev::${type}::ParseRevs $f "-1 0"]
+ set files [list dir1 f1 f2]
+ set expect [list dir1/f11 f1]
+ set expect [lsort -dictionary $expect]
+ set patch [eskil::rev::${type}::getPatch $revs $files outFileList]
+ if {$outFileList ne $expect} {
+ return $outFileList ;#$patch
+ } else {
+ return 1
+ }
+ } -result 1
+
+ clearTmp
+}
-