#----------------------------------------------------------------------
# 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]
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 <Alt-d> [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 <Drop> "[mymethod fileDrop any ] %D"
dnd bindtarget $win.e1 text/uri-list <Drop> "[mymethod fileDrop base1 ] %D"
dnd bindtarget $win.e2 text/uri-list <Drop> "[mymethod fileDrop change1] %D"
dnd bindtarget $win.e3 text/uri-list <Drop> "[mymethod fileDrop base2 ] %D"
dnd bindtarget $win.e4 text/uri-list <Drop> "[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 {} {
# 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)
}
}
# 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 {} {
$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)
}
}
# 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)}
# Do compare of files, to generate patches
foreach side {1 2} {
set differr [catch {DiffUtil::diffFiles {*}$opts \
$files(base$side) $files(change$side)} diffres]
if {$differr != 0} {
# TODO error
return
}
set outfile($side) [tmpFile]
set ch [open $outfile($side) w]
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))"
}
}
puts $ch $line
}
puts $ch [string repeat "-" 78]
if {[llength $diffres] == 0} {
}
set doingLine1 1
set doingLine2 1
set ch1 [open $files(base$side)]
set ch2 [open $files(change$side)]
set t 0
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
}
# Now run a diff window with the patch files
set top [newDiff $outfile(1) $outfile(2)]
}
# 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
}