"Fossies" - the Fresh Open Source Software Archive 
Member "dirdiff-2.1/dirdiff" (19 Apr 2005, 128833 Bytes) of package /linux/privat/old/dirdiff-2.1.tar.gz:
As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Bash source code syntax highlighting (style:
standard) with prefixed line numbers and
code folding option.
Alternatively you can here
view or
download the uninterpreted source code file.
1 #!/bin/sh
2 # Tcl ignores the next line \
3 exec wish "$0" -- "${1+$@}"
4
5 # Copyright (C) 1999-2004 Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
9
10 set Script [info script]
11 set ScriptTail [file tail $Script]
12 if {[file type $Script] == "link"} {
13 set ScriptBin [file join [file dirname $Script] [file readlink $Script]]
14 } else {
15 set ScriptBin $Script
16 }
17 set TclExe [info nameofexecutable]
18 set compound_ok [expr {$tcl_version >= 8.4}]
19
20 set nofilecmp [catch {load libfilecmp.so.0.0}]
21 set rcsflag {}
22 set diffbflag {}
23 set diffBflag {}
24 set diffiflag {}
25 set diffwflag {}
26 set diffdflag {}
27 set ctxlines 3
28 set showsame 0
29 set underlinetabs 0
30 set redisp_immed 1
31 set diffnewfirst 0
32 set nukefiles {*.o *~ *.orig CVS *.a *.link *.old *.save .depend .*.flags SCCS}
33 set filelistfont {Helvetica -12}
34 set textfont {Courier -12}
35 set maxdepth 9999999
36 set nxdirmode 0
37 set docvsignore 0
38
39 set defaultcvsignore {
40 RCS SCCS CVS CVS.adm RCSLOG cvslog.* tags TAGS
41 .make.state .nse_depinfo *~ \#* .\#* ,* _$* *$
42 *.old *.bak *.BAK *.orig *.rej .del-* *.a *.olb
43 *.o *.obj *.so *.exe *.Z *.elc *.ln core
44 }
45
46 if {$tcl_platform(platform) == "windows"} {
47 set TclExe [file attributes $TclExe -shortname]
48 # I don't like it any better than you do
49 set nullfile "C:/temp/nulfile"
50 set nf [open "$nullfile" w]
51 close $nf
52 } else {
53 set nullfile "/dev/null"
54 }
55 set diffprogram {}
56 set showprogram {}
57
58 set numlines 20
59 set canvy0 0
60 set canvy 0
61 set canvx 0
62
63 set have_unidiff 1
64 set caught [catch "exec diff -u $nullfile $nullfile" err]
65 if {$caught != 0} {
66 puts "Unified diff not available. Will use context diff for patches."
67 set have_unidiff 0
68 }
69
70 catch {source ~/.dirdiff}
71
72 proc ignorefile pat {
73 global nukefiles
74 if {$pat == "!"} {
75 set nukefiles {}
76 } else {
77 lappend nukefiles $pat
78 }
79 }
80
81 set linespc [font metrics $filelistfont -linespace]
82 if {$linespc < 15} {set linespc 15}
83 set blotw [expr $linespc-3]
84 set bloth [expr $linespc-3]
85 set blotspc $linespc
86
87 proc usage {} {
88 puts stderr {Usage: dirdiff [options]... dir1 dir2 ...
89
90 Options:
91 -a, --all don't exclude any files
92 -o, --only pattern only process files matching pattern
93 -I, --ignore pattern don't process files matching pattern
94 -r, --rcs ignore differences in RCS strings
95 -c, --context num set number of lines of context to show
96 -b, -w, -B, -i, -d pass these on to diff(1)
97 -S show files that are the same in the file list
98 -C Ignore files listed in .cvsignore files
99
100 Note: dirdiff needs to be able to load the libfilecmp.so.0.0 shared library
101 for the -r or -t flags to work.}
102 }
103
104 proc NewDirDialog {} {
105 global d0 d1 d2 d3 d4
106 toplevel .newdirDlg
107 wm transient .newdirDlg
108 wm title .newdirDlg "Directories"
109 set waitvar 0
110
111 frame .newdirDlg.top -borderwidth 2 -relief groove
112 pack .newdirDlg.top -side top -fill x \
113 -ipadx 20 -ipady 20 -padx 5 -pady 5
114
115 button .newdirDlg.top.b0 -text "Browse..." -command { set d0 [tk_chooseDirectory] }
116 button .newdirDlg.top.b1 -text "Browse..." -command { set d1 [tk_chooseDirectory] }
117 button .newdirDlg.top.b2 -text "Browse..." -command { set d2 [tk_chooseDirectory] }
118 button .newdirDlg.top.b3 -text "Browse..." -command { set d3 [tk_chooseDirectory] }
119 button .newdirDlg.top.b4 -text "Browse..." -command { set d4 [tk_chooseDirectory] }
120 for { set n 0 } { $n < 5 } { incr n } {
121 set dn [expr {$n + 1}]
122 label .newdirDlg.top.l$n -text "Directory $dn"
123 entry .newdirDlg.top.e$n -width 25 -textvariable d$n
124 grid .newdirDlg.top.l$n -row $n -column 0 -sticky e
125 grid .newdirDlg.top.e$n -row $n -column 1 -sticky sew -pady 4
126 grid .newdirDlg.top.b$n -row $n -column 2 -sticky w
127 }
128 grid columnconfigure .newdirDlg.top 0 -weight 0
129 grid columnconfigure .newdirDlg.top 1 -weight 1
130 grid columnconfigure .newdirDlg.top 2 -weight 0
131
132 frame .newdirDlg.bot
133 button .newdirDlg.bot.ok -text "OK" -width 5 -default active \
134 -command {
135 set dirs [list $d0 $d1 $d2 $d3 $d4]
136 destroy .newdirDlg
137 set waitvar 1
138 }
139 button .newdirDlg.bot.cancel -text "Cancel" -width 5 -default normal \
140 -command {
141 set dirs {}
142 destroy .newdirDlg
143 exit 0
144 }
145
146 pack .newdirDlg.bot -side bottom -fill x -expand n
147 pack .newdirDlg.bot.ok .newdirDlg.bot.cancel \
148 -side left -fill none -expand y -pady 4
149
150 tkwait variable waitvar
151 }
152
153 proc addfiles {sd} {
154 global dirs stat onlyfiles statinfo fserial nextserial
155 global filetype filesize filetime nxdirmode
156 global docvsignore cvsignores defaultcvsignore
157 if {$nxdirmode == 0} {
158 set dcount 0
159 foreach d $dirs {
160 if {[catch {file stat $d/$sd stat}] == 0} {
161 if {$stat(type) == "directory"} {incr dcount}
162 }
163 }
164 if {$dcount <= 1} {
165 return {}
166 }
167 }
168 if {$docvsignore} {
169 # read the .cvsignore in each directory
170 set cvsignores($sd) {}
171 foreach d $dirs {
172 catch {
173 set ign $defaultcvsignore
174 set f [open $d/$sd.cvsignore r]
175 while {[gets $f line] >= 0} {
176 foreach i [split $line] {
177 if {$i == "!"} {
178 set ign {}
179 } else {
180 lappend ign $i
181 }
182 }
183 }
184 close $f
185 set cvsignores($sd) [concat $cvsignores($sd) $ign]
186 }
187 }
188 set cvsignores($sd) [lsort -unique $cvsignores($sd)]
189 }
190 foreach d $dirs {
191 foreach f [lsort [glob -nocomplain $d/$sd* $d/$sd.*]] {
192 set fs $sd[file tail $f]
193 set wantim 0
194 if [notnuked $fs] {
195 if {[catch {file lstat $f stat}] == 0} {
196 if {$stat(type) == "file"} {
197 if [info exists onlyfiles] {
198 foreach o $onlyfiles {
199 if [string match $o $fs] {
200 set wantim 1
201 break
202 }
203 }
204 } else {
205 set wantim [notcvsignored $fs]
206 }
207 } elseif {$stat(type) == "directory"} {
208 append fs /
209 set wantim 1
210 }
211 }
212 }
213 if {$wantim} {
214 if {![info exists files($fs)]} {
215 set fserial($fs) [incr nextserial]
216 set files($fs) 1
217 }
218 set filetype($f) $stat(type)
219 set filesize($f) $stat(size)
220 set filetime($f) $stat(mtime)
221 }
222 }
223 }
224 return [lsort [array names files]]
225 }
226
227 # Called to re-lstat a given file across all directories
228 proc updatefileinfo {f} {
229 global dirs filetype filesize filetime
230
231 foreach d $dirs {
232 set df [joinname $d [string trimright $f /]]
233 if {[catch {file lstat $df stat}] == 0} {
234 set filetype($df) $stat(type)
235 set filesize($df) $stat(size)
236 set filetime($df) $stat(mtime)
237 } else {
238 catch {unset filetype($df)}
239 }
240 }
241 }
242
243 # Returns 1 if we are interested in this file, i.e. if it isn't
244 # matched by something in the exclude list
245 proc notnuked {f} {
246 global nukefiles
247 set ft [file tail $f]
248 if {$ft == "." || $ft == ".."} {
249 return 0
250 }
251 foreach n $nukefiles {
252 if {[string match $n $f] || [string match $n $ft]} {
253 return 0
254 }
255 }
256 return 1
257 }
258
259 proc notcvsignored {f} {
260 global docvsignore cvsignores
261 set sd [file dirname $f]/
262 if {$sd == "./"} {
263 set sd ""
264 }
265 set ft [file tail $f]
266 if {$docvsignore && [info exists cvsignores($sd)]} {
267 foreach n $cvsignores($sd) {
268 if {[string match $n $ft]} {
269 return 0
270 }
271 }
272 }
273 return 1
274 }
275
276 proc joinname {dir f} {
277 global filemode
278 if {$filemode} {
279 return $dir
280 }
281 return [file join $dir $f]
282 }
283
284 proc fileisa {f t} {
285 global filetype
286 return [expr {[info exists filetype($f)] && $filetype($f) == $t}]
287 }
288
289 proc diffages {f showsame maxdepth} {
290 global dirs nofilecmp rcsflag filesize filetime nxdirmode
291 set numgroups 0
292 set notexist {}
293 set doesexist {}
294 foreach d $dirs {
295 set sameas($d) {}
296 set group($d) 0
297 set fname [joinname $d [string trimright $f /]]
298 if {!([fileisa $fname "file"]
299 || ($maxdepth <= 0 && [fileisa $fname "directory"]))} {
300 set fd [file dirname $fname]
301 if {$nxdirmode || [file dirname $f] == "." \
302 || [fileisa $fd "directory"]} {
303 lappend notexist $d
304 }
305 } else {
306 lappend doesexist $d
307 set fsize($d) $filesize($fname)
308 set fmtime($d) $filetime($fname)
309 foreach d2 $dirs {
310 if {$d2 == $d} break
311 if {$sameas($d2) != "" || $group($d2) == 0} continue
312 if {$fsize($d) == $fsize($d2) \
313 && $fmtime($d) == $fmtime($d2)} {
314 set notsame 0
315 } elseif {$rcsflag != "" || $fsize($d) == $fsize($d2)} {
316 set fname2 [joinname $d2 [string trimright $f /]]
317 if $nofilecmp {
318 set notsame [catch {exec cmp -s $fname $fname2}]
319 } else {
320 set same 0
321 catch {
322 set same [eval filecmp $rcsflag $fname $fname2]
323 }
324 set notsame [expr !$same]
325 }
326 } else {
327 set notsame 1
328 }
329 if {$notsame == 0} {
330 set sameas($d) $d2
331 set g $group($d2)
332 set group($d) $g
333 lappend groupelts($g) $d
334 if {$fmtime($d) > $gmtime($g)} {
335 set gmtime($g) $fmtime($d)
336 }
337 break
338 }
339 }
340 if {$sameas($d) == ""} {
341 incr numgroups
342 set group($d) $numgroups
343 set groupelts($numgroups) $d
344 set gmtime($numgroups) $fmtime($d)
345 }
346 }
347 }
348 if {!$showsame && $numgroups == 1 && $notexist == ""} {
349 return {}
350 }
351 set glist {}
352 for {set g 1} {$g <= $numgroups} {incr g} {
353 lappend glist [list [format "%.8x" $gmtime($g)] $g]
354 }
355 set grank(0) 0
356 set rank 1
357 foreach xx [lsort -decreasing $glist] {
358 set g [lindex $xx 1]
359 set grank($g) $rank
360 incr rank
361 }
362 set res {}
363 foreach d $dirs {
364 lappend res $grank($group($d))
365 }
366 return [list $numgroups $res]
367 }
368
369 proc subdirgroups {sd} {
370 global dirs
371 set nummiss 0
372 set groups {}
373 foreach d $dirs {
374 set fn [joinname $d $sd]
375 if {![fileisa $fn "directory"]} {
376 set pd [file dirname $sd]
377 lappend groups 0
378 set fnp [joinname $d $pd]
379 if {$pd == "." || [fileisa $fnp "directory"]} {
380 incr nummiss
381 }
382 } else {
383 lappend groups 1
384 }
385 }
386 if {$nummiss == 0} {
387 return {}
388 }
389 return [list dir $groups]
390 }
391
392 set stringx 8
393
394 proc initcanv {} {
395 global canvw canvx canvy canvy0 linespc stringx ruletype
396 global dirs arroww blotspc blotw ycoord filelistfont
397 $canvw delete all
398 $canvw yview moveto 0
399 $canvw conf -scrollregion {0 0 0 1}
400 catch {unset ycoord}
401 catch {unset ruletype}
402 set canvy $canvy0
403 if {![info exists arroww]} {
404 set stringx [expr $blotspc + 8]
405 return
406 }
407 set numdirs [llength $dirs]
408 set stringx [expr $numdirs * $blotspc + 8]
409 $arroww delete all
410 set arrowh [expr ($numdirs+1) * $linespc]
411 $arroww conf -height $arrowh
412 set y 0
413 set yoff [expr $linespc / 2]
414 set x [expr $canvx + 3 + ($blotw / 2)]
415 set x2 [expr $stringx - 3]
416 set horiz [expr $arrowh + 2]
417 foreach d $dirs {
418 set y2 [expr $y + $yoff]
419 set t [$arroww create line $x $horiz $x $y2 $x2 $y2 \
420 -width 2 -arrow first]
421 $arroww addtag arrows withtag $t
422 set t [$arroww create text $stringx $y -text $d -anchor nw \
423 -font $filelistfont]
424 $arroww addtag strings withtag $t
425 incr y $linespc
426 incr x $blotspc
427 }
428
429 set dx [expr [$arroww cget -width] / 2]
430 set dy [expr $horiz - 1]
431 $arroww create text $dx $dy -text "Older <- " -anchor se
432 $arroww create image $dx $dy -image paper_red -anchor sw
433 incr dx $blotspc
434 $arroww create image $dx $dy -image paper_orange -anchor sw
435 incr dx $blotspc
436 $arroww create image $dx $dy -image paper_yellow -anchor sw
437 incr dx $blotspc
438 $arroww create image $dx $dy -image paper_yellowgreen -anchor sw
439 incr dx $blotspc
440 $arroww create image $dx $dy -image paper_green -anchor sw
441 incr dx $blotspc
442 $arroww create text $dx $dy -text " -> Newer" -anchor sw
443 }
444
445 proc addcline {blots str} {
446 global canvy canvx linespc stringx blotw bloth blotspc canvw ycoord
447 global filelistfont
448 set x [expr $canvx+1]
449 set y [expr $canvy+1]
450 foreach b $blots {
451 set t [$canvw create image $x $y -image $b -anchor nw]
452 $canvw addtag blots withtag $t
453 incr x $blotspc
454 }
455 set t [$canvw create text $stringx $canvy -anchor nw -text $str \
456 -font $filelistfont]
457 $canvw addtag strings withtag $t
458 set ycoord($str) $canvy
459 incr canvy $linespc
460 set vis [lindex [$canvw yview] 1]
461 $canvw conf -scrollregion "0 0 0 $canvy"
462 if {$vis >= 1.0} {
463 $canvw yview moveto 1
464 }
465 }
466
467 proc displine {groups name} {
468 global agecolors
469 set ng [lindex $groups 0]
470 set cols $agecolors($ng)
471 set blots {}
472 foreach g [lindex $groups 1] {
473 lappend blots [lindex $cols $g]
474 }
475 addcline $blots $name
476 }
477
478 proc dispfilelines {groups} {
479 global agecolors dirs
480 set ng [lindex $groups 0]
481 set cols $agecolors($ng)
482 set n 0
483 foreach g [lindex $groups 1] {
484 addcline [lindex $cols $g] [lindex $dirs $n]
485 incr n
486 }
487 }
488
489 proc ruleoff {stopped} {
490 global canvw canvy linespc ruletype
491 set y [expr $canvy + $linespc/2]
492 set color black
493 if {$stopped} {set color red}
494 $canvw create line 0 $y [$canvw cget -width] $y -width 2 -fill $color
495 incr canvy $linespc
496 set vis [lindex [$canvw yview] 1]
497 $canvw conf -scrollregion "0 0 0 $canvy"
498 if {$vis >= 1.0} {
499 $canvw yview moveto 1
500 }
501 set ruletype $stopped
502 }
503
504 proc updatecline {si di f} {
505 global ycoord canvw blotspc bloth blotw groups
506 global filemode dirs changed
507 if {$filemode} {
508 set fs [lindex $dirs $si]
509 set fd [lindex $dirs $di]
510 if {![info exists ycoord($fs)] || ![info exists ycoord($fd)]} return
511 set ys [expr $ycoord($fs) + 2]
512 set yd [expr $ycoord($fd) + 2]
513 set xs 2
514 set xd 2
515 } else {
516 if {![info exists ycoord($f)]} return
517 set ys [expr $ycoord($f) + 2]
518 set yd $ys
519 set xs [expr $si * $blotspc + 2]
520 set xd [expr $di * $blotspc + 2]
521 }
522 set ts [$canvw find overlapping $xs $ys \
523 [expr $xs+$blotw-2] [expr $ys+$bloth-2]]
524 set td [$canvw find overlapping $xd $yd \
525 [expr $xd+$blotw-2] [expr $yd+$bloth-2]]
526 if {$ts != "" && $td != ""} {
527 $canvw itemconf $td -image [$canvw itemcget $ts -image]
528 set changed 1
529 }
530 set ng [lindex $groups($f) 0]
531 set g [lindex $groups($f) 1]
532 set groups($f) [list $ng [lreplace $g $di $di [lindex $g $si]]]
533 }
534
535 proc refreshcline {f} {
536 global ycoord canvw blotspc bloth blotw groups
537 global agecolors changed
538 if {![info exists ycoord($f)]} return
539 set y [expr $ycoord($f) + 2]
540 set ng [lindex $groups($f) 0]
541 set cols $agecolors($ng)
542 set x 2
543 foreach g [lindex $groups($f) 1] {
544 set t [$canvw find overlapping $x $y \
545 [expr $x+$blotw-2] [expr $y+$bloth-2]]
546 if {$t != ""} {
547 $canvw itemconf $t -image [lindex $cols $g]
548 set changed 1
549 }
550 incr x $blotspc
551 }
552 }
553
554 proc makepatchmenu {base} {
555 global dirs
556 menu $base.p -tearoff 0
557 set sub1 0
558 foreach d1 $dirs {
559 set any 0
560 incr sub1
561 menu $base.p.$sub1 -tearoff 0
562 foreach d2 $dirs {
563 if {$d1 == $d2} continue
564 set any 1
565 $base.p.$sub1 add command -label "$d2" \
566 -command "makepatch \"$d1\" \"$d2\""
567 }
568 if {$any} {
569 $base.p add cascade -label "$d1 ->" -menu $base.p.$sub1
570 }
571 incr sub1
572 }
573 $base add cascade -label "Make patch" -menu $base.p
574 }
575
576 proc maketouchmenu {base} {
577 global dirs dirreadonly
578 menu $base.t -tearoff 0
579 set i 0
580 foreach d $dirs {
581 if {!$dirreadonly($i)} {
582 $base.t add command -label $d -command "touchfiles \"$d\""
583 }
584 incr i
585 }
586 $base add cascade -label "Touch" -menu $base.t
587 }
588
589 proc readonlychange {i} {
590 global dirreadonly
591 .bar.file.t entryconf $i \
592 -state [expr {$dirreadonly($i)? "disabled": "normal"}]
593 selcurfile
594 }
595
596 proc makewins {} {
597 global canvw numlines linespc arroww diffbut copybut filelabel nofilecmp
598 global filemode dirs dirinterest filelistfont dirreadonly
599 global rcsflag diffiflag diffwflag diffbflag diffBflag diffdflag
600 global bgcolors
601
602 set i 0
603 foreach d $dirs {
604 set dirreadonly($i) 0
605 incr i
606 }
607
608 # Native-style menubar
609 menu .bar
610 .bar add cascade -label "File" -menu .bar.file
611
612 # File menu
613 menu .bar.file
614 .bar.file add command -label "Rediff" -command rediff
615 if {!$filemode} {
616 .bar.file add command -label "Redisplay" -command "redisplay 1"
617 }
618 set menubg [lindex [.bar.file configure -background] 4]
619 set bgcolors(1) [list $menubg $menubg]
620 set bgcolors(2) [list $menubg green "#ff8080"]
621 set bgcolors(3) [list $menubg green yellow "#ff8080"]
622 set bgcolors(4) [list $menubg green yellow orange "#ff8080"]
623 set bgcolors(5) [list $menubg green "#e0ff90" yellow orange "#ff8080"]
624
625 makepatchmenu .bar.file
626 maketouchmenu .bar.file
627 .bar.file add command -label "Exclude selection" -command exclsel
628 .bar.file add command -label "Stop" -command "set stopped 1"
629 .bar.file add separator
630 .bar.file add command -label "Quit" -command "set stopped 1; destroy ."
631
632 # Diff menu
633 set diffbut .bar.diff
634 menu $diffbut
635 .bar add cascade -label "Diff" -menu $diffbut
636 $diffbut add command -label "All" -command difffiles
637
638 # Copy menu
639 set copybut .bar.copy
640 menu $copybut
641 .bar add cascade -label "Copy/Del" -menu $copybut
642
643 # Options menu
644 menu .bar.options
645 .bar add cascade -label "Options" -menu .bar.options
646
647 .bar.options add radiobutton -label "Literal comparison" \
648 -variable rcsflag -value " " \
649 -state [expr {$nofilecmp? "disabled": "normal"}]
650 .bar.options add radiobutton -label "Ignore differences in RCS strings" \
651 -variable rcsflag -value "-rcs" \
652 -state [expr {$nofilecmp? "disabled": "normal"}]
653 .bar.options add checkbutton -label "Show files that are identical" \
654 -variable showsame
655
656 .bar.options add checkbutton -label "Redisplay immediately" \
657 -variable redisp_immed
658 .bar.options add checkbutton -label "Show files that aren't in some dirs" \
659 -variable nxdirmode
660 .bar.options add checkbutton -label "Ignore files in .cvsignore" \
661 -variable docvsignore
662 .bar.options add command -label "Excluded files..." -command exclfilelist
663 .bar.options add command -label "Diff options..." -command diffoptions
664 .bar.options add command -label "External viewers..." -command extprograms
665 .bar.options add command -label "Save options" -command saveoptions
666
667 .bar.options add separator
668 set i 0
669 foreach d $dirs {
670 set dirinterest($i) 1
671 .bar.options add checkbutton -label "Show $d" \
672 -variable dirinterest($i) -command redisplay
673 incr i
674 }
675
676 .bar.options add separator
677 set i 0
678 foreach d $dirs {
679 .bar.options add checkbutton -label "Read-only $d" \
680 -variable dirreadonly($i) -command "readonlychange $i"
681 incr i
682 }
683
684 # Help menu
685 menu .bar.help
686 .bar add cascade -label "Help" -menu .bar.help
687 .bar.help add command -label "About dirdiff" -command about
688 .bar.help add command -label "About diff" -command about_diff
689 .bar.help add command -label "Show help text" -command helptext
690
691 . configure -menu .bar
692
693 # make the filename display bar
694 if {!$filemode} {
695 frame .file -relief sunk -bd 1
696 set filelabel .file.name
697 #label $filelabel -relief flat -padx 7 -text "File: "
698 label $filelabel -relief flat -padx 7 -image paper
699 set fileentry .file.ent
700 entry $fileentry -relief sunk -bd 1 -textvariable selfile \
701 -font $filelistfont
702 pack $filelabel -side left
703 pack $fileentry -side left -fill x -expand yes
704 pack .file -side top -fill x
705 }
706
707 # make the frame containing the 2 canvases (one for the top section
708 # containing the directory names, one for the files) and the scrollbar
709 # in file mode the top section is omitted
710 frame .cf
711 if {$filemode} {
712 set numlines [llength $dirs]
713 }
714 canvas .cf.c -height [expr $numlines * $linespc] \
715 -yscrollincr $linespc -yscrollcommand ".csb set" \
716 -bg white -relief sunk -bd 1
717 set canvw .cf.c
718 if {!$filemode} {
719 canvas .cf.d -height [expr 3 * $linespc] \
720 -relief flat -bd 1 -highlightthickness 0
721 set arroww .cf.d
722 pack .cf.d -side top -fill x
723 }
724 pack .cf.c -side bottom -fill both -expand 1
725 scrollbar .csb -command "$canvw yview" -highlightthickness 0
726 pack .csb -side right -fill y
727 pack .cf -side left -fill both -expand 1
728
729 if {!$filemode} {
730 bind $fileentry <Return> "search_canvas"
731 }
732 # set up event bindings on the main canvas
733 bind $canvw <1> {selcanvline %x %y 0}
734 bind $canvw <Shift-1> {selcanvline %x %y 1}
735 bind $canvw <B1-Motion> {selcanvline %x %y 2}
736 bind $canvw <Control-1> {selcanvline %x %y 3}
737 # This caused selcurfile to always be done twice
738 #bind $canvw <ButtonRelease-1> {selcurfile}
739 bind $canvw <ButtonRelease-4> "$canvw yview scroll -5 u"
740 bind $canvw <ButtonRelease-5> "$canvw yview scroll 5 u"
741 bind $canvw <2> "$canvw scan mark 0 %y"
742 bind $canvw <B2-Motion> "$canvw scan dragto 0 %y"
743 bind $canvw <Double-Button-1> "set doubleclick 1; showsomediff 0"
744 bind $canvw <Key-Return> "showsomediff 0"
745 $canvw conf -scrollregion {0 0 0 1}
746 if {!$filemode} {
747 bind . N "diffnextfile 1"
748 bind . P "diffnextfile -1"
749 }
750 bind . C copydifffile
751 bind . <Key-Return> "showsomediff 0"
752 bind . <Key-Prior> "$canvw yview scroll -1 p"
753 bind . <Key-Next> "$canvw yview scroll 1 p"
754 bind . <Key-Delete> "$canvw yview scroll -1 p"
755 bind . <Key-BackSpace> "$canvw yview scroll -1 p"
756 bind . <Key-space> "$canvw yview scroll 1 p"
757 bind . <Key-Up> "$canvw yview scroll -1 u"
758 bind . <Key-Down> "$canvw yview scroll 1 u"
759 bind . Q "set stopped 1; destroy ."
760 # Need a way to unselect all
761 bind . <Escape> resetsel
762
763 }
764
765 proc about {} {
766 set w .about
767 if {[winfo exists $w]} {
768 raise $w
769 return
770 }
771 toplevel $w
772 wm title $w "About dirdiff"
773 message $w.m -text {
774 Dirdiff version 2.1
775
776 Copyright © 1999-2005 Paul Mackerras
777
778 Use and redistribute under the terms of the GNU General Public License
779
780 (CVS $Revision: 1.69 $)} \
781 -justify center -aspect 400
782 pack $w.m -side top -fill x -padx 20 -pady 20
783 button $w.ok -text Close -command "destroy $w"
784 pack $w.ok -side bottom
785 }
786
787 proc about_diff {} {
788 set w .about_diff
789 if {[winfo exists $w]} {
790 raise $w
791 return
792 }
793 toplevel $w
794 wm title $w "About diff"
795 set retval [catch "exec diff -v" err]
796 message $w.m -text $err -justify center -aspect 600
797 pack $w.m -side top -fill x -padx 20 -pady 20
798 if {$retval == 0} {
799 text $w.t -bg white -yscrollcommand "$w.sb set" -wrap word
800 scrollbar $w.sb -command "$w.t yview"
801 pack $w.sb -side right -fill y
802 pack $w.t -side left -fill both -expand 1
803 set fdh [open "|diff --help" r]
804 while { [eof $fdh] == 0 } {
805 $w.t insert end "[gets $fdh]\n"
806 }
807 pack $w.t -side top -fill both -expand yes
808 }
809 button $w.ok -text Close -command "destroy $w"
810 pack $w.ok -side bottom
811 }
812
813 proc helptext {} {
814 set w .help
815 if {[winfo exists $w]} {
816 raise $w
817 return
818 }
819 toplevel $w
820 wm title $w "Dirdiff help"
821 text $w.t -font {Times -14} -yscrollcommand "$w.sb set" -wrap word
822 scrollbar $w.sb -command "$w.t yview"
823 pack $w.sb -side right -fill y
824 pack $w.t -side left -fill both -expand 1
825 bind $w <Key-Prior> "$w.t yview scroll -1 p"
826 bind $w <Key-BackSpace> "$w.t yview scroll -1 p"
827 bind $w <Key-Delete> "$w.t yview scroll -1 p"
828 bind $w b "$w.t yview scroll -1 p"
829 bind $w B "$w.t yview scroll -1 p"
830 bind $w <Key-Up> "$w.t yview scroll -1 u"
831 bind $w <Key-Down> "$w.t yview scroll 1 u"
832 bind $w d "$w.t yview scroll \[expr \"int(\[$w.t cget -height\]/2)\"\] u"
833 bind $w D "$w.t yview scroll \[expr \"int(\[$w.t cget -height\]/2)\"\] u"
834 bind $w u "$w.t yview scroll \[expr \"int(-\[$w.t cget -height\]/2)\"\] u"
835 bind $w U "$w.t yview scroll \[expr \"int(-\[$w.t cget -height\]/2)\"\] u"
836 bind $w q "destroy $w"
837 bind $w Q "destroy $w"
838 $w.t insert end {Dirdiff instructions.
839
840 Dirdiff compares all the files in up to five directories. There is one \
841 column in the main window for each directory.
842
843 Each file is shown with a coloured square indicating its status. Files \
844 are like leaves on a deciduous tree: the newest ones are green, and then \
845 they turn yellow, orange, and red as they get older.
846
847 Double-click a file to show differences between two versions. By default, \
848 the first and last versions are compared, but this can be changed by the \
849 'Diff' menu in the main window.
850
851 You can select several files to copy or to make a patch by shift-clicking.
852
853 You can search for a file by typing part of its name in the entry and \
854 pressing the <Return> key.
855
856 In the diff window, check the boxes on the left margin for changes you \
857 want to preserve, and then choose 'Merge' to move those changes into one \
858 of the files. Alternatively, choose 'Copy' in the main window to copy \
859 across the whole file, replacing any changes.
860
861 'Make patch' produces a file describing the changes between the files that \
862 can be applied by the patch tool. You can edit the patch before saving, \
863 and may wish to add explanatory text, instructions, or patch(1) Prereq \
864 lines at the beginning. To save the patch, enter a filename in the patch \
865 window relative to the current directory, and choose 'Save'. This will \
866 also close the window.
867
868 If you are sending out patches, then the "from" directory should be the \
869 original version of the source. Try to make sure that the two files have \
870 the same number of leading directories. See the patch(1) man page for \
871 more information.
872 }
873
874 $w.t conf -state disabled
875 }
876
877 proc filediffs {} {
878 global groups selitem fserial
879 updatefileinfo .
880 set groups(.) [set gr [diffages . 1 1]]
881 set fserial(.) 1
882 dispfilelines $gr
883 clearsecsel
884 selcurfile
885 }
886
887 proc diffsin {sd maxdepth} {
888 global groups stopped showsame alllines nxdirmode
889 foreach f [addfiles $sd] {
890 if {$stopped} return
891 lappend alllines $f
892 set d [string trimright $f /]
893 if {$d == $f || $maxdepth <= 0} {
894 set groups($f) [set gr [diffages $f $showsame $maxdepth]]
895 if [interesting_line $gr] {
896 displine $gr $f
897 }
898 } else {
899 set groups($f) [set gr [subdirgroups $d]]
900 if {$nxdirmode == 0 && [interesting_line $gr]} {
901 displine $gr $f
902 }
903 diffsin $f [expr $maxdepth-1]
904 }
905 catch update
906 }
907 }
908
909 proc canvdiffs {} {
910 global canvw groups stopped filemode alllines
911 global filetype filetime filesize maxdepth
912 set stopped 0
913 set alllines {}
914 catch {unset filetype}
915 catch {unset filetime}
916 catch {unset filesize}
917 initcanv
918 if {$filemode} {
919 filediffs
920 } else {
921 diffsin {} $maxdepth
922 if {[catch update]} return
923 ruleoff $stopped
924 }
925 if {[catch update]} return
926 if {[lindex [$canvw yview] 1] >= 1.0} {
927 $canvw yview moveto 0
928 }
929 }
930
931 proc textitemat {x y} {
932 global canvw
933 foreach i [$canvw find overlapping $x $y [expr $x+50] $y] {
934 if {[$canvw type $i] == "text"} {
935 return $i
936 }
937 }
938 return {}
939 }
940
941 proc itemofname {f} {
942 global stringx ycoord linespc
943 if {![info exists ycoord($f)]} {
944 return {}
945 }
946 return [textitemat [expr {$stringx+5}] [expr {$ycoord($f) + $linespc/2}]]
947 }
948
949 proc addtobbox {bbox x y} {
950 set x0 [lindex $bbox 0]
951 set y0 [lindex $bbox 1]
952 set x1 [lindex $bbox 2]
953 set y1 [lindex $bbox 3]
954 if {$x < $x0} {set x0 $x}
955 if {$y < $y0} {set y0 $y}
956 if {$x > $x1} {set x1 $x}
957 if {$x > $y1} {set y1 $y}
958 return [list $x0 $y0 $x1 $y1]
959 }
960
961 proc selcanvline {x y tipe} {
962 global canvw stringx selitem secsel clickitem groups selfile clickmode
963 global filemode doubleclick clicky
964 if {$filemode} return
965 set x [expr $stringx+5]
966 set y [$canvw canvasy $y]
967 set it [textitemat $x $y]
968 if {$it == {}} return
969 if {$tipe == 0} {
970 # click, no shift
971 clearsecsel
972 selectitem $it
973 set clickitem $it
974 set clicky $y
975 set clickmode 1
976 selcurfile
977 addsecsel $it
978 set doubleclick 0
979 } elseif {$tipe == 1} {
980 # shift-click
981 set clickitem $it
982 set clicky $y
983 if {$it != $selitem} {
984 if {![info exists secsel($it)]} {
985 set clickmode 1
986 addsecsel $it
987 } else {
988 set clickmode 0
989 remsecsel $it
990 }
991 }
992 set doubleclick 0
993 } elseif {$tipe == 2 || $tipe == 3} {
994 # motion with button 1 down
995 if {$tipe == 2 && [info exists doubleclick] && $doubleclick} return
996 if {![info exists clickitem]} return
997 foreach i [$canvw find overlapping \
998 $x [expr {$y < $clicky? $y: $clicky}] \
999 [expr $x+50] [expr {$y > $clicky? $y: $clicky}]] {
1000 if {[$canvw type $i] == "text"} {
1001 set f [$canvw itemcget $i -text]
1002 if {$groups($f) == $groups($selfile)} {
1003 if {$clickmode && ![info exists secsel($i)]} {
1004 addsecsel $i
1005 } elseif {!$clickmode && [info exists secsel($i)]} {
1006 remsecsel $i
1007 }
1008 }
1009 }
1010 }
1011 }
1012 }
1013
1014 proc selectitem {it} {
1015 global selitem canvw
1016 set selitem $it
1017 $canvw select from $it 0
1018 $canvw select to $it end
1019 }
1020
1021 proc addsecsel {it} {
1022 global canvw secsel
1023 set t [eval $canvw create rect [$canvw bbox $it] -outline {{}} \
1024 -tags secsel -fill [$canvw cget -selectbackground]]
1025 $canvw lower $t
1026 set secsel($it) $t
1027 }
1028
1029 proc remsecsel {it} {
1030 global canvw secsel
1031 $canvw delete $secsel($it)
1032 unset secsel($it)
1033 }
1034
1035 proc clearsecsel {} {
1036 global canvw secsel
1037 $canvw delete secsel
1038 catch {unset secsel}
1039 }
1040
1041 proc selnextline {inc} {
1042 global canvw selitem linespc stringx canvy filemode
1043 if {$filemode} {
1044 if {$inc != 0} {
1045 return 0
1046 }
1047 selcurfile
1048 return 1
1049 }
1050 if {$selitem == ""} {
1051 return 0
1052 }
1053 set y [expr [lindex [$canvw bbox $selitem] 1] + $linespc * $inc + 5]
1054 set x [expr $stringx+5]
1055 set i [textitemat $x $y]
1056 if {$i == ""} {
1057 return 0
1058 }
1059 clearsecsel
1060 selectitem $i
1061 set bbox [$canvw bbox $i]
1062 set y [expr {([lindex $bbox 1] + [lindex $bbox 3]) / 2.0}]
1063 if {$canvy > 0} {
1064 set ytop [expr {($y - $linespc / 2.0) / $canvy}]
1065 set ybot [expr {($y + $linespc / 2.0) / $canvy}]
1066 set wnow [$canvw yview]
1067 if {$ytop < [lindex $wnow 0]} {
1068 $canvw yview moveto $ytop
1069 } elseif {$ybot > [lindex $wnow 1]} {
1070 set wh [expr {[lindex $wnow 1] - [lindex $wnow 0]}]
1071 $canvw yview moveto [expr {$ybot - $wh}]
1072 }
1073 } else {
1074 $canvw yview moveto 0
1075 }
1076 selcurfile
1077 addsecsel $i
1078 return 1
1079 }
1080
1081 proc calcgroupelts {f} {
1082 global groupelts numgroups groups
1083 set gr $groups($f)
1084 set numgroups [lindex $gr 0]
1085 if {$numgroups == "dir"} {
1086 set numgroups 1
1087 }
1088 set gr [lindex $gr 1]
1089 for {set g 0} {$g <= $numgroups} {incr g} {
1090 set groupelts($g) {}
1091 }
1092 set i 0
1093 foreach g $gr {
1094 lappend groupelts($g) $i
1095 incr i
1096 }
1097 }
1098
1099 proc selcurfile {} {
1100 global canvw selitem filelabel selfile groups filemode
1101 global groupelts diffbut copybut numgroups
1102 if {!$filemode} {
1103 if {$selitem == ""} return
1104 set selfile [$canvw itemcget $selitem -text]
1105 } else {
1106 set selfile .
1107 }
1108 calcgroupelts $selfile
1109 set x [string trimright $selfile /]
1110 if {$x == $selfile} {
1111 if {[info exists filelabel]} {
1112 $filelabel conf -image paper
1113 }
1114 confdiffbut 0
1115 confcopybutfile
1116 } else {
1117 if {[info exists filelabel]} {
1118 $filelabel conf -image folder
1119 }
1120 confdiffbut 1
1121 confcopybutdir
1122 }
1123 }
1124
1125 proc mkdiffimage {gn go} {
1126 global numgroups agecolors
1127 set cols $agecolors($numgroups)
1128 set i1 [lindex $cols $go]
1129 set i2 [lindex $cols $gn]
1130 set iname "icon-$i1-$i2"
1131 if {![info exists $iname]} {
1132 set w1 [image width $i1]
1133 set w2 [image width $i2]
1134 set h [image height $i1]
1135 image create photo $iname -width [expr {$w1+$w2}] -height $h
1136 $iname copy $i1
1137 $iname copy $i2 -to $w1 0
1138 }
1139 return $iname
1140 }
1141
1142 proc confdiffbut {isdir} {
1143 global diffbut numgroups dirs selfile groupelts filemode
1144 global groups agecolors bgcolors compound_ok
1145 $diffbut delete 0 end
1146 destroy [winfo children $diffbut]
1147 set ng [lindex $groups($selfile) 0]
1148
1149 if {$isdir} {
1150 # do nothing
1151 } elseif {$numgroups == 1} {
1152 set xi [lindex $groupelts(1) 0]
1153 if {$xi != ""} {
1154 set x [lindex $dirs $xi]
1155 $diffbut add command -label "Show $x" \
1156 -command "showfile \"$x\" \"$selfile\""
1157 }
1158 } elseif {$numgroups > 1} {
1159 if {$numgroups > 2} {
1160 set x {}
1161 for {set gn 1} {$gn <= $numgroups} {incr gn} {
1162 set i [lindex $groupelts($gn) 0]
1163 lappend x [lindex $dirs $i]
1164 }
1165 $diffbut add command -label "$numgroups-way diff" \
1166 -command "diffn {$x} {$selfile}"
1167 }
1168 for {set gn 1} {$gn < $numgroups} {incr gn} {
1169 set yi [lindex $groupelts($gn) 0]
1170 if {$yi == ""} continue
1171
1172 set age [lindex [lindex $groups($selfile) 1] $yi]
1173 set im [lindex $agecolors($ng) $age]
1174 set cl [lindex $bgcolors($ng) $age]
1175 set y [lindex $dirs $yi]
1176 if {[winfo exists $diffbut.$gn]} {destroy $diffbut.$gn}
1177 menu $diffbut.$gn -tearoff 0
1178 set any 0
1179 for {set go [expr $gn+1]} {$go <= $numgroups} {incr go} {
1180 set xi [lindex $groupelts($go) 0]
1181 set age [lindex [lindex $groups($selfile) 1] $xi]
1182 set im2 [lindex $agecolors($ng) $age]
1183 set cl2 [lindex $bgcolors($ng) $age]
1184 set xi [lindex $groupelts($go) 0]
1185 if {$xi == ""} continue
1186 set x [lindex $dirs $xi]
1187 set cmd "diff2 \"$x\" \"$y\" \"$selfile\""
1188 if {$numgroups <= 3} {
1189 if {$compound_ok} {
1190 $diffbut add command -label "$x vs. $y" \
1191 -command $cmd \
1192 -image [mkdiffimage $gn $go] \
1193 -compound left
1194 } else {
1195 $diffbut add command -label "$x vs. $y" \
1196 -command $cmd
1197 }
1198 } else {
1199 incr any
1200 if {$compound_ok} {
1201 $diffbut.$gn add command -label "$x" \
1202 -image $im2 -compound left \
1203 -command $cmd
1204 } else {
1205 $diffbut.$gn add command -label "$x" \
1206 -background $cl2 \
1207 -command $cmd
1208 }
1209 }
1210 }
1211 if {$any} {
1212 if {$compound_ok} {
1213 $diffbut add cascade -label "$y vs. ..." \
1214 -image $im -compound left \
1215 -menu $diffbut.$gn
1216 } else {
1217 $diffbut add cascade -label "$y vs. ..." \
1218 -background $cl \
1219 -menu $diffbut.$gn
1220 }
1221 }
1222 }
1223 }
1224 if {!$filemode} {
1225 $diffbut add separator
1226 $diffbut add command -label "Rediff selected file(s)" \
1227 -command "redifffiles"
1228 }
1229 .bar entryconfigure 2 -state normal
1230 }
1231
1232 proc mkcopyimage {i1 i2} {
1233 if {$i1 == ""} {
1234 return $i2
1235 }
1236 if {$i2 == ""} {
1237 return $i1
1238 }
1239 set iname "icon-$i1-$i2"
1240 if {![info exists $iname]} {
1241 set w1 [image width $i1]
1242 set w2 [image width $i2]
1243 set h [image height $i1]
1244 image create photo $iname -width [expr {$w1+$w2}] -height $h
1245 $iname copy $i1
1246 $iname copy $i2 -to $w1 0
1247 }
1248 return $iname
1249 }
1250
1251 proc confcopybutfile {} {
1252 global copybut groupelts numgroups selfile dirs
1253 global groups agecolors bgcolors compound_ok dirreadonly
1254 $copybut delete 0 end
1255 destroy [winfo children $copybut]
1256 set numdirs [llength $dirs]
1257 set srcs {}
1258 set rev {}
1259 set ng [lindex $groups($selfile) 0]
1260
1261 for {set gn 1} {$gn <= $numgroups} {incr gn} {
1262 set srcs [concat $srcs $groupelts($gn)]
1263 set src [lindex $groupelts($gn) 0]
1264 if {$src == ""} continue
1265 set age [lindex [lindex $groups($selfile) 1] $src]
1266 set im [lindex $agecolors($ng) $age]
1267 set cl [lindex $bgcolors($ng) $age]
1268
1269 set x [lindex $dirs $src]
1270 if {[winfo exists $copybut.new2old$src]} {destroy $copybut.new2old$src}
1271 menu $copybut.new2old$src -tearoff 0
1272 set dsts {}
1273 for {set dst 0} {$dst < $numdirs} {incr dst} {
1274 if {!$dirreadonly($dst) && [lsearch $srcs $dst] < 0} {
1275 lappend dsts $dst
1276 }
1277 }
1278 set any [llength $dsts]
1279 if {$any} {
1280 foreach dst $dsts {
1281 set age [lindex [lindex $groups($selfile) 1] $dst]
1282 set im2 [lindex $agecolors($ng) $age]
1283 set cl2 [lindex $bgcolors($ng) $age]
1284 if {$im2 == "ex"} {set im2 ""}
1285 set y [lindex $dirs $dst]
1286 set cmd "copyselfile \"$src\" \"$dst\" \"$selfile\" 0"
1287 if {$any == 1} {
1288 if {$compound_ok} {
1289 $copybut add command -label "$x -> $y" \
1290 -command $cmd -image [mkcopyimage $im $im2] \
1291 -compound left
1292 } else {
1293 $copybut add command -label "$x -> $y" \
1294 -command $cmd
1295 }
1296 } elseif {$compound_ok} {
1297 $copybut.new2old$src add command -label "$y" \
1298 -image $im2 -compound left \
1299 -command $cmd
1300 } else {
1301 $copybut.new2old$src add command -label "$y" \
1302 -background $cl2 \
1303 -command $cmd
1304 }
1305 }
1306 if {$any > 1} {
1307 if {$compound_ok} {
1308 $copybut add cascade -label "$x ->" \
1309 -image $im -compound left \
1310 -menu $copybut.new2old$src
1311 } else {
1312 $copybut add cascade -label "$x ->" \
1313 -background $cl \
1314 -menu $copybut.new2old$src
1315 }
1316 }
1317 }
1318 }
1319 set needsep 1
1320 for {set gn $numgroups} {$gn >= 1} {incr gn -1} {
1321 set src [lindex $groupelts($gn) 0]
1322 if {$src == ""} continue
1323
1324 set age [lindex [lindex $groups($selfile) 1] $src]
1325 set im [lindex $agecolors($ng) $age]
1326 set cl [lindex $bgcolors($ng) $age]
1327 set x [lindex $dirs $src]
1328 if {[winfo exists $copybut.old2new$src]} {destroy $copybut.old2new$src}
1329 menu $copybut.old2new$src -tearoff 0
1330 set dsts {}
1331 for {set gd 1} {$gd < $gn} {incr gd} {
1332 foreach dst $groupelts($gd) {
1333 if {!$dirreadonly($dst)} {
1334 lappend dsts $dst
1335 }
1336 }
1337 }
1338 set any [llength $dsts]
1339 if {$any} {
1340 if $needsep {
1341 $copybut add separator
1342 set needsep 0
1343 }
1344 foreach dst $dsts {
1345 set age [lindex [lindex $groups($selfile) 1] $dst]
1346 set im2 [lindex $agecolors($ng) $age]
1347 set cl2 [lindex $bgcolors($ng) $age]
1348 set y [lindex $dirs $dst]
1349 set cmd "copyselfile \"$src\" \"$dst\" \"$selfile\" 1"
1350 if {$any == 1} {
1351 if {$compound_ok} {
1352 $copybut add command -label "$x -> $y" \
1353 -command $cmd -image [mkcopyimage $im $im2] \
1354 -compound left
1355 } else {
1356 $copybut add command -label "$x -> $y" \
1357 -command $cmd
1358 }
1359 } elseif {$compound_ok} {
1360 $copybut.old2new$src add command -label "$y" \
1361 -image $im2 -compound left \
1362 -command $cmd
1363 } else {
1364 $copybut.old2new$src add command -label "$y" \
1365 -background $cl2 \
1366 -command $cmd
1367 }
1368 }
1369 }
1370 if {$any > 1} {
1371 if {$compound_ok} {
1372 $copybut add cascade -label "$x ->" \
1373 -image $im -compound left \
1374 -menu $copybut.old2new$src
1375 } else {
1376 $copybut add cascade -label "$x ->" \
1377 -background $cl \
1378 -menu $copybut.old2new$src
1379 }
1380 }
1381 }
1382 if {$groupelts(0) != {}} {
1383 set needsep 1
1384 for {set gn 1} {$gn <= $numgroups} {incr gn} {
1385 foreach dst $groupelts($gn) {
1386 if {$dirreadonly($dst)} continue
1387 set x [lindex $dirs $dst]
1388 if $needsep {
1389 $copybut add separator
1390 set needsep 0
1391 }
1392 if {$compound_ok} {
1393 $copybut add command -label "Remove from $x" \
1394 -image ex -compound left \
1395 -command "removeselfile \"$dst\" \"$selfile\""
1396 } else {
1397 $copybut add command -label "Remove from $x" \
1398 -command "removeselfile \"$dst\" \"$selfile\""
1399 }
1400 }
1401 }
1402 }
1403 .bar entryconfigure 3 -state normal
1404 }
1405
1406 proc confcopybutdir {} {
1407 global copybut groupelts selfile dirs compound_ok dirreadonly
1408 $copybut delete 0 end
1409 set srcs $groupelts(1)
1410 set dsts $groupelts(0)
1411 if {$srcs != {} && $dsts != {}} {
1412 foreach s $srcs {
1413 set x [lindex $dirs $s]
1414 foreach d $dsts {
1415 if {$dirreadonly($d)} continue
1416 set y [lindex $dirs $d]
1417 $copybut add command -label "$x -> $y" \
1418 -command "copyselfile \"$s\" \"$d\" \"$selfile\" 0"
1419 }
1420 }
1421 set needsep 1
1422 foreach s $srcs {
1423 if {$dirreadonly($s)} continue
1424 set x [lindex $dirs $s]
1425 if {$needsep} {
1426 $copybut add separator
1427 set needsep 0
1428 }
1429 if {$compound_ok} {
1430 $copybut add command -label "Remove from $x" \
1431 -image ex -compound left \
1432 -command "removeselfile \"$s\" \"$selfile\""
1433 } else {
1434 $copybut add command -label "Remove from $x" \
1435 -command "removeselfile \"$s\" \"$selfile\""
1436 }
1437 }
1438 }
1439 .bar entryconfigure 3 -state normal
1440 }
1441
1442 proc resetsel {} {
1443 global selitem selfile filelabel diffbut copybut
1444 global canvw
1445 set selitem {}
1446 set selfile {}
1447 $canvw select clear
1448 if {[info exists filelabel]} {
1449 $filelabel conf -image paper
1450 }
1451 .bar entryconfigure 2 -state disabled
1452 .bar entryconfigure 3 -state disabled
1453 clearsecsel
1454 }
1455
1456 proc removediffs {} {
1457 global texttop textw diffing difff
1458 catch {destroy $texttop}
1459 catch {unset texttop}
1460 catch {unset textw}
1461 catch {close $difff}
1462 set diffing 0
1463 }
1464
1465 proc showfile {d f} {
1466 global showprogram incline
1467
1468 set fn [joinname $d $f]
1469
1470 # Show the file in an external viewer
1471 if { [llength $showprogram] > 0} {
1472 eval "exec $showprogram \"$fn\" &"
1473 return
1474 }
1475 # Or make our own viewer
1476 global textw texttop mergebut
1477 if {!([info exists textw] && [winfo exists $textw])} {
1478 maketextw
1479 } else {
1480 raise $texttop
1481 }
1482 wm title $texttop "Contents of $fn"
1483 $mergebut.m delete 0 end
1484 $textw conf -state normal -tabs {}
1485 $textw delete 0.0 end
1486 set nl {}
1487 set f [open $fn r]
1488 set n [gets $f line]
1489 while {$n >= 0} {
1490 $textw insert end "$nl$line"
1491 set nl "\n"
1492 set n [gets $f line]
1493 }
1494 close $f
1495 $textw conf -state disabled
1496 bind $textw <2> {}
1497 bind $textw <B2-Motion> {}
1498 bind $textw <ButtonRelease-2> {}
1499 catch {unset incline}
1500 }
1501
1502 proc redifffiles {} {
1503 global groups showsame selfile rediffed groups filemode
1504 if {$filemode} {
1505 resetsel
1506 canvdiffs
1507 return
1508 }
1509 if {$selfile == {}} return
1510 set files [secondarysel $selfile]
1511 foreach f $files {
1512 updatefileinfo $f
1513 set d [string trimright $f /]
1514 if {[lindex $groups($f) 0] != "dir"} {
1515 set groups($f) [diffages $f 1 0]
1516 } else {
1517 set groups($f) [subdirgroups $d]
1518 }
1519 refreshcline $f
1520 }
1521 selcurfile
1522 set rediffed $selfile
1523 }
1524
1525 proc diff2 {d1 d2 f {orig 1}} {
1526 global diffprogram nullfile
1527
1528 global textw groups dirs numgroups bgcolors selfile texttop
1529 global difff lno diffdirs diffiflag diffwflag diffbflag diffBflag diffdflag
1530 global ctxlines difffile charwidth mergebut diffcolors
1531 global diffing filemode rediffed diffnewfirst underlinetabs
1532 global nextlix diffndirs allf origdiffdirs difftabs
1533 set diffndirs 2
1534 set difftabs ""
1535 set allf {0 1}
1536 set group [lindex $groups($selfile) 1]
1537 set i1 [lindex $group [lsearch $dirs $d1]]
1538 set i2 [lindex $group [lsearch $dirs $d2]]
1539 if {($i1 > $i2) == $diffnewfirst} {
1540 set x $d1
1541 set d1 $d2
1542 set d2 $x
1543 set x $i1
1544 set i1 $i2
1545 set i2 $x
1546 }
1547 set ds [list $d1 $d2]
1548 if {$diffing} {
1549 if {$ds == $diffdirs && $f == $difffile} return
1550 catch {close $difff}
1551 }
1552 set diffdirs $ds
1553 set difffile $f
1554 if {$orig} {
1555 set origdiffdirs $ds
1556 }
1557 if {[info exists rediffed] && $rediffed == $f} {
1558 unset rediffed
1559 }
1560 set path1 [joinname $d1 $f]
1561 set path2 [joinname $d2 $f]
1562 set diffopts "-U $ctxlines $diffiflag $diffwflag $diffbflag $diffBflag $diffdflag"
1563
1564 if { [llength $diffprogram] > 0} {
1565 eval "exec $diffprogram \"$path1\" \"$path2\" &"
1566 return
1567 }
1568 # If we used an external diff program, its options are used. If we didn't,
1569 # we use our diffopts, and we may be in trouble.
1570 set caught [catch "exec diff $diffopts $nullfile $nullfile" err]
1571 if {$caught != 0} {
1572 set msg "diff $diffopts\n$err\n"
1573 append msg "Suggestion: Use an external diff viewer such as tkdiff or gvimdiff"
1574 error_popup "$msg"
1575 return
1576 }
1577
1578 # Build a window
1579 if {![info exists textw] || ![winfo exists $textw]} {
1580 maketextw
1581 }
1582 if {$filemode} {
1583 wm title $texttop "Differences: $d1 vs $d2"
1584 } else {
1585 wm title $texttop "Differences: $f"
1586 }
1587 $mergebut.m delete 0 end
1588 $textw conf -state normal
1589 $textw delete 0.0 end
1590 set charwidth [font measure [$textw cget -font] n]
1591 $textw conf -tabs "[expr 4*$charwidth] left [expr 12*$charwidth] left"
1592 set x $bgcolors($numgroups)
1593 $textw tag delete [$textw tag names]
1594 set diffoldcolor [lindex $x $i1]
1595 set diffnewcolor [lindex $x $i2]
1596 $textw tag conf d0 -back $diffoldcolor
1597 $textw tag conf d1 -back $diffnewcolor
1598 set diffcolors [list $diffoldcolor $diffnewcolor]
1599 $textw tag conf sep -back blue -fore white
1600 $textw tag conf ul -underline $underlinetabs
1601 $textw tag lower sep
1602 bind $textw <1> "startbutspan %x %y 0; break"
1603 bind $textw <Shift-Button-1> "startbutspan %x %y 1; break"
1604 bind $textw <B1-Motion> "setbutspan %x %y; break"
1605 bind $textw <ButtonRelease-1> "endbutspan; break"
1606 bind $textw <B1-Leave> "startbutscroll %W %x %y; break"
1607 bind $textw <B1-Enter> "endbutscroll %W %x %y; break"
1608 bind $textw <2> "startdrag $textw %x %y; break"
1609 bind $textw <B2-Motion> "dragdiff $textw %x %y; break"
1610 bind $textw <ButtonRelease-2> "finishdrag $textw"
1611 bind $textw <Any-Button-3> "togglebuts %x %y"
1612
1613 # Start a diff
1614 set difff [open "|diff $diffopts $path1 $path2" r]
1615 set diffing 1
1616 set lno 1
1617 set nextlix 1000
1618 catch {unset oldin}
1619 catch {unset newin}
1620
1621 global linelist
1622 set linelist {{{} {} {}}}
1623
1624 global fcontents
1625 update
1626 catch {
1627 set f [open $path1 r]
1628 set fcontents(0) [split [read -nonewline $f] "\n"]
1629 close $f
1630 }
1631 catch {
1632 set f [open $path2 r]
1633 set fcontents(1) [split [read -nonewline $f] "\n"]
1634 }
1635
1636 global file1lnum file2lnum incline
1637 set file1lnum 0
1638 set file2lnum 0
1639 catch {unset incline}
1640 fconfigure $difff -blocking 0
1641 fileevent $difff readable "readdiff $difff"
1642 }
1643
1644 # linelist structure:
1645 # one entry per displayed line, plus a 0'th null entry (not displayed)
1646 # each entry is: linenumbers treenumbers line lix
1647 # linenumbers contains one entry per tree, {} if this line
1648 # isn't in a tree's version of the file
1649 # treenumbers is a list of the tree numbers where this line appears,
1650 # or {} for a separator line ($allf for a context line)
1651 # line is the actual text of the line, or for a separator line,
1652 # a list of the pieces of text to appear across the separator line
1653 # lix is the index of the checkbutton for this line if present
1654 # header lines (---/+++) have linenumbers == {} and treenumbers == {}
1655
1656 proc readdiff {f} {
1657 global difff lno textw dirreadonly nextlix
1658 global incline linelist
1659 global file1lnum file2lnum diffing textfont
1660 global fcontents allf
1661 if {$f != $difff} {
1662 catch {close $f}
1663 return
1664 }
1665 set n [gets $difff line]
1666 if {$n < 0} {
1667 if {![eof $difff]} return
1668 catch {close $difff}
1669 set diffing 0
1670 if {$lno > 1} {
1671 $textw delete "end - 1c" end
1672 set t [$textw tag names "end - 1l"]
1673 if {$t != ""} {
1674 $textw tag add $t "end - 1l" end
1675 }
1676 }
1677 $textw conf -state disabled
1678 if {$lno > 3} {
1679 confmergebut
1680 confmpatchbut
1681 }
1682 return
1683 }
1684 set x [string index $line 0]
1685 if {$x == "@" && [regexp { -([0-9,]+) .*\+([0-9,]+) } $line z r1 r2]} {
1686 set r1 [lindex [split $r1 ,] 0]
1687 set r2 [lindex [split $r2 ,] 0]
1688 catch {set file1lnum [expr {$r1+0}]}
1689 catch {set file2lnum [expr {$r2+0}]}
1690 lappend linelist [makesepline $lno [list $file1lnum $file2lnum]]
1691 $textw insert end "\n"
1692 redisplaylines $textw $lno 1
1693 incr lno
1694 return
1695 }
1696 set ix 1
1697 if {($x == "-" || $x == "+") && $lno > 3} {
1698 set lix $nextlix
1699 incr nextlix
1700 set incline($lix) 0
1701 makecheckbox $textw $lix end
1702 set ix 2
1703 set line [string range $line 1 end]
1704 if {$x == "-"} {
1705 lappend linelist [list [list $file1lnum {}] 0 $line $lix]
1706 } else {
1707 lappend linelist [list [list {} $file2lnum] 1 $line $lix]
1708 }
1709 } elseif {$x == "-" || $x == "+"} {
1710 set line [string trimleft $line $x]
1711 lappend linelist [list {} [expr {$x == "+"}] $line]
1712 } elseif {$x == " "} {
1713 set line [string range $line 1 end]
1714 lappend linelist [list [list $file1lnum $file2lnum] $allf $line]
1715 }
1716 set lbeg [$textw index "end - 1c linestart"]
1717 $textw insert end "\t"
1718 set r [tabexpand $line $ix]
1719 $textw insert end [lindex $r 0]
1720 $textw insert end "\n"
1721 foreach tgp [lindex $r 1] {
1722 $textw tag add ul "$lbeg + [lindex $tgp 0]c" "$lbeg + [lindex $tgp 1]c"
1723 }
1724 set lend [$textw index "$lbeg + 1l"]
1725 if {$x == "-"} {
1726 $textw tag add d0 $lbeg $lend
1727 } elseif {$x == "+"} {
1728 $textw tag add d1 $lbeg $lend
1729 }
1730 if {$x != "+"} {incr file1lnum}
1731 if {$x != "-"} {incr file2lnum}
1732 incr lno
1733 }
1734
1735 proc confmergebut {} {
1736 global mergebut diffdirs difffile
1737 global groups dirs diffmtime allf dirreadonly
1738 set group [lindex $groups($difffile) 1]
1739 foreach i $allf {
1740 set g [lindex $group [lsearch $dirs [lindex $diffdirs $i]]]
1741 set k 0
1742 foreach gx $group {
1743 if {$gx == $g && !$dirreadonly($k)} {
1744 set f [lindex $dirs $k]
1745 $mergebut.m add command -label "update $f" \
1746 -command "diffmerge $i \"$f\""
1747 set path [joinname $f $difffile]
1748 set diffmtime($path) [file mtime $path]
1749 }
1750 incr k
1751 }
1752 }
1753 }
1754
1755 proc confmpatchbut {} {
1756 global mpatchbut diffdirs difffile
1757 global groups dirs allf dirreadonly
1758 set group [lindex $groups($difffile) 1]
1759 foreach i $allf {
1760 set g [lindex $group [lsearch $dirs [lindex $diffdirs $i]]]
1761 set k 0
1762 foreach gx $group {
1763 if {$gx == $g && !$dirreadonly($k)} {
1764 set f [lindex $dirs $k]
1765 $mpatchbut.m add command -label "for $f" \
1766 -command "diffmpatch $i \"$f\""
1767 }
1768 incr k
1769 }
1770 }
1771 }
1772
1773 proc makesepline {lno lnums} {
1774 global linelist fcontents diffndirs
1775 set plinfo [lindex $linelist [expr $lno-1]]
1776 set lns [lindex $plinfo 0]
1777 set gapmin [llength $fcontents(0)]
1778 set gapmax 0
1779 for {set i 0} {$i < $diffndirs} {incr i} {
1780 set fl($i) [lindex $lnums $i]
1781 set pfl [lindex $lns $i]
1782 if {$pfl == {}} {set pfl 0}
1783 set gap [expr $fl($i) - $pfl - 1]
1784 if {$gap < $gapmin} {set gapmin $gap}
1785 if {$gap > $gapmax} {set gapmax $gap}
1786 set flen [llength $fcontents($i)]
1787 if {$flen == 0} {
1788 set pct($i) "--"
1789 } else {
1790 set pct($i) [expr {int($fl($i) * 100.0 / $flen)}]
1791 }
1792 }
1793 set nls $gapmin
1794 if {$nls != $gapmax} {
1795 append nls "-$gapmax lines"
1796 } elseif {$nls == 1} {
1797 append nls " line"
1798 } else {
1799 append nls " lines"
1800 }
1801 set pad [expr {$diffndirs > 4? " ": " "}]
1802 set line [list "$pad\(gap: $nls)$pad"]
1803 for {set i 0} {$i < $diffndirs} {incr i} {
1804 lappend line "$pad$fl($i) ($pct($i)%)$pad"
1805 }
1806 return [list $lnums {} $line]
1807 }
1808
1809 proc makecheckbox {w lix pos} {
1810 checkbutton $w.inc$lix -variable incline($lix) \
1811 -font {Courier -10} -cursor top_left_arrow \
1812 -highlightthickness 0 -padx 2 -pady 0
1813 $w window create $pos -window $w.inc$lix -stretch true
1814 bind $w.inc$lix <1> "wstartbutspan %W %x %y; break"
1815 bind $w.inc$lix <B1-Motion> "wsetbutspan %W %x %y; break"
1816 bind $w.inc$lix <ButtonRelease-1> "endbutspan; break"
1817 bind $w.inc$lix <Shift-Button-1> "wtogglebuts %W %x %y; break"
1818 bind $w.inc$lix <Any-Button-3> "wtogglebuts %W %x %y"
1819 }
1820
1821 proc tabexpand {line ix} {
1822 set col 0
1823 set txt {}
1824 set tgs {}
1825 set trailb [string length [string trimright $line]]
1826 while {[set tpos [string first "\t" $line]] >= 0} {
1827 if {$tpos > 0} {
1828 append txt [string range $line 0 [expr $tpos-1]]
1829 if {$trailb < $tpos} {
1830 lappend tgs [list [expr $ix+$trailb] [expr $ix+$tpos]]
1831 set trailb 0
1832 } else {
1833 set trailb [expr $trailb-$tpos]
1834 }
1835 incr ix $tpos
1836 incr col $tpos
1837 }
1838 set nsp [expr {8 - ($col & 7)}]
1839 append txt [string range " " 1 $nsp]
1840 lappend tgs [list $ix [expr $ix+$nsp]]
1841 set line [string range $line [expr $tpos+1] end]
1842 incr ix $nsp
1843 incr col $nsp
1844 if {$trailb > 0} {incr trailb -1}
1845 }
1846 append txt $line
1847 set tpos [string length $line]
1848 if {$trailb < $tpos} {
1849 lappend tgs [list [expr $ix+$trailb] [expr $ix+$tpos]]
1850 }
1851 return [list $txt $tgs]
1852 }
1853
1854 proc startbutspan {x y doall} {
1855 global butspanstart textw linelist butspanline
1856 set l [lindex [split [$textw index @$x,$y] .] 0]
1857 set lix [lindex [lindex $linelist $l] 3]
1858 if {$lix != {}} {
1859 set butspanstart $lix
1860 set butspanline $l
1861 $textw.inc$lix toggle
1862 if {$doall} {
1863 togglegroup $l
1864 }
1865 }
1866 }
1867
1868 proc setbutspan {x y} {
1869 global incline butspanstart textw linelist butspanline
1870 global textscrollx textscrolly
1871 if {![info exists butspanstart]} return
1872 set lend [lindex [split [$textw index @$x,$y] .] 0]
1873 set ln $butspanline
1874 set textscrollx $x
1875 set textscrolly $y
1876 set butspanline $lend
1877 if {$ln == $lend} return
1878 set inc [expr {$ln < $lend? 1: -1}]
1879 set m $butspanstart
1880 while 1 {
1881 incr ln $inc
1882 set l [lindex [lindex $linelist $ln] 3]
1883 if {[info exists incline($l)] && [info exists incline($m)]} {
1884 set incline($l) $incline($m)
1885 }
1886 if {$ln == $lend} break
1887 }
1888 }
1889
1890 proc endbutspan {} {
1891 global butspanstart
1892 catch {unset butspanstart}
1893 }
1894
1895 proc wstartbutspan {w x y} {
1896 incr x [winfo x $w]
1897 incr y [winfo y $w]
1898 startbutspan $x $y 0
1899 }
1900
1901 proc wsetbutspan {w x y} {
1902 incr x [winfo x $w]
1903 incr y [winfo y $w]
1904 setbutspan $x $y
1905 }
1906
1907 proc dobutscroll {} {
1908 global textscrollid textscrollx textscrolly textw
1909 if {![winfo exists $textw]} return
1910 if {$textscrolly < 0} {
1911 $textw yview scroll -2 units
1912 } elseif {$textscrolly >= [winfo height $textw]} {
1913 $textw yview scroll 2 units
1914 }
1915 setbutspan $textscrollx $textscrolly
1916 set textscrollid [after 100 dobutscroll]
1917 }
1918
1919 proc startbutscroll {w x y} {
1920 global textscrollx textscrolly
1921 set textscrollx $x
1922 set textscrolly $y
1923 dobutscroll
1924 }
1925
1926 proc endbutscroll {w x y} {
1927 global textscrollid
1928 catch {after cancel $textscrollid; unset textscrollid}
1929 }
1930
1931 proc redisplaylines {w l nl} {
1932 global linelist diffndirs difftabs
1933 for {set i 0} {$i < $nl} {incr i} {
1934 set lend [$w index "$l.0 + 1l"]
1935 for {set j 0} {$j < $diffndirs} {incr j} {
1936 $w tag remove d$j $l.0 $lend
1937 }
1938 $w tag remove sep $l.0 $lend
1939 $w delete $l.0 "$l.0 lineend"
1940 set linfo [lindex $linelist $l]
1941 set ty [lindex $linfo 1]
1942 set line [lindex $linfo 2]
1943 if {$ty == {}} {
1944 $w insert $l.0 "\t$difftabs[lindex $line 0]" sep
1945 for {set j 0} {$j < $diffndirs} {incr j} {
1946 $w insert "$l.0 lineend" [lindex $line [expr $j+1]] d$j
1947 }
1948 $w insert "$l.0 lineend" " " sep
1949 $w tag add sep "$l.0 lineend" "$l.0 + 1l"
1950 } else {
1951 set nm [llength $ty]
1952 set main [lindex $ty [expr $nm-1]]
1953 set ix 0
1954 set lix [lindex $linfo 3]
1955 if {$lix != {}} {
1956 catch {destroy $w.inc$lix}
1957 makecheckbox $w $lix $l.0
1958 incr ix
1959 }
1960
1961 $w insert $l.$ix "\t$difftabs"
1962 incr ix [expr $diffndirs-1]
1963 if {$nm < $diffndirs} {
1964 set sub [lindex $ty 0]
1965 if {$nm <= 2} {
1966 $w tag add d$sub $l.0 $l.$ix
1967 } else {
1968 set pix 0
1969 set nix [expr {$ix - $diffndirs + 3}]
1970 for {set j 0} {$j < $diffndirs-2} {incr j} {
1971 set x [lindex $ty $j]
1972 $w tag add d$x $l.$pix $l.$nix
1973 set pix $nix
1974 incr nix
1975 }
1976 }
1977 }
1978
1979 set x [tabexpand $line $ix]
1980 $w insert $l.$ix [lindex $x 0]
1981 foreach tgp [lindex $x 1] {
1982 $w tag add ul $l.[lindex $tgp 0] $l.[lindex $tgp 1]
1983 }
1984 if {$nm < $diffndirs} {
1985 set lend [$w index "$l.0 + 1l"]
1986 $w tag add d$main $l.$ix $lend
1987 }
1988 }
1989 incr l
1990 }
1991 }
1992
1993 proc exchangelines {w start na nb} {
1994 global linelist
1995 set last [expr $start+$na+$nb-1]
1996 set eltsa [lrange $linelist $start [expr $start+$na-1]]
1997 set eltsb [lrange $linelist [expr $start+$na] $last]
1998 set linelist [eval lreplace \$linelist $start $last $eltsb $eltsa]
1999 $w conf -state normal
2000 redisplaylines $w $start [expr $na+$nb]
2001 $w conf -state disabled
2002 }
2003
2004 proc addtoall {l x} {
2005 set ret {}
2006 foreach i $l {
2007 lappend ret [expr {$i + $x}]
2008 }
2009 return $ret
2010 }
2011
2012 proc subfromall {l x} {
2013 set ret {}
2014 foreach i $l {
2015 lappend ret [expr {$i - $x}]
2016 }
2017 return $ret
2018 }
2019
2020 proc setunion {a b} {
2021 return [lsort -unique [concat $a $b]]
2022 }
2023
2024 proc setintersects {a b} {
2025 return [expr {[llength [setunion $a $b]] < [llength $a] + [llength $b]}]
2026 }
2027
2028 # called on button 2 down in the diff window
2029 # start dragging a diff hunk or separator line
2030 proc startdrag {w x y} {
2031 global dragline draglineorig draguplines dragdownlines allf
2032 global dragsep dragseporig linelist dragsplit dragsplitorig
2033 global diffndirs
2034 set pos [$w index @$x,$y]
2035 set l [lindex [split $pos .] 0]
2036 $w tag remove sel 0.0 end
2037 set linfo [lindex $linelist $l]
2038 set ltype [lindex $linfo 1]
2039 if {$ltype == {}} {
2040 # dragging a separator line
2041 set dragsep $l
2042 set dragseporig $l
2043 catch {unset dragline}
2044 catch {unset dragsplit}
2045 # check for a separator bar covering a single line of context
2046 dragsepstart $w
2047 $w tag add sel $l.0 "$l.0 + 1l"
2048 } elseif {$ltype == $allf} {
2049 # dragging a context line
2050 set dragsplit $l
2051 set dragsplitorig $l
2052 catch {unset dragline}
2053 catch {unset dragsep}
2054 $w tag add sel $l.0 "$l.0 + 1l"
2055 } else {
2056 # dragging a diff line
2057 set dragline $l
2058 set draglineorig $l
2059 catch {unset dragsep}
2060 catch {unset dragsplit}
2061 $w tag add sel $l.0 "$l.0 + 1l"
2062 }
2063 }
2064
2065 # called on movement with button 2 down in the diff window
2066 proc dragdiff {w x y} {
2067 global dragline draglineorig linelist dragsep dragsplit
2068 global diffndirs allf dragnlines
2069 if {[info exists dragsep]} {
2070 dragsepbar $w $x $y
2071 return
2072 } elseif {[info exists dragsplit]} {
2073 dragdiffsplit $w $x $y
2074 return
2075 }
2076 if {![info exists dragline]} return
2077 set pos [$w index @$x,$y]
2078 set l [lindex [split $pos .] 0]
2079 if {$l == $dragline} return
2080 $w tag remove sel 0.0 end
2081 set id [lindex $linelist $dragline]
2082 # t = set of trees this line is in
2083 set t [lindex $id 1]
2084 set dist [expr $l - $dragline]
2085 while {$dist != 0} {
2086 if {$dragline < $draglineorig \
2087 || ($dragline == $draglineorig && $l < $dragline)} {
2088 # moving line $dragline and lines above it of same type
2089 if {$dist < 0} {
2090 # dragging upwards
2091 set i [expr $dragline - 1]
2092 while 1 {
2093 set pt [lindex [lindex $linelist $i] 1]
2094 if {$pt == {} || $pt == $allf \
2095 || ![setintersects $pt $t]} break
2096 set t [setunion $t $pt]
2097 incr i -1
2098 }
2099 set nlines [expr $dragline - $i]
2100 set j $i
2101 while {$i > $j + $dist} {
2102 set pt [lindex [lindex $linelist $i] 1]
2103 if {$pt == {} || $pt == $allf \
2104 || [setintersects $pt $t]} break
2105 incr i -1
2106 }
2107 set nabove [expr $j - $i]
2108 if {$nabove > 0} {
2109 exchangelines $w [expr $i+1] $nabove $nlines
2110 incr dist $nabove
2111 for {set k 0} {$k < $nabove} {incr k} {
2112 set dragnlines($dragline) $nlines
2113 incr dragline -1
2114 }
2115 } else {
2116 set dist 0
2117 }
2118 } else {
2119 # dragging back downwards
2120 incr dragline
2121 incr dist -1
2122 set nlines $dragnlines($dragline)
2123 exchangelines $w [expr {$dragline - $nlines}] $nlines 1
2124 }
2125 } else {
2126 # moving line $dragline and lines below it of same type
2127 if {$dist > 0} {
2128 # dragging downwards
2129 set i [expr $dragline + 1]
2130 while 1 {
2131 set pt [lindex [lindex $linelist $i] 1]
2132 if {$pt == {} || $pt == $allf \
2133 || ![setintersects $pt $t]} break
2134 set t [setunion $t $pt]
2135 incr i
2136 }
2137 set nlines [expr $i - $dragline]
2138 set j $i
2139 while {$i < $j + $dist} {
2140 set pt [lindex [lindex $linelist $i] 1]
2141 if {$pt == {} || $pt == $allf \
2142 || [setintersects $pt $t]} break
2143 incr i
2144 }
2145 set nbelow [expr $i - $j]
2146 if {$nbelow > 0} {
2147 exchangelines $w $dragline $nlines $nbelow
2148 incr dist -$nbelow
2149 for {set k 0} {$k < $nbelow} {incr k} {
2150 set dragnlines($dragline) $nlines
2151 incr dragline
2152 }
2153 } else {
2154 set dist 0
2155 }
2156 } else {
2157 # dragging back upwards
2158 incr dragline -1
2159 incr dist
2160 set nlines $dragnlines($dragline)
2161 exchangelines $w $dragline 1 $nlines
2162 }
2163 }
2164 }
2165 $w tag add sel $dragline.0 "$dragline.0 + 1l"
2166 }
2167
2168 # starting to drag a separator bar (button 2 down)
2169 proc dragsepstart {w} {
2170 global dragsep linelist fcontents dragsepnowhere allf diffndirs
2171 set plinfob [lindex $linelist [expr $dragsep-1]]
2172 set f1lb [lindex [lindex $plinfob 0] 0]
2173 set plinfo [lindex $linelist $dragsep]
2174 set plns [lindex $plinfo 0]
2175 set f1l [lindex $plns 0]
2176 set dragsepnowhere [expr {$f1l <= $f1lb + 2}]
2177 if {$f1l == $f1lb + 2} {
2178 # turn the separator into a line of context
2179 set line [lindex $fcontents(0) [expr {$f1l - 2}]]
2180 set linelist [lreplace $linelist $dragsep $dragsep \
2181 [list [subfromall $plns 1] $allf $line]]
2182 $w conf -state normal
2183 redisplaylines $w $dragsep 1
2184 $w conf -state disabled
2185 }
2186 }
2187
2188 proc dragsepbar {w x y} {
2189 global dragsep dragseporig linelist fcontents dragsepnowhere allf
2190 set l [lindex [split [$w index @$x,$y] .] 0]
2191 if {$l == $dragsep || $dragsepnowhere} return
2192 $w tag remove sel 0.0 end
2193 set dist [expr $l - $dragsep]
2194 while {$dist != 0} {
2195 set plinfob [lindex $linelist [expr $dragsep-1]]
2196 set f1lb [lindex [lindex $plinfob 0] 0]
2197 set plinfo [lindex $linelist $dragsep]
2198 set plns [lindex $plinfo 0]
2199 set f1l [lindex $plns 0]
2200 set ty [lindex $plinfo 1]
2201 if {$dragsep < $dragseporig \
2202 || ($dragsep == $dragseporig && $l < $dragsep)} {
2203 # the separator bar is above its original location (or will be)
2204 set inc [expr {$dist < 0? 1: -1}]
2205 set lnums [subfromall $plns $inc]
2206 if {$ty != {}} {
2207 if {$dist < 0} break
2208 set lnums [addtoall $lnums 1]
2209 }
2210 set f1l [lindex $lnums 0]
2211 $w conf -state normal
2212 if {$dist < 0} {
2213 # dragging further upwards
2214 set line [lindex $fcontents(0) [expr $f1l-1]]
2215 if {$f1lb + 2 == $f1l} {
2216 # turn the separator into an ordinary line
2217 set lns [subfromall $lnums 1]
2218 set f1ls [lindex $lns 0]
2219 set lsep [lindex $fcontents(0) [expr $f1ls-1]]
2220 set linelist [lreplace $linelist $dragsep $dragsep \
2221 [list $lns $allf $lsep] \
2222 [list $lnums $allf $line]]
2223 } else {
2224 set sline [makesepline $dragsep $lnums]
2225 set linelist [lreplace $linelist $dragsep $dragsep \
2226 $sline [list $lnums $allf $line]]
2227 }
2228 $w insert "$dragsep.0 + 1l" "\n"
2229 redisplaylines $w $dragsep 2
2230 $w yview scroll 1 units
2231 } else {
2232 # moving back down towards original location
2233 set sline [makesepline $dragsep $lnums]
2234 set linelist [lreplace $linelist $dragsep [expr $dragsep+1] \
2235 $sline]
2236 $w delete "$dragsep.0 + 1l" "$dragsep.0 + 2l"
2237 redisplaylines $w $dragsep 1
2238 $w yview scroll -1 units
2239 }
2240 $w conf -state disabled
2241 incr dragseporig $inc
2242 incr dist $inc
2243 } else {
2244 # the separator bar is below its original location (or will be)
2245 if {$dist > 0} {
2246 # dragging further downwards
2247 if {$ty != {}} break
2248 set plnsb [lindex $plinfob 0]
2249 set lnumsb [addtoall $plnsb 1]
2250 set f1lb [lindex $lnumsb 0]
2251 set line [lindex $fcontents(0) [expr $f1lb-1]]
2252 set linelist [linsert $linelist $dragsep \
2253 [list $lnumsb $allf $line]]
2254 $w conf -state normal
2255 $w insert $dragsep.0 "\n"
2256 redisplaylines $w $dragsep 1
2257 incr dragsep
2258 incr dist -1
2259 if {$f1l == $f1lb + 2} {
2260 # replace separator bar by normal line
2261 set lnums [subfromall $plns 1]
2262 set f1l [lindex $lnums 0]
2263 set line [lindex $fcontents(0) [expr $f1l-1]]
2264 set linelist [lreplace $linelist $dragsep $dragsep \
2265 [list $lnums $allf $line]]
2266 } else {
2267 set sline [makesepline $dragsep $plns]
2268 set linelist [lreplace $linelist $dragsep $dragsep $sline]
2269 }
2270 redisplaylines $w $dragsep 1
2271 $w conf -state disabled
2272 } else {
2273 # moving back up towards original location
2274 incr dragsep -1
2275 set linelist [lreplace $linelist $dragsep $dragsep]
2276 $w conf -state normal
2277 $w delete $dragsep.0 "$dragsep.0 + 1l"
2278 # reconstruct the separator line
2279 if {$ty != {}} {
2280 set plns [addtoall $plns 1]
2281 }
2282 set sline [makesepline $dragsep $plns]
2283 set linelist [lreplace $linelist $dragsep $dragsep $sline]
2284 redisplaylines $w $dragsep 1
2285 $w conf -state disabled
2286 incr dist
2287 }
2288 }
2289 }
2290 $w tag add sel $dragsep.0 "$dragsep.0 + 1l"
2291 }
2292
2293 # dragging a context line - splits it into -/+ versions
2294 proc dragdiffsplit {w x y} {
2295 global dragsplit dragsplitorig linelist fcontents diffndirs
2296 global nextlix incline allf
2297 set pos [$w index @$x,$y]
2298 set l [lindex [split $pos .] 0]
2299 if {$l == $dragsplit} return
2300 $w tag remove sel 0.0 end
2301 set dist [expr $l - $dragsplit]
2302 $w conf -state normal
2303 while {$dist != 0} {
2304 if {$dragsplit < $dragsplitorig \
2305 || ($dragsplit == $dragsplitorig && $l < $dragsplit)} {
2306 # moving line $dragsplit up
2307 if {$dist < 0} {
2308 # split line dragsplit
2309 set linfo [lindex $linelist $dragsplit]
2310 if {[lindex $linfo 1] != $allf} break
2311 set lns [lindex $linfo 0]
2312 set newlns {}
2313 for {set i 0} {$i < $diffndirs} {incr i} {
2314 lappend newlns {}
2315 }
2316
2317 set f1l [lindex $lns 0]
2318 set line1 [lindex $fcontents(0) [expr $f1l-1]]
2319 set lix1 $nextlix
2320 set incline($lix1) 0
2321 set lnsx [lreplace $newlns 0 0 $f1l]
2322 set linelist [lreplace $linelist $dragsplit $dragsplit \
2323 [list $lnsx 0 $line1 $lix1]]
2324 redisplaylines $w $dragsplit 1
2325
2326 set l [expr $dragsplitorig + 1]
2327 set deltal [expr {$l - $dragsplit}]
2328
2329 for {set i 1} {$i < $diffndirs} {incr i} {
2330 set fl [lindex $lns $i]
2331 set line [lindex $fcontents($i) [expr $fl-1]]
2332 set lix [incr nextlix]
2333 set incline($lix) 0
2334 set lnsx [lreplace $newlns $i $i $fl]
2335 set linelist [linsert $linelist $l \
2336 [list $lnsx $i $line $lix]]
2337 $w insert $l.0 "\n"
2338 redisplaylines $w $l 1
2339 incr l $deltal
2340 }
2341
2342 incr nextlix
2343 incr dragsplit -1
2344 incr dist
2345 } else {
2346 # reduce split by one line
2347 incr dragsplit
2348 set l [expr $dragsplitorig + 1]
2349 set deltal [expr {$l - $dragsplit}]
2350 set kl $dragsplit
2351 set lnums {}
2352 for {set k 0} {$k < $diffndirs} {incr k} {
2353 set fl [lindex [lindex [lindex $linelist $kl] 0] $k]
2354 lappend lnums $fl
2355 incr kl $deltal
2356 }
2357
2358 set f1l [lindex $lnums 0]
2359 set line1 [lindex $fcontents(0) [expr $f1l-1]]
2360 set linelist [lreplace $linelist $dragsplit $dragsplit \
2361 [list $lnums $allf $line1]]
2362 redisplaylines $w $dragsplit 1
2363
2364 incr deltal -1
2365 for {set k 1} {$k < $diffndirs} {incr k} {
2366 set linelist [lreplace $linelist $l $l]
2367 $w delete $l.0 "$l.0 + 1l"
2368 incr l $deltal
2369 }
2370
2371 incr dist -1
2372 }
2373 } else {
2374 # moving line $dragsplit down
2375 if {$dist > 0} {
2376 # split another line
2377 set deltal [expr {$dragsplit - $dragsplitorig}]
2378 set l [expr $dragsplit + ($diffndirs - 1) * $deltal]
2379 set linfo [lindex $linelist $l]
2380 if {[lindex $linfo 1] != $allf} break
2381 set lns [lindex $linfo 0]
2382 set nullns {}
2383 for {set i 0} {$i < $diffndirs} {incr i} {
2384 lappend nullns {}
2385 }
2386
2387 set l $dragsplit
2388 for {set i 0} {$i < $diffndirs} {incr i} {
2389 set fl [lindex $lns $i]
2390 set line [lindex $fcontents($i) [expr $fl-1]]
2391 set lix $nextlix
2392 incr nextlix
2393 set incline($lix) 0
2394 set lnums [lreplace $nullns $i $i $fl]
2395 if {$i < $diffndirs - 1} {
2396 set linelist [linsert $linelist $l \
2397 [list $lnums $i $line $lix]]
2398 $w insert $l.0 "\n"
2399 redisplaylines $w $l 1
2400 incr l
2401 } else {
2402 set linelist [lreplace $linelist $l $l \
2403 [list $lnums $i $line $lix]]
2404 redisplaylines $w $l 1
2405 }
2406 incr l $deltal
2407 }
2408
2409 incr dragsplit
2410 incr dist -1
2411 } else {
2412 # reduce split by one line
2413 incr dragsplit -1
2414 incr dist
2415 set deltal [expr {$dragsplit - $dragsplitorig}]
2416 set l $dragsplit
2417 set lnums {}
2418 for {set i 0} {$i < $diffndirs} {incr i} {
2419 lappend lnums [lindex [lindex [lindex $linelist $l] 0] $i]
2420 if {$i < $diffndirs - 1} {
2421 set linelist [lreplace $linelist $l $l]
2422 $w delete $l.0 "$l.0 + 1l"
2423 } else {
2424 set f1l [lindex $lnums 0]
2425 set line1 [lindex $fcontents(0) [expr $f1l-1]]
2426 set linelist [lreplace $linelist $l $l \
2427 [list $lnums $allf $line1]]
2428 redisplaylines $w $l 1
2429 }
2430 incr l $deltal
2431 }
2432 }
2433 break
2434 }
2435 }
2436 $w conf -state disabled
2437 }
2438
2439 # button 2 up
2440 proc finishdrag {w} {
2441 global dragline dragsep dragsplit
2442 if {[info exists dragline]} {
2443 $w tag remove sel 0.0 end
2444 unset dragline
2445 }
2446 if {[info exists dragsep]} {
2447 $w tag remove sel 0.0 end
2448 unset dragsep
2449 }
2450 if {[info exists dragsplit]} {
2451 $w tag remove sel 0.0 end
2452 unset dragsplit
2453 }
2454 }
2455
2456 proc togglegroup {l} {
2457 global incline textw linelist
2458 set linfo [lindex $linelist $l]
2459 set lix [lindex $linfo 3]
2460 if {$lix == {}} return
2461 if $incline($lix) {
2462 set state select
2463 } else {
2464 set state deselect
2465 }
2466 set l0 $l
2467 while 1 {
2468 incr l0 -1
2469 set linfo [lindex $linelist $l0]
2470 set lix [lindex $linfo 3]
2471 if {$lix == {}} break
2472 $textw.inc$lix $state
2473 }
2474 set l1 $l
2475 while 1 {
2476 incr l1
2477 set linfo [lindex $linelist $l1]
2478 set lix [lindex $linfo 3]
2479 if {$lix == {}} break
2480 $textw.inc$lix $state
2481 }
2482 }
2483
2484 proc togglebuts {x y} {
2485 global textw linelist
2486 set l [lindex [split [$textw index @$x,$y] .] 0]
2487 set lix [lindex [lindex $linelist $l] 3]
2488 if {$lix != {}} {
2489 $textw.inc$lix toggle
2490 togglegroup $l
2491 }
2492 }
2493
2494 proc wtogglebuts {w x y} {
2495 incr x [winfo x $w]
2496 incr y [winfo y $w]
2497 togglebuts $x $y
2498 }
2499
2500 proc invertbuttons {} {
2501 global incline textw
2502 foreach l [array names incline] {
2503 set incline($l) [expr {1 - $incline($l)}]
2504 }
2505 }
2506
2507 proc changeunderlinetabs {} {
2508 global textw underlinetabs
2509 $textw tag conf ul -underline $underlinetabs
2510 }
2511
2512 proc diffn {dirlist f {orig 1}} {
2513 global diffing diffdirs difffile difffds diffrel allf
2514 global difflnos diffndirs diffstate difflnum nextdiffhdr diffhdr
2515 global diffiflag diffwflag diffbflag diffdflag incline
2516 global diffblocked fcontents ldisp havediffs nextlix origdiffdirs
2517
2518 if {$orig} {
2519 set origdiffdirs $dirlist
2520 }
2521 # reverse the list so we have oldest first
2522 set x {}
2523 for {set i [llength $dirlist]} {[incr i -1] >= 0} {} {
2524 lappend x [lindex $dirlist $i]
2525 }
2526 set dirlist $x
2527 if {$diffing} {
2528 if {$dirlist == $diffdirs && $f == $difffile} return
2529 foreach i [array names difffds] {
2530 catch {close $difffds($i)}
2531 }
2532 }
2533 set diffdirs $dirlist
2534 set difffile $f
2535 set diffndirs [llength $dirlist]
2536 set nextdiffhdr 0
2537 catch {unset diffhdr}
2538 set havediffs 0
2539 set nextlix 1000
2540 catch {unset incline}
2541
2542 set diffopts "-u $diffiflag $diffwflag $diffbflag $diffdflag"
2543 set d [lindex $dirlist 0]
2544 set p [joinname $d $f]
2545 set diffrel(0) 0
2546 set allf 0
2547 for {set j 1} {$j < $diffndirs} {incr j} {
2548 set e [lindex $dirlist $j]
2549 set q [joinname $e $f]
2550 set difflnos($j) {0 0}
2551 set diffstate($j) 0
2552 set difflnum($j) 0
2553 set diffblocked($j) 0
2554 set diffrel($j) 0
2555 set fd [open "|diff $diffopts $p $q" r]
2556 set difffds($j) $fd
2557 fconfigure $fd -blocking 0
2558 fileevent $fd readable "readndiff $fd $j"
2559 lappend allf $j
2560 }
2561 for {set i 0} {$i < $diffndirs} {incr i} {
2562 set ldisp($i) 0
2563 }
2564
2565 # Build a window
2566 global textw filemode mergebut mpatchbut bgcolors numgroups
2567 global groups dirs difftabs linelist texttop underlinetabs
2568 global diffcolors
2569 if {![info exists textw] || ![winfo exists $textw]} {
2570 maketextw
2571 }
2572 if {$filemode} {
2573 wm title $texttop "Differences: all files"
2574 } else {
2575 wm title $texttop "Differences: $f"
2576 }
2577 $mergebut.m delete 0 end
2578 $mpatchbut.m delete 0 end
2579 $textw conf -state normal
2580 $textw delete 0.0 end
2581 set charwidth [font measure [$textw cget -font] n]
2582 set tlist "[expr 4*$charwidth] left"
2583 set difftabs ""
2584 set j 4
2585 for {set i 2} {$i < $diffndirs} {incr i} {
2586 incr j 2
2587 if {$diffndirs < 4} {
2588 incr j
2589 }
2590 append tlist " [expr $j*$charwidth] left"
2591 append difftabs "\t"
2592 }
2593 incr j 8
2594 append tlist " [expr $j*$charwidth] left"
2595 $textw conf -tabs $tlist
2596 set x $bgcolors($numgroups)
2597 $textw tag delete [$textw tag names]
2598 set group [lindex $groups($f) 1]
2599 set diffcolors {}
2600 for {set i 0} {$i < $diffndirs} {incr i} {
2601 set d [lindex $diffdirs $i]
2602 set j [lindex $group [lsearch $dirs $d]]
2603 set c [lindex $x $j]
2604 $textw tag conf d$i -back $c
2605 lappend diffcolors $c
2606 }
2607 $textw tag conf sep -back blue -fore white
2608 $textw tag conf ul -underline $underlinetabs
2609 $textw tag lower sep
2610 bind $textw <1> "startbutspan %x %y 0; break"
2611 bind $textw <Shift-Button-1> "startbutspan %x %y 1; break"
2612 bind $textw <B1-Motion> "setbutspan %x %y; break"
2613 bind $textw <ButtonRelease-1> "endbutspan; break"
2614 bind $textw <B1-Leave> "startbutscroll %W %x %y; break"
2615 bind $textw <B1-Enter> "endbutscroll %W %x %y; break"
2616 bind $textw <2> "startdrag $textw %x %y; break"
2617 bind $textw <B2-Motion> "dragdiff $textw %x %y; break"
2618 bind $textw <ButtonRelease-2> "finishdrag $textw"
2619 bind $textw <Any-Button-3> "togglebuts %x %y"
2620 set linelist {{{} {} {}}}
2621
2622 # read in the files
2623 set i 0
2624 foreach d $dirlist {
2625 set p [joinname $d $f]
2626 set fcontents($i) {}
2627 if {[catch {
2628 set fd [open $p r]
2629 set fcontents($i) [split [read -nonewline $fd] "\n"]
2630 close $fd
2631 } err]} {
2632 puts "error reading $p: $err"
2633 }
2634 incr i
2635 }
2636 }
2637
2638 proc readndiff {fd ix} {
2639 global difflnos diffeof difflnum diffhdr
2640 global nextdiffhdr diffstate diffhunk
2641 global parthunklen parthunkstart diffblocked
2642
2643 set n [gets $fd line]
2644 set l [incr difflnum($ix)]
2645 if {$n < 0} {
2646 if {![eof $fd]} return
2647 #puts "eof for $ix"
2648 addhunk $ix 2
2649 close $fd
2650 return
2651 }
2652 set x [string index $line 0]
2653 if {$l <= 2} {
2654 # expect --- or +++ line or "Binary files ..."
2655 if {$ix == 1 && $x == "-"} {
2656 set diffhdr(0) [string range $line 4 end]
2657 }
2658 if {$x == "+"} {
2659 set diffhdr($ix) [string range $line 4 end]
2660 }
2661 while {[info exists diffhdr($nextdiffhdr)]} {
2662 emithdr $nextdiffhdr $diffhdr($nextdiffhdr)
2663 incr nextdiffhdr
2664 }
2665 return
2666 }
2667 if {$x == "-" || $x == "+"} {
2668 set addit [expr {$x == "+"}]
2669 set line [string range $line 1 end]
2670 if {$diffstate($ix) == 0} {
2671 # start of a new hunk of diff
2672 set parthunklen($ix,0) 0
2673 set parthunklen($ix,1) 0
2674 set parthunkstart($ix) $difflnos($ix)
2675 if {[info exists diffhunk($ix)]} {
2676 # block this diff for now
2677 fileevent $fd readable {}
2678 set diffblocked($ix) 1
2679 #puts "blocking $ix"
2680 }
2681 set diffstate($ix) 1
2682 }
2683 set fl [lindex $difflnos($ix) $addit]
2684 incr parthunklen($ix,$addit)
2685 set difflnos($ix) [lreplace $difflnos($ix) $addit $addit [incr fl]]
2686 } else {
2687 if {$diffstate($ix) == 1} {
2688 # end of a new hunk of diff
2689 addhunk $ix 0
2690 }
2691 set f0l [lindex $difflnos($ix) 0]
2692 set f1l [lindex $difflnos($ix) 1]
2693 if {$x == "@" && [regexp { -([0-9,]+) .*\+([0-9,]+) } $line z r1 r2]} {
2694 set r1 [lindex [split $r1 ,] 0]
2695 set r2 [lindex [split $r2 ,] 0]
2696 catch {set f0l [expr {$r1+0}]}
2697 catch {set f1l [expr {$r2+0}]}
2698 } else {
2699 incr f0l
2700 incr f1l
2701 }
2702 set difflnos($ix) [list $f0l $f1l]
2703 }
2704 }
2705
2706 proc addhunk {ix newstate} {
2707 global diffstate parthunklen parthunkstart diffhunk
2708 #puts "addhunk $ix newstate=$newstate diffstate($ix)=$diffstate($ix)"
2709 if {$diffstate($ix) == 1} {
2710 #puts " start=$parthunkstart($ix) len= $parthunklen($ix,0) $parthunklen($ix,1)"
2711 if {[info exists diffhunk($ix)]} {
2712 puts "oops, overwriting hunk for $ix"
2713 }
2714 set diffhunk($ix) [list $parthunkstart($ix) \
2715 $parthunklen($ix,0) $parthunklen($ix,1)]
2716 }
2717 set diffstate($ix) $newstate
2718 processhunks
2719 }
2720
2721 proc consumehunk {ix} {
2722 global diffhunk diffblocked difffds
2723 #puts "consumehunk $ix"
2724 unset diffhunk($ix)
2725 if {$diffblocked($ix)} {
2726 set fd $difffds($ix)
2727 fileevent $fd readable "readndiff $fd $ix"
2728 set diffblocked($ix) 0
2729 }
2730 }
2731
2732 proc diffstart {lno} {
2733 global hunkstart hunkend diffndirs diffrel
2734 #puts -nonewline "diffstart $lno:"
2735 for {set j 0} {$j < $diffndirs} {incr j} {
2736 set hunkstart($j) [expr $lno + $diffrel($j)]
2737 set hunkend($j) $hunkstart($j)
2738 #puts -nonewline " $hunkstart($j)"
2739 }
2740 #puts ""
2741 }
2742
2743 proc adddiffhunk {ix} {
2744 global hunkend diffndirs diffhunk
2745 #puts "adddiffhunk $ix: $diffhunk($ix)"
2746 set stl [lindex $diffhunk($ix) 0]
2747 set lst [lindex $stl 0]
2748 set rst [lindex $stl 1]
2749 set llen [lindex $diffhunk($ix) 1]
2750 set rlen [lindex $diffhunk($ix) 2]
2751 set lend [expr $lst + $llen]
2752 set rend [expr $rst + $rlen]
2753 set x [expr $lend - $hunkend(0)]
2754 if {$x < 0} {
2755 set rend [expr $rend - $x]
2756 } elseif {$x > 0} {
2757 for {set i 0} {$i < $diffndirs} {incr i} {
2758 incr hunkend($i) $x
2759 }
2760 }
2761 set hunkend($ix) $rend
2762 }
2763
2764 proc addoverlaps {} {
2765 global diffhunk hunkend diffndirs diffstate
2766 set overlap 0
2767 for {set j 1} {$j < $diffndirs} {incr j} {
2768 if {![info exists diffhunk($j)]} continue
2769 set lnos [lindex $diffhunk($j) 0]
2770 if {[lindex $lnos 0] <= $hunkend(0) || \
2771 [lindex $lnos 1] <= $hunkend($j)} {
2772 set overlap 1
2773 adddiffhunk $j
2774 consumehunk $j
2775 }
2776 }
2777 return $overlap
2778 }
2779
2780 proc processhunks {} {
2781 global diffhunk diffstate diffndirs diffrel
2782 global havediffs hunkstart hunkend
2783
2784 while 1 {
2785 if {$havediffs} {
2786 addoverlaps
2787 }
2788
2789 # check that we have a hunk or EOF for each pair
2790 set alleof 1
2791 for {set j 1} {$j < $diffndirs} {incr j} {
2792 if {$diffstate($j) != 2} {
2793 set alleof 0
2794 if {![info exists diffhunk($j)]} return
2795 }
2796 }
2797 #if {$alleof} {puts "processhunks: eof on all"}
2798
2799 if {$havediffs} {
2800 putdiffhunks
2801 #puts -nonewline "diffrel:"
2802 for {set j 1} {$j < $diffndirs} {incr j} {
2803 set diffrel($j) [expr $hunkend($j) - $hunkend(0)]
2804 #puts -nonewline " $diffrel($j)"
2805 }
2806 #puts ""
2807 set havediffs 0
2808 unset hunkstart
2809 unset hunkend
2810 }
2811
2812 # find which hunk is the earliest
2813 set first {}
2814 for {set j 1} {$j < $diffndirs} {incr j} {
2815 if {[info exists diffhunk($j)]} {
2816 set st0 [lindex [lindex $diffhunk($j) 0] 0]
2817 if {$first == {} || $st0 < $earliest} {
2818 set first $j
2819 set earliest $st0
2820 }
2821 }
2822 }
2823 if {$first == {}} {
2824 # have reached EOF on all diffs
2825 ndiffdone
2826 return
2827 }
2828
2829 set havediffs 1
2830 diffstart $earliest
2831 adddiffhunk $first
2832 consumehunk $first
2833 }
2834 }
2835
2836 proc existingmatch {matches f fl} {
2837 global diffndirs
2838 foreach m $matches {
2839 if {$f == [lindex $m 0]} {
2840 set nl [lindex $m 2]
2841 set lnos [lindex $m 1]
2842 set o [expr [lindex $fl 0] - [lindex $lnos 0]]
2843 if {$o < 0 || $o >= $nl} {
2844 return 0
2845 }
2846 for {set i 0} {$i < [llength $f]} {incr i} {
2847 if {[lindex $fl $i] != [lindex $lnos $i] + $o} {
2848 return 0
2849 }
2850 }
2851 return 1
2852 }
2853 }
2854 return 0
2855 }
2856
2857 # f is a list of file indices, fl is a corresponding list of line numbers
2858 # relative to the start of this section
2859 proc matchlength {f fl} {
2860 global difflines
2861 set l0 [lindex $fl 0]
2862 set f0 [lindex $f 0]
2863 set f0len [llength $difflines($f0)]
2864 set nf [llength $f]
2865 set len 1
2866 while {[incr l0] < $f0len} {
2867 set line [lindex $difflines($f0) $l0]
2868 for {set i 1} {$i < $nf} {incr i} {
2869 set fi [lindex $f $i]
2870 set li [expr [lindex $fl $i] + $len]
2871 if {$li >= [llength $difflines($fi)] || \
2872 [lindex $difflines($fi) $li] != $line} {
2873 return $len
2874 }
2875 }
2876 incr len
2877 }
2878 return $len
2879 }
2880
2881 # m is a match expressed as a list {files lines length}
2882 # existing is a list of matches in that format
2883 proc expandmatchback {m existing} {
2884 global difflines
2885 set fi [lindex $m 0]
2886 set fl [lindex $m 1]
2887 set len [lindex $m 2]
2888 set f0 [lindex $fi 0]
2889 set l0 [lindex $fl 0]
2890 set nf [llength $fi]
2891 for {set j 0} {$j < $nf} {incr j} {
2892 set f [lindex $fi $j]
2893 set l [lindex $fl $j]
2894 set lno($f) $l
2895 set minlno($f) 0
2896 }
2897 foreach e $existing {
2898 set k 0
2899 foreach ef [lindex $e 0] {
2900 if {[info exists lno($ef)]} {
2901 set el [lindex [lindex $e 1] $k]
2902 if {$el < $lno($ef)} {
2903 incr el [lindex $e 2]
2904 if {$el > $minlno($ef)} {
2905 set minlno($ef) $el
2906 }
2907 }
2908 }
2909 incr k
2910 }
2911 }
2912 set nl [expr $l0 - $minlno($f0)]
2913 for {set x 1} {$x <= $nl} {incr x} {
2914 set line [lindex $difflines($f0) [expr $l0 - $x]]
2915 for {set j 1} {$j < $nf} {incr j} {
2916 set f [lindex $fi $j]
2917 set l [expr [lindex $fl $j] - $x]
2918 if {$l < $minlno($f)} break
2919 if {[lindex $difflines($f) $l] != $line} break
2920 }
2921 if {$j < $nf} break
2922 }
2923 if {$x == 1} {
2924 return $m
2925 }
2926 set newfl {}
2927 incr x -1
2928 foreach l $fl {
2929 lappend newfl [expr $l - $x]
2930 }
2931 return [list $fi $newfl [expr $len + $x]]
2932 }
2933
2934 proc removematches {matches f l nl} {
2935 set new {}
2936 set el [expr $l + $nl]
2937 foreach m $matches {
2938 set i [lsearch [lindex $m 0] $f]
2939 if {$i < 0} {
2940 lappend new $m
2941 } else {
2942 set lm [lindex [lindex $m 1] $i]
2943 set elm [expr [lindex $m 2] + $lm]
2944 if {$el <= $lm || $elm <= $l} {
2945 lappend new $m
2946 } else {
2947 if {$lm < $l} {
2948 lappend new [lreplace $m 2 2 [expr $l - $lm]]
2949 }
2950 if {$elm > $el} {
2951 set inc [expr $el - $lm]
2952 set lnos {}
2953 foreach x [lindex $m 1] {
2954 lappend lnos [expr $x + $inc]
2955 }
2956 lappend new [lreplace $m 1 2 $lnos [expr $elm - $el]]
2957 }
2958 }
2959 }
2960 }
2961 return $new
2962 }
2963
2964 proc removeinversions {matches bm} {
2965 set bf [lindex $bm 0]
2966 set bl [lindex $bm 1]
2967 set new {}
2968 foreach m $matches {
2969 set isbefore 0
2970 set isafter 0
2971 set i 0
2972 set mf [lindex $m 0]
2973 set ml [lindex $m 1]
2974 foreach f $mf {
2975 set j [lsearch -exact $bf $f]
2976 if {$j >= 0} {
2977 if {[lindex $ml $i] < [lindex $bl $j]} {
2978 set isbefore 1
2979 } else {
2980 set isafter 1
2981 }
2982 }
2983 incr i
2984 }
2985 if {!($isbefore && $isafter)} {
2986 lappend new $m
2987 }
2988 }
2989 return $new
2990 }
2991
2992 proc overlapsbest {bestmatches mf ml mlen} {
2993 foreach bm $bestmatches {
2994 set bf [lindex $bm 0]
2995 set bl [lindex $bm 1]
2996 set blen [lindex $bm 2]
2997 set isbefore 0
2998 set isafter 0
2999 set i 0
3000 foreach f $mf {
3001 set j [lsearch -exact $bf $f]
3002 if {$j >= 0} {
3003 set li [lindex $ml $i]
3004 set lj [lindex $bl $j]
3005 if {$li < $lj} {
3006 if {$isafter || $li + $mlen > $lj} {
3007 return 1
3008 }
3009 set isbefore 1
3010 } else {
3011 if {$isbefore || $lj + $blen > $li} {
3012 return 1
3013 }
3014 set isafter 1
3015 }
3016 }
3017 incr i
3018 }
3019 }
3020 return 0
3021 }
3022
3023 proc findbestmatch {matches} {
3024 set best 0
3025 set bestnf 0
3026 set bm {}
3027 foreach m $matches {
3028 set nf [llength [lindex $m 0]]
3029 set good [lindex $m 2]
3030 if {$nf > $bestnf || ($nf == $bestnf && $good > $best)} {
3031 set best $good
3032 set bestnf $nf
3033 set bm $m
3034 }
3035 }
3036 return $bm
3037 }
3038
3039 proc findmatches {} {
3040 global hunkstart hunkend diffndirs
3041 global difflines fcontents lineinst diffwflag diffbflag
3042 set matches {}
3043 catch {unset lineinst}
3044 for {set i 0} {$i < $diffndirs} {incr i} {
3045 set difflines($i) {}
3046 for {set j $hunkstart($i)} {$j < $hunkend($i)} {incr j} {
3047 set line [lindex $fcontents($i) [expr $j-1]]
3048 if {$diffwflag != ""} {
3049 regsub -all {[ ]+} $line {} line
3050 } elseif {$diffbflag != ""} {
3051 regsub -all {[ ]+} $line { } line
3052 regsub { $} $line {} line
3053 }
3054 lappend difflines($i) $line
3055 }
3056 }
3057 for {set i 0} {$i < $diffndirs} {incr i} {
3058 set l 0
3059 foreach line $difflines($i) {
3060 lappend lineinst($line) [list $i $l]
3061 if {![regexp {^[[:space:]]*$} $line]} {
3062 foreach inst $lineinst($line) {
3063 set f [lindex $inst 0]
3064 if {$f == $i || [lsearch -exact $f $i] >= 0} continue
3065 set fl [lindex $inst 1]
3066 lappend f $i
3067 lappend fl $l
3068 if {![existingmatch $matches $f $fl]} {
3069 lappend matches [list $f $fl [matchlength $f $fl]]
3070 }
3071 lappend lineinst($line) [list $f $fl]
3072 }
3073 }
3074 incr l
3075 }
3076 }
3077 set bestmatches {}
3078 while {$matches != {}} {
3079 set bm [findbestmatch $matches]
3080 set bm [expandmatchback $bm $bestmatches]
3081 lappend bestmatches $bm
3082 set i 0
3083 set nl [lindex $bm 2]
3084 foreach f [lindex $bm 0] {
3085 set lno [lindex [lindex $bm 1] $i]
3086 set matches [removematches $matches $f $lno $nl]
3087 incr i
3088 }
3089 set matches [removeinversions $matches $bm]
3090 }
3091
3092 # now add in the blank-line matches that we ignored before
3093 set matches {}
3094 for {set i 0} {$i < $diffndirs} {incr i} {
3095 set l 0
3096 foreach line $difflines($i) {
3097 if {[regexp {^[[:space:]]*$} $line]} {
3098 foreach inst $lineinst($line) {
3099 set f [lindex $inst 0]
3100 if {$f >= $i || [lsearch -exact $f $i] >= 0} continue
3101 set fl [lindex $inst 1]
3102 lappend f $i
3103 lappend fl $l
3104 if {![existingmatch $matches $f $fl]} {
3105 set mlen [matchlength $f $fl]
3106 if {![overlapsbest $bestmatches $f $fl $mlen]} {
3107 lappend matches [list $f $fl $mlen]
3108 }
3109 }
3110 lappend lineinst($line) [list $f $fl]
3111 }
3112 }
3113 incr l
3114 }
3115 }
3116 while {$matches != {}} {
3117 set bm [findbestmatch $matches]
3118 lappend bestmatches $bm
3119 set i 0
3120 set nl [lindex $bm 2]
3121 foreach f [lindex $bm 0] {
3122 set lno [lindex [lindex $bm 1] $i]
3123 set matches [removematches $matches $f $lno $nl]
3124 incr i
3125 }
3126 set matches [removeinversions $matches $bm]
3127 }
3128
3129 #puts "best matches: $bestmatches"
3130 return $bestmatches
3131 }
3132
3133 proc filematches {matches i nlines} {
3134 global hunkstart hunkend diffndirs
3135 set res {}
3136 foreach m $matches {
3137 set k [lsearch -exact [lindex $m 0] $i]
3138 if {$k >= 0} {
3139 set l [lindex [lindex $m 1] $k]
3140 set e [expr $l + [lindex $m 2]]
3141 lappend res [list $l $e $m]
3142 }
3143 }
3144 set full {}
3145 set ld 0
3146 foreach m [lsort -integer -index 0 $res] {
3147 set l [lindex $m 0]
3148 if {$ld < $l} {
3149 lappend full [list $ld $l [list $i $ld [expr $l - $ld]]]
3150 }
3151 if {[lindex [lindex [lindex $m 2] 0] 0] == $i} {
3152 lappend full $m
3153 }
3154 set ld [lindex $m 1]
3155 }
3156 if {$ld < $nlines} {
3157 lappend full [list $ld $nlines [list $i $ld [expr $nlines - $ld]]]
3158 }
3159 #puts "filematches $i -> {$full}"
3160 return $full
3161 }
3162
3163 proc putdiffhunks {} {
3164 global hunkstart hunkend diffndirs
3165 global matchlist fcontents
3166 #puts -nonewline "putdiffhunks"
3167 #for {set i 0} {$i < $diffndirs} {incr i} {
3168 #puts -nonewline " $i: ($hunkstart($i),$hunkend($i))"
3169 #}
3170 #puts ""
3171 set matches [findmatches]
3172 #puts "matches: $matches"
3173 set totsegs 0
3174 for {set i 0} {$i < $diffndirs} {incr i} {
3175 set nlines($i) [expr $hunkend($i) - $hunkstart($i)]
3176 set displ($i) [filematches $matches $i $nlines($i)]
3177 set nsegs($i) [llength $displ($i)]
3178 set ix($i) 0
3179 if {$nsegs($i) > 0} {
3180 set curseg($i) [lindex $displ($i) 0]
3181 incr totsegs $nsegs($i)
3182 }
3183 set nextline($i) 0
3184 }
3185 set displist {}
3186 while {$totsegs > 0} {
3187 for {set i 0} {$i < $diffndirs} {incr i} {
3188 if {$nsegs($i) == 0} continue
3189 set m [lindex $curseg($i) 2]
3190 set blocked 0
3191 set k 0
3192 set lnos [lindex $m 1]
3193 foreach f [lindex $m 0] {
3194 set l [lindex $lnos $k]
3195 if {$l > $nextline($f)} {
3196 set blocked 1
3197 break
3198 }
3199 if {$l < $nextline($f)} {
3200 puts "oops, misordered span for $i {$curseg($i)}"
3201 #puts -nonewline "nextline: "
3202 #for {set z 0} {$z < $diffndirs} {incr z} {
3203 #puts -nonewline " $nextline($z)"
3204 #}
3205 #puts -nonewline "\nix: "
3206 #for {set z 0} {$z < $diffndirs} {incr z} {
3207 #puts -nonewline " $ix($z)"
3208 #}
3209 #puts -nonewline "\nnsegs: "
3210 #for {set z 0} {$z < $diffndirs} {incr z} {
3211 #puts -nonewline " $nsegs($z)"
3212 #}
3213 #puts ""
3214 #for {set z 0} {$z < $diffndirs} {incr z} {
3215 #puts "displ($z): {$displ($z)}"
3216 #}
3217 #puts "displist:"
3218 #foreach z $displist {
3219 #puts " $z"
3220 #}
3221 #puts ""
3222 }
3223 incr k
3224 }
3225 if {!$blocked} {
3226 lappend displist $curseg($i)
3227 set nl [lindex $m 2]
3228 foreach f [lindex $m 0] {
3229 incr nextline($f) $nl
3230 }
3231 incr ix($i)
3232 incr nsegs($i) -1
3233 if {$nsegs($i) > 0} {
3234 set curseg($i) [lindex $displ($i) $ix($i)]
3235 } else {
3236 unset curseg($i)
3237 }
3238 break
3239 }
3240 }
3241 incr totsegs -1
3242 }
3243 #puts "displist:"
3244 #foreach d $displist {
3245 #puts $d
3246 #}
3247 emitstart
3248 foreach d $displist {
3249 set l [lindex $d 0]
3250 set e [lindex $d 1]
3251 set m [lindex $d 2]
3252 set fs [lindex $m 0]
3253 set i [lindex $fs 0]
3254 set fl [expr $hunkstart($i) + $l - 1]
3255 for {} {$l < $e} {incr l} {
3256 emitdiff $fs [lindex $fcontents($i) $fl]
3257 incr fl
3258 }
3259 }
3260 }
3261
3262 proc emithdr {i line} {
3263 global textw difftabs linelist
3264 $textw insert end "\t$difftabs$line\n" d$i
3265 lappend linelist [list {} {} $line]
3266 }
3267
3268 proc emitctxline {} {
3269 global textw linelist ldisp fcontents difftabs diffndirs
3270 set lnums {}
3271 set memb {}
3272 set line [lindex $fcontents(0) [expr $ldisp(0)-1]]
3273 for {set i 0} {$i < $diffndirs} {incr i} {
3274 lappend lnums $ldisp($i)
3275 incr ldisp($i)
3276 lappend memb $i
3277 }
3278 lappend linelist [list $lnums $memb $line]
3279 set ix [expr $diffndirs-1]
3280 set r [tabexpand $line $ix]
3281 set l [lindex [split [$textw index "end - 1c"] .] 0]
3282 $textw insert end "\t$difftabs[lindex $r 0]\n"
3283 foreach tgp [lindex $r 1] {
3284 $textw tag add ul $l.[lindex $tgp 0] $l.[lindex $tgp 1]
3285 }
3286 }
3287
3288 proc emitstart {} {
3289 global diffndirs ctxlines ldisp textw difftabs linelist
3290 global prevhunkend fcontents hunkstart
3291 set nctx $ctxlines
3292 set needsep 1
3293 if {[info exists prevhunkend]} {
3294 if {$hunkstart(0) - $prevhunkend <= 2 * $ctxlines + 1} {
3295 set nctx [expr $hunkstart(0) - $prevhunkend]
3296 set needsep 0
3297 } else {
3298 for {set l 0} {$l < $ctxlines} {incr l} {
3299 emitctxline
3300 }
3301 }
3302 }
3303 if {$nctx >= $hunkstart(0)} {
3304 set nctx [expr $hunkstart(0) - 1]
3305 }
3306 if {$needsep} {
3307 set lnums {}
3308 for {set i 0} {$i < $diffndirs} {incr i} {
3309 set ldisp($i) [expr $hunkstart($i) - $nctx]
3310 lappend lnums $ldisp($i)
3311 }
3312 set l [llength $linelist]
3313 lappend linelist [makesepline $l $lnums]
3314 $textw insert end "\n"
3315 redisplaylines $textw $l 1
3316 }
3317 for {set l 0} {$l < $nctx} {incr l} {
3318 emitctxline
3319 }
3320 }
3321
3322 proc emitdiff {set line} {
3323 global diffndirs ldisp textw difftabs linelist
3324 global prevhunkend fcontents nextlix incline
3325 #puts -nonewline "emitdiff set={$set} ldisp ="
3326 #for {set i 0} {$i < $diffndirs} {incr i} {puts -nonewline " $ldisp($i)"}
3327 #puts " line={$line}"
3328 set nm [llength $set]
3329 if {$nm == $diffndirs} {
3330 emitctxline
3331 return
3332 }
3333 if {$nm == 0 || $nm > $diffndirs} {
3334 #puts "oops, $nm members in emitdiff?"
3335 return
3336 }
3337 for {set i 0} {$i < $diffndirs} {incr i} {
3338 set isin($i) 0
3339 }
3340 foreach i $set {
3341 set isin($i) 1
3342 }
3343 set lnums {}
3344 for {set i 0} {$i < $diffndirs} {incr i} {
3345 if {$isin($i)} {
3346 lappend lnums $ldisp($i)
3347 incr ldisp($i)
3348 } else {
3349 lappend lnums {}
3350 }
3351 }
3352 set lix $nextlix
3353 incr nextlix
3354 set incline($lix) 0
3355 set l [llength $linelist]
3356 lappend linelist [list $lnums $set $line $lix]
3357 $textw insert end "\n"
3358 redisplaylines $textw $l 1
3359 set prevhunkend $ldisp(0)
3360 }
3361
3362 proc ndiffdone {} {
3363 global textw prevhunkend fcontents ctxlines
3364 global diffing ldisp diffndirs
3365 #puts -nonewline "ldisp ="
3366 #for {set i 0} {$i < $diffndirs} {incr i} {puts -nonewline " $ldisp($i)"}
3367 #puts ""
3368 if {[info exists prevhunkend]} {
3369 set l0 [llength $fcontents(0)]
3370 #puts "ndiffdone, prevhunkend=$prevhunkend l0=$l0 ctxlines=$ctxlines"
3371 set nctx $ctxlines
3372 if {$prevhunkend - 1 + $nctx > $l0} {
3373 set nctx [expr $l0 - $prevhunkend + 1]
3374 }
3375 for {set l 0} {$l < $nctx} {incr l} {
3376 emitctxline
3377 }
3378 unset prevhunkend
3379 } else {
3380 #puts "ndiffdone, prevhunkend not set"
3381 }
3382 set diffing 0
3383 $textw delete "end - 1c" end
3384 $textw conf -state disabled
3385
3386 # configure the merge button
3387 confmergebut
3388 confmpatchbut
3389 }
3390
3391 proc diffmerge {ix dir} {
3392 global diffdirs difffile diffmtime fserial linelist
3393 global dirs diffcolors textfont incline diffndirs
3394 global fcontents allf
3395 set infile [joinname $dir $difffile]
3396 if {$diffmtime($infile) != [file mtime $infile]} {
3397 error_popup "File $infile has changed since the diff was performed."
3398 return
3399 }
3400
3401 set di [lsearch -exact $dirs $dir]
3402 set fi $fserial($difffile)
3403 set w ".merge:$di:$fi"
3404 catch {destroy $w}
3405 toplevel $w
3406 wm title $w "Dirdiff: merged $infile"
3407 frame $w.bar -relief raised -border 2
3408 pack $w.bar -side top -fill x
3409 menubutton $w.bar.file -text File -menu $w.bar.file.m -padx 10 -pady 1
3410 menu $w.bar.file.m -tearoff 0
3411 $w.bar.file.m add command -label Save -command "savemerge $w"
3412 $w.bar.file.m add command -label Close -command "destroy $w"
3413 pack $w.bar.file -side left
3414 menubutton $w.bar.edit -text Edit -menu $w.bar.edit.m -padx 10 -pady 1
3415 menu $w.bar.edit.m -tearoff 0
3416 $w.bar.edit.m add command -label Cut -command "tk_textCut $w.t"
3417 $w.bar.edit.m add command -label Copy -command "tk_textCopy $w.t"
3418 $w.bar.edit.m add command -label Paste -command "tk_textPaste $w.t"
3419 $w.bar.edit.m add command -label Find \
3420 -command "difffind :merge:$di:$fi $w.t"
3421 pack $w.bar.edit -side left
3422 frame $w.f -relief sunk -border 2
3423 entry $w.f.filename
3424 $w.f.filename insert 0 $infile
3425 pack $w.f.filename -side left -fill x -expand 1
3426 pack $w.f -side top -fill x
3427 text $w.t -yscrollcommand "$w.sb set" -font $textfont
3428 scrollbar $w.sb -command "$w.t yview"
3429 pack $w.sb -side right -fill y
3430 pack $w.t -side left -fill both -expand 1
3431 bind $w <Key-Prior> "$w.t yview scroll -1 p"
3432 bind $w <Key-Next> "$w.t yview scroll 1 p"
3433 for {set x 0} {$x < $diffndirs} {incr x} {
3434 $w.t tag conf d$x -back [lindex $diffcolors $x]
3435 }
3436
3437 set inf $fcontents($ix)
3438 set l 1
3439 foreach m $linelist {
3440 set lns [lindex $m 0]
3441 set ty [lindex $m 1]
3442 if {$lns == {} || $ty == {}} continue
3443 set tl [lindex $lns $ix]
3444 if {$tl != {}} {
3445 for {} {$l < $tl} {incr l} {
3446 set line [lindex $inf [expr $l-1]]
3447 $w.t insert end "$line\n"
3448 }
3449 }
3450 if {$ty == $allf} {
3451 set line [lindex $inf [expr $l-1]]
3452 $w.t insert end "$line\n"
3453 incr l
3454 } elseif {[llength $ty] < $diffndirs} {
3455 set isme [expr {$ty == $ix || [lsearch -exact $ty $ix] >= 0}]
3456 set lix [lindex $m 3]
3457 set inc $incline($lix)
3458 if {!$inc} {
3459 if {$isme} {
3460 set line [lindex $inf [expr $l-1]]
3461 $w.t insert end "$line\n" d$ix
3462 incr l
3463 }
3464 } else {
3465 if {!$isme} {
3466 # insert this line
3467 set line [lindex $m 2]
3468 set last [lindex $ty end]
3469 $w.t insert end "$line\n" d$last
3470 } else {
3471 # delete this line
3472 incr l
3473 }
3474 }
3475 }
3476 }
3477 for {set nl [llength $inf]} {$l <= $nl} {incr l} {
3478 set line [lindex $inf [expr $l-1]]
3479 $w.t insert end "$line\n"
3480 }
3481 # delete last newline
3482 catch {$w.t delete "end - 1c" end}
3483 }
3484
3485 proc savemerge {w} {
3486 set infile [$w.f.filename get]
3487 if {$infile == {}} {return}
3488 set tmpfile "$infile.tmp"
3489 set tf [open $tmpfile w]
3490 puts -nonewline $tf [$w.t get 0.0 end]
3491 close $tf
3492 scmedit $infile
3493 catch {file attr $tmpfile -perm [file attr $infile -perm]}
3494 file rename -force $infile $infile.orig
3495 file rename $tmpfile $infile
3496 destroy $w
3497 redifffiles
3498 }
3499
3500 # Make a patch that would make the same changes to a destination
3501 # file that doing a merge would have made.
3502 proc diffmpatch {ix dir} {
3503 global difffile diffmtime linelist
3504 global dirs textfont incline diffndirs filemode
3505 global fcontents allf mpatchserial
3506
3507 if {![info exists mpatchserial]} {
3508 set mpatchserial 0
3509 }
3510 set fi [incr mpatchserial]
3511 set w ".mpatch:$fi"
3512 toplevel $w
3513 set fname [joinname $dir $difffile]
3514 set ftail [file tail $fname]
3515 wm title $w "Dirdiff: patch for $ftail"
3516 frame $w.bar -relief raised -border 2
3517 pack $w.bar -side top -fill x
3518 menubutton $w.bar.file -text File -menu $w.bar.file.m -padx 10 -pady 1
3519 menu $w.bar.file.m -tearoff 0
3520 $w.bar.file.m add command -label Save -command "savemerge $w"
3521 $w.bar.file.m add command -label Close -command "destroy $w"
3522 pack $w.bar.file -side left
3523 menubutton $w.bar.edit -text Edit -menu $w.bar.edit.m -padx 10 -pady 1
3524 menu $w.bar.edit.m -tearoff 0
3525 $w.bar.edit.m add command -label Cut -command "tk_textCut $w.t"
3526 $w.bar.edit.m add command -label Copy -command "tk_textCopy $w.t"
3527 $w.bar.edit.m add command -label Paste -command "tk_textPaste $w.t"
3528 $w.bar.edit.m add command -label Find \
3529 -command "difffind :mpatch:$fi $w.t"
3530 pack $w.bar.edit -side left
3531 frame $w.f -relief sunk -border 2
3532 entry $w.f.filename
3533 $w.f.filename insert 0 "$ftail.patch"
3534 pack $w.f.filename -side left -fill x -expand 1
3535 pack $w.f -side top -fill x
3536 text $w.t -yscrollcommand "$w.sb set" -font $textfont
3537 scrollbar $w.sb -command "$w.t yview"
3538 pack $w.sb -side right -fill y
3539 pack $w.t -side left -fill both -expand 1
3540 bind $w <Key-Prior> "$w.t yview scroll -1 p"
3541 bind $w <Key-Next> "$w.t yview scroll 1 p"
3542
3543 set inf $fcontents($ix)
3544 set l 1
3545 set delta 0
3546 set pluslines {}
3547 set ctxstart {}
3548 set filelen [llength $fcontents($ix)]
3549
3550 foreach m $linelist {
3551 set lns [lindex $m 0]
3552 set ty [lindex $m 1]
3553 set lix [lindex $m 3]
3554 if {$lns == {}} continue
3555 set lineno [lindex $lns $ix]
3556 if {$lineno != {}} {
3557 set l $lineno
3558 }
3559 if {$ty == {} || $ty == $allf || $lix == {} \
3560 || ($lineno != {} && !$incline($lix))} {
3561 # output accumulated '+' lines
3562 if {$pluslines != {}} {
3563 $w.t insert end $pluslines
3564 set pluslines {}
3565 }
3566 if {$ty != {} && $lineno != {}} {
3567 incr l
3568 }
3569 continue
3570 }
3571 if {!$incline($lix)} continue
3572
3573 # see if we need to start a new hunk
3574 if {$ctxstart == {} || $l > $ctxstart + 6} {
3575 if {$ctxstart == {}} {
3576 # insert diff header
3577 set difftimefmt "%Y-%m-%d %H:%M:%S"
3578 $w.t insert end "--- $fname.orig\t"
3579 $w.t insert end [clock format $diffmtime($fname) \
3580 -format $difftimefmt]
3581 $w.t insert end "\n+++ $fname\t"
3582 $w.t insert end [clock format [clock seconds] \
3583 -format $difftimefmt]
3584 $w.t insert end "\n"
3585 } else {
3586 finishhunk $w $ix $ctxstart $nctx $ndel $nadd
3587 }
3588 set nctx 0
3589 set ndel 0
3590 set nadd 0
3591 set ctxstart [expr $l - 3]
3592 if {$ctxstart < 1} {set ctxstart 1}
3593 $w.t insert end "@@ -$ctxstart, "
3594 $w.t mark set nminus "end - 2c"
3595 $w.t insert end "+[expr $ctxstart + $delta], "
3596 $w.t mark set nplus "end - 2c"
3597 $w.t insert end "\n"
3598 }
3599 while {$ctxstart < $l} {
3600 set line [lindex $fcontents($ix) [expr $ctxstart - 1]]
3601 $w.t insert end " $line\n"
3602 incr nctx
3603 incr ctxstart
3604 }
3605
3606 if {$lineno != {}} {
3607 # delete this line
3608 set line [lindex $inf [expr $lineno-1]]
3609 $w.t insert end "-$line\n"
3610 incr delta -1
3611 incr l
3612 incr ndel
3613 } else {
3614 # insert this line
3615 set line [lindex $m 2]
3616 append pluslines "+$line\n"
3617 incr delta
3618 incr nadd
3619 }
3620 set ctxstart $l
3621 }
3622
3623 if {$pluslines != {}} {
3624 $w.t insert end $pluslines
3625 }
3626 if {$ctxstart != {}} {
3627 finishhunk $w $ix $ctxstart $nctx $ndel $nadd
3628 }
3629 # delete last newline
3630 catch {$w.t delete "end - 1c" end}
3631 }
3632
3633 proc finishhunk {w ix ctxstart nctx nneg npos} {
3634 global fcontents
3635
3636 set filelen [llength $fcontents($ix)]
3637 for {set i $ctxstart} {$i < $ctxstart + 3} {incr i} {
3638 if {$i > $filelen} break
3639 set line [lindex $fcontents($ix) [expr $i - 1]]
3640 $w.t insert end " $line\n"
3641 incr nctx
3642 }
3643 $w.t insert nminus [expr $nctx + $nneg]
3644 $w.t insert nplus [expr $nctx + $npos]
3645 }
3646
3647 proc nextdiff {} {
3648 global textw linelist
3649 set l [lindex [split [$textw index @0,0] .] 0]
3650 set nl [llength $linelist]
3651 while {[incr l] < $nl} {
3652 if {[lindex [lindex $linelist $l] 1] == {}} {
3653 $textw yview $l.0
3654 break
3655 }
3656 }
3657 }
3658
3659 proc prevdiff {} {
3660 global textw linelist
3661 set l [lindex [split [$textw index @0,0] .] 0]
3662 while {[incr l -1] > 0} {
3663 if {[lindex [lindex $linelist $l] 1] == {}} {
3664 $textw yview $l.0
3665 break
3666 }
3667 }
3668 }
3669
3670 proc diffnextfile {inc} {
3671 global diffdirs selfile numgroups groups dirs textw
3672 global ycoord canvw origdiffdirs
3673 if {!([info exists textw] && [winfo exists $textw])} return
3674 if {![selnextline $inc] || $numgroups <= 1 \
3675 || ![info exists origdiffdirs]} {
3676 return
3677 }
3678 set seengrps {}
3679 set group [lindex $groups($selfile) 1]
3680 set ds {}
3681 foreach d $origdiffdirs {
3682 set i [lindex $group [lsearch $dirs $d]]
3683 if {$i != 0 && [lsearch -exact $seengrps $i] < 0} {
3684 lappend ds $d
3685 lappend seengrps $i
3686 }
3687 }
3688 if {[llength $ds] == 2} {
3689 diff2 [lindex $ds 0] [lindex $ds 1] $selfile 0
3690 } elseif {[llength $ds] > 2} {
3691 diffn $ds $selfile 0
3692 }
3693 }
3694
3695 proc showsomediff {inc} {
3696 global diffdirs difffile selfile numgroups groups dirs textw
3697 global ycoord canvw groupelts dirinterest
3698 if {![selnextline $inc]} return
3699 if {[lindex $groups($selfile) 0] == "dir"} return
3700
3701 if {$numgroups <= 1} {
3702 set xi [lindex $groupelts(1) 0]
3703 if {$xi != ""} {
3704 showfile [lindex $dirs $xi] $selfile
3705 }
3706 return
3707 }
3708
3709 set dirlist {}
3710 for {set gn 1} {$gn <= $numgroups} {incr gn} {
3711 foreach i $groupelts($gn) {
3712 if {$dirinterest($i)} {
3713 lappend dirlist [lindex $dirs $i]
3714 break
3715 }
3716 }
3717 }
3718 if {[llength $dirlist] == 2} {
3719 diff2 [lindex $dirlist 0] [lindex $dirlist 1] $selfile
3720 } elseif {[llength $dirlist] > 2} {
3721 diffn $dirlist $selfile
3722 }
3723 }
3724
3725 proc copydifffile {} {
3726 global diffdirs selfile groups dirs changed
3727 if {![info exists diffdirs] || [llength $diffdirs] != 2} return
3728 set d1 [lindex $diffdirs 0]
3729 set d2 [lindex $diffdirs 1]
3730 if {[lindex $groups($selfile) 0] == "dir"} return
3731 set group [lindex $groups($selfile) 1]
3732 set n1 [lsearch $dirs $d1]
3733 set n2 [lsearch $dirs $d2]
3734 set i1 [lindex $group $n1]
3735 set i2 [lindex $group $n2]
3736 if {$i1 == 0 || $i2 == 0 || $i1 == $i2} return
3737 set changed 0
3738 copyfile $n2 $n1 $selfile 0
3739 if {$changed} redisplay
3740 }
3741
3742 proc maketextw {} {
3743 global textw texttop mergebut mpatchbut filemode textfont dirs
3744 toplevel .diffs
3745 wm title .diffs "Differences"
3746 frame .diffs.bar -relief sunken -border 2
3747 pack .diffs.bar -side top -fill x
3748 button .diffs.bar.rediff -text Rediff -command "diffnextfile 0"
3749 pack .diffs.bar.rediff -side left
3750 button .diffs.bar.options -text Options -command diffoptions
3751 pack .diffs.bar.options -side left
3752 button .diffs.bar.find -text Find -command "difffind :diffs .diffs.t"
3753 pack .diffs.bar.find -side left
3754 menubutton .diffs.bar.merge -text Merge -menu .diffs.bar.merge.m -padx 10
3755 menu .diffs.bar.merge.m -tearoff 0
3756 pack .diffs.bar.merge -side left
3757 menubutton .diffs.bar.mpatch -text Patch -menu .diffs.bar.mpatch.m -padx 10
3758 menu .diffs.bar.mpatch.m -tearoff 0
3759 pack .diffs.bar.mpatch -side left
3760 if {!$filemode} {
3761 button .diffs.bar.next -text "Next file" -command "diffnextfile 1"
3762 pack .diffs.bar.next -side left
3763 button .diffs.bar.prev -text "Previous file" -command "diffnextfile -1"
3764 pack .diffs.bar.prev -side left
3765 }
3766 button .diffs.bar.invert -text "Invert" -command "invertbuttons"
3767 pack .diffs.bar.invert -side left
3768 set texttop .diffs
3769 set textw .diffs.t
3770 set mergebut .diffs.bar.merge
3771 set mpatchbut .diffs.bar.mpatch
3772 set wid [expr 82 + 2 * [llength $dirs]]
3773 text $textw -width $wid -height 32 -yscrollcommand ".diffs.sb set" \
3774 -font $textfont
3775 scrollbar .diffs.sb -command "$textw yview"
3776 pack .diffs.sb -side right -fill y
3777 pack $textw -side left -fill both -expand 1
3778 bind .diffs <Key-Prior> "$textw yview scroll -1 p"
3779 bind .diffs b "$textw yview scroll -1 p"
3780 bind .diffs B "$textw yview scroll -1 p"
3781 bind .diffs <Key-BackSpace> "$textw yview scroll -1 p"
3782 bind .diffs <Key-Delete> "$textw yview scroll -1 p"
3783 bind .diffs <Key-Next> "$textw yview scroll 1 p"
3784 bind .diffs <Key-space> "$textw yview scroll 1 p"
3785 bind .diffs <Key-Up> "$textw yview scroll -1 u"
3786 bind .diffs <Key-Down> "$textw yview scroll 1 u"
3787 bind .diffs d "$textw yview scroll \[expr \"int(\[$textw cget -height\]/2)\"\] u"
3788 bind .diffs D "$textw yview scroll \[expr \"int(\[$textw cget -height\]/2)\"\] u"
3789 bind .diffs u "$textw yview scroll \[expr \"int(-\[$textw cget -height\]/2)\"\] u"
3790 bind .diffs U "$textw yview scroll \[expr \"int(-\[$textw cget -height\]/2)\"\] u"
3791 bind .diffs n nextdiff
3792 bind .diffs p prevdiff
3793 if {!$filemode} {
3794 bind .diffs N "diffnextfile 1"
3795 bind .diffs P "diffnextfile -1"
3796 }
3797 bind .diffs q removediffs
3798 bind .diffs Q "set stopped 1; destroy ."
3799 bind .diffs <Key-Home> "$textw yview 1.0"
3800 bind .diffs g "$textw yview 1.0"
3801 bind .diffs <Key-End> "$textw yview -pickplace \[$textw index end\]"
3802 bind .diffs G "$textw yview -pickplace \[$textw index end\]"
3803 bind .diffs C copydifffile
3804 }
3805
3806 proc diffoptions {} {
3807 global optionw
3808 if {[info exists optionw] && [winfo exists $optionw]} {
3809 raise $optionw
3810 return
3811 }
3812 set optionw .options
3813 toplevel $optionw
3814 wm title .options "Dirdiff options"
3815 checkbutton $optionw.diffiflag -text "Ignore case" \
3816 -offvalue "" -onvalue "-i" -anchor w
3817 pack $optionw.diffiflag -side top -fill x
3818 checkbutton $optionw.diffwflag -text "Ignore all white space" \
3819 -offvalue "" -onvalue "-w" -anchor w
3820 pack $optionw.diffwflag -side top -fill x
3821 checkbutton $optionw.diffbflag -text "Ignore amount of white space" \
3822 -offvalue "" -onvalue "-b" -anchor w
3823 pack $optionw.diffbflag -side top -fill x
3824 checkbutton $optionw.diffBflag -text "Ignore blank lines" \
3825 -offvalue "" -onvalue "-B" -anchor w
3826 pack $optionw.diffBflag -side top -fill x
3827 checkbutton $optionw.diffdflag -text "Minimize diffs" \
3828 -offvalue "" -onvalue "-d" -anchor w
3829 pack $optionw.diffdflag -side top -fill x
3830 checkbutton $optionw.ultabs -text "Underline tabs" -anchor w \
3831 -variable underlinetabs -command changeunderlinetabs
3832 pack $optionw.ultabs -side top -fill x
3833 checkbutton $optionw.newfirst -text "Newer file first" -anchor w \
3834 -variable diffnewfirst
3835 pack $optionw.newfirst -side top -fill x
3836 frame $optionw.ctx
3837 pack $optionw.ctx -side top
3838 label $optionw.ctx.l -text "Lines of context: "
3839 pack $optionw.ctx.l -side left
3840 entry $optionw.ctx.v -width 5 -textvariable ctxlines
3841 pack $optionw.ctx.v -side left
3842 button $optionw.save -text "Save options" -command saveoptions
3843 pack $optionw.save -side top -fill x
3844 frame $optionw.space -height 6
3845 pack $optionw.space -side top -fill x
3846 button $optionw.dismiss -text "Dismiss" -command "destroy $optionw"
3847 pack $optionw.dismiss -side bottom -fill x
3848 bind $optionw <Return> "destroy $optionw"
3849 }
3850
3851 proc saveoptions {} {
3852 global rcsflag diffiflag diffwflag diffbflag diffBflag diffdflag
3853 global ctxlines showsame underlinetabs nukefiles redisp_immed
3854 global diffprogram showprogram
3855 global diffnewfirst textfont filelistfont nxdirmode
3856 global docvsignore
3857 set f [open "~/.dirdiff" w]
3858 puts $f [list set diffprogram $diffprogram]
3859 puts $f [list set showprogram $showprogram]
3860 puts $f [list set rcsflag $rcsflag]
3861 puts $f [list set diffiflag $diffiflag]
3862 puts $f [list set diffwflag $diffwflag]
3863 puts $f [list set diffbflag $diffbflag]
3864 puts $f [list set diffBflag $diffBflag]
3865 puts $f [list set diffdflag $diffdflag]
3866 puts $f [list set ctxlines $ctxlines]
3867 puts $f [list set showsame $showsame]
3868 puts $f [list set underlinetabs $underlinetabs]
3869 puts $f [list set redisp_immed $redisp_immed]
3870 puts $f [list set diffnewfirst $diffnewfirst]
3871 puts $f [list set nukefiles $nukefiles]
3872 puts $f [list set filelistfont $filelistfont]
3873 puts $f [list set textfont $textfont]
3874 puts $f [list set nxdirmode $nxdirmode]
3875 puts $f [list set docvsignore $docvsignore]
3876 close $f
3877 }
3878
3879 proc difffind {tag txt} {
3880 global dfindw$tag igncase$tag diffiflag regexp$tag backwards$tag
3881 if {[info exists dfindw$tag] && [winfo exists [set dfindw$tag]]} {
3882 raise [set dfindw$tag]
3883 return
3884 }
3885 set w .find$tag
3886 set dfindw$tag $w
3887 toplevel $w
3888 wm title $w "Dirdiff: Find"
3889 frame $w.f
3890 pack $w.f -side top -fill x -expand 1
3891 button $w.f.b -text "Find:" -command [list dofind $tag $txt $w]
3892 bind $w <Return> [list dofind $tag $txt $w]
3893 pack $w.f.b -side left
3894 entry $w.f.e
3895 pack $w.f.e -side right
3896 if {![info exists igncase$tag]} {
3897 set igncase$tag [expr {$diffiflag != {}}]
3898 }
3899 checkbutton $w.case -variable igncase$tag -text "Ignore case" -anchor w
3900 pack $w.case -side top -fill x
3901 checkbutton $w.regexp -variable regexp$tag -text "Regular expression" \
3902 -anchor w
3903 pack $w.regexp -side top -fill x
3904 checkbutton $w.backwards -variable backwards$tag \
3905 -text "Search backwards" -anchor w
3906 pack $w.backwards -side top -fill x
3907 button $w.close -text "Close" -command "destroy $w"
3908 pack $w.close -side top -fill x
3909 }
3910
3911 proc dofind {tag txt w} {
3912 global dfindw$tag igncase$tag regexp$tag backwards$tag
3913 if {![winfo exists $txt]} return
3914 set w [set dfindw$tag]
3915 set str [$w.f.e get]
3916 if {$str == {}} return
3917 set back [set backwards$tag]
3918 # By default, start the search from the insertion point.
3919 # If there is a selection, start from the end of the selection for
3920 # a forwards search, or from the beginning for a backwards search.
3921 set start [$txt index insert]
3922 if {[$txt tag ranges sel] != {}} {
3923 if {$back} {
3924 set start [$txt index sel.first]
3925 } else {
3926 set start [$txt index sel.last]
3927 }
3928 }
3929 set opts {}
3930 if {$back} {
3931 lappend opts "-backwards"
3932 }
3933 if {[set regexp$tag]} {
3934 lappend opts "-regexp"
3935 }
3936 if {[set igncase$tag]} {
3937 lappend opts "-nocase"
3938 }
3939 set pos [eval $txt search $opts -count count -- [list $str] $start]
3940 if {$pos == {}} {
3941 bell
3942 return
3943 }
3944 set epos "$pos + $count c"
3945 $txt mark set insert $epos
3946 $txt tag remove sel 0.0 end
3947 $txt tag add sel $pos $epos
3948 $txt see $epos
3949 $txt see $pos
3950 }
3951
3952 proc makepatch {d1 d2} {
3953 global patchnum selfile patchfiles patch_outfile
3954 global showprogram
3955
3956 set files [secondarysel $selfile]
3957 if {$files == {}} {
3958 error_popup "No files selected!"
3959 return
3960 }
3961 if {![info exists patchnum]} {
3962 set patchnum 0
3963 }
3964 set patchfiles($patchnum) $files
3965
3966 # Put the diff in a temporary file for external viewer
3967 if { [llength $showprogram] > 0} {
3968 set patch_outfile "patch${patchnum}.diff"
3969 set w [open $patch_outfile w]
3970 # Or build our own viewer
3971 } else {
3972 set w ".patch:$patchnum"
3973 catch {destroy $w}
3974 toplevel $w
3975 wm title $w "Patch: $d1 to $d2"
3976 frame $w.bar -relief raised -border 2
3977 pack $w.bar -side top -fill x
3978 menubutton $w.bar.file -text File -menu $w.bar.file.m -padx 10 -pady 1
3979 menu $w.bar.file.m -tearoff 0
3980 $w.bar.file.m add command -label Save -command "savepatch $w"
3981 $w.bar.file.m add command -label Close -command "destroy $w"
3982 pack $w.bar.file -side left
3983 menubutton $w.bar.edit -text Edit -menu $w.bar.edit.m -padx 10 -pady 1
3984 menu $w.bar.edit.m -tearoff 0
3985 $w.bar.edit.m add command -label Cut -command "tk_textCut $w.t"
3986 $w.bar.edit.m add command -label Copy -command "tk_textCopy $w.t"
3987 $w.bar.edit.m add command -label Paste -command "tk_textPaste $w.t"
3988 $w.bar.edit.m add command -label Find \
3989 -command "difffind :patch:$patchnum $w.t"
3990 pack $w.bar.edit -side left
3991 frame $w.f -relief sunk -border 2
3992 label $w.f.l -text "Filename: "
3993 entry $w.f.filename
3994 $w.f.filename insert 0 "patch$patchnum"
3995 pack $w.f.l -side left
3996 pack $w.f.filename -side left -fill x -expand 1
3997 pack $w.f -side top -fill x
3998 text $w.t -yscrollcommand "$w.sb set"
3999 scrollbar $w.sb -command "$w.t yview"
4000 pack $w.sb -side right -fill y
4001 pack $w.t -side left -fill both -expand 1
4002 bind $w <Key-Prior> "$w.t yview scroll -1 p"
4003 bind $w <Key-Next> "$w.t yview scroll 1 p"
4004 }
4005
4006 patchnext $patchnum $w $d1 $d2 0
4007 incr patchnum
4008 }
4009
4010 # Output lines to either our external patchfile or the internal vieiwer
4011 proc lineout {w line} {
4012 if {[string match ".*" $w]} {
4013 $w.t insert end "$line\n"
4014 } else {
4015 puts $w "$line"
4016 }
4017 }
4018
4019 proc patchnext {pnum w d1 d2 i} {
4020 global patchfiles have_unidiff showprogram patch_outfile nullfile
4021
4022 set contextopt [expr {$have_unidiff ? "-u" : "-c"}]
4023 update
4024 for {} {[set f [lindex $patchfiles($pnum) $i]] != {}} {incr i} {
4025 set p1 [joinname $d1 $f]
4026 set p2 [joinname $d2 $f]
4027 if {[file exists $p1] && [file exists $p2]} {
4028 set fh [open "|diff $contextopt $p1 $p2" r]
4029 } elseif {[file exists $p1] && ! [file exists $p2]} {
4030 set fh [open "|diff $contextopt $p1 $nullfile" r]
4031 } elseif {! [file exists $p1] && [file exists $p2]} {
4032 set fh [open "|diff $contextopt $nullfile $p2" r]
4033 } else {
4034 continue
4035 }
4036 fconfigure $fh -blocking 0
4037 fileevent $fh readable "readpatch $fh $pnum $w $d1 $d2 $i \"$f\""
4038 return
4039 }
4040 if {[string match ".*" $w]} {
4041 $w.t delete "end - 1c" end
4042 } else {
4043 close $w
4044 eval "exec $showprogram \"$patch_outfile\" &"
4045 # Should we remove the tempfile here? We don't have it if we used
4046 # the internal viewer
4047 }
4048 unset patchfiles($pnum)
4049 }
4050
4051 proc diffl_out {w d1 d2 f} {
4052 global have_unidiff
4053 set contextopt [expr {$have_unidiff ? "-urN" : "-cr"}]
4054 lineout $w "diff $contextopt [joinname $d1 $f] [joinname $d2 $f]"
4055 }
4056
4057 proc readpatch {difff pnum w d1 d2 i f} {
4058 global have_unidiff showprogram
4059 set n [gets $difff line]
4060 if {$n < 0} {
4061 if {![eof $difff]} return
4062 catch {close $difff}
4063 patchnext $pnum $w $d1 $d2 [expr $i+1]
4064 return
4065 }
4066 if {[string match "Binary*" $line]} return
4067 if {$have_unidiff} {
4068 if {[string match "---*" $line]} {
4069 diffl_out $w $d1 $d2 $f
4070 }
4071 } else {
4072 if {[string match "\*\*\* ${d1}*" $line]} {
4073 diffl_out $w $d1 $d2 $f
4074 }
4075 }
4076 lineout $w $line
4077 }
4078
4079 proc savepatch {w} {
4080 set outfile [$w.f.filename get]
4081 if {$outfile == {}} {return}
4082 set outf [open $outfile w]
4083 puts -nonewline $outf [$w.t get 0.0 end]
4084 close $outf
4085 destroy $w
4086 }
4087
4088 # invoked from the File->Touch menu item
4089 proc touchfiles {d} {
4090 global selfile
4091 set files [secondarysel $selfile]
4092 if {$files == {}} {
4093 error_popup "No files selected!"
4094 return
4095 }
4096 set now [clock seconds]
4097 set bad {}
4098 foreach f $files {
4099 set df [file join $d $f]
4100 if {[catch {file mtime $df $now} err]} {
4101 append bad "$df: $err\n"
4102 }
4103 }
4104 if {$bad != {}} {
4105 error_popup "Errors occurred:\n$bad"
4106 }
4107 redifffiles
4108 }
4109
4110 proc exclfilelist {} {
4111 global exclw nukefiles
4112 if {[info exists exclw] && [winfo exists $exclw]} {
4113 raise $exclw
4114 return
4115 }
4116 toplevel .excl
4117 wm title .excl "Dirdiff: excluded files"
4118 set exclw .excl
4119 frame $exclw.b
4120 listbox $exclw.l -height 10 -width 40 -yscrollcommand "$exclw.sb set" \
4121 -selectmode single
4122 scrollbar $exclw.sb -command "$exclw.l yview"
4123 entry $exclw.e
4124 pack $exclw.b -side bottom -fill x
4125 pack $exclw.e -side bottom -fill x
4126 pack $exclw.sb -side right -fill y
4127 pack $exclw.l -side left -fill both -expand 1
4128 button $exclw.b.add -text "Add" -padx 20 -command addexcl
4129 button $exclw.b.rem -text "Remove" -command remexcl
4130 button $exclw.b.close -text "Close" -command closeexcl
4131 pack $exclw.b.add -side left -fill x
4132 pack $exclw.b.rem -side left -fill x
4133 pack $exclw.b.close -side right -fill x
4134 bind $exclw.e <Return> "addexcl"
4135 foreach i $nukefiles {
4136 $exclw.l insert end $i
4137 }
4138 }
4139
4140 proc addexcl {} {
4141 global exclw nukefiles
4142 if {[info exists exclw] && [winfo exists $exclw]} {
4143 set e [$exclw.e get]
4144 if {$e != {}} {
4145 $exclw.l insert end $e
4146 lappend nukefiles $e
4147 $exclw.l see end
4148 }
4149 }
4150 }
4151
4152 proc remexcl {} {
4153 global exclw nukefiles
4154 if {[info exists exclw] && [winfo exists $exclw]} {
4155 set s [$exclw.l curselection]
4156 if {$s != {}} {
4157 $exclw.l delete $s
4158 set nukefiles [lreplace $nukefiles $s $s]
4159 }
4160 }
4161 }
4162
4163 proc exclsel {} {
4164 global selfile nukefiles exclw
4165 set files [secondarysel $selfile]
4166 foreach f $files {
4167 set df [string trimright $f /]
4168 if {$df != {}} {
4169 lappend nukefiles $df
4170 if {[info exists exclw] && [winfo exists $exclw]} {
4171 $exclw.l insert end $df
4172 }
4173 }
4174 }
4175 redisplay
4176 }
4177
4178 proc extprograms {} {
4179 global showprogram diffprogram
4180 toplevel .ext
4181 frame .ext.top
4182 label .ext.top.diffl -text "Diff Viewing/Merging"
4183 entry .ext.top.diffe -textvariable diffprogram
4184 label .ext.top.showl -text "File Viewing"
4185 entry .ext.top.showe -textvariable showprogram
4186 grid .ext.top.diffl -row 0 -column 0 -sticky e
4187 grid .ext.top.diffe -row 0 -column 1 -sticky nsew -pady 4
4188 grid .ext.top.showl -row 1 -column 0 -sticky e
4189 grid .ext.top.showe -row 1 -column 1 -sticky nsew -pady 4
4190 grid columnconfigure .ext.top 0 -weight 0
4191 grid columnconfigure .ext.top 1 -weight 1
4192 pack .ext.top -fill x -expand yes
4193 frame .ext.bot
4194 button .ext.bot.ok -text "OK" \
4195 -command {
4196 destroy .ext
4197 }
4198 pack .ext.bot .ext.bot.ok -fill x -expand yes
4199 }
4200
4201 proc closeexcl {} {
4202 global exclw
4203 catch {destroy $exclw}
4204 catch {unset exclw}
4205 }
4206
4207 proc secondarysel {fname} {
4208 global secsel canvw
4209 set files {}
4210 foreach it [array names secsel] {
4211 lappend files [$canvw itemcget $it -text]
4212 }
4213 if {$files == {}} {
4214 if {$fname == {}} {
4215 return {}
4216 }
4217 set files [list $fname]
4218 }
4219 return [lsort $files]
4220 }
4221
4222 proc copyselfile {src dst fname confirm} {
4223 global dirs changed
4224 set files [secondarysel $fname]
4225 set n [llength $files]
4226 set changed 0
4227 if {$n == 1} {
4228 copyfile $src $dst $fname $confirm
4229 } else {
4230 if {$confirm} {
4231 set sd [lindex $dirs $src]
4232 set dd [lindex $dirs $dst]
4233 if {![confirm_popup "Copy $n older files from $sd to $dd?"]} {
4234 return
4235 }
4236 }
4237 foreach f $files {
4238 copyfile $src $dst $f 0
4239 }
4240 }
4241 if {$changed} redisplay
4242 after idle selcurfile
4243 }
4244
4245 proc copyfile {src dst fname confirm} {
4246 global dirs filemode
4247 set sd [lindex $dirs $src]
4248 set dd [lindex $dirs $dst]
4249 set srcf [joinname $sd $fname]
4250 set dstf [joinname $dd $fname]
4251 if {$filemode} {
4252 set msg "$src to $dst"
4253 set copydst $dstf
4254 } else {
4255 set msg "$fname from $sd to $dd"
4256 set copydst [file dirname $dstf]
4257 }
4258 if {$confirm} {
4259 if {![confirm_popup "Copy older $msg?"]} {
4260 return
4261 }
4262 }
4263 set z [string trimright $fname /]
4264 if {$z != $fname} {
4265 copydir $src $dst $z
4266 return
4267 }
4268 scmedit $dstf
4269 if [catch {file copy -force -- $srcf $copydst} err] {
4270 error_popup "Error copying $msg: $err"
4271 } else {
4272 scmnew $dstf
4273 updatecline $src $dst $fname
4274 }
4275 }
4276
4277 proc copydir {src dst dname} {
4278 global dirs groups alllines
4279 set sn [lindex $dirs $src]
4280 set dn [lindex $dirs $dst]
4281 if [catch {exec cp -p -r $sn/$dname [file dirname $dn/$dname]} err] {
4282 error_popup "Error copying $dname from $sn to $dn: $err"
4283 return
4284 }
4285 foreach f $alllines {
4286 if [string match $dname* $f] {
4287 updatecline $src $dst $f
4288 }
4289 }
4290 }
4291
4292 proc scmedit {name} {
4293 }
4294
4295 proc scmnew {name} {
4296 }
4297
4298 proc removeselfile {dst fname} {
4299 global groupelts dirs changed
4300 set files [secondarysel $fname]
4301 if {$files == {}} return
4302 set nf 0
4303 set nd 0
4304 foreach x $files {
4305 if {[string range $x end end] == "/"} {
4306 incr nd
4307 } else {
4308 incr nf
4309 }
4310 }
4311 set dd [lindex $dirs $dst]
4312 if {$nd + $nf == 1} {
4313 set x [string trimright [joinname $dd $fname] /]
4314 if {![confirm_popup "Remove $x?"]} {
4315 return
4316 }
4317 } else {
4318 set stuff "Remove "
4319 if {$nd > 0} {
4320 if {$nd == 1} {
4321 append stuff "1 directory "
4322 } else {
4323 append stuff "$nd directories "
4324 }
4325 if {$nf > 0} {
4326 append stuff "and "
4327 }
4328 }
4329 if {$nf == 1} {
4330 append stuff "1 file "
4331 } elseif {$nf > 1} {
4332 append stuff "$nf files "
4333 }
4334 append stuff "from $dd?"
4335 if {![confirm_popup $stuff]} {
4336 return
4337 }
4338 }
4339 set changed 0
4340 foreach f $files {
4341 set d [string trimright $f /]
4342 set dstf [joinname $dd $d]
4343 if {$d == $f} {
4344 set bad [catch {file delete $dstf} err]
4345 } else {
4346 set bad [catch {file delete -force $dstf} err]
4347 }
4348 if $bad {
4349 error_popup "Error deleting $dstf: $err"
4350 } else {
4351 updatecline [lindex $groupelts(0) 0] $dst $f
4352 }
4353 }
4354 if {$changed} redisplay
4355 after idle selcurfile
4356 }
4357
4358 proc confirm_popup msg {
4359 global confirm_ok
4360 set confirm_ok 0
4361 set w .confirm
4362 toplevel $w
4363 wm transient $w .
4364 message $w.m -text $msg -justify center -aspect 400
4365 pack $w.m -side top -fill x -padx 20 -pady 20
4366 button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
4367 pack $w.ok -side left -fill x
4368 button $w.cancel -text Cancel -command "destroy $w"
4369 pack $w.cancel -side right -fill x
4370 bind $w <Visibility> "grab $w; focus $w"
4371 tkwait window $w
4372 return $confirm_ok
4373 }
4374
4375 proc error_popup msg {
4376 set w .error
4377 toplevel $w
4378 wm transient $w .
4379 message $w.m -text $msg -justify center -aspect 400
4380 pack $w.m -side top -fill x -padx 20 -pady 20
4381 button $w.ok -text OK -command "destroy $w"
4382 pack $w.ok -side bottom -fill x
4383 bind $w <Visibility> "grab $w; focus $w"
4384 tkwait window $w
4385 }
4386
4387 proc notalldirs {dirs} {
4388 set type ""
4389 foreach d $dirs {
4390 if {[catch {file lstat $d stat} err]} {
4391 puts stderr $err
4392 exit 1
4393 }
4394 if {$type == ""} {
4395 set type $stat(type)
4396 } elseif {$type != $stat(type)} {
4397 puts stderr "Error: $d is a $stat(type) but [lindex $dirs 0] is a $type"
4398 exit 1
4399 }
4400 }
4401 return [expr {$type == "file"}]
4402 }
4403
4404 proc go {} {
4405 global diffing filemode dirs nextserial
4406 if {[llength $dirs] == 0} {exit 0}
4407 set diffing 0
4408 set nextserial 0
4409 set filemode [notalldirs $dirs]
4410 icons
4411 makewins
4412 initcanv
4413 resetsel
4414 removediffs
4415 update
4416 canvdiffs
4417 }
4418
4419 proc rediff {} {
4420 initcanv
4421 resetsel
4422 removediffs
4423 update
4424 canvdiffs
4425 }
4426
4427 proc repackgroups {gr} {
4428 if {[lindex $gr 0] == "dir"} {
4429 return $gr
4430 }
4431 set glist [lindex $gr 1]
4432 set glsort [lsort $glist]
4433 set ng(0) 0
4434 set lg 0
4435 set gc 0
4436 foreach e $glsort {
4437 if {$e != $lg} {
4438 set lg $e
4439 incr gc
4440 set ng($e) $gc
4441 }
4442 }
4443 if {$gc == [lindex $gr 0]} {
4444 return $gr
4445 }
4446 set newlist {}
4447 foreach e $glist {
4448 lappend newlist $ng($e)
4449 }
4450 return [list $gc $newlist]
4451 }
4452
4453 proc interesting_line {gr} {
4454 global dirinterest dirs showsame
4455 if {$gr == {}} {
4456 return 0
4457 }
4458 if {$showsame} {
4459 return 1
4460 }
4461 set glist [lindex $gr 1]
4462 set i 0
4463 foreach e $glist {
4464 if $dirinterest($i) {
4465 if {[info exists first]} {
4466 if {$e != $first} {
4467 return 1
4468 }
4469 } else {
4470 set first $e
4471 }
4472 }
4473 incr i
4474 }
4475 return 0
4476 }
4477
4478 proc redisplay {{zapdiffs 0}} {
4479 global canvw canvy canvy0 alllines groups ruletype linespc stringx
4480 global ruletype selfile secsel ycoord filemode redisp_immed
4481 if {$filemode || !($zapdiffs || $redisp_immed)} return
4482 set y [expr {[lindex [$canvw yview] 0] * $canvy}]
4483 set i [textitemat [expr {$stringx+5}] [expr {$y + $linespc/2}]]
4484 set topy 0
4485 set topline {}
4486 if {$i != {}} {
4487 set topline [$canvw itemcget $i -text]
4488 }
4489 if {$zapdiffs} {
4490 removediffs
4491 } else {
4492 set filesel $selfile
4493 set filesecsel [secondarysel $selfile]
4494 }
4495 $canvw delete all
4496 set canvy $canvy0
4497 $canvw conf -scrollregion "0 0 0 1"
4498 catch {unset ycoord}
4499 resetsel
4500 foreach f $alllines {
4501 if {$f == $topline} {
4502 set topy $canvy
4503 }
4504 set gr $groups($f)
4505 if {$gr != {} && [notnuked [string trimright $f /]]} {
4506 set gr [repackgroups $gr]
4507 set groups($f) $gr
4508 if {[interesting_line $gr]} {
4509 displine $gr $f
4510 }
4511 }
4512 }
4513 if {[info exists ruletype]} {
4514 ruleoff $ruletype
4515 }
4516 if {$canvy > 0} {
4517 $canvw yview moveto [expr {$topy * 1.0 / $canvy}]
4518 } else {
4519 $canvw yview moveto 0
4520 }
4521 if {!$zapdiffs} {
4522 foreach f $filesecsel {
4523 set i [itemofname $f]
4524 if {$i != {}} {
4525 addsecsel $i
4526 }
4527 }
4528 set i [itemofname $filesel]
4529 if {$i != {}} {
4530 selectitem $i
4531 addsecsel $i
4532 }
4533 selcurfile
4534 }
4535 }
4536
4537 proc icons {} {
4538 global agecolors
4539
4540 image create photo ex \
4541 -format gif -data {
4542 R0lGODlhEAANAIAAAAAAAP///yH+Dk1hZGUgd2l0aCBHSU1QACH5BAEAAAEA
4543 LAAAAAAQAA0AAAIgjI95ABqcWENSVXMtzE5CR30g5o3PJkYiR05LenauqRQA
4544 Ow==
4545 }
4546 image create photo folder \
4547 -format gif -data {
4548 R0lGODlhEAANAMIAAISEhMbGxv/si////wAAAAAAAAAAAAAAACH+Dk1hZGUg
4549 d2l0aCBHSU1QACH5BAEAAAQALAAAAAAQAA0AAAMoSATM+nAFQUUAUYFZ6W3g
4550 II4kyQxd2p1qy7bpC1fyLNQzDusu6P+ABAA7
4551 }
4552 image create photo paper \
4553 -format gif -data {
4554 R0lGODlhEAANAKEAAISEhP///8bGxgAAACH+Dk1hZGUgd2l0aCBHSU1QACH5
4555 BAEAAAMALAAAAAAQAA0AAAIp3ICpxhcPAxCgufhAoE1jmXRfVDHeKIloaq6s
4556 cY4l7M4XasdfrvSIUQAAOw==
4557 }
4558 image create photo paper_green \
4559 -format gif -data {
4560 R0lGODlhEAANAMIAAP///4SEhP7/vsbGxgDKAP///////////yH5BAEAAAcALAAAAAAQAA0A
4561 AAMoeBfcrnCRSUmwUdZ5Mezb821hBJKecpKBiVLt+KbaG6szvZaf4zOKBAA7
4562 }
4563 image create photo paper_yellowgreen \
4564 -format gif -data {
4565 R0lGODlhEAANAMIAAP///4SEhP7/vsbGxgCAAACAQNLmAP///yH5BAEAAAcALAAAAAAQAA0A
4566 AAMoeBfcrnCZSU2wUdZ5Mezb821hBJKecpKBiVLt+KbaG6szvZaf4zOKBAA7
4567 }
4568 image create photo paper_yellow \
4569 -format gif -data {
4570 R0lGODlhEAANAMIAAP///4SEhPfhAMbGxv///////////////yH5BAEAAAMALAAAAAAQAA0A
4571 AAMoOBPcrnCJSUWwUdZ5Mezb821hBJKecpKBiVLt+KbaG6szvZaf4zOKBAA7
4572 }
4573 image create photo paper_orange \
4574 -format gif -data {
4575 R0lGODlhEAANAMIAAP///4SEhOxzAMbGxv///////////////yH5BAEAAAMALAAAAAAQAA0A
4576 AAMoOBPcrnCJSUWwUdZ5Mezb821hBJKecpKBiVLt+KbaG6szvZaf4zOKBAA7
4577 }
4578 image create photo paper_red \
4579 -format gif -data {
4580 R0lGODlhEAANAKEAAISEhOE+IbchAP///yH5BAEAAAMALAAAAAAQAA0AAAIo3ICpxhcPA5DN
4581 xQcEZfPK1HQeFo4QUJqbIY4op66W+bJxPbuhwiNGAQA7
4582 }
4583
4584
4585 set agecolors(dir) {ex folder}
4586 set agecolors(0) {ex}
4587 set agecolors(1) {ex paper}
4588 set agecolors(2) {ex paper_green paper_red}
4589 set agecolors(3) {ex paper_green paper_yellow paper_red}
4590 set agecolors(4) {ex paper_green paper_yellow paper_orange paper_red}
4591 set agecolors(5) {ex paper_green paper_yellowgreen paper_yellow paper_orange paper_red}
4592 }
4593
4594 proc midy {bbox} {
4595 return [expr ([lindex $bbox 1] + [lindex $bbox 3]) / 2]
4596 }
4597
4598 proc search_canvas {} {
4599 global canvw selfile clickitem clickmode clicky
4600 set search $selfile
4601 resetsel
4602 update
4603 set str_items [$canvw find withtag strings]
4604 foreach idx $str_items {
4605 set name [$canvw itemcget $idx -text]
4606 if {[string match "*$search*" $name]} {
4607 set selitem $idx
4608 $canvw select from $idx 0
4609 $canvw select to $idx end
4610 set clickitem $idx
4611 set clicky [midy [$canvw bbox $clickitem]]
4612 set clickmode 1
4613 selcurfile
4614 addsecsel $idx
4615 }
4616 }
4617 }
4618
4619 if {![info exists dirs]} {
4620 global onlyfiles ctxlines showsame
4621 set dirs {}
4622 set ok 1
4623 set argc [llength $argv]
4624 set moreopts 1
4625 for {set i 0} {$i < $argc} {incr i} {
4626 set arg [lindex $argv $i]
4627 if {$moreopts && [string range $arg 0 0] == "-"} {
4628 switch -regexp -- $arg {
4629 "--" {
4630 set moreopts 0
4631 }
4632 "-a|--all" {
4633 set nukefiles {}
4634 }
4635 "-o|--only" {
4636 incr i
4637 if {$i < $argc} {
4638 lappend onlyfiles [lindex $argv $i]
4639 set nukefiles {}
4640 } else {
4641 puts stderr "no argument given to $arg option"
4642 set ok 0
4643 }
4644 }
4645 "-I|--ignore" {
4646 incr i
4647 if {$i < $argc} {
4648 ignorefile [lindex $argv $i]
4649 } else {
4650 puts stderr "no argument given to $arg option"
4651 set ok 0
4652 }
4653