#!/bin/sh
# Run tixwish from the users PATH \
exec wish8.4 -f "$0" ${1+"$@"}
###############################################################################
#
# Copyright (c) 1998, 1999, 2000, 2004 Bob Willcox
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer
# in this position and unchanged.
# 2. Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
# 3. The name of the author may not be used to endorse or promote products
# derived from this software withought specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
# OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
# IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
# Credits: This program was inspired by the tkdiff program, originally
# written by John Klassa. (It has a new owner and has been
# enhanced significantly, and even supports merging now.)
#
# $Id: tkmerge,v 1.13 2006/12/20 14:17:34 bob Exp $
#
###############################################################################
######################################################################
#
# Text formatting routines (procs put-text & purge-all-tags) used for
# displaying the help text were derived from Klondike.
# Reproduced here with permission from their author.
#
# Copyright (C) 1993,1994 by John Heidemann <johnh@ficus.cs.ucla.edu>
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
# 3. The name of John Heidemann may not be used to endorse or promote products
# derived from this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY JOHN HEIDEMANN ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL JOHN HEIDEMANN BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#
######################################################################
set Version "0.85"
package require BWidget
proc usage {} {
puts stderr {Usage: tkmerge [-b] file1 file2 [output_file]}
exit 1
}
set opts(diffopts) {}
set errf false
while {[string index [lindex $argv 0] 0] == "-"} {
set opt [lindex $argv 0]
switch -exact -- $opt {
-b {set opts(diffopts) "-b"}
default {
puts stderr "tkmerge: unrecognized option: $opt"
set errf true
}
}
set argv [lrange $argv 1 end]
}
set parm(f1) [lindex $argv 0]
set parm(f2) [lindex $argv 1]
set parm(fo) [lindex $argv 2]
if {$errf || [string length $parm(f2)] == 0} {
usage
}
if {[string length $parm(fo)] == 0} {
set parm(fo) "$parm(f1).intg"
}
set parm(pgm) [exec basename $argv0]
set parm(tmp) "/tmp/$parm(pgm)[pid]"
set data(diffo) {}
set data(info) {}
namespace eval TkMerge {
variable subdone
variable diffl
variable count 0
variable index 0
}
###############################################################################
#
# Defaults for these global options are stored in the ~/.tkmergerc file
#
set opts(follow) 1
set opts(file_dlms) 1
set opts(skip) 0
set opts(autonext) 1
set opts(editor) {}
set opts(editgeo) "-geometry 80x40" ;# Geometry for editor's xterm
set opts(left_dlm) "<<<<<<<"
set opts(right_dlm) ">>>>>>>"
set opts(geometry) 100x80+0+0
if {[string first "color" [winfo visual .]] >= 0} {
set bg "#9977cc"
set opts(ctag) "-background powderblue -foreground black"
set opts(dtag) "-background snow -foreground blue"
set opts(otag) "-background snow -foreground gray50"
set opts(ntag) "-background snow -foreground VioletRed"
} else {
set bg "black"
set opts(ctag) "-bg black -fg white"
set opts(dtag) "-bg white -fg black"
set opts(otag) "-bg white -fg black"
set opts(ntag) "-bg black -fg white"
}
#
###############################################################################
# Return the smallest of two values
proc min {a b} {
return [expr {$a < $b ? $a : $b}]
}
# Return the largest of two values
proc max {a b} {
return [expr {$a > $b ? $a : $b}]
}
proc TkMerge::Disabled {pgm} {
global opts
if {![info exists opts($pgm)]} {
return 0
} elseif {$opts($pgm) != "NO"} {
return 0
}
return 1
}
# Create at scrollable text widget to display file data or merge text in
proc TkMerge::Text_widget { f h {yside right} args } {
global fonts
if {[string length $h] > 50} {
# Restrict heading length to only 50 characters
set h "...[string range $h [expr [string length $h] - 50] end]"
}
frame $f -relief groove -borderwidth 3
label $f.hdg -text $h -relief sunken -bg gray75 -font $fonts(title)
text $f.text \
-relief raised -bd 2 -setgrid true \
-bg snow \
-font $fonts(text) \
-xscrollcommand "$f.xscroll set" \
-yscrollcommand "$f.yscroll set"
eval {$f.text configure} $args
scrollbar $f.xscroll -orient horizontal \
-command [list $f.text xview]
scrollbar $f.yscroll -orient vertical \
-command [list $f.text yview]
pack $f.hdg -side top -fill x
pack $f.yscroll -side $yside -fill y
pack $f.xscroll -side bottom -fill x
pack $f.text -side left -fill both -expand true
return $f
}
#
# Display a dialog box
#
proc Dialog {type text {flag 0} {dflt 0} args} {
global ok2all
set rc 0
switch $type {
info {
set oki 0
set title "Information"
set bitm "info"
}
warning {
set oki 1
set title "Warning"
set bitm "info"
}
error {
set oki 2
set title "Error"
set bitm "error"
}
default {
puts "My_Dialog: Bad type - $type"
return $rc
}
}
switch $flag {
0 { set rc [tk_dialog .dlg $title $text $bitm $dflt Ok] }
1 { if {!$ok2all($oki)} {
set rc [tk_dialog .dlg $title $text $bitm $dflt Ok "Ok to All"]
if {$rc == 1} {
set ok2all($oki) 1
}
}
}
2 { set rc [tk_dialog .dlg $title $text $bitm $dflt Ok Cancel] }
3 { set rc [eval tk_dialog .dlg $title {$text} $bitm $dflt Ok $args] }
}
update
return $rc
}
# Like the "file type" command except that we may (depending upon
# the follow option) follow links
proc TkMerge::file_type {file} {
global opts
if {$opts(follow)} {
set stat stat
} else {
set stat lstat
}
if [catch {eval [file $stat $file fstat]}] {
return "Unknown"
}
return $fstat(type)
}
# Get differences between two files
proc TkMerge::Get_diffs {{popts ""} f1 f2} {
global opts
if {![file exists $f1]} {
Dialog error "File: $f1 was not found" 0
} elseif {[file_type $f1] != "file"} {
Dialog error "File: $f1 is not a regular file" 0
} elseif {![file exists $f2]} {
Dialog error "File: $f2 not found" 0
} elseif {[file_type $f2] != "file"} {
Dialog error "File: $f2 is not a regular file" 0
} else {
return [exec sh -c \
"diff $opts(diffopts) $popts $f1 $f2 2>/dev/null | egrep -v '^(<|>|\-)' ; exit 0"]
}
exit 1
}
# Delete the text in the output text widget corresponding to the current
# DR and copy the data from bufa into its place.
proc TkMerge::Up_text {} {
#puts "Up_text"
global w data bufa
variable diffl
variable index
variable subdone
set idx $index
scan [lindex $diffl(0) $idx] "%s" type
set smark [format "ms%03d" $idx]
set emark [format "me%03d" $idx]
#puts "smark: $smark; emark: $emark"
#puts [$w(to) dump -mark -text 1.0 end]
$w(to) configure -state normal ;# Allow modification
$w(to) delete $smark $emark
$w(to) insert $smark [Get_lines $bufa($idx) 8] new
$w(to) configure -state disabled ;# Prohibit modification
#puts [$w(to) dump -mark -text 1.0 end]
Set_tag $w(to) remove $idx 3 old_tag
Tag_mark $w(to) add $idx new_tag
set subdone($idx) true
}
# Copy all missing (not specified) diff regions
proc TkMerge::Copy_missing {which misslist} {
#puts "Copy_missing $which $misslist"
global w data bufa
variable index
foreach idx $misslist {
if {$idx != ""} {
#puts "Copy_missing: $idx from $which text box"
Show_this $index $idx
switch $which {
left { Use_left }
right { Use_right }
}
}
}
}
# Copy data into the substitution text widget
proc TkMerge::Copy_in {t} {
#puts "Copy_in $t"
global data bufa
variable index
set idx $index
$t delete 1.0 end
if [info exists bufa($idx)] {
#puts $bufa($idx)
$t insert end $bufa($idx)
}
}
# Copy data out of the substitution text widget
proc TkMerge::Copy_out {t} {
#puts "Copy_out $t"
global bufa
variable index
set buf [$t get 1.0 end]
set bufa($index) [string range $buf 0 [expr [string length $buf] - 2]]
Up_text
}
# Pick the next DR
proc TkMerge::Pick_next {{previous 0}} {
global w opts data bufa
variable count
variable index
set data(info) {}
set cnt 0
while {$cnt < $count} {
if {$previous} {
incr index -1
if {$index <= 0} {
set index $count
set data(info) "-Wrapped-"
bell
}
} else {
incr index
if {$index > $count} {
set index 1
set data(info) "-Wrapped-"
bell
}
}
if {$opts(skip)} {
set exists [info exists bufa($index)]
if {$exists} {
set len [string length $bufa($index)]
} else {
set len 0
}
if {!($exists && $len)} {
break
}
} else {
break
}
incr cnt
}
# Did we wrap around and find none to pick? Set to first if so
if {$cnt >= $count} {
set index 1
}
return $index
}
proc TkMerge::Show_first {} {
variable index
# Reset index and tag first entry as current
set index 0
Show_this $index [Pick_next]
}
proc TkMerge::Show_next {} {
variable index
Show_this $index [Pick_next]
}
proc TkMerge::Show_prev {} {
variable index
Show_this $index [Pick_next 1]
}
proc TkMerge::Show_this {oidx nidx} {
global w opts data
variable index
# If we already have an idx, re-tag it to diff tag
if {$oidx > 0} {
# Change the old DR back to the diff tag
Chg_tag $w(t1) $oidx curr_tag diff_tag 1
Chg_tag $w(t2) $oidx curr_tag diff_tag 2
}
# Set index to the desired value
set index $nidx
if [info exists w(ts)] {
Copy_in $w(ts)
}
# Change the new DR to the current tag
Chg_tag $w(t1) $nidx diff_tag curr_tag 1
Chg_tag $w(t2) $nidx diff_tag curr_tag 2
Set_drcb
Set_pos
update
}
proc TkMerge::Get_data {file} {
set fid [open $file "r"]
set buf [read $fid]
catch [close $fid]
return $buf
}
proc TkMerge::Load_data {t file} {
set lno 0
set fid [open $file "r"]
while {![eof $fid]} {
incr lno
$t insert end [format "%-7d %s\n" $lno [gets $fid]]
}
# We delete the last line inserted since we detect eof to late
# to prevent its insertion
$t delete $lno.0 end
$t insert end "\n" ;# Must put the newline back
catch {close $fid}
return $t
}
# Extract parameters from a diff summary line
# Output is: type start1 end1 start2 end2
proc TkMerge::extract {line} {
if [regexp {^([0-9]+)(a|c|d)} $line d digit action] {
set s1 $digit
set e1 $digit
} elseif [regexp {^([0-9]+),([0-9]+)(a|c|d)} $line d start end action] {
set s1 $start
set e1 $end
}
if [regexp {(a|c|d)([0-9]+)$} $line d action digit] {
set s2 $digit
set e2 $digit
} elseif [regexp {(a|c|d)([0-9]+),([0-9]+)$} $line d action start end] {
set s2 $start
set e2 $end
}
if {[info exists s1] && [info exists s2]} {
return "$action $s1 $e1 $s2 $e2"
} else {
puts "Cannot parse output from diff:"
puts "\t$line"
exit
}
}
# Parse the diff summary list into more usable format
proc TkMerge::parse {diffl} {
foreach dl $diffl {
if [string length $dl] {
lappend result [extract $dl]
} else {
lappend result "x 0 0 0 0"
}
}
return $result
}
# Add a tag to chars in a text widget
# Where: t is the widget
# tag is the tag value
# type operation type: a is add, d is delete
# start starting index
# end ending index
# n text widget number: 1 is left, 2 is right
proc TkMerge::Add_tag {t tag type start end n} {
global w
#puts "Add_tag $t $tag $type $start $end $n"
if {($type == "a" && $n == 1) || ($type == "d" && $n == 2)} {
# Its a delete, just tag line number
#puts "Add_tag: performing delete marking"
for {set idx $start} {$idx <= $end} {incr idx} {
$t tag add $tag $idx.0 $idx.6
}
} else {
$t tag add $tag $start.0 $end.end
}
}
# Move the specified line to the middle of the visible text window and
# attempt to center it.
proc TkMerge::Move_textw {t} {
#puts "Move_textw $t"
variable index
set reqh [winfo reqheight $t] ;# Window height in pixels
set reql [$t cget -height] ;# Window requested lines
set curh [winfo height $t] ;# Current window height in pixels
#puts "reqh: $reqh, reql: $reql, curh: $curh"
if {$curh <= 1} {set curh $reqh}
# Calculate number of lines in window
set charsize floor([expr $reqh / $reql])
set wlines [expr $curh / $charsize] ;# Visible lines
set smark [format "ms%03d" $index]
set emark [format "me%03d" $index]
set spos [lindex [split [$t index $smark] "."] 0]
set epos [lindex [split [$t index $emark] "."] 0]
#puts "spos: $spos, epos: $epos"
set size [expr $epos - $spos]
# Set v to mid point if diff size < window lines
if {$size < $wlines} {
set v [expr {($wlines - $size) / 2}]
set v [expr round($v)]
} else {
set v 2 ;# Set to 2 if not
}
#puts "wlines=$wlines, size=$size, v=$v"
# Calculate move amount
set v1 [expr int([expr {$spos - $v}])]
if {$v1 < 0} {set v1 0}
# Move the window
$t yview $v1
}
# Position our text widgets to display new block
proc TkMerge::Set_pos {} {
global w
# Move the text windows
Move_textw $w(t1)
Move_textw $w(t2)
Move_textw $w(to)
}
# Set a tag for a marked region
# Where: t text widget
# fun tag function to perform (add or remove)
# idx Diff region index number
# tag The tag value to set
proc TkMerge::Tag_mark {t fun idx tag} {
global w
#puts "Tag_mark: $t $fun $idx $tag"
set marks [format "ms%03d" $idx]
set marke [format "me%03d" $idx]
#puts "$t tag $fun $tag $marks $marke"
$t tag $fun $tag $marks $marke
}
# Set the tag for a difference region
# Where: t text widget
# fun tag function to perform (add or remove)
# idx Diff index
# tag The tag value to set
# wn Window number
proc TkMerge::Set_tag {t fun idx wn tag} {
#puts "Set_tag: $t $fun $idx $wn $tag"
global w data
variable diffl
set le [lindex $diffl($wn) $idx]
scan $le "%s %d %d" type start end
#puts "$type $start $end"
set endcol 0
switch -exact $type {
"a" {
if {$wn == 2} {
set end [expr $end+1]
} else {
set endcol 8 ;# include the line number
}
}
"d" {
if {$wn != 2} {
set end [expr $end+1]
} else {
set endcol 8 ;# include the line number
}
}
default {set end [expr $end+1]}
}
#puts "$t tag $fun $tag $start.0 $end.$endcol"
$t tag $fun $tag $start.0 $end.$endcol
}
# Set the tags (for colors) in the source text widgets
# Where: t text widget
# wn Window number (1 orig, 2 new, 3 result)
# tag The tag value to be set
proc TkMerge::Do_tags {t wn tag} {
#puts "Do_tags $t $wn $tag"
global parm opts data
variable diffl
variable count
for {set idx 1} {$idx <= $count} {incr idx} {
Set_tag $t add $idx $wn $tag
}
}
# Change a tag from otag to ntag
proc TkMerge::Chg_tag {t idx otag ntag wn} {
Set_tag $t remove $idx $wn $otag
Set_tag $t add $idx $wn $ntag
}
proc TkMerge::Set_mark {t le idx wn} {
#puts "Set_mark: $t $le $idx $wn"
global w
scan $le "%s %d %d" type start end
#puts "$type $start $end"
switch -exact $type {
"a" {
set end [expr $end+1]
if {$wn != 2} {
set start $end
}
}
"d" {if {$wn != 2} {set end [expr $end+1]}}
default {set end [expr $end+1]}
}
set smark [format "ms%03d" $idx]
set emark [format "me%03d" $idx]
# Mark lines in the text box
#puts "$smark: $start.0, $emark: $end.0"
$t mark set $smark $start.0
$t mark set $emark $end.0
$t mark gravity $smark left
}
# Set start and end marks in the text widget based on the diff list
proc TkMerge::Do_marks {t wn} {
#puts "Do_marks: $t $wn"
global parm opts data
variable diffl
set list $diffl($wn)
set nbr [expr [llength $list] - 1]
for {set idx 1} {$idx <= $nbr} {incr idx} {
set le [lindex $list $idx]
Set_mark $t $le $idx $wn
}
}
proc TkMerge::Get_text {t start end} {
for {set idx $start} {$idx <= $end} {incr idx} {
append result [format "%s\n" [string range [$t get $idx.0 $idx.end] \
6 end]]
}
return $result
}
proc TkMerge::Strip_lnos {ibuf} {
#puts "Strip_lnos $ibuf"
set obuf {}
while {[string length $ibuf] > 0} {
set i [string first "\n" $ibuf]
#puts "i=$i"
if {$i >= 0} {
set tbuf [string range $ibuf 8 $i]
set ibuf [string range $ibuf [expr $i+1] end]
} else {
set tbuf [string range $ibuf 8 end]
set ibuf {}
}
#puts "tbuf=$tbuf"
append obuf $tbuf
}
#puts "obuf=$obuf"
return $obuf
}
# Use left-hand file text
proc TkMerge::Use_left {{keep 0} {nocopy 0}} {
global w parm opts data
#puts "Use_left $keep $nocopy"
set buf {}
if {!$keep} {
$w(ts) delete 1.0 end
}
if {$opts(file_dlms)} {
set buf [format "%s %s\n" $opts(left_dlm) $parm(f1)]
}
append buf [Strip_lnos [$w(t1) get curr_tag.first curr_tag.last]]
$w(ts) insert end $buf
if {!$nocopy} {
Copy_out $w(ts)
}
}
# Use right-hand file text
proc TkMerge::Use_right {{keep 0} {nocopy 0}} {
#puts "Use_right $keep $nocopy"
global w parm opts data
set buf {}
if {!$keep} {
$w(ts) delete 1.0 end
}
if {$opts(file_dlms)} {
set buf [format "%s %s\n" $opts(right_dlm) $parm(f2)]
}
append buf [Strip_lnos [$w(t2) get curr_tag.first curr_tag.last]]
$w(ts) insert end $buf
if {!$nocopy} {
Copy_out $w(ts)
}
}
proc TkMerge::Use_both {} {
#puts "Use_both"
Use_left 0 1
Use_right 1 0
}
# Copy left and right into the subsitution box
proc TkMerge::Load_subt {} {
#puts "Load_subt"
Use_left 0 1
Use_right 1 1
}
# Use what's in the substitution box
proc TkMerge::Use_subt {} {
global w parm opts data
Copy_out $w(ts)
}
# Fire up the user's favorite editor on the differences
proc TkMerge::Edit_both {} {
global w parm opts data
variable index
set idx $index
set temp "$parm(tmp)E"
set end [$w(ts) index end]
# Seems that the following expr is always TRUE
if {$end == "2.0"} {
# If only one line, see if its empty
set buf [$w(ts) get 1.0 $end]
if {[string length $buf] == 0 || \
([string length $buf] == 1 && $buf == "\n")} {
Load_subt
set end [expr [$w(ts) index end] - 1]
}
}
# Copy output text box to our temporary file for the editor
set fid [open $temp "w"]
puts -nonewline $fid [$w(ts) get 1.0 $end]
catch {close $fid}
# Let user edit the temp file
Edit $temp
# Copy edited result back to output text box
set fid [open $temp "r"]
$w(ts) delete 1.0 $end
$w(ts) insert end [read $fid]
catch {close $fid}
catch {exec rm -f $temp}
Copy_out $w(ts)
}
# Start an xterm editor session
proc TkMerge::Edit {fn args} {
global env opts
if {![info exists opt(editor)] || $opts(editor) == ""} {
set opts(editor) $env(EDITOR)
if {$opts(editor) == ""} {
set opts(editor) "vi"
}
}
if {[catch {eval exec xterm $opts(editgeo) +sb -title $fn \
-e $opts(editor) $args $fn} rs] < 0} {
Dialog error "Editor $opts(editor) failed: $rs" 0
}
}
# Extract data from a buffer, skipping delimiter lines
proc TkMerge::Get_lines {ibuf {shift 0}} {
#puts "Get_lines $ibuf"
global opts data
variable diffl
variable index
set obuf {}
set plen [string length $opts(right_dlm)]
set sbuf {}
for {set j 0} {$j < $shift} {incr j} {
append sbuf " "
}
set le [lindex $diffl(0) $index]
scan $le "%s" type
while {[string length $ibuf] > 0} {
set i [string first "\n" $ibuf]
#puts "Get_lines: i = $i"
if {$i >= 0} {
set tbuf [string range $ibuf 0 [expr $i-1]]
set ibuf [string range $ibuf [expr $i+1] end]
} else {
set tbuf $ibuf
set ibuf {}
}
# Skip lines with path delimiter prefix (they're not data)
if {[string length $tbuf] >= $plen} {
set prfx [string range $tbuf 0 [expr $plen-1]]
#puts "prfx=$prfx"
if {$prfx == $opts(right_dlm) || $prfx == $opts(left_dlm)} {
continue
}
}
#puts "$tbuf"
append obuf $sbuf $tbuf "\n"
}
#puts "Get_lines: obuf=\"$obuf\""
return $obuf
}
# Write out the merged result
proc TkMerge::Write_output {} {
#puts "Write_output"
global parm opts data bufa
variable diffl
variable count
set done 0
set lno 1
set fidi [open $parm(f1) "r"]
set fido [open $parm(fo) "w"]
for {set idx 1} {$idx <= $count} {incr idx} {
scan [lindex $diffl(0) $idx] "%s %d %d %d %d" type s1 e1 s2 e2
#puts "Write_output: $type $s1 $e1 $s2 $e2"
# Adds are for "add after" so we want to copy the s1 line
if {$type == "a"} {
incr s1
}
# Copy from file 1 to output till we reach s1
#puts "Write_output: copying to [expr $s1 - 1]"
while {$lno < $s1 && ![eof $fidi]} {
if {[gets $fidi line] >= 0} {
puts $fido $line
incr lno
}
}
# Write out difference text block from bufa
#puts "Write_output: writing out DR $idx"
if [info exists bufa($idx)] {
puts -nonewline $fido [Get_lines $bufa($idx)]
}
# Skip over lines in file 1 till we reach e1
#puts "Write_output: skipping to $e1"
while {$lno <= $e1 && ![eof $fidi]} {
if {[gets $fidi line] >= 0} {
incr lno
}
}
}
# Write the out balance of file 1 to output file
#puts "Write_output: copying to EOF"
if {![eof $fidi]} {
while {[gets $fidi line] >= 0} {
puts $fido $line
incr lno
}
}
catch {close $fidi}
catch {close $fido}
return 0
}
# Save what we currently have.
proc TkMerge::Save {} {
#puts "Save"
global w data bufa
variable count
variable index
variable subdone
set rc 0
set missing {}
set misscnt 0
# Check for DRs w/o substitution
for {set idx 1} {$idx <= $count} {incr idx} {
if {!$subdone($idx)} {
append missing "$idx "
incr misscnt
}
}
if {$misscnt > 0} {
set idx $index
set rc [Dialog warning \
[format "No substitution text has been selected for DR%s: %s" \
[expr {($misscnt == 1) ? "":"s"}] $missing] 3 1 Cancel \
"Use Left" "Use Right"]
#puts "rc = $rc"
if {$rc == 0 || $rc == 1} {
# Ok or Cancel
return $rc
} elseif {$rc == 2} {
# Use Left
Copy_missing left [split $missing]
} elseif {$rc == 3} {
# Use Right
Copy_missing right [split $missing]
}
if {$index != $idx} {Show_this $index $idx}
}
set rc [Write_output]
return $rc
}
# User has asked to quit. Write the output file first.
proc TkMerge::Quit {} {
#puts "Quit"
global w data bufa
variable count
variable subdone
set rc [Save]
if {$rc == 0} {
exit 0
}
return $rc
}
# User selected the Cancel button. Toss all work.
proc TkMerge::Cancel {} {
variable count
variable index
variable subdone
set rc 0
for {set idx 1} {$idx <= $count} {incr idx} {
if {$subdone($idx)} {
set rc 1
}
}
if {$rc} {
if [Dialog warning "Are you sure you want to Cancel? The output file will not be written." 2] {
return
}
}
exit 1
}
#
# Write out the tkmerge startup file
#
proc TkMerge::Write_rcfile {fn {newfile 0}} {
global opts Version
# The list of prefrence variables
set var_lst { \
{geometry "Geometry of root window" {wm geometry .}} \
{editor "Editor to use"} \
{editgeo "Geometry for editor's xterm"} \
{follow "Follow symbolic links"} \
{skip "Skip completed DRs"} \
{autonext "Automatically move to next DR after selection"} \
{left_dlm "Left-hand file text delimeter"} \
{right_dlm "Right-hand file text delimeter"} \
{dtag "Colors for DRs"} \
{ctag "Colors for current DR"} \
}
# Open the startup file for writing
if [catch {open $fn "w"} fid] {
Dialog error $fid 0
return
}
# Identify and timestamp the file
puts $fid [format "#\n# Startup file for TkMerge. Created %s" \
[clock format [clock seconds]]]
puts $fid "# Warning: This file must be in valid TCL syntax.\n#\n"
puts $fid [format "set rcVersion %s\t;# TkMerge version creating this file" \
$Version]
# Write out all of our prefrence variables
foreach next $var_lst {
set name [lindex $next 0]
set cmnt [lindex $next 1]
# This is a HACK: we don't execute the specified command if we are
# building a new rc file. This is to avoid getting the geometry of
# the root window before we've created it.
if {[llength $next] >= 3 && !$newfile} {
set value [eval [lindex $next 2]]
#puts "$name value: $value"
} else {
if [info exists opts($name)] {
set value $opts($name)
} else {
set value {}
}
}
set pat {*[ ]*}
set whtsp [string match $pat $value]
if {$whtsp == 1} {
puts $fid [format "set opts(%s)\t\{%s\}\t;# %s" $name $value $cmnt]
} else {
puts $fid [format "set opts(%s)\t%s\t;# %s" $name $value $cmnt]
}
}
close $fid
}
# Process the user's .tkmergerc file
proc TkMerge::do_rcfile {} {
global env parm opts Version
# Source the ~/.tkmerge startup file if it exists. If it doesn't
# exist we will create it for next time.
set rcfile [file join $env(HOME) ".tkmergerc"]
if [file exists $rcfile] {
source $rcfile
# If old startup file, update it
if {![info exists rcVersion] || $rcVersion < $Version} {
if [info exists ignorele] {
set textcomp $ignorele
}
puts "Notice: Updating $rcfile to newer version"
Write_rcfile $rcfile 1
}
} else {
puts "Notice: Creating $rcfile startup file"
Write_rcfile $rcfile 1
}
set parm(rcfile) $rcfile
}
proc TkMerge::Set_drcb {} {
global w data
variable index
$w(md).drcb setvalue @[expr $index-1]
}
proc TkMerge::Move_to {} {
global opts data
variable index
if {$opts(ready)} {
set nidx [lindex [split $data(cdiff) ":"] 0]
Show_this $index $nidx
}
}
proc TkMerge::main {} {
global w opts parm Version data fonts
variable diffl
variable index
variable count
variable subdone
set opts(ready) false
set w(menudesc) {
"&File" all file 0 {
{command "&Save" {} "Save merge file" {}
-command TkMerge::Save}
{command "Save Settings" {} "Save current settings" {}
-command "TkMerge::Write_rcfile $parm(rcfile)"}
{separator}
{command "&Cancel" {} "Cancel operation" {}
-command "TkMerge::Cancel"}
{command "&Quit" {} "Quit tkmerge" {}
-command TkMerge::Quit}
}
"&Options" all options 0 {
{checkbutton "&Delimiters" {} "Enable/disable filename delimiters" {}
-variable opts(file_dlms)}
{checkbutton "&Skip Completed" {} "Skip Completed Difference Regions" {}
-variable opts(skip)}
{checkbutton "&Automatic Next" {} "Perform Automatic Next Function" {}
-variable opts(autonext)}
}
"&Substitution" all substitution 0 {
{command "&Load" {}
"Load differences into Substitution Text Window" {}
-command TkMerge::Load_subt}
{command "&Use" {}
"Copy data in the Substitution Text Window to the merged file" {}
-command {TkMerge::Use_subt; if {$opts(autonext)} TkMerge::Show_next}}
}
"&Help" all help 0 {
{command "&Info" {} "Program Information" {} -command Help}
{command "&About" {} "About the Program" {} -command About}
}
}
# Set up the fonts to be used
set fonts(text) [font create -family Fixed -size 11 -weight normal]
set fonts(button) [font create -family Helvetica -size 10 -weight bold]
set fonts(label) [font create -family Helvetica -size 11 -weight normal]
set fonts(title) [font create -family Helvetica -size 11 -weight bold]
set fonts(chkbut) [font create -family Helvetica -size 10 -weight bold]
do_rcfile
wm title . "TkMerge v$Version"
set w(mf) [MainFrame .mf -menu $w(menudesc) \
-textvariable w(status)]
pack $w(mf) -fill both -expand true
set w(tb) [$w(mf) addtoolbar]
set w(uf) [$w(mf) getframe]
$w(mf) addindicator -textvariable data(info) -fg red
# Create the paned windows
# Top/bottom frames
set w(vp) [PanedWindow $w(uf).vp -side left]
set w(vpt) [$w(vp) add]
set w(vpb) [$w(vp) add]
pack $w(vp) $w(vpt) $w(vpb) -fill both -expand true
# Top pane contains the old/new text
set w(pt) [PanedWindow $w(vpt).pt -side bottom]
set w(ptl) [$w(pt) add]
set w(ptr) [$w(pt) add]
pack $w(pt) $w(ptl) $w(ptr) -fill both -expand true
# Bottom pane contains the merged & substitution text + nav/sub buttons
set w(pr) [PanedWindow $w(vpb).pr -side top]
set w(prl) [$w(pr) add]
set w(prr) [$w(pr) add]
pack $w(pr) $w(prl) $w(prr) -fill both -expand true
# Create the text widgets
set w(f1) [Text_widget $w(ptl).f1 $parm(f1) right \
-wrap none -height 27]
set w(f2) [Text_widget $w(ptr).f2 $parm(f2) left \
-wrap none -height 27]
set w(fo) [Text_widget $w(prl).fo $parm(fo) right \
-wrap none -height 27]
set w(fs) [Text_widget $w(prr).fs "Substitution Text" left \
-wrap none -height 12]
set w(md) [frame $w(tb).ds]
label $w(md).lbl -text "Diff Region: " -font $fonts(label)
label $w(md).of -text " of" -font $fonts(label)
label $w(md).cnt -textvariable TkMerge::count -font $fonts(label)
ComboBox $w(md).drcb \
-editable false \
-width 25 \
-font $fonts(label) \
-textvariable data(cdiff) \
-modifycmd TkMerge::Move_to
set data(cdiff) {}
# Navigation buttons
set w(nav) [frame $w(tb).nav]
label $w(nav).lbl -text "Navigation: " -font $fonts(label) -fg blue
button $w(nav).first -text First -command TkMerge::Show_first \
-font $fonts(button) -pady .5m
button $w(nav).prev -text Prev -command TkMerge::Show_prev \
-font $fonts(button) -pady .5m
button $w(nav).next -text Next -command TkMerge::Show_next \
-font $fonts(button) -pady .5m
pack $w(nav).lbl $w(nav).prev $w(nav).first $w(nav).next -side left
# Selection buttons
set w(sel) [frame $w(tb).sel]
label $w(sel).lbl -text "Selection: " -font $fonts(label) -fg red
button $w(sel).left -text Left -font $fonts(button) -pady .5m \
-command {TkMerge::Use_left; if {$opts(autonext)} TkMerge::Show_next}
button $w(sel).right -text Right -font $fonts(button) -pady .5m \
-command {TkMerge::Use_right; if {$opts(autonext)} TkMerge::Show_next}
button $w(sel).both -text Both -font $fonts(button) -pady .5m \
-command {TkMerge::Use_both; if {$opts(autonext)} TkMerge::Show_next}
pack $w(sel).lbl $w(sel).left $w(sel).both $w(sel).right -side left
# Editor button
button $w(tb).edit -text Editor -fg black -activeforeground red4 \
-font $fonts(button) -pady .5m \
-command {TkMerge::Edit_both; if {$opts(autonext)} TkMerge::Show_next}
# Pack editor, navigation and selection buttons
pack $w(tb).edit $w(sel) $w(nav) -side right -padx 2m
# Get the diffs and build our diff list
set data(diffo) [Get_diffs "" $parm(f1) $parm(f2)]
if {[string length $data(diffo)] > 0} {
#puts "\"$data(diffo)\""
set data(diffo) [split $data(diffo) \n]
# Load the differences combo box
set i 0
foreach dif $data(diffo) {
incr i
set clist [format "%3d: %s" $i $dif]
#$w(md).drcb appendhistory $clist
lappend data(clist) $clist
}
$w(md).drcb configure -values $data(clist)
# Create the differences list. Note that the 0th entry in the
# list is a dummy place holder.
set data(diffo) [linsert $data(diffo) 0 ""]
set diffl(0) [parse $data(diffo)]
# Create the mark lists:
# diffl(1) is the list of where to mark the left-hand text widget.
# diffl(2) is the list of where to mark the right-hand text widget.
# diffl(3) is the list of where to mark the output text widget.
set i 0
foreach le $diffl(0) {
scan $le "%s %d %d %d %d" type s1 e1 s2 e2
lappend diffl(1) [list $type $s1 $e1]
lappend diffl(2) [list $type $s2 $e2]
lappend diffl(3) [list $type $s1 $e1]
incr i
}
set count [expr $i - 1]
# Init all substitution done flags to false
for {set i 1} {$i <= $count} {incr i} {
set TkMerge::subdone($i) false
}
# Load the text widgets
set w(t1) [Load_data $w(f1).text $parm(f1)]
set w(t2) [Load_data $w(f2).text $parm(f2)]
set w(to) [Load_data $w(fo).text $parm(f1)]
set w(ts) $w(fs).text
# Configure the tags.
foreach x {$w(t1) $w(t2) $w(to)} {
set t [subst $x]
eval $t tag configure diff_tag $opts(dtag)
eval $t tag configure curr_tag $opts(ctag)
eval $t tag configure new_tag $opts(ntag)
eval $t tag configure old_tag $opts(otag)
}
# Mark the segments of the text widgets for where the differences are
# and where the text is to be substituted (for the output widget).
Do_marks $w(t1) 1
Do_marks $w(t2) 2
Do_marks $w(to) 3
# Highlight DRs in the text widgets
Do_tags $w(t1) 1 diff_tag
Do_tags $w(t2) 2 diff_tag
Do_tags $w(to) 3 old_tag
# Don't allow user to change data in these file boxes
foreach x {$w(t1) $w(t2) $w(to)} {
set t [subst $x]
$t configure -state disabled
}
# Position to the first DR
Show_first
set opts(ready) true
# Pack the Diff Region combobox
pack $w(md).lbl $w(md).drcb $w(md).of $w(md).cnt $w(md) \
-side left -pady 2
# Pack the text widgets
pack $w(fo) $w(fs) -side left -fill both -expand true
pack $w(f1) $w(f2) -side left -fill both -expand true
# Size and locate the root window
set geom [split $opts(geometry) "x+"]
set ww [lindex $geom 0]
set wh [lindex $geom 1]
set x [lindex $geom 2]
set y [lindex $geom 3]
BWidget::place . $ww $wh at $x $y
} else {
puts "tkmerge: files $parm(f1) and $parm(f2) are identical"
exit 0
}
}
# Display some info about the program usage
proc TkHelp {pgm_name vers info} {
global help_text
catch {destroy .help}
set w [toplevel .help]
wm title $w "$pgm_name v$vers Help"
wm geometry $w 80x40
wm minsize $w 10 10
pack [frame .help.f -background black] \
-expand true -fill both
pack [scrollbar .help.f.scr -command {.help.f.f.text yview}] \
-side right -fill y -padx 1
pack [frame .help.f.f -background white] \
-expand true -fill both
pack [text .help.f.f.text -wrap word -setgrid true \
-width 55 -yscroll {.help.f.scr set} \
-background white -foreground black] \
-side left -expand true -fill both -padx 5
pack [button .help.done -text done -command {destroy .help}] \
-side bottom -fill x
put-text .help.f.f.text $info
.help.f.f.text configure -state disabled
}
proc put-text {tw txt} {
$tw configure -font -*-Times-Medium-R-Normal-*-140-*
$tw tag configure bld -font -*-Times-Bold-R-Normal-*-140-*
$tw tag configure cmp -font -*-Courier-Bold-R-Normal-*-120-*
$tw tag configure hdr -font -*-Times-Bold-R-Normal-*-180-* -underline 1
$tw tag configure itl -font -*-Times-Medium-I-Normal-*-140-*
$tw tag configure rev -foreground white -background black
$tw tag configure btn \
-font -*-Courier-Medium-R-Normal-*-120-* \
-foreground black -background white \
-relief groove -borderwidth 2
$tw mark set insert 0.0
set t $txt
while {[regexp -indices {<([^@>]*)>} $t match inds] == 1} {
set start [lindex $inds 0]
set end [lindex $inds 1]
set keyword [string range $t $start $end]
set oldend [$tw index end]
$tw insert end [string range $t 0 [expr $start - 2]]
purge-all-tags $tw $oldend insert
if {[string range $keyword 0 0] == "/"} {
set keyword [string trimleft $keyword "/"]
if {[info exists tags($keyword)] == 0} {
error "end tag $keyword without beginning"
}
$tw tag add $keyword $tags($keyword) insert
unset tags($keyword)
} else {
if {[info exists tags($keyword)] == 1} {
error "nesting of begin tag $keyword"
}
set tags($keyword) [$tw index insert]
}
set t [string range $t [expr $end + 2] end]
}
set oldend [$tw index end]
$tw insert end $t
purge-all-tags $tw $oldend insert
}
proc purge-all-tags {w start end} {
foreach tag [$w tag names $start] {
$w tag remove $tag $start $end
}
}
proc About {} {
global Version opts
Dialog info "This is TkMerge, Version $Version\nWritten by Bob Willcox" 0
}
# Display some info about the program usage
proc Help {} {
global Version opts
TkHelp TkMerge $Version {
<hdr>TkMerge</hdr>
This tool provides a graphical aid in the merging of differences between two similar files.
<hdr>Startup</hdr>
<bld>TkMerge</bld> is started as follows:<cmp>
tkmerge file1 file2 [ outfile ] ]</cmp>
The <itl>file1</itl> and <itl>file2</itl> arguments are used to specify the paths of the two files to be merged. The optional <itl>outfile</itl> argument may be coded to specify the path of the output (merged) file. If omitted, <itl>file1</itl>.intg will be used.
<hdr>Layout</hdr>
The most prominent aspects of the <bld>TkMerge</bld> window are the four text widgets in the four quadrants of the window. The two on on top contain copies of the data in <itl>file1</itl> and <itl>file2</itl>. The left-most displays the <itl>file1</itl> data and the right-most displays the <itl>file2</itl> data.
The differences between the two files (referred to here as difference regions or DRs) are highlighted using different foreground and background colors. Highlignting for the currently selected DR is with a blue background and white foreground. Highlighting for all other DRs is with a white background and blue foreground.
The lower right-hand text widget is the current output text for the selected DR. It contains the text to be used in place of the text in the selected DRs. Text may be inserted into this widget via one of the three text selection buttons or the <btn> Editor </btn> button described below. You may also directly key or edit text in(to) this text widget.
The lower left text widget contains what will be the output file (when written). It is initially loaded with data from <itl>file1</itl> just as the upper left-hand widget. However <bld>TkMerge</bld> uses a different highlighting scheme for this widget. Data to be substituted is displayed with a gray foreground color. As the substitution text is selected/created, the foreground color of the replacement text set to a violet-red.
The upper left corner of the menu bar displays the number of the current DR, the total number of DRs, and the <itl>diff</itl> program summary line for the current DR.
<bld>Notes</bld>:
1. You are not allowed to directly edit the text of either the top two or the lower left text widgets. You can, however, edit the text in the lower right text widget (the Substitution Text).
2. The color choices for the highlighting of the text may be changed by editing <bld>TkMerge</bld>'s startup file, <itl>~/.tkmergerc</itl>.
<hdr>Operations</hdr>
<bld>File Menu</bld>
<btn> Save </btn> Saves the current changes to the output file.
<btn> Save Settings </btn> Causes the various persistent options of <itl>TkMerge</itl> to be saved to the <itl>~/.tkmergerc</itl> startup file. For a list of which options these are, please can take a look at this file.
<btn> Cancel </btn> Terminates <bld>TkMerge</bld> without writing the output file.
<btn> Quit </btn> Terminates <bld>TkMerge</bld> causing the output file to be written..
<bld>Options Menu</bld>
<btn> Delimiters </btn>: Filename delimiters are to be included in the substitution text widget and the in the data provided to the editor session. Note that these delimiters are <bld>not</bld> written to the output file.
<btn> Skip Completed </btn>: Causes the skipping of DRs that have output text stored for them when navagating through the DRs with the <btn> Next </btn>, <btn> Previous </btn>, and <btn> First </btn> buttons.
<btn> Automatic Next </btn>: Automatically move to the next DR upon completion of the <btn> Left </btn>, <btn> Right </btn>, or <btn> Editor </btn> button operations. Note that the <btn> Both </btn> button does not result in an automatic next, even if the <itl>Perform Automatic Next Function</itl> option is selected.
<bld>Substitution Menu</bld>
<btn> Load </btn>: Load the lines containing the differences between the files for the current difference region into the Substitution Text window.
<btn> Use </btn>: Copy the lines from the Substitution Text window to the merged text window.
<bld>Navagation Buttons</bld>
<btn> Prev </btn> Return to the previous DR.
<btn> First </btn> Select the first DR.
<btn> Next </btn> Step to the next DR.
<bld>Text Selection</bld>
<btn> Left </btn> Select the current DR text from the left file text widget.
<btn> Both </btn> Select the current DR text from both file's text widgets.
<btn> Right </btn> Select the current DR text from the right file text widget.
<btn> Editor </btn> Invoke an external editor program (as specified in the EDITOR environment variable, or <itl>vi</itl> if there is no EDITOR variable in the environment) to be used to edit/create the replacement text. If there is no text currently in the output text widget, the selected differecne block text from both file text widgets will be presented to the editor.
<bld>Help Menu</bld>
<btn> Info </btn> Displays this information.
<btn> About </btn> Displays the program name, version and author.
<hdr>Files</hdr>
<bld>Startup File</bld>
<itl>TkMerge</itl> reads the <itl>~/.tkmergerc</itl> in the users home directory at startup to set the initial values for the persistent options. If this file does not exist it will be created with default values. While running, clicking the <btn> Save Settings </btn> (with the left mouse button) will cause the current setting of these options to be written to the <itl>~/.tkmergerc</itl> file.
You may wish to manually edit the <itl>~/.tkmergerc</itl> file (with your favorite editor) to change some of the options not directly available from the <itl>TkMerge</itl> window. <bld>Warning</bld>: If you do so, be careful to maintain proper tcl/tk statement syntax since this file is sourced by <itl>TkMerge</itl> at startup and any errors in it will prevent the execution of the program.
<hdr>Credits</hdr>
Thanks go to Frances Willcox and Wayne Willcox for beta testing and for giving valuable suggestions during the early phases of development. Thanks must also be given to John Klassa for his great <itl>TkDiff</itl> program which was used as a model for the file difference display (especially the marking of the differences) of <itl>TkMerge</itl>. Also, for his do-help and extract procedures in <itl>TkDiff</itl> upon which the <itl>TkMerge</itl> versions are based. Credit also goes to John Heidemann, author of <itl>Klondike</itl> (a great Tk-based Solitaire game). John Klassa claims to have shamelessly stolen John's window tags routines out of <itl>Klondike</itl> and used them there. I, in turn, have shamelessly stolen them from <itl>TkDiff</itl> and used them here (with John Heidemann's permission).
Finaly, I would like to thank Brian W. Kernighan and Rob Pike for the <itl>idiff</itl> program in their book "The UNIX Programming Environment" which was the inspiration for <itl>TkMerge</itl>.
<hdr>Comments</hdr>
Questions and comments should be directed to Bob Willcox at <itl>bob@immure.com</itl>.
<hdr>Copyright Information</hdr>
Copyright (c) 1998-2005 Robert W. Willcox. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer in this position and unchanged.
2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
3. The name of the author may not be used to endorse or promote products derived from this software withought specific prior written permission.
<hdr>Disclaimer</hdr>
<bld>THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.</bld>
}
}
TkMerge::main
syntax highlighted by Code2HTML, v. 0.9.1