#----------------------------------------------------------------------
# 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 <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 {} {
$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 <<ListboxSelect>> [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
}