1#!/bin/sh 2# Tcl ignores the next line \ 3exec /usr/local/bin/wish8.6 "$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 10set Script [info script] 11set ScriptTail [file tail $Script] 12if {[file type $Script] == "link"} { 13 set ScriptBin [file join [file dirname $Script] [file readlink $Script]] 14} else { 15 set ScriptBin $Script 16} 17set TclExe [info nameofexecutable] 18set compound_ok [expr {$tcl_version >= 8.4}] 19 20set nofilecmp [catch {load libfilecmp.so.0.0}] 21set rcsflag {} 22set diffbflag {} 23set diffBflag {} 24set diffiflag {} 25set diffwflag {} 26set diffdflag {} 27set ctxlines 3 28set showsame 0 29set underlinetabs 0 30set redisp_immed 1 31set diffnewfirst 0 32set nukefiles {*.o *~ *.orig CVS *.a *.link *.old *.save .depend .*.flags SCCS} 33set filelistfont {Helvetica -12} 34set textfont {Courier -12} 35set maxdepth 9999999 36set nxdirmode 0 37set docvsignore 0 38 39set 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 46if {$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} 55set diffprogram {} 56set showprogram {} 57 58set numlines 20 59set canvy0 0 60set canvy 0 61set canvx 0 62 63set have_unidiff 1 64set caught [catch "exec diff -u $nullfile $nullfile" err] 65if {$caught != 0} { 66 puts "Unified diff not available. Will use context diff for patches." 67 set have_unidiff 0 68} 69 70catch {source ~/.dirdiff} 71 72proc ignorefile pat { 73 global nukefiles 74 if {$pat == "!"} { 75 set nukefiles {} 76 } else { 77 lappend nukefiles $pat 78 } 79} 80 81set linespc [font metrics $filelistfont -linespace] 82if {$linespc < 15} {set linespc 15} 83set blotw [expr $linespc-3] 84set bloth [expr $linespc-3] 85set blotspc $linespc 86 87proc usage {} { 88 puts stderr {Usage: dirdiff [options]... dir1 dir2 ... 89 90Options: 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 100Note: dirdiff needs to be able to load the libfilecmp.so.0.0 shared library 101for the -r or -t flags to work.} 102} 103 104proc 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 153proc 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 228proc 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 245proc 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 259proc 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 276proc joinname {dir f} { 277 global filemode 278 if {$filemode} { 279 return $dir 280 } 281 return [file join $dir $f] 282} 283 284proc fileisa {f t} { 285 global filetype 286 return [expr {[info exists filetype($f)] && $filetype($f) == $t}] 287} 288 289proc 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 369proc 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 392set stringx 8 393 394proc 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 445proc 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 467proc 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 478proc 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 489proc 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 504proc 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 535proc 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 554proc 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 576proc 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 589proc readonlychange {i} { 590 global dirreadonly 591 .bar.file.t entryconf $i \ 592 -state [expr {$dirreadonly($i)? "disabled": "normal"}] 593 selcurfile 594} 595 596proc 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 765proc 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 { 774Dirdiff version 2.1 775 776Copyright � 1999-2005 Paul Mackerras 777 778Use and redistribute under the terms of the GNU General Public License 779 780(CVS $Revision: 1.70 $)} \ 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 787proc 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 813proc 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 840Dirdiff compares all the files in up to five directories. There is one \ 841column in the main window for each directory. 842 843Each file is shown with a coloured square indicating its status. Files \ 844are like leaves on a deciduous tree: the newest ones are green, and then \ 845they turn yellow, orange, and red as they get older. 846 847Double-click a file to show differences between two versions. By default, \ 848the first and last versions are compared, but this can be changed by the \ 849'Diff' menu in the main window. 850 851You can select several files to copy or to make a patch by shift-clicking. 852 853You can search for a file by typing part of its name in the entry and \ 854pressing the <Return> key. 855 856In the diff window, check the boxes on the left margin for changes you \ 857want to preserve, and then choose 'Merge' to move those changes into one \ 858of the files. Alternatively, choose 'Copy' in the main window to copy \ 859across the whole file, replacing any changes. 860 861'Make patch' produces a file describing the changes between the files that \ 862can be applied by the patch tool. You can edit the patch before saving, \ 863and may wish to add explanatory text, instructions, or patch(1) Prereq \ 864lines at the beginning. To save the patch, enter a filename in the patch \ 865window relative to the current directory, and choose 'Save'. This will \ 866also close the window. 867 868If you are sending out patches, then the "from" directory should be the \ 869original version of the source. Try to make sure that the two files have \ 870the same number of leading directories. See the patch(1) man page for \ 871more information. 872 } 873 874 $w.t conf -state disabled 875} 876 877proc 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 887proc 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 909proc 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 931proc 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 941proc 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 949proc 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 961proc 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 1014proc selectitem {it} { 1015 global selitem canvw 1016 set selitem $it 1017 $canvw select from $it 0 1018 $canvw select to $it end 1019} 1020 1021proc 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 1029proc remsecsel {it} { 1030 global canvw secsel 1031 $canvw delete $secsel($it) 1032 unset secsel($it) 1033} 1034 1035proc clearsecsel {} { 1036 global canvw secsel 1037 $canvw delete secsel 1038 catch {unset secsel} 1039} 1040 1041proc 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 1081proc 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 1099proc 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 1125proc 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 1142proc 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 1232proc 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 1251proc 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 1406proc 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 1442proc 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 1456proc 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 1465proc 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 <1> {} 1497 bind $textw <Shift-Button-1> {} 1498 bind $textw <B1-Motion> {} 1499 bind $textw <ButtonRelease-1> {} 1500 bind $textw <B1-Leave> {} 1501 bind $textw <B1-Enter> {} 1502 bind $textw <2> {} 1503 bind $textw <B2-Motion> {} 1504 bind $textw <ButtonRelease-2> {} 1505 bind $textw <Any-Button-3> {} 1506 catch {unset incline} 1507} 1508 1509proc redifffiles {} { 1510 global groups showsame selfile rediffed groups filemode 1511 if {$filemode} { 1512 resetsel 1513 canvdiffs 1514 return 1515 } 1516 if {$selfile == {}} return 1517 set files [secondarysel $selfile] 1518 foreach f $files { 1519 updatefileinfo $f 1520 set d [string trimright $f /] 1521 if {[lindex $groups($f) 0] != "dir"} { 1522 set groups($f) [diffages $f 1 0] 1523 } else { 1524 set groups($f) [subdirgroups $d] 1525 } 1526 refreshcline $f 1527 } 1528 selcurfile 1529 set rediffed $selfile 1530} 1531 1532proc diff2 {d1 d2 f {orig 1}} { 1533 global diffprogram nullfile 1534 1535 global textw groups dirs numgroups bgcolors selfile texttop 1536 global difff lno diffdirs diffiflag diffwflag diffbflag diffBflag diffdflag 1537 global ctxlines difffile charwidth mergebut diffcolors 1538 global diffing filemode rediffed diffnewfirst underlinetabs 1539 global nextlix diffndirs allf origdiffdirs difftabs 1540 set diffndirs 2 1541 set difftabs "" 1542 set allf {0 1} 1543 set group [lindex $groups($selfile) 1] 1544 set i1 [lindex $group [lsearch $dirs $d1]] 1545 set i2 [lindex $group [lsearch $dirs $d2]] 1546 if {($i1 > $i2) == $diffnewfirst} { 1547 set x $d1 1548 set d1 $d2 1549 set d2 $x 1550 set x $i1 1551 set i1 $i2 1552 set i2 $x 1553 } 1554 set ds [list $d1 $d2] 1555 if {$diffing} { 1556 if {$ds == $diffdirs && $f == $difffile} return 1557 catch {close $difff} 1558 } 1559 set diffdirs $ds 1560 set difffile $f 1561 if {$orig} { 1562 set origdiffdirs $ds 1563 } 1564 if {[info exists rediffed] && $rediffed == $f} { 1565 unset rediffed 1566 } 1567 set path1 [joinname $d1 $f] 1568 set path2 [joinname $d2 $f] 1569 set diffopts "-U $ctxlines $diffiflag $diffwflag $diffbflag $diffBflag $diffdflag" 1570 1571 if { [llength $diffprogram] > 0} { 1572 eval "exec $diffprogram \"$path1\" \"$path2\" &" 1573 return 1574 } 1575 # If we used an external diff program, its options are used. If we didn't, 1576 # we use our diffopts, and we may be in trouble. 1577 set caught [catch "exec diff $diffopts $nullfile $nullfile" err] 1578 if {$caught != 0} { 1579 set msg "diff $diffopts\n$err\n" 1580 append msg "Suggestion: Use an external diff viewer such as tkdiff or gvimdiff" 1581 error_popup "$msg" 1582 return 1583 } 1584 1585 # Build a window 1586 if {![info exists textw] || ![winfo exists $textw]} { 1587 maketextw 1588 } 1589 if {$filemode} { 1590 wm title $texttop "Differences: $d1 vs $d2" 1591 } else { 1592 wm title $texttop "Differences: $f" 1593 } 1594 $mergebut.m delete 0 end 1595 $textw conf -state normal 1596 $textw delete 0.0 end 1597 set charwidth [font measure [$textw cget -font] n] 1598 $textw conf -tabs "[expr 4*$charwidth] left [expr 12*$charwidth] left" 1599 set x $bgcolors($numgroups) 1600 $textw tag delete [$textw tag names] 1601 set diffoldcolor [lindex $x $i1] 1602 set diffnewcolor [lindex $x $i2] 1603 $textw tag conf d0 -back $diffoldcolor 1604 $textw tag conf d1 -back $diffnewcolor 1605 set diffcolors [list $diffoldcolor $diffnewcolor] 1606 $textw tag conf sep -back blue -fore white 1607 $textw tag conf ul -underline $underlinetabs 1608 $textw tag lower sep 1609 bind $textw <1> "startbutspan %x %y 0" 1610 bind $textw <Shift-Button-1> "startbutspan %x %y 1; break" 1611 bind $textw <B1-Motion> "setbutspan %x %y" 1612 bind $textw <ButtonRelease-1> "endbutspan" 1613 bind $textw <B1-Leave> "startbutscroll %W %x %y; break" 1614 bind $textw <B1-Enter> "endbutscroll %W %x %y; break" 1615 bind $textw <2> "startdrag $textw %x %y; break" 1616 bind $textw <B2-Motion> "dragdiff $textw %x %y; break" 1617 bind $textw <ButtonRelease-2> "finishdrag $textw" 1618 bind $textw <Any-Button-3> "togglebuts %x %y" 1619 1620 # Start a diff 1621 set difff [open "|diff $diffopts $path1 $path2" r] 1622 set diffing 1 1623 set lno 1 1624 set nextlix 1000 1625 catch {unset oldin} 1626 catch {unset newin} 1627 1628 global linelist 1629 set linelist {{{} {} {}}} 1630 1631 global fcontents 1632 update 1633 catch { 1634 set f [open $path1 r] 1635 set fcontents(0) [split [read -nonewline $f] "\n"] 1636 close $f 1637 } 1638 catch { 1639 set f [open $path2 r] 1640 set fcontents(1) [split [read -nonewline $f] "\n"] 1641 } 1642 1643 global file1lnum file2lnum incline 1644 set file1lnum 0 1645 set file2lnum 0 1646 catch {unset incline} 1647 fconfigure $difff -blocking 0 1648 fileevent $difff readable "readdiff $difff" 1649} 1650 1651# linelist structure: 1652# one entry per displayed line, plus a 0'th null entry (not displayed) 1653# each entry is: linenumbers treenumbers line lix 1654# linenumbers contains one entry per tree, {} if this line 1655# isn't in a tree's version of the file 1656# treenumbers is a list of the tree numbers where this line appears, 1657# or {} for a separator line ($allf for a context line) 1658# line is the actual text of the line, or for a separator line, 1659# a list of the pieces of text to appear across the separator line 1660# lix is the index of the checkbutton for this line if present 1661# header lines (---/+++) have linenumbers == {} and treenumbers == {} 1662 1663proc readdiff {f} { 1664 global difff lno textw dirreadonly nextlix 1665 global incline linelist 1666 global file1lnum file2lnum diffing textfont 1667 global fcontents allf 1668 if {$f != $difff} { 1669 catch {close $f} 1670 return 1671 } 1672 set n [gets $difff line] 1673 if {$n < 0} { 1674 if {![eof $difff]} return 1675 catch {close $difff} 1676 set diffing 0 1677 if {$lno > 1} { 1678 $textw delete "end - 1c" end 1679 set t [$textw tag names "end - 1l"] 1680 if {$t != ""} { 1681 $textw tag add $t "end - 1l" end 1682 } 1683 } 1684 $textw conf -state disabled 1685 if {$lno > 3} { 1686 confmergebut 1687 confmpatchbut 1688 } 1689 return 1690 } 1691 set x [string index $line 0] 1692 if {$x == "@" && [regexp { -([0-9,]+) .*\+([0-9,]+) } $line z r1 r2]} { 1693 set r1 [lindex [split $r1 ,] 0] 1694 set r2 [lindex [split $r2 ,] 0] 1695 catch {set file1lnum [expr {$r1+0}]} 1696 catch {set file2lnum [expr {$r2+0}]} 1697 lappend linelist [makesepline $lno [list $file1lnum $file2lnum]] 1698 $textw insert end "\n" 1699 redisplaylines $textw $lno 1 1700 incr lno 1701 return 1702 } 1703 set ix 1 1704 if {($x == "-" || $x == "+") && $lno > 3} { 1705 set lix $nextlix 1706 incr nextlix 1707 set incline($lix) 0 1708 makecheckbox $textw $lix end 1709 set ix 2 1710 set line [string range $line 1 end] 1711 if {$x == "-"} { 1712 lappend linelist [list [list $file1lnum {}] 0 $line $lix] 1713 } else { 1714 lappend linelist [list [list {} $file2lnum] 1 $line $lix] 1715 } 1716 } elseif {$x == "-" || $x == "+"} { 1717 set line [string trimleft $line $x] 1718 lappend linelist [list {} [expr {$x == "+"}] $line] 1719 } elseif {$x == " "} { 1720 set line [string range $line 1 end] 1721 lappend linelist [list [list $file1lnum $file2lnum] $allf $line] 1722 } 1723 set lbeg [$textw index "end - 1c linestart"] 1724 $textw insert end "\t" 1725 set r [tabexpand $line $ix] 1726 $textw insert end [lindex $r 0] 1727 $textw insert end "\n" 1728 foreach tgp [lindex $r 1] { 1729 $textw tag add ul "$lbeg + [lindex $tgp 0]c" "$lbeg + [lindex $tgp 1]c" 1730 } 1731 set lend [$textw index "$lbeg + 1l"] 1732 if {$x == "-"} { 1733 $textw tag add d0 $lbeg $lend 1734 } elseif {$x == "+"} { 1735 $textw tag add d1 $lbeg $lend 1736 } 1737 if {$x != "+"} {incr file1lnum} 1738 if {$x != "-"} {incr file2lnum} 1739 incr lno 1740} 1741 1742proc confmergebut {} { 1743 global mergebut diffdirs difffile 1744 global groups dirs diffmtime allf dirreadonly 1745 set group [lindex $groups($difffile) 1] 1746 foreach i $allf { 1747 set g [lindex $group [lsearch $dirs [lindex $diffdirs $i]]] 1748 set k 0 1749 foreach gx $group { 1750 if {$gx == $g && !$dirreadonly($k)} { 1751 set f [lindex $dirs $k] 1752 $mergebut.m add command -label "update $f" \ 1753 -command "diffmerge $i \"$f\"" 1754 set path [joinname $f $difffile] 1755 set diffmtime($path) [file mtime $path] 1756 } 1757 incr k 1758 } 1759 } 1760} 1761 1762proc confmpatchbut {} { 1763 global mpatchbut diffdirs difffile 1764 global groups dirs allf dirreadonly 1765 set group [lindex $groups($difffile) 1] 1766 foreach i $allf { 1767 set g [lindex $group [lsearch $dirs [lindex $diffdirs $i]]] 1768 set k 0 1769 foreach gx $group { 1770 if {$gx == $g && !$dirreadonly($k)} { 1771 set f [lindex $dirs $k] 1772 $mpatchbut.m add command -label "for $f" \ 1773 -command "diffmpatch $i \"$f\"" 1774 } 1775 incr k 1776 } 1777 } 1778} 1779 1780proc makesepline {lno lnums} { 1781 global linelist fcontents diffndirs 1782 set plinfo [lindex $linelist [expr $lno-1]] 1783 set lns [lindex $plinfo 0] 1784 set gapmin [llength $fcontents(0)] 1785 set gapmax 0 1786 for {set i 0} {$i < $diffndirs} {incr i} { 1787 set fl($i) [lindex $lnums $i] 1788 set pfl [lindex $lns $i] 1789 if {$pfl == {}} {set pfl 0} 1790 set gap [expr $fl($i) - $pfl - 1] 1791 if {$gap < $gapmin} {set gapmin $gap} 1792 if {$gap > $gapmax} {set gapmax $gap} 1793 set flen [llength $fcontents($i)] 1794 if {$flen == 0} { 1795 set pct($i) "--" 1796 } else { 1797 set pct($i) [expr {int($fl($i) * 100.0 / $flen)}] 1798 } 1799 } 1800 set nls $gapmin 1801 if {$nls != $gapmax} { 1802 append nls "-$gapmax lines" 1803 } elseif {$nls == 1} { 1804 append nls " line" 1805 } else { 1806 append nls " lines" 1807 } 1808 set pad [expr {$diffndirs > 4? " ": " "}] 1809 set line [list "$pad\(gap: $nls)$pad"] 1810 for {set i 0} {$i < $diffndirs} {incr i} { 1811 lappend line "$pad$fl($i) ($pct($i)%)$pad" 1812 } 1813 return [list $lnums {} $line] 1814} 1815 1816proc makecheckbox {w lix pos} { 1817 checkbutton $w.inc$lix -variable incline($lix) \ 1818 -font {Courier -10} -cursor top_left_arrow \ 1819 -highlightthickness 0 -padx 2 -pady 0 1820 $w window create $pos -window $w.inc$lix -stretch true 1821 bind $w.inc$lix <1> "wstartbutspan %W %x %y; break" 1822 bind $w.inc$lix <B1-Motion> "wsetbutspan %W %x %y; break" 1823 bind $w.inc$lix <ButtonRelease-1> "endbutspan; break" 1824 bind $w.inc$lix <Shift-Button-1> "wtogglebuts %W %x %y; break" 1825 bind $w.inc$lix <Any-Button-3> "wtogglebuts %W %x %y" 1826} 1827 1828proc tabexpand {line ix} { 1829 set col 0 1830 set txt {} 1831 set tgs {} 1832 set trailb [string length [string trimright $line]] 1833 while {[set tpos [string first "\t" $line]] >= 0} { 1834 if {$tpos > 0} { 1835 append txt [string range $line 0 [expr $tpos-1]] 1836 if {$trailb < $tpos} { 1837 lappend tgs [list [expr $ix+$trailb] [expr $ix+$tpos]] 1838 set trailb 0 1839 } else { 1840 set trailb [expr $trailb-$tpos] 1841 } 1842 incr ix $tpos 1843 incr col $tpos 1844 } 1845 set nsp [expr {8 - ($col & 7)}] 1846 append txt [string range " " 1 $nsp] 1847 lappend tgs [list $ix [expr $ix+$nsp]] 1848 set line [string range $line [expr $tpos+1] end] 1849 incr ix $nsp 1850 incr col $nsp 1851 if {$trailb > 0} {incr trailb -1} 1852 } 1853 append txt $line 1854 set tpos [string length $line] 1855 if {$trailb < $tpos} { 1856 lappend tgs [list [expr $ix+$trailb] [expr $ix+$tpos]] 1857 } 1858 return [list $txt $tgs] 1859} 1860 1861proc startbutspan {x y doall} { 1862 global butspanstart textw linelist butspanline 1863 set l [lindex [split [$textw index @$x,$y] .] 0] 1864 set lix [lindex [lindex $linelist $l] 3] 1865 if {$lix != {}} { 1866 set butspanstart $lix 1867 set butspanline $l 1868 $textw.inc$lix toggle 1869 if {$doall} { 1870 togglegroup $l 1871 } 1872 } 1873} 1874 1875proc setbutspan {x y} { 1876 global incline butspanstart textw linelist butspanline 1877 global textscrollx textscrolly 1878 if {![info exists butspanstart]} return 1879 set lend [lindex [split [$textw index @$x,$y] .] 0] 1880 set ln $butspanline 1881 set textscrollx $x 1882 set textscrolly $y 1883 set butspanline $lend 1884 if {$ln == $lend} return 1885 set inc [expr {$ln < $lend? 1: -1}] 1886 set m $butspanstart 1887 while 1 { 1888 incr ln $inc 1889 set l [lindex [lindex $linelist $ln] 3] 1890 if {[info exists incline($l)] && [info exists incline($m)]} { 1891 set incline($l) $incline($m) 1892 } 1893 if {$ln == $lend} break 1894 } 1895} 1896 1897proc endbutspan {} { 1898 global butspanstart 1899 catch {unset butspanstart} 1900} 1901 1902proc wstartbutspan {w x y} { 1903 incr x [winfo x $w] 1904 incr y [winfo y $w] 1905 startbutspan $x $y 0 1906} 1907 1908proc wsetbutspan {w x y} { 1909 incr x [winfo x $w] 1910 incr y [winfo y $w] 1911 setbutspan $x $y 1912} 1913 1914proc dobutscroll {} { 1915 global textscrollid textscrollx textscrolly textw 1916 if {![winfo exists $textw]} return 1917 if {$textscrolly < 0} { 1918 $textw yview scroll -2 units 1919 } elseif {$textscrolly >= [winfo height $textw]} { 1920 $textw yview scroll 2 units 1921 } 1922 setbutspan $textscrollx $textscrolly 1923 set textscrollid [after 100 dobutscroll] 1924} 1925 1926proc startbutscroll {w x y} { 1927 global textscrollx textscrolly 1928 set textscrollx $x 1929 set textscrolly $y 1930 dobutscroll 1931} 1932 1933proc endbutscroll {w x y} { 1934 global textscrollid 1935 catch {after cancel $textscrollid; unset textscrollid} 1936} 1937 1938proc redisplaylines {w l nl} { 1939 global linelist diffndirs difftabs 1940 for {set i 0} {$i < $nl} {incr i} { 1941 set lend [$w index "$l.0 + 1l"] 1942 for {set j 0} {$j < $diffndirs} {incr j} { 1943 $w tag remove d$j $l.0 $lend 1944 } 1945 $w tag remove sep $l.0 $lend 1946 $w delete $l.0 "$l.0 lineend" 1947 set linfo [lindex $linelist $l] 1948 set ty [lindex $linfo 1] 1949 set line [lindex $linfo 2] 1950 if {$ty == {}} { 1951 $w insert $l.0 "\t$difftabs[lindex $line 0]" sep 1952 for {set j 0} {$j < $diffndirs} {incr j} { 1953 $w insert "$l.0 lineend" [lindex $line [expr $j+1]] d$j 1954 } 1955 $w insert "$l.0 lineend" " " sep 1956 $w tag add sep "$l.0 lineend" "$l.0 + 1l" 1957 } else { 1958 set nm [llength $ty] 1959 set main [lindex $ty [expr $nm-1]] 1960 set ix 0 1961 set lix [lindex $linfo 3] 1962 if {$lix != {}} { 1963 catch {destroy $w.inc$lix} 1964 makecheckbox $w $lix $l.0 1965 incr ix 1966 } 1967 1968 $w insert $l.$ix "\t$difftabs" 1969 incr ix [expr $diffndirs-1] 1970 if {$nm < $diffndirs} { 1971 set sub [lindex $ty 0] 1972 if {$nm <= 2} { 1973 $w tag add d$sub $l.0 $l.$ix 1974 } else { 1975 set pix 0 1976 set nix [expr {$ix - $diffndirs + 3}] 1977 for {set j 0} {$j < $diffndirs-2} {incr j} { 1978 set x [lindex $ty $j] 1979 $w tag add d$x $l.$pix $l.$nix 1980 set pix $nix 1981 incr nix 1982 } 1983 } 1984 } 1985 1986 set x [tabexpand $line $ix] 1987 $w insert $l.$ix [lindex $x 0] 1988 foreach tgp [lindex $x 1] { 1989 $w tag add ul $l.[lindex $tgp 0] $l.[lindex $tgp 1] 1990 } 1991 if {$nm < $diffndirs} { 1992 set lend [$w index "$l.0 + 1l"] 1993 $w tag add d$main $l.$ix $lend 1994 } 1995 } 1996 incr l 1997 } 1998} 1999 2000proc exchangelines {w start na nb} { 2001 global linelist 2002 set last [expr $start+$na+$nb-1] 2003 set eltsa [lrange $linelist $start [expr $start+$na-1]] 2004 set eltsb [lrange $linelist [expr $start+$na] $last] 2005 set linelist [eval lreplace \$linelist $start $last $eltsb $eltsa] 2006 $w conf -state normal 2007 redisplaylines $w $start [expr $na+$nb] 2008 $w conf -state disabled 2009} 2010 2011proc addtoall {l x} { 2012 set ret {} 2013 foreach i $l { 2014 lappend ret [expr {$i + $x}] 2015 } 2016 return $ret 2017} 2018 2019proc subfromall {l x} { 2020 set ret {} 2021 foreach i $l { 2022 lappend ret [expr {$i - $x}] 2023 } 2024 return $ret 2025} 2026 2027proc setunion {a b} { 2028 return [lsort -unique [concat $a $b]] 2029} 2030 2031proc setintersects {a b} { 2032 return [expr {[llength [setunion $a $b]] < [llength $a] + [llength $b]}] 2033} 2034 2035# called on button 2 down in the diff window 2036# start dragging a diff hunk or separator line 2037proc startdrag {w x y} { 2038 global dragline draglineorig draguplines dragdownlines allf 2039 global dragsep dragseporig linelist dragsplit dragsplitorig 2040 global diffndirs 2041 set pos [$w index @$x,$y] 2042 set l [lindex [split $pos .] 0] 2043 $w tag remove sel 0.0 end 2044 set linfo [lindex $linelist $l] 2045 set ltype [lindex $linfo 1] 2046 if {$ltype == {}} { 2047 # dragging a separator line 2048 set dragsep $l 2049 set dragseporig $l 2050 catch {unset dragline} 2051 catch {unset dragsplit} 2052 # check for a separator bar covering a single line of context 2053 dragsepstart $w 2054 $w tag add sel $l.0 "$l.0 + 1l" 2055 } elseif {$ltype == $allf} { 2056 # dragging a context line 2057 set dragsplit $l 2058 set dragsplitorig $l 2059 catch {unset dragline} 2060 catch {unset dragsep} 2061 $w tag add sel $l.0 "$l.0 + 1l" 2062 } else { 2063 # dragging a diff line 2064 set dragline $l 2065 set draglineorig $l 2066 catch {unset dragsep} 2067 catch {unset dragsplit} 2068 $w tag add sel $l.0 "$l.0 + 1l" 2069 } 2070} 2071 2072# called on movement with button 2 down in the diff window 2073proc dragdiff {w x y} { 2074 global dragline draglineorig linelist dragsep dragsplit 2075 global diffndirs allf dragnlines 2076 if {[info exists dragsep]} { 2077 dragsepbar $w $x $y 2078 return 2079 } elseif {[info exists dragsplit]} { 2080 dragdiffsplit $w $x $y 2081 return 2082 } 2083 if {![info exists dragline]} return 2084 set pos [$w index @$x,$y] 2085 set l [lindex [split $pos .] 0] 2086 if {$l == $dragline} return 2087 $w tag remove sel 0.0 end 2088 set id [lindex $linelist $dragline] 2089 # t = set of trees this line is in 2090 set t [lindex $id 1] 2091 set dist [expr $l - $dragline] 2092 while {$dist != 0} { 2093 if {$dragline < $draglineorig \ 2094 || ($dragline == $draglineorig && $l < $dragline)} { 2095 # moving line $dragline and lines above it of same type 2096 if {$dist < 0} { 2097 # dragging upwards 2098 set i [expr $dragline - 1] 2099 while 1 { 2100 set pt [lindex [lindex $linelist $i] 1] 2101 if {$pt == {} || $pt == $allf \ 2102 || ![setintersects $pt $t]} break 2103 set t [setunion $t $pt] 2104 incr i -1 2105 } 2106 set nlines [expr $dragline - $i] 2107 set j $i 2108 while {$i > $j + $dist} { 2109 set pt [lindex [lindex $linelist $i] 1] 2110 if {$pt == {} || $pt == $allf \ 2111 || [setintersects $pt $t]} break 2112 incr i -1 2113 } 2114 set nabove [expr $j - $i] 2115 if {$nabove > 0} { 2116 exchangelines $w [expr $i+1] $nabove $nlines 2117 incr dist $nabove 2118 for {set k 0} {$k < $nabove} {incr k} { 2119 set dragnlines($dragline) $nlines 2120 incr dragline -1 2121 } 2122 } else { 2123 set dist 0 2124 } 2125 } else { 2126 # dragging back downwards 2127 incr dragline 2128 incr dist -1 2129 set nlines $dragnlines($dragline) 2130 exchangelines $w [expr {$dragline - $nlines}] $nlines 1 2131 } 2132 } else { 2133 # moving line $dragline and lines below it of same type 2134 if {$dist > 0} { 2135 # dragging downwards 2136 set i [expr $dragline + 1] 2137 while 1 { 2138 set pt [lindex [lindex $linelist $i] 1] 2139 if {$pt == {} || $pt == $allf \ 2140 || ![setintersects $pt $t]} break 2141 set t [setunion $t $pt] 2142 incr i 2143 } 2144 set nlines [expr $i - $dragline] 2145 set j $i 2146 while {$i < $j + $dist} { 2147 set pt [lindex [lindex $linelist $i] 1] 2148 if {$pt == {} || $pt == $allf \ 2149 || [setintersects $pt $t]} break 2150 incr i 2151 } 2152 set nbelow [expr $i - $j] 2153 if {$nbelow > 0} { 2154 exchangelines $w $dragline $nlines $nbelow 2155 incr dist -$nbelow 2156 for {set k 0} {$k < $nbelow} {incr k} { 2157 set dragnlines($dragline) $nlines 2158 incr dragline 2159 } 2160 } else { 2161 set dist 0 2162 } 2163 } else { 2164 # dragging back upwards 2165 incr dragline -1 2166 incr dist 2167 set nlines $dragnlines($dragline) 2168 exchangelines $w $dragline 1 $nlines 2169 } 2170 } 2171 } 2172 $w tag add sel $dragline.0 "$dragline.0 + 1l" 2173} 2174 2175# starting to drag a separator bar (button 2 down) 2176proc dragsepstart {w} { 2177 global dragsep linelist fcontents dragsepnowhere allf diffndirs 2178 set plinfob [lindex $linelist [expr $dragsep-1]] 2179 set f1lb [lindex [lindex $plinfob 0] 0] 2180 set plinfo [lindex $linelist $dragsep] 2181 set plns [lindex $plinfo 0] 2182 set f1l [lindex $plns 0] 2183 set dragsepnowhere [expr {$f1l <= $f1lb + 2}] 2184 if {$f1l == $f1lb + 2} { 2185 # turn the separator into a line of context 2186 set line [lindex $fcontents(0) [expr {$f1l - 2}]] 2187 set linelist [lreplace $linelist $dragsep $dragsep \ 2188 [list [subfromall $plns 1] $allf $line]] 2189 $w conf -state normal 2190 redisplaylines $w $dragsep 1 2191 $w conf -state disabled 2192 } 2193} 2194 2195proc dragsepbar {w x y} { 2196 global dragsep dragseporig linelist fcontents dragsepnowhere allf 2197 set l [lindex [split [$w index @$x,$y] .] 0] 2198 if {$l == $dragsep || $dragsepnowhere} return 2199 $w tag remove sel 0.0 end 2200 set dist [expr $l - $dragsep] 2201 while {$dist != 0} { 2202 set plinfob [lindex $linelist [expr $dragsep-1]] 2203 set f1lb [lindex [lindex $plinfob 0] 0] 2204 set plinfo [lindex $linelist $dragsep] 2205 set plns [lindex $plinfo 0] 2206 set f1l [lindex $plns 0] 2207 set ty [lindex $plinfo 1] 2208 if {$dragsep < $dragseporig \ 2209 || ($dragsep == $dragseporig && $l < $dragsep)} { 2210 # the separator bar is above its original location (or will be) 2211 set inc [expr {$dist < 0? 1: -1}] 2212 set lnums [subfromall $plns $inc] 2213 if {$ty != {}} { 2214 if {$dist < 0} break 2215 set lnums [addtoall $lnums 1] 2216 } 2217 set f1l [lindex $lnums 0] 2218 $w conf -state normal 2219 if {$dist < 0} { 2220 # dragging further upwards 2221 set line [lindex $fcontents(0) [expr $f1l-1]] 2222 if {$f1lb + 2 == $f1l} { 2223 # turn the separator into an ordinary line 2224 set lns [subfromall $lnums 1] 2225 set f1ls [lindex $lns 0] 2226 set lsep [lindex $fcontents(0) [expr $f1ls-1]] 2227 set linelist [lreplace $linelist $dragsep $dragsep \ 2228 [list $lns $allf $lsep] \ 2229 [list $lnums $allf $line]] 2230 } else { 2231 set sline [makesepline $dragsep $lnums] 2232 set linelist [lreplace $linelist $dragsep $dragsep \ 2233 $sline [list $lnums $allf $line]] 2234 } 2235 $w insert "$dragsep.0 + 1l" "\n" 2236 redisplaylines $w $dragsep 2 2237 $w yview scroll 1 units 2238 } else { 2239 # moving back down towards original location 2240 set sline [makesepline $dragsep $lnums] 2241 set linelist [lreplace $linelist $dragsep [expr $dragsep+1] \ 2242 $sline] 2243 $w delete "$dragsep.0 + 1l" "$dragsep.0 + 2l" 2244 redisplaylines $w $dragsep 1 2245 $w yview scroll -1 units 2246 } 2247 $w conf -state disabled 2248 incr dragseporig $inc 2249 incr dist $inc 2250 } else { 2251 # the separator bar is below its original location (or will be) 2252 if {$dist > 0} { 2253 # dragging further downwards 2254 if {$ty != {}} break 2255 set plnsb [lindex $plinfob 0] 2256 set lnumsb [addtoall $plnsb 1] 2257 set f1lb [lindex $lnumsb 0] 2258 set line [lindex $fcontents(0) [expr $f1lb-1]] 2259 set linelist [linsert $linelist $dragsep \ 2260 [list $lnumsb $allf $line]] 2261 $w conf -state normal 2262 $w insert $dragsep.0 "\n" 2263 redisplaylines $w $dragsep 1 2264 incr dragsep 2265 incr dist -1 2266 if {$f1l == $f1lb + 2} { 2267 # replace separator bar by normal line 2268 set lnums [subfromall $plns 1] 2269 set f1l [lindex $lnums 0] 2270 set line [lindex $fcontents(0) [expr $f1l-1]] 2271 set linelist [lreplace $linelist $dragsep $dragsep \ 2272 [list $lnums $allf $line]] 2273 } else { 2274 set sline [makesepline $dragsep $plns] 2275 set linelist [lreplace $linelist $dragsep $dragsep $sline] 2276 } 2277 redisplaylines $w $dragsep 1 2278 $w conf -state disabled 2279 } else { 2280 # moving back up towards original location 2281 incr dragsep -1 2282 set linelist [lreplace $linelist $dragsep $dragsep] 2283 $w conf -state normal 2284 $w delete $dragsep.0 "$dragsep.0 + 1l" 2285 # reconstruct the separator line 2286 if {$ty != {}} { 2287 set plns [addtoall $plns 1] 2288 } 2289 set sline [makesepline $dragsep $plns] 2290 set linelist [lreplace $linelist $dragsep $dragsep $sline] 2291 redisplaylines $w $dragsep 1 2292 $w conf -state disabled 2293 incr dist 2294 } 2295 } 2296 } 2297 $w tag add sel $dragsep.0 "$dragsep.0 + 1l" 2298} 2299 2300# dragging a context line - splits it into -/+ versions 2301proc dragdiffsplit {w x y} { 2302 global dragsplit dragsplitorig linelist fcontents diffndirs 2303 global nextlix incline allf 2304 set pos [$w index @$x,$y] 2305 set l [lindex [split $pos .] 0] 2306 if {$l == $dragsplit} return 2307 $w tag remove sel 0.0 end 2308 set dist [expr $l - $dragsplit] 2309 $w conf -state normal 2310 while {$dist != 0} { 2311 if {$dragsplit < $dragsplitorig \ 2312 || ($dragsplit == $dragsplitorig && $l < $dragsplit)} { 2313 # moving line $dragsplit up 2314 if {$dist < 0} { 2315 # split line dragsplit 2316 set linfo [lindex $linelist $dragsplit] 2317 if {[lindex $linfo 1] != $allf} break 2318 set lns [lindex $linfo 0] 2319 set newlns {} 2320 for {set i 0} {$i < $diffndirs} {incr i} { 2321 lappend newlns {} 2322 } 2323 2324 set f1l [lindex $lns 0] 2325 set line1 [lindex $fcontents(0) [expr $f1l-1]] 2326 set lix1 $nextlix 2327 set incline($lix1) 0 2328 set lnsx [lreplace $newlns 0 0 $f1l] 2329 set linelist [lreplace $linelist $dragsplit $dragsplit \ 2330 [list $lnsx 0 $line1 $lix1]] 2331 redisplaylines $w $dragsplit 1 2332 2333 set l [expr $dragsplitorig + 1] 2334 set deltal [expr {$l - $dragsplit}] 2335 2336 for {set i 1} {$i < $diffndirs} {incr i} { 2337 set fl [lindex $lns $i] 2338 set line [lindex $fcontents($i) [expr $fl-1]] 2339 set lix [incr nextlix] 2340 set incline($lix) 0 2341 set lnsx [lreplace $newlns $i $i $fl] 2342 set linelist [linsert $linelist $l \ 2343 [list $lnsx $i $line $lix]] 2344 $w insert $l.0 "\n" 2345 redisplaylines $w $l 1 2346 incr l $deltal 2347 } 2348 2349 incr nextlix 2350 incr dragsplit -1 2351 incr dist 2352 } else { 2353 # reduce split by one line 2354 incr dragsplit 2355 set l [expr $dragsplitorig + 1] 2356 set deltal [expr {$l - $dragsplit}] 2357 set kl $dragsplit 2358 set lnums {} 2359 for {set k 0} {$k < $diffndirs} {incr k} { 2360 set fl [lindex [lindex [lindex $linelist $kl] 0] $k] 2361 lappend lnums $fl 2362 incr kl $deltal 2363 } 2364 2365 set f1l [lindex $lnums 0] 2366 set line1 [lindex $fcontents(0) [expr $f1l-1]] 2367 set linelist [lreplace $linelist $dragsplit $dragsplit \ 2368 [list $lnums $allf $line1]] 2369 redisplaylines $w $dragsplit 1 2370 2371 incr deltal -1 2372 for {set k 1} {$k < $diffndirs} {incr k} { 2373 set linelist [lreplace $linelist $l $l] 2374 $w delete $l.0 "$l.0 + 1l" 2375 incr l $deltal 2376 } 2377 2378 incr dist -1 2379 } 2380 } else { 2381 # moving line $dragsplit down 2382 if {$dist > 0} { 2383 # split another line 2384 set deltal [expr {$dragsplit - $dragsplitorig}] 2385 set l [expr $dragsplit + ($diffndirs - 1) * $deltal] 2386 set linfo [lindex $linelist $l] 2387 if {[lindex $linfo 1] != $allf} break 2388 set lns [lindex $linfo 0] 2389 set nullns {} 2390 for {set i 0} {$i < $diffndirs} {incr i} { 2391 lappend nullns {} 2392 } 2393 2394 set l $dragsplit 2395 for {set i 0} {$i < $diffndirs} {incr i} { 2396 set fl [lindex $lns $i] 2397 set line [lindex $fcontents($i) [expr $fl-1]] 2398 set lix $nextlix 2399 incr nextlix 2400 set incline($lix) 0 2401 set lnums [lreplace $nullns $i $i $fl] 2402 if {$i < $diffndirs - 1} { 2403 set linelist [linsert $linelist $l \ 2404 [list $lnums $i $line $lix]] 2405 $w insert $l.0 "\n" 2406 redisplaylines $w $l 1 2407 incr l 2408 } else { 2409 set linelist [lreplace $linelist $l $l \ 2410 [list $lnums $i $line $lix]] 2411 redisplaylines $w $l 1 2412 } 2413 incr l $deltal 2414 } 2415 2416 incr dragsplit 2417 incr dist -1 2418 } else { 2419 # reduce split by one line 2420 incr dragsplit -1 2421 incr dist 2422 set deltal [expr {$dragsplit - $dragsplitorig}] 2423 set l $dragsplit 2424 set lnums {} 2425 for {set i 0} {$i < $diffndirs} {incr i} { 2426 lappend lnums [lindex [lindex [lindex $linelist $l] 0] $i] 2427 if {$i < $diffndirs - 1} { 2428 set linelist [lreplace $linelist $l $l] 2429 $w delete $l.0 "$l.0 + 1l" 2430 } else { 2431 set f1l [lindex $lnums 0] 2432 set line1 [lindex $fcontents(0) [expr $f1l-1]] 2433 set linelist [lreplace $linelist $l $l \ 2434 [list $lnums $allf $line1]] 2435 redisplaylines $w $l 1 2436 } 2437 incr l $deltal 2438 } 2439 } 2440 break 2441 } 2442 } 2443 $w conf -state disabled 2444} 2445 2446# button 2 up 2447proc finishdrag {w} { 2448 global dragline dragsep dragsplit 2449 if {[info exists dragline]} { 2450 $w tag remove sel 0.0 end 2451 unset dragline 2452 } 2453 if {[info exists dragsep]} { 2454 $w tag remove sel 0.0 end 2455 unset dragsep 2456 } 2457 if {[info exists dragsplit]} { 2458 $w tag remove sel 0.0 end 2459 unset dragsplit 2460 } 2461} 2462 2463proc togglegroup {l} { 2464 global incline textw linelist 2465 set linfo [lindex $linelist $l] 2466 set lix [lindex $linfo 3] 2467 if {$lix == {}} return 2468 if $incline($lix) { 2469 set state select 2470 } else { 2471 set state deselect 2472 } 2473 set l0 $l 2474 while 1 { 2475 incr l0 -1 2476 set linfo [lindex $linelist $l0] 2477 set lix [lindex $linfo 3] 2478 if {$lix == {}} break 2479 $textw.inc$lix $state 2480 } 2481 set l1 $l 2482 while 1 { 2483 incr l1 2484 set linfo [lindex $linelist $l1] 2485 set lix [lindex $linfo 3] 2486 if {$lix == {}} break 2487 $textw.inc$lix $state 2488 } 2489} 2490 2491proc togglebuts {x y} { 2492 global textw linelist 2493 set l [lindex [split [$textw index @$x,$y] .] 0] 2494 set lix [lindex [lindex $linelist $l] 3] 2495 if {$lix != {}} { 2496 $textw.inc$lix toggle 2497 togglegroup $l 2498 } 2499} 2500 2501proc wtogglebuts {w x y} { 2502 incr x [winfo x $w] 2503 incr y [winfo y $w] 2504 togglebuts $x $y 2505} 2506 2507proc invertbuttons {} { 2508 global incline textw 2509 foreach l [array names incline] { 2510 set incline($l) [expr {1 - $incline($l)}] 2511 } 2512} 2513 2514proc changeunderlinetabs {} { 2515 global textw underlinetabs 2516 $textw tag conf ul -underline $underlinetabs 2517} 2518 2519proc diffn {dirlist f {orig 1}} { 2520 global diffing diffdirs difffile difffds diffrel allf 2521 global difflnos diffndirs diffstate difflnum nextdiffhdr diffhdr 2522 global diffiflag diffwflag diffbflag diffdflag incline 2523 global diffblocked fcontents ldisp havediffs nextlix origdiffdirs 2524 2525 if {$orig} { 2526 set origdiffdirs $dirlist 2527 } 2528 # reverse the list so we have oldest first 2529 set x {} 2530 for {set i [llength $dirlist]} {[incr i -1] >= 0} {} { 2531 lappend x [lindex $dirlist $i] 2532 } 2533 set dirlist $x 2534 if {$diffing} { 2535 if {$dirlist == $diffdirs && $f == $difffile} return 2536 foreach i [array names difffds] { 2537 catch {close $difffds($i)} 2538 } 2539 } 2540 set diffdirs $dirlist 2541 set difffile $f 2542 set diffndirs [llength $dirlist] 2543 set nextdiffhdr 0 2544 catch {unset diffhdr} 2545 set havediffs 0 2546 set nextlix 1000 2547 catch {unset incline} 2548 2549 set diffopts "-u $diffiflag $diffwflag $diffbflag $diffdflag" 2550 set d [lindex $dirlist 0] 2551 set p [joinname $d $f] 2552 set diffrel(0) 0 2553 set allf 0 2554 for {set j 1} {$j < $diffndirs} {incr j} { 2555 set e [lindex $dirlist $j] 2556 set q [joinname $e $f] 2557 set difflnos($j) {0 0} 2558 set diffstate($j) 0 2559 set difflnum($j) 0 2560 set diffblocked($j) 0 2561 set diffrel($j) 0 2562 set fd [open "|diff $diffopts $p $q" r] 2563 set difffds($j) $fd 2564 fconfigure $fd -blocking 0 2565 fileevent $fd readable "readndiff $fd $j" 2566 lappend allf $j 2567 } 2568 for {set i 0} {$i < $diffndirs} {incr i} { 2569 set ldisp($i) 0 2570 } 2571 2572 # Build a window 2573 global textw filemode mergebut mpatchbut bgcolors numgroups 2574 global groups dirs difftabs linelist texttop underlinetabs 2575 global diffcolors 2576 if {![info exists textw] || ![winfo exists $textw]} { 2577 maketextw 2578 } 2579 if {$filemode} { 2580 wm title $texttop "Differences: all files" 2581 } else { 2582 wm title $texttop "Differences: $f" 2583 } 2584 $mergebut.m delete 0 end 2585 $mpatchbut.m delete 0 end 2586 $textw conf -state normal 2587 $textw delete 0.0 end 2588 set charwidth [font measure [$textw cget -font] n] 2589 set tlist "[expr 4*$charwidth] left" 2590 set difftabs "" 2591 set j 4 2592 for {set i 2} {$i < $diffndirs} {incr i} { 2593 incr j 2 2594 if {$diffndirs < 4} { 2595 incr j 2596 } 2597 append tlist " [expr $j*$charwidth] left" 2598 append difftabs "\t" 2599 } 2600 incr j 8 2601 append tlist " [expr $j*$charwidth] left" 2602 $textw conf -tabs $tlist 2603 set x $bgcolors($numgroups) 2604 $textw tag delete [$textw tag names] 2605 set group [lindex $groups($f) 1] 2606 set diffcolors {} 2607 for {set i 0} {$i < $diffndirs} {incr i} { 2608 set d [lindex $diffdirs $i] 2609 set j [lindex $group [lsearch $dirs $d]] 2610 set c [lindex $x $j] 2611 $textw tag conf d$i -back $c 2612 lappend diffcolors $c 2613 } 2614 $textw tag conf sep -back blue -fore white 2615 $textw tag conf ul -underline $underlinetabs 2616 $textw tag lower sep 2617 bind $textw <1> "startbutspan %x %y 0; break" 2618 bind $textw <Shift-Button-1> "startbutspan %x %y 1; break" 2619 bind $textw <B1-Motion> "setbutspan %x %y; break" 2620 bind $textw <ButtonRelease-1> "endbutspan; break" 2621 bind $textw <B1-Leave> "startbutscroll %W %x %y; break" 2622 bind $textw <B1-Enter> "endbutscroll %W %x %y; break" 2623 bind $textw <2> "startdrag $textw %x %y; break" 2624 bind $textw <B2-Motion> "dragdiff $textw %x %y; break" 2625 bind $textw <ButtonRelease-2> "finishdrag $textw" 2626 bind $textw <Any-Button-3> "togglebuts %x %y" 2627 set linelist {{{} {} {}}} 2628 2629 # read in the files 2630 set i 0 2631 foreach d $dirlist { 2632 set p [joinname $d $f] 2633 set fcontents($i) {} 2634 if {[catch { 2635 set fd [open $p r] 2636 set fcontents($i) [split [read -nonewline $fd] "\n"] 2637 close $fd 2638 } err]} { 2639 puts "error reading $p: $err" 2640 } 2641 incr i 2642 } 2643} 2644 2645proc readndiff {fd ix} { 2646 global difflnos diffeof difflnum diffhdr 2647 global nextdiffhdr diffstate diffhunk 2648 global parthunklen parthunkstart diffblocked 2649 2650 set n [gets $fd line] 2651 set l [incr difflnum($ix)] 2652 if {$n < 0} { 2653 if {![eof $fd]} return 2654 #puts "eof for $ix" 2655 addhunk $ix 2 2656 close $fd 2657 return 2658 } 2659 set x [string index $line 0] 2660 if {$l <= 2} { 2661 # expect --- or +++ line or "Binary files ..." 2662 if {$ix == 1 && $x == "-"} { 2663 set diffhdr(0) [string range $line 4 end] 2664 } 2665 if {$x == "+"} { 2666 set diffhdr($ix) [string range $line 4 end] 2667 } 2668 while {[info exists diffhdr($nextdiffhdr)]} { 2669 emithdr $nextdiffhdr $diffhdr($nextdiffhdr) 2670 incr nextdiffhdr 2671 } 2672 return 2673 } 2674 if {$x == "-" || $x == "+"} { 2675 set addit [expr {$x == "+"}] 2676 set line [string range $line 1 end] 2677 if {$diffstate($ix) == 0} { 2678 # start of a new hunk of diff 2679 set parthunklen($ix,0) 0 2680 set parthunklen($ix,1) 0 2681 set parthunkstart($ix) $difflnos($ix) 2682 if {[info exists diffhunk($ix)]} { 2683 # block this diff for now 2684 fileevent $fd readable {} 2685 set diffblocked($ix) 1 2686 #puts "blocking $ix" 2687 } 2688 set diffstate($ix) 1 2689 } 2690 set fl [lindex $difflnos($ix) $addit] 2691 incr parthunklen($ix,$addit) 2692 set difflnos($ix) [lreplace $difflnos($ix) $addit $addit [incr fl]] 2693 } else { 2694 if {$diffstate($ix) == 1} { 2695 # end of a new hunk of diff 2696 addhunk $ix 0 2697 } 2698 set f0l [lindex $difflnos($ix) 0] 2699 set f1l [lindex $difflnos($ix) 1] 2700 if {$x == "@" && [regexp { -([0-9,]+) .*\+([0-9,]+) } $line z r1 r2]} { 2701 set r1 [lindex [split $r1 ,] 0] 2702 set r2 [lindex [split $r2 ,] 0] 2703 catch {set f0l [expr {$r1+0}]} 2704 catch {set f1l [expr {$r2+0}]} 2705 } else { 2706 incr f0l 2707 incr f1l 2708 } 2709 set difflnos($ix) [list $f0l $f1l] 2710 } 2711} 2712 2713proc addhunk {ix newstate} { 2714 global diffstate parthunklen parthunkstart diffhunk 2715 #puts "addhunk $ix newstate=$newstate diffstate($ix)=$diffstate($ix)" 2716 if {$diffstate($ix) == 1} { 2717 #puts " start=$parthunkstart($ix) len= $parthunklen($ix,0) $parthunklen($ix,1)" 2718 if {[info exists diffhunk($ix)]} { 2719 puts "oops, overwriting hunk for $ix" 2720 } 2721 set diffhunk($ix) [list $parthunkstart($ix) \ 2722 $parthunklen($ix,0) $parthunklen($ix,1)] 2723 } 2724 set diffstate($ix) $newstate 2725 processhunks 2726} 2727 2728proc consumehunk {ix} { 2729 global diffhunk diffblocked difffds 2730 #puts "consumehunk $ix" 2731 unset diffhunk($ix) 2732 if {$diffblocked($ix)} { 2733 set fd $difffds($ix) 2734 fileevent $fd readable "readndiff $fd $ix" 2735 set diffblocked($ix) 0 2736 } 2737} 2738 2739proc diffstart {lno} { 2740 global hunkstart hunkend diffndirs diffrel 2741 #puts -nonewline "diffstart $lno:" 2742 for {set j 0} {$j < $diffndirs} {incr j} { 2743 set hunkstart($j) [expr $lno + $diffrel($j)] 2744 set hunkend($j) $hunkstart($j) 2745 #puts -nonewline " $hunkstart($j)" 2746 } 2747 #puts "" 2748} 2749 2750proc adddiffhunk {ix} { 2751 global hunkend diffndirs diffhunk 2752 #puts "adddiffhunk $ix: $diffhunk($ix)" 2753 set stl [lindex $diffhunk($ix) 0] 2754 set lst [lindex $stl 0] 2755 set rst [lindex $stl 1] 2756 set llen [lindex $diffhunk($ix) 1] 2757 set rlen [lindex $diffhunk($ix) 2] 2758 set lend [expr $lst + $llen] 2759 set rend [expr $rst + $rlen] 2760 set x [expr $lend - $hunkend(0)] 2761 if {$x < 0} { 2762 set rend [expr $rend - $x] 2763 } elseif {$x > 0} { 2764 for {set i 0} {$i < $diffndirs} {incr i} { 2765 incr hunkend($i) $x 2766 } 2767 } 2768 set hunkend($ix) $rend 2769} 2770 2771proc addoverlaps {} { 2772 global diffhunk hunkend diffndirs diffstate 2773 set overlap 0 2774 for {set j 1} {$j < $diffndirs} {incr j} { 2775 if {![info exists diffhunk($j)]} continue 2776 set lnos [lindex $diffhunk($j) 0] 2777 if {[lindex $lnos 0] <= $hunkend(0) || \ 2778 [lindex $lnos 1] <= $hunkend($j)} { 2779 set overlap 1 2780 adddiffhunk $j 2781 consumehunk $j 2782 } 2783 } 2784 return $overlap 2785} 2786 2787proc processhunks {} { 2788 global diffhunk diffstate diffndirs diffrel 2789 global havediffs hunkstart hunkend 2790 2791 while 1 { 2792 if {$havediffs} { 2793 addoverlaps 2794 } 2795 2796 # check that we have a hunk or EOF for each pair 2797 set alleof 1 2798 for {set j 1} {$j < $diffndirs} {incr j} { 2799 if {$diffstate($j) != 2} { 2800 set alleof 0 2801 if {![info exists diffhunk($j)]} return 2802 } 2803 } 2804 #if {$alleof} {puts "processhunks: eof on all"} 2805 2806 if {$havediffs} { 2807 putdiffhunks 2808 #puts -nonewline "diffrel:" 2809 for {set j 1} {$j < $diffndirs} {incr j} { 2810 set diffrel($j) [expr $hunkend($j) - $hunkend(0)] 2811 #puts -nonewline " $diffrel($j)" 2812 } 2813 #puts "" 2814 set havediffs 0 2815 unset hunkstart 2816 unset hunkend 2817 } 2818 2819 # find which hunk is the earliest 2820 set first {} 2821 for {set j 1} {$j < $diffndirs} {incr j} { 2822 if {[info exists diffhunk($j)]} { 2823 set st0 [lindex [lindex $diffhunk($j) 0] 0] 2824 if {$first == {} || $st0 < $earliest} { 2825 set first $j 2826 set earliest $st0 2827 } 2828 } 2829 } 2830 if {$first == {}} { 2831 # have reached EOF on all diffs 2832 ndiffdone 2833 return 2834 } 2835 2836 set havediffs 1 2837 diffstart $earliest 2838 adddiffhunk $first 2839 consumehunk $first 2840 } 2841} 2842 2843proc existingmatch {matches f fl} { 2844 global diffndirs 2845 foreach m $matches { 2846 if {$f == [lindex $m 0]} { 2847 set nl [lindex $m 2] 2848 set lnos [lindex $m 1] 2849 set o [expr [lindex $fl 0] - [lindex $lnos 0]] 2850 if {$o < 0 || $o >= $nl} { 2851 return 0 2852 } 2853 for {set i 0} {$i < [llength $f]} {incr i} { 2854 if {[lindex $fl $i] != [lindex $lnos $i] + $o} { 2855 return 0 2856 } 2857 } 2858 return 1 2859 } 2860 } 2861 return 0 2862} 2863 2864# f is a list of file indices, fl is a corresponding list of line numbers 2865# relative to the start of this section 2866proc matchlength {f fl} { 2867 global difflines 2868 set l0 [lindex $fl 0] 2869 set f0 [lindex $f 0] 2870 set f0len [llength $difflines($f0)] 2871 set nf [llength $f] 2872 set len 1 2873 while {[incr l0] < $f0len} { 2874 set line [lindex $difflines($f0) $l0] 2875 for {set i 1} {$i < $nf} {incr i} { 2876 set fi [lindex $f $i] 2877 set li [expr [lindex $fl $i] + $len] 2878 if {$li >= [llength $difflines($fi)] || \ 2879 [lindex $difflines($fi) $li] != $line} { 2880 return $len 2881 } 2882 } 2883 incr len 2884 } 2885 return $len 2886} 2887 2888# m is a match expressed as a list {files lines length} 2889# existing is a list of matches in that format 2890proc expandmatchback {m existing} { 2891 global difflines 2892 set fi [lindex $m 0] 2893 set fl [lindex $m 1] 2894 set len [lindex $m 2] 2895 set f0 [lindex $fi 0] 2896 set l0 [lindex $fl 0] 2897 set nf [llength $fi] 2898 for {set j 0} {$j < $nf} {incr j} { 2899 set f [lindex $fi $j] 2900 set l [lindex $fl $j] 2901 set lno($f) $l 2902 set minlno($f) 0 2903 } 2904 foreach e $existing { 2905 set k 0 2906 foreach ef [lindex $e 0] { 2907 if {[info exists lno($ef)]} { 2908 set el [lindex [lindex $e 1] $k] 2909 if {$el < $lno($ef)} { 2910 incr el [lindex $e 2] 2911 if {$el > $minlno($ef)} { 2912 set minlno($ef) $el 2913 } 2914 } 2915 } 2916 incr k 2917 } 2918 } 2919 set nl [expr $l0 - $minlno($f0)] 2920 for {set x 1} {$x <= $nl} {incr x} { 2921 set line [lindex $difflines($f0) [expr $l0 - $x]] 2922 for {set j 1} {$j < $nf} {incr j} { 2923 set f [lindex $fi $j] 2924 set l [expr [lindex $fl $j] - $x] 2925 if {$l < $minlno($f)} break 2926 if {[lindex $difflines($f) $l] != $line} break 2927 } 2928 if {$j < $nf} break 2929 } 2930 if {$x == 1} { 2931 return $m 2932 } 2933 set newfl {} 2934 incr x -1 2935 foreach l $fl { 2936 lappend newfl [expr $l - $x] 2937 } 2938 return [list $fi $newfl [expr $len + $x]] 2939} 2940 2941proc removematches {matches f l nl} { 2942 set new {} 2943 set el [expr $l + $nl] 2944 foreach m $matches { 2945 set i [lsearch [lindex $m 0] $f] 2946 if {$i < 0} { 2947 lappend new $m 2948 } else { 2949 set lm [lindex [lindex $m 1] $i] 2950 set elm [expr [lindex $m 2] + $lm] 2951 if {$el <= $lm || $elm <= $l} { 2952 lappend new $m 2953 } else { 2954 if {$lm < $l} { 2955 lappend new [lreplace $m 2 2 [expr $l - $lm]] 2956 } 2957 if {$elm > $el} { 2958 set inc [expr $el - $lm] 2959 set lnos {} 2960 foreach x [lindex $m 1] { 2961 lappend lnos [expr $x + $inc] 2962 } 2963 lappend new [lreplace $m 1 2 $lnos [expr $elm - $el]] 2964 } 2965 } 2966 } 2967 } 2968 return $new 2969} 2970 2971proc removeinversions {matches bm} { 2972 set bf [lindex $bm 0] 2973 set bl [lindex $bm 1] 2974 set new {} 2975 foreach m $matches { 2976 set isbefore 0 2977 set isafter 0 2978 set i 0 2979 set mf [lindex $m 0] 2980 set ml [lindex $m 1] 2981 foreach f $mf { 2982 set j [lsearch -exact $bf $f] 2983 if {$j >= 0} { 2984 if {[lindex $ml $i] < [lindex $bl $j]} { 2985 set isbefore 1 2986 } else { 2987 set isafter 1 2988 } 2989 } 2990 incr i 2991 } 2992 if {!($isbefore && $isafter)} { 2993 lappend new $m 2994 } 2995 } 2996 return $new 2997} 2998 2999proc overlapsbest {bestmatches mf ml mlen} { 3000 foreach bm $bestmatches { 3001 set bf [lindex $bm 0] 3002 set bl [lindex $bm 1] 3003 set blen [lindex $bm 2] 3004 set isbefore 0 3005 set isafter 0 3006 set i 0 3007 foreach f $mf { 3008 set j [lsearch -exact $bf $f] 3009 if {$j >= 0} { 3010 set li [lindex $ml $i] 3011 set lj [lindex $bl $j] 3012 if {$li < $lj} { 3013 if {$isafter || $li + $mlen > $lj} { 3014 return 1 3015 } 3016 set isbefore 1 3017 } else { 3018 if {$isbefore || $lj + $blen > $li} { 3019 return 1 3020 } 3021 set isafter 1 3022 } 3023 } 3024 incr i 3025 } 3026 } 3027 return 0 3028} 3029 3030proc findbestmatch {matches} { 3031 set best 0 3032 set bestnf 0 3033 set bm {} 3034 foreach m $matches { 3035 set nf [llength [lindex $m 0]] 3036 set good [lindex $m 2] 3037 if {$nf > $bestnf || ($nf == $bestnf && $good > $best)} { 3038 set best $good 3039 set bestnf $nf 3040 set bm $m 3041 } 3042 } 3043 return $bm 3044} 3045 3046proc findmatches {} { 3047 global hunkstart hunkend diffndirs 3048 global difflines fcontents lineinst diffwflag diffbflag 3049 set matches {} 3050 catch {unset lineinst} 3051 for {set i 0} {$i < $diffndirs} {incr i} { 3052 set difflines($i) {} 3053 for {set j $hunkstart($i)} {$j < $hunkend($i)} {incr j} { 3054 set line [lindex $fcontents($i) [expr $j-1]] 3055 if {$diffwflag != ""} { 3056 regsub -all {[ ]+} $line {} line 3057 } elseif {$diffbflag != ""} { 3058 regsub -all {[ ]+} $line { } line 3059 regsub { $} $line {} line 3060 } 3061 lappend difflines($i) $line 3062 } 3063 } 3064 for {set i 0} {$i < $diffndirs} {incr i} { 3065 set l 0 3066 foreach line $difflines($i) { 3067 lappend lineinst($line) [list $i $l] 3068 if {![regexp {^[[:space:]]*$} $line]} { 3069 foreach inst $lineinst($line) { 3070 set f [lindex $inst 0] 3071 if {$f == $i || [lsearch -exact $f $i] >= 0} continue 3072 set fl [lindex $inst 1] 3073 lappend f $i 3074 lappend fl $l 3075 if {![existingmatch $matches $f $fl]} { 3076 lappend matches [list $f $fl [matchlength $f $fl]] 3077 } 3078 lappend lineinst($line) [list $f $fl] 3079 } 3080 } 3081 incr l 3082 } 3083 } 3084 set bestmatches {} 3085 while {$matches != {}} { 3086 set bm [findbestmatch $matches] 3087 set bm [expandmatchback $bm $bestmatches] 3088 lappend bestmatches $bm 3089 set i 0 3090 set nl [lindex $bm 2] 3091 foreach f [lindex $bm 0] { 3092 set lno [lindex [lindex $bm 1] $i] 3093 set matches [removematches $matches $f $lno $nl] 3094 incr i 3095 } 3096 set matches [removeinversions $matches $bm] 3097 } 3098 3099 # now add in the blank-line matches that we ignored before 3100 set matches {} 3101 for {set i 0} {$i < $diffndirs} {incr i} { 3102 set l 0 3103 foreach line $difflines($i) { 3104 if {[regexp {^[[:space:]]*$} $line]} { 3105 foreach inst $lineinst($line) { 3106 set f [lindex $inst 0] 3107 if {$f >= $i || [lsearch -exact $f $i] >= 0} continue 3108 set fl [lindex $inst 1] 3109 lappend f $i 3110 lappend fl $l 3111 if {![existingmatch $matches $f $fl]} { 3112 set mlen [matchlength $f $fl] 3113 if {![overlapsbest $bestmatches $f $fl $mlen]} { 3114 lappend matches [list $f $fl $mlen] 3115 } 3116 } 3117 lappend lineinst($line) [list $f $fl] 3118 } 3119 } 3120 incr l 3121 } 3122 } 3123 while {$matches != {}} { 3124 set bm [findbestmatch $matches] 3125 lappend bestmatches $bm 3126 set i 0 3127 set nl [lindex $bm 2] 3128 foreach f [lindex $bm 0] { 3129 set lno [lindex [lindex $bm 1] $i] 3130 set matches [removematches $matches $f $lno $nl] 3131 incr i 3132 } 3133 set matches [removeinversions $matches $bm] 3134 } 3135 3136 #puts "best matches: $bestmatches" 3137 return $bestmatches 3138} 3139 3140proc filematches {matches i nlines} { 3141 global hunkstart hunkend diffndirs 3142 set res {} 3143 foreach m $matches { 3144 set k [lsearch -exact [lindex $m 0] $i] 3145 if {$k >= 0} { 3146 set l [lindex [lindex $m 1] $k] 3147 set e [expr $l + [lindex $m 2]] 3148 lappend res [list $l $e $m] 3149 } 3150 } 3151 set full {} 3152 set ld 0 3153 foreach m [lsort -integer -index 0 $res] { 3154 set l [lindex $m 0] 3155 if {$ld < $l} { 3156 lappend full [list $ld $l [list $i $ld [expr $l - $ld]]] 3157 } 3158 if {[lindex [lindex [lindex $m 2] 0] 0] == $i} { 3159 lappend full $m 3160 } 3161 set ld [lindex $m 1] 3162 } 3163 if {$ld < $nlines} { 3164 lappend full [list $ld $nlines [list $i $ld [expr $nlines - $ld]]] 3165 } 3166 #puts "filematches $i -> {$full}" 3167 return $full 3168} 3169 3170proc putdiffhunks {} { 3171 global hunkstart hunkend diffndirs 3172 global matchlist fcontents 3173 #puts -nonewline "putdiffhunks" 3174 #for {set i 0} {$i < $diffndirs} {incr i} { 3175 #puts -nonewline " $i: ($hunkstart($i),$hunkend($i))" 3176 #} 3177 #puts "" 3178 set matches [findmatches] 3179 #puts "matches: $matches" 3180 set totsegs 0 3181 for {set i 0} {$i < $diffndirs} {incr i} { 3182 set nlines($i) [expr $hunkend($i) - $hunkstart($i)] 3183 set displ($i) [filematches $matches $i $nlines($i)] 3184 set nsegs($i) [llength $displ($i)] 3185 set ix($i) 0 3186 if {$nsegs($i) > 0} { 3187 set curseg($i) [lindex $displ($i) 0] 3188 incr totsegs $nsegs($i) 3189 } 3190 set nextline($i) 0 3191 } 3192 set displist {} 3193 while {$totsegs > 0} { 3194 for {set i 0} {$i < $diffndirs} {incr i} { 3195 if {$nsegs($i) == 0} continue 3196 set m [lindex $curseg($i) 2] 3197 set blocked 0 3198 set k 0 3199 set lnos [lindex $m 1] 3200 foreach f [lindex $m 0] { 3201 set l [lindex $lnos $k] 3202 if {$l > $nextline($f)} { 3203 set blocked 1 3204 break 3205 } 3206 if {$l < $nextline($f)} { 3207 puts "oops, misordered span for $i {$curseg($i)}" 3208 #puts -nonewline "nextline: " 3209 #for {set z 0} {$z < $diffndirs} {incr z} { 3210 #puts -nonewline " $nextline($z)" 3211 #} 3212 #puts -nonewline "\nix: " 3213 #for {set z 0} {$z < $diffndirs} {incr z} { 3214 #puts -nonewline " $ix($z)" 3215 #} 3216 #puts -nonewline "\nnsegs: " 3217 #for {set z 0} {$z < $diffndirs} {incr z} { 3218 #puts -nonewline " $nsegs($z)" 3219 #} 3220 #puts "" 3221 #for {set z 0} {$z < $diffndirs} {incr z} { 3222 #puts "displ($z): {$displ($z)}" 3223 #} 3224 #puts "displist:" 3225 #foreach z $displist { 3226 #puts " $z" 3227 #} 3228 #puts "" 3229 } 3230 incr k 3231 } 3232 if {!$blocked} { 3233 lappend displist $curseg($i) 3234 set nl [lindex $m 2] 3235 foreach f [lindex $m 0] { 3236 incr nextline($f) $nl 3237 } 3238 incr ix($i) 3239 incr nsegs($i) -1 3240 if {$nsegs($i) > 0} { 3241 set curseg($i) [lindex $displ($i) $ix($i)] 3242 } else { 3243 unset curseg($i) 3244 } 3245 break 3246 } 3247 } 3248 incr totsegs -1 3249 } 3250 #puts "displist:" 3251 #foreach d $displist { 3252 #puts $d 3253 #} 3254 emitstart 3255 foreach d $displist { 3256 set l [lindex $d 0] 3257 set e [lindex $d 1] 3258 set m [lindex $d 2] 3259 set fs [lindex $m 0] 3260 set i [lindex $fs 0] 3261 set fl [expr $hunkstart($i) + $l - 1] 3262 for {} {$l < $e} {incr l} { 3263 emitdiff $fs [lindex $fcontents($i) $fl] 3264 incr fl 3265 } 3266 } 3267} 3268 3269proc emithdr {i line} { 3270 global textw difftabs linelist 3271 $textw insert end "\t$difftabs$line\n" d$i 3272 lappend linelist [list {} {} $line] 3273} 3274 3275proc emitctxline {} { 3276 global textw linelist ldisp fcontents difftabs diffndirs 3277 set lnums {} 3278 set memb {} 3279 set line [lindex $fcontents(0) [expr $ldisp(0)-1]] 3280 for {set i 0} {$i < $diffndirs} {incr i} { 3281 lappend lnums $ldisp($i) 3282 incr ldisp($i) 3283 lappend memb $i 3284 } 3285 lappend linelist [list $lnums $memb $line] 3286 set ix [expr $diffndirs-1] 3287 set r [tabexpand $line $ix] 3288 set l [lindex [split [$textw index "end - 1c"] .] 0] 3289 $textw insert end "\t$difftabs[lindex $r 0]\n" 3290 foreach tgp [lindex $r 1] { 3291 $textw tag add ul $l.[lindex $tgp 0] $l.[lindex $tgp 1] 3292 } 3293} 3294 3295proc emitstart {} { 3296 global diffndirs ctxlines ldisp textw difftabs linelist 3297 global prevhunkend fcontents hunkstart 3298 set nctx $ctxlines 3299 set needsep 1 3300 if {[info exists prevhunkend]} { 3301 if {$hunkstart(0) - $prevhunkend <= 2 * $ctxlines + 1} { 3302 set nctx [expr $hunkstart(0) - $prevhunkend] 3303 set needsep 0 3304 } else { 3305 for {set l 0} {$l < $ctxlines} {incr l} { 3306 emitctxline 3307 } 3308 } 3309 } 3310 if {$nctx >= $hunkstart(0)} { 3311 set nctx [expr $hunkstart(0) - 1] 3312 } 3313 if {$needsep} { 3314 set lnums {} 3315 for {set i 0} {$i < $diffndirs} {incr i} { 3316 set ldisp($i) [expr $hunkstart($i) - $nctx] 3317 lappend lnums $ldisp($i) 3318 } 3319 set l [llength $linelist] 3320 lappend linelist [makesepline $l $lnums] 3321 $textw insert end "\n" 3322 redisplaylines $textw $l 1 3323 } 3324 for {set l 0} {$l < $nctx} {incr l} { 3325 emitctxline 3326 } 3327} 3328 3329proc emitdiff {set line} { 3330 global diffndirs ldisp textw difftabs linelist 3331 global prevhunkend fcontents nextlix incline 3332 #puts -nonewline "emitdiff set={$set} ldisp =" 3333 #for {set i 0} {$i < $diffndirs} {incr i} {puts -nonewline " $ldisp($i)"} 3334 #puts " line={$line}" 3335 set nm [llength $set] 3336 if {$nm == $diffndirs} { 3337 emitctxline 3338 return 3339 } 3340 if {$nm == 0 || $nm > $diffndirs} { 3341 #puts "oops, $nm members in emitdiff?" 3342 return 3343 } 3344 for {set i 0} {$i < $diffndirs} {incr i} { 3345 set isin($i) 0 3346 } 3347 foreach i $set { 3348 set isin($i) 1 3349 } 3350 set lnums {} 3351 for {set i 0} {$i < $diffndirs} {incr i} { 3352 if {$isin($i)} { 3353 lappend lnums $ldisp($i) 3354 incr ldisp($i) 3355 } else { 3356 lappend lnums {} 3357 } 3358 } 3359 set lix $nextlix 3360 incr nextlix 3361 set incline($lix) 0 3362 set l [llength $linelist] 3363 lappend linelist [list $lnums $set $line $lix] 3364 $textw insert end "\n" 3365 redisplaylines $textw $l 1 3366 set prevhunkend $ldisp(0) 3367} 3368 3369proc ndiffdone {} { 3370 global textw prevhunkend fcontents ctxlines 3371 global diffing ldisp diffndirs 3372 #puts -nonewline "ldisp =" 3373 #for {set i 0} {$i < $diffndirs} {incr i} {puts -nonewline " $ldisp($i)"} 3374 #puts "" 3375 if {[info exists prevhunkend]} { 3376 set l0 [llength $fcontents(0)] 3377 #puts "ndiffdone, prevhunkend=$prevhunkend l0=$l0 ctxlines=$ctxlines" 3378 set nctx $ctxlines 3379 if {$prevhunkend - 1 + $nctx > $l0} { 3380 set nctx [expr $l0 - $prevhunkend + 1] 3381 } 3382 for {set l 0} {$l < $nctx} {incr l} { 3383 emitctxline 3384 } 3385 unset prevhunkend 3386 } else { 3387 #puts "ndiffdone, prevhunkend not set" 3388 } 3389 set diffing 0 3390 $textw delete "end - 1c" end 3391 $textw conf -state disabled 3392 3393 # configure the merge button 3394 confmergebut 3395 confmpatchbut 3396} 3397 3398proc diffmerge {ix dir} { 3399 global diffdirs difffile diffmtime fserial linelist 3400 global dirs diffcolors textfont incline diffndirs 3401 global fcontents allf 3402 set infile [joinname $dir $difffile] 3403 if {$diffmtime($infile) != [file mtime $infile]} { 3404 error_popup "File $infile has changed since the diff was performed." 3405 return 3406 } 3407 3408 set di [lsearch -exact $dirs $dir] 3409 set fi $fserial($difffile) 3410 set w ".merge:$di:$fi" 3411 catch {destroy $w} 3412 toplevel $w 3413 wm title $w "Dirdiff: merged $infile" 3414 frame $w.bar -relief raised -border 2 3415 pack $w.bar -side top -fill x 3416 menubutton $w.bar.file -text File -menu $w.bar.file.m -padx 10 -pady 1 3417 menu $w.bar.file.m -tearoff 0 3418 $w.bar.file.m add command -label Save -command "savemerge $w" 3419 $w.bar.file.m add command -label Close -command "destroy $w" 3420 pack $w.bar.file -side left 3421 menubutton $w.bar.edit -text Edit -menu $w.bar.edit.m -padx 10 -pady 1 3422 menu $w.bar.edit.m -tearoff 0 3423 $w.bar.edit.m add command -label Cut -command "tk_textCut $w.t" 3424 $w.bar.edit.m add command -label Copy -command "tk_textCopy $w.t" 3425 $w.bar.edit.m add command -label Paste -command "tk_textPaste $w.t" 3426 $w.bar.edit.m add command -label Find \ 3427 -command "difffind :merge:$di:$fi $w.t" 3428 pack $w.bar.edit -side left 3429 frame $w.f -relief sunk -border 2 3430 entry $w.f.filename 3431 $w.f.filename insert 0 $infile 3432 pack $w.f.filename -side left -fill x -expand 1 3433 pack $w.f -side top -fill x 3434 text $w.t -yscrollcommand "$w.sb set" -font $textfont 3435 scrollbar $w.sb -command "$w.t yview" 3436 pack $w.sb -side right -fill y 3437 pack $w.t -side left -fill both -expand 1 3438 bind $w <Key-Prior> "$w.t yview scroll -1 p" 3439 bind $w <Key-Next> "$w.t yview scroll 1 p" 3440 for {set x 0} {$x < $diffndirs} {incr x} { 3441 $w.t tag conf d$x -back [lindex $diffcolors $x] 3442 } 3443 3444 set inf $fcontents($ix) 3445 set l 1 3446 foreach m $linelist { 3447 set lns [lindex $m 0] 3448 set ty [lindex $m 1] 3449 if {$lns == {} || $ty == {}} continue 3450 set tl [lindex $lns $ix] 3451 if {$tl != {}} { 3452 for {} {$l < $tl} {incr l} { 3453 set line [lindex $inf [expr $l-1]] 3454 $w.t insert end "$line\n" 3455 } 3456 } 3457 if {$ty == $allf} { 3458 set line [lindex $inf [expr $l-1]] 3459 $w.t insert end "$line\n" 3460 incr l 3461 } elseif {[llength $ty] < $diffndirs} { 3462 set isme [expr {$ty == $ix || [lsearch -exact $ty $ix] >= 0}] 3463 set lix [lindex $m 3] 3464 set inc $incline($lix) 3465 if {!$inc} { 3466 if {$isme} { 3467 set line [lindex $inf [expr $l-1]] 3468 $w.t insert end "$line\n" d$ix 3469 incr l 3470 } 3471 } else { 3472 if {!$isme} { 3473 # insert this line 3474 set line [lindex $m 2] 3475 set last [lindex $ty end] 3476 $w.t insert end "$line\n" d$last 3477 } else { 3478 # delete this line 3479 incr l 3480 } 3481 } 3482 } 3483 } 3484 for {set nl [llength $inf]} {$l <= $nl} {incr l} { 3485 set line [lindex $inf [expr $l-1]] 3486 $w.t insert end "$line\n" 3487 } 3488 # delete last newline 3489 catch {$w.t delete "end - 1c" end} 3490} 3491 3492proc savemerge {w} { 3493 set infile [$w.f.filename get] 3494 if {$infile == {}} {return} 3495 set tmpfile "$infile.tmp" 3496 set tf [open $tmpfile w] 3497 puts -nonewline $tf [$w.t get 0.0 end] 3498 close $tf 3499 scmedit $infile 3500 catch {file attr $tmpfile -perm [file attr $infile -perm]} 3501 file rename -force $infile $infile.orig 3502 file rename $tmpfile $infile 3503 destroy $w 3504 redifffiles 3505} 3506 3507# Make a patch that would make the same changes to a destination 3508# file that doing a merge would have made. 3509proc diffmpatch {ix dir} { 3510 global difffile diffmtime linelist 3511 global dirs textfont incline diffndirs filemode 3512 global fcontents allf mpatchserial 3513 3514 if {![info exists mpatchserial]} { 3515 set mpatchserial 0 3516 } 3517 set fi [incr mpatchserial] 3518 set w ".mpatch:$fi" 3519 toplevel $w 3520 set fname [joinname $dir $difffile] 3521 set ftail [file tail $fname] 3522 wm title $w "Dirdiff: patch for $ftail" 3523 frame $w.bar -relief raised -border 2 3524 pack $w.bar -side top -fill x 3525 menubutton $w.bar.file -text File -menu $w.bar.file.m -padx 10 -pady 1 3526 menu $w.bar.file.m -tearoff 0 3527 $w.bar.file.m add command -label Save -command "savemerge $w" 3528 $w.bar.file.m add command -label Close -command "destroy $w" 3529 pack $w.bar.file -side left 3530 menubutton $w.bar.edit -text Edit -menu $w.bar.edit.m -padx 10 -pady 1 3531 menu $w.bar.edit.m -tearoff 0 3532 $w.bar.edit.m add command -label Cut -command "tk_textCut $w.t" 3533 $w.bar.edit.m add command -label Copy -command "tk_textCopy $w.t" 3534 $w.bar.edit.m add command -label Paste -command "tk_textPaste $w.t" 3535 $w.bar.edit.m add command -label Find \ 3536 -command "difffind :mpatch:$fi $w.t" 3537 pack $w.bar.edit -side left 3538 frame $w.f -relief sunk -border 2 3539 entry $w.f.filename 3540 $w.f.filename insert 0 "$ftail.patch" 3541 pack $w.f.filename -side left -fill x -expand 1 3542 pack $w.f -side top -fill x 3543 text $w.t -yscrollcommand "$w.sb set" -font $textfont 3544 scrollbar $w.sb -command "$w.t yview" 3545 pack $w.sb -side right -fill y 3546 pack $w.t -side left -fill both -expand 1 3547 bind $w <Key-Prior> "$w.t yview scroll -1 p" 3548 bind $w <Key-Next> "$w.t yview scroll 1 p" 3549 3550 set inf $fcontents($ix) 3551 set l 1 3552 set delta 0 3553 set pluslines {} 3554 set ctxstart {} 3555 set filelen [llength $fcontents($ix)] 3556 3557 foreach m $linelist { 3558 set lns [lindex $m 0] 3559 set ty [lindex $m 1] 3560 set lix [lindex $m 3] 3561 if {$lns == {}} continue 3562 set lineno [lindex $lns $ix] 3563 if {$lineno != {}} { 3564 set l $lineno 3565 } 3566 if {$ty == {} || $ty == $allf || $lix == {} \ 3567 || ($lineno != {} && !$incline($lix))} { 3568 # output accumulated '+' lines 3569 if {$pluslines != {}} { 3570 $w.t insert end $pluslines 3571 set pluslines {} 3572 } 3573 if {$ty != {} && $lineno != {}} { 3574 incr l 3575 } 3576 continue 3577 } 3578 if {!$incline($lix)} continue 3579 3580 # see if we need to start a new hunk 3581 if {$ctxstart == {} || $l > $ctxstart + 6} { 3582 if {$ctxstart == {}} { 3583 # insert diff header 3584 set difftimefmt "%Y-%m-%d %H:%M:%S" 3585 $w.t insert end "--- $fname.orig\t" 3586 $w.t insert end [clock format $diffmtime($fname) \ 3587 -format $difftimefmt] 3588 $w.t insert end "\n+++ $fname\t" 3589 $w.t insert end [clock format [clock seconds] \ 3590 -format $difftimefmt] 3591 $w.t insert end "\n" 3592 } else { 3593 finishhunk $w $ix $ctxstart $nctx $ndel $nadd 3594 } 3595 set nctx 0 3596 set ndel 0 3597 set nadd 0 3598 set ctxstart [expr $l - 3] 3599 if {$ctxstart < 1} {set ctxstart 1} 3600 $w.t insert end "@@ -$ctxstart, " 3601 $w.t mark set nminus "end - 2c" 3602 $w.t insert end "+[expr $ctxstart + $delta], " 3603 $w.t mark set nplus "end - 2c" 3604 $w.t insert end "\n" 3605 } 3606 while {$ctxstart < $l} { 3607 set line [lindex $fcontents($ix) [expr $ctxstart - 1]] 3608 $w.t insert end " $line\n" 3609 incr nctx 3610 incr ctxstart 3611 } 3612 3613 if {$lineno != {}} { 3614 # delete this line 3615 set line [lindex $inf [expr $lineno-1]] 3616 $w.t insert end "-$line\n" 3617 incr delta -1 3618 incr l 3619 incr ndel 3620 } else { 3621 # insert this line 3622 set line [lindex $m 2] 3623 append pluslines "+$line\n" 3624 incr delta 3625 incr nadd 3626 } 3627 set ctxstart $l 3628 } 3629 3630 if {$pluslines != {}} { 3631 $w.t insert end $pluslines 3632 } 3633 if {$ctxstart != {}} { 3634 finishhunk $w $ix $ctxstart $nctx $ndel $nadd 3635 } 3636 # delete last newline 3637 catch {$w.t delete "end - 1c" end} 3638} 3639 3640proc finishhunk {w ix ctxstart nctx nneg npos} { 3641 global fcontents 3642 3643 set filelen [llength $fcontents($ix)] 3644 for {set i $ctxstart} {$i < $ctxstart + 3} {incr i} { 3645 if {$i > $filelen} break 3646 set line [lindex $fcontents($ix) [expr $i - 1]] 3647 $w.t insert end " $line\n" 3648 incr nctx 3649 } 3650 $w.t insert nminus [expr $nctx + $nneg] 3651 $w.t insert nplus [expr $nctx + $npos] 3652} 3653 3654proc nextdiff {} { 3655 global textw linelist 3656 set l [lindex [split [$textw index @0,0] .] 0] 3657 set nl [llength $linelist] 3658 while {[incr l] < $nl} { 3659 if {[lindex [lindex $linelist $l] 1] == {}} { 3660 $textw yview $l.0 3661 break 3662 } 3663 } 3664} 3665 3666proc prevdiff {} { 3667 global textw linelist 3668 set l [lindex [split [$textw index @0,0] .] 0] 3669 while {[incr l -1] > 0} { 3670 if {[lindex [lindex $linelist $l] 1] == {}} { 3671 $textw yview $l.0 3672 break 3673 } 3674 } 3675} 3676 3677proc diffnextfile {inc} { 3678 global diffdirs selfile numgroups groups dirs textw 3679 global ycoord canvw origdiffdirs 3680 if {!([info exists textw] && [winfo exists $textw])} return 3681 if {![selnextline $inc] || $numgroups <= 1 \ 3682 || ![info exists origdiffdirs]} { 3683 return 3684 } 3685 set seengrps {} 3686 set group [lindex $groups($selfile) 1] 3687 set ds {} 3688 foreach d $origdiffdirs { 3689 set i [lindex $group [lsearch $dirs $d]] 3690 if {$i != 0 && [lsearch -exact $seengrps $i] < 0} { 3691 lappend ds $d 3692 lappend seengrps $i 3693 } 3694 } 3695 if {[llength $ds] == 2} { 3696 diff2 [lindex $ds 0] [lindex $ds 1] $selfile 0 3697 } elseif {[llength $ds] > 2} { 3698 diffn $ds $selfile 0 3699 } 3700} 3701 3702proc showsomediff {inc} { 3703 global diffdirs difffile selfile numgroups groups dirs textw 3704 global ycoord canvw groupelts dirinterest 3705 if {![selnextline $inc]} return 3706 if {[lindex $groups($selfile) 0] == "dir"} return 3707 3708 if {$numgroups <= 1} { 3709 set xi [lindex $groupelts(1) 0] 3710 if {$xi != ""} { 3711 showfile [lindex $dirs $xi] $selfile 3712 } 3713 return 3714 } 3715 3716 set dirlist {} 3717 for {set gn 1} {$gn <= $numgroups} {incr gn} { 3718 foreach i $groupelts($gn) { 3719 if {$dirinterest($i)} { 3720 lappend dirlist [lindex $dirs $i] 3721 break 3722 } 3723 } 3724 } 3725 if {[llength $dirlist] == 2} { 3726 diff2 [lindex $dirlist 0] [lindex $dirlist 1] $selfile 3727 } elseif {[llength $dirlist] > 2} { 3728 diffn $dirlist $selfile 3729 } 3730} 3731 3732proc copydifffile {} { 3733 global diffdirs selfile groups dirs changed 3734 if {![info exists diffdirs] || [llength $diffdirs] != 2} return 3735 set d1 [lindex $diffdirs 0] 3736 set d2 [lindex $diffdirs 1] 3737 if {[lindex $groups($selfile) 0] == "dir"} return 3738 set group [lindex $groups($selfile) 1] 3739 set n1 [lsearch $dirs $d1] 3740 set n2 [lsearch $dirs $d2] 3741 set i1 [lindex $group $n1] 3742 set i2 [lindex $group $n2] 3743 if {$i1 == 0 || $i2 == 0 || $i1 == $i2} return 3744 set changed 0 3745 copyfile $n2 $n1 $selfile 0 3746 if {$changed} redisplay 3747} 3748 3749proc maketextw {} { 3750 global textw texttop mergebut mpatchbut filemode textfont dirs 3751 toplevel .diffs 3752 wm title .diffs "Differences" 3753 frame .diffs.bar -relief sunken -border 2 3754 pack .diffs.bar -side top -fill x 3755 button .diffs.bar.rediff -text Rediff -command "diffnextfile 0" 3756 pack .diffs.bar.rediff -side left 3757 button .diffs.bar.options -text Options -command diffoptions 3758 pack .diffs.bar.options -side left 3759 button .diffs.bar.find -text Find -command "difffind :diffs .diffs.t" 3760 pack .diffs.bar.find -side left 3761 menubutton .diffs.bar.merge -text Merge -menu .diffs.bar.merge.m -padx 10 3762 menu .diffs.bar.merge.m -tearoff 0 3763 pack .diffs.bar.merge -side left 3764 menubutton .diffs.bar.mpatch -text Patch -menu .diffs.bar.mpatch.m -padx 10 3765 menu .diffs.bar.mpatch.m -tearoff 0 3766 pack .diffs.bar.mpatch -side left 3767 if {!$filemode} { 3768 button .diffs.bar.next -text "Next file" -command "diffnextfile 1" 3769 pack .diffs.bar.next -side left 3770 button .diffs.bar.prev -text "Previous file" -command "diffnextfile -1" 3771 pack .diffs.bar.prev -side left 3772 } 3773 button .diffs.bar.invert -text "Invert" -command "invertbuttons" 3774 pack .diffs.bar.invert -side left 3775 set texttop .diffs 3776 set textw .diffs.t 3777 set mergebut .diffs.bar.merge 3778 set mpatchbut .diffs.bar.mpatch 3779 set wid [expr 82 + 2 * [llength $dirs]] 3780 text $textw -width $wid -height 32 -yscrollcommand ".diffs.sb set" \ 3781 -font $textfont 3782 scrollbar .diffs.sb -command "$textw yview" 3783 pack .diffs.sb -side right -fill y 3784 pack $textw -side left -fill both -expand 1 3785 bind .diffs <Key-Prior> "$textw yview scroll -1 p" 3786 bind .diffs b "$textw yview scroll -1 p" 3787 bind .diffs B "$textw yview scroll -1 p" 3788 bind .diffs <Key-BackSpace> "$textw yview scroll -1 p" 3789 bind .diffs <Key-Delete> "$textw yview scroll -1 p" 3790 bind .diffs <Key-Next> "$textw yview scroll 1 p" 3791 bind .diffs <Key-space> "$textw yview scroll 1 p" 3792 bind .diffs <Key-Up> "$textw yview scroll -1 u" 3793 bind .diffs <Key-Down> "$textw yview scroll 1 u" 3794 bind .diffs d "$textw yview scroll \[expr \"int(\[$textw cget -height\]/2)\"\] u" 3795 bind .diffs D "$textw yview scroll \[expr \"int(\[$textw cget -height\]/2)\"\] u" 3796 bind .diffs u "$textw yview scroll \[expr \"int(-\[$textw cget -height\]/2)\"\] u" 3797 bind .diffs U "$textw yview scroll \[expr \"int(-\[$textw cget -height\]/2)\"\] u" 3798 bind .diffs n nextdiff 3799 bind .diffs p prevdiff 3800 if {!$filemode} { 3801 bind .diffs N "diffnextfile 1" 3802 bind .diffs P "diffnextfile -1" 3803 } 3804 bind .diffs q removediffs 3805 bind .diffs Q "set stopped 1; destroy ." 3806 bind .diffs <Key-Home> "$textw yview 1.0" 3807 bind .diffs g "$textw yview 1.0" 3808 bind .diffs <Key-End> "$textw yview -pickplace \[$textw index end\]" 3809 bind .diffs G "$textw yview -pickplace \[$textw index end\]" 3810 bind .diffs C copydifffile 3811} 3812 3813proc diffoptions {} { 3814 global optionw 3815 if {[info exists optionw] && [winfo exists $optionw]} { 3816 raise $optionw 3817 return 3818 } 3819 set optionw .options 3820 toplevel $optionw 3821 wm title .options "Dirdiff options" 3822 checkbutton $optionw.diffiflag -text "Ignore case" \ 3823 -offvalue "" -onvalue "-i" -anchor w 3824 pack $optionw.diffiflag -side top -fill x 3825 checkbutton $optionw.diffwflag -text "Ignore all white space" \ 3826 -offvalue "" -onvalue "-w" -anchor w 3827 pack $optionw.diffwflag -side top -fill x 3828 checkbutton $optionw.diffbflag -text "Ignore amount of white space" \ 3829 -offvalue "" -onvalue "-b" -anchor w 3830 pack $optionw.diffbflag -side top -fill x 3831 checkbutton $optionw.diffBflag -text "Ignore blank lines" \ 3832 -offvalue "" -onvalue "-B" -anchor w 3833 pack $optionw.diffBflag -side top -fill x 3834 checkbutton $optionw.diffdflag -text "Minimize diffs" \ 3835 -offvalue "" -onvalue "-d" -anchor w 3836 pack $optionw.diffdflag -side top -fill x 3837 checkbutton $optionw.ultabs -text "Underline tabs" -anchor w \ 3838 -variable underlinetabs -command changeunderlinetabs 3839 pack $optionw.ultabs -side top -fill x 3840 checkbutton $optionw.newfirst -text "Newer file first" -anchor w \ 3841 -variable diffnewfirst 3842 pack $optionw.newfirst -side top -fill x 3843 frame $optionw.ctx 3844 pack $optionw.ctx -side top 3845 label $optionw.ctx.l -text "Lines of context: " 3846 pack $optionw.ctx.l -side left 3847 entry $optionw.ctx.v -width 5 -textvariable ctxlines 3848 pack $optionw.ctx.v -side left 3849 button $optionw.save -text "Save options" -command saveoptions 3850 pack $optionw.save -side top -fill x 3851 frame $optionw.space -height 6 3852 pack $optionw.space -side top -fill x 3853 button $optionw.dismiss -text "Dismiss" -command "destroy $optionw" 3854 pack $optionw.dismiss -side bottom -fill x 3855 bind $optionw <Return> "destroy $optionw" 3856} 3857 3858proc saveoptions {} { 3859 global rcsflag diffiflag diffwflag diffbflag diffBflag diffdflag 3860 global ctxlines showsame underlinetabs nukefiles redisp_immed 3861 global diffprogram showprogram 3862 global diffnewfirst textfont filelistfont nxdirmode 3863 global docvsignore 3864 set f [open "~/.dirdiff" w] 3865 puts $f [list set diffprogram $diffprogram] 3866 puts $f [list set showprogram $showprogram] 3867 puts $f [list set rcsflag $rcsflag] 3868 puts $f [list set diffiflag $diffiflag] 3869 puts $f [list set diffwflag $diffwflag] 3870 puts $f [list set diffbflag $diffbflag] 3871 puts $f [list set diffBflag $diffBflag] 3872 puts $f [list set diffdflag $diffdflag] 3873 puts $f [list set ctxlines $ctxlines] 3874 puts $f [list set showsame $showsame] 3875 puts $f [list set underlinetabs $underlinetabs] 3876 puts $f [list set redisp_immed $redisp_immed] 3877 puts $f [list set diffnewfirst $diffnewfirst] 3878 puts $f [list set nukefiles $nukefiles] 3879 puts $f [list set filelistfont $filelistfont] 3880 puts $f [list set textfont $textfont] 3881 puts $f [list set nxdirmode $nxdirmode] 3882 puts $f [list set docvsignore $docvsignore] 3883 close $f 3884} 3885 3886proc difffind {tag txt} { 3887 global dfindw$tag igncase$tag diffiflag regexp$tag backwards$tag 3888 if {[info exists dfindw$tag] && [winfo exists [set dfindw$tag]]} { 3889 raise [set dfindw$tag] 3890 return 3891 } 3892 set w .find$tag 3893 set dfindw$tag $w 3894 toplevel $w 3895 wm title $w "Dirdiff: Find" 3896 frame $w.f 3897 pack $w.f -side top -fill x -expand 1 3898 button $w.f.b -text "Find:" -command [list dofind $tag $txt $w] 3899 bind $w <Return> [list dofind $tag $txt $w] 3900 pack $w.f.b -side left 3901 entry $w.f.e 3902 pack $w.f.e -side right 3903 if {![info exists igncase$tag]} { 3904 set igncase$tag [expr {$diffiflag != {}}] 3905 } 3906 checkbutton $w.case -variable igncase$tag -text "Ignore case" -anchor w 3907 pack $w.case -side top -fill x 3908 checkbutton $w.regexp -variable regexp$tag -text "Regular expression" \ 3909 -anchor w 3910 pack $w.regexp -side top -fill x 3911 checkbutton $w.backwards -variable backwards$tag \ 3912 -text "Search backwards" -anchor w 3913 pack $w.backwards -side top -fill x 3914 button $w.close -text "Close" -command "destroy $w" 3915 pack $w.close -side top -fill x 3916} 3917 3918proc dofind {tag txt w} { 3919 global dfindw$tag igncase$tag regexp$tag backwards$tag 3920 if {![winfo exists $txt]} return 3921 set w [set dfindw$tag] 3922 set str [$w.f.e get] 3923 if {$str == {}} return 3924 set back [set backwards$tag] 3925 # By default, start the search from the insertion point. 3926 # If there is a selection, start from the end of the selection for 3927 # a forwards search, or from the beginning for a backwards search. 3928 set start [$txt index insert] 3929 if {[$txt tag ranges sel] != {}} { 3930 if {$back} { 3931 set start [$txt index sel.first] 3932 } else { 3933 set start [$txt index sel.last] 3934 } 3935 } 3936 set opts {} 3937 if {$back} { 3938 lappend opts "-backwards" 3939 } 3940 if {[set regexp$tag]} { 3941 lappend opts "-regexp" 3942 } 3943 if {[set igncase$tag]} { 3944 lappend opts "-nocase" 3945 } 3946 set pos [eval $txt search $opts -count count -- [list $str] $start] 3947 if {$pos == {}} { 3948 bell 3949 return 3950 } 3951 set epos "$pos + $count c" 3952 $txt mark set insert $epos 3953 $txt tag remove sel 0.0 end 3954 $txt tag add sel $pos $epos 3955 $txt see $epos 3956 $txt see $pos 3957} 3958 3959proc makepatch {d1 d2} { 3960 global patchnum selfile patchfiles patch_outfile 3961 global showprogram 3962 3963 set files [secondarysel $selfile] 3964 if {$files == {}} { 3965 error_popup "No files selected!" 3966 return 3967 } 3968 if {![info exists patchnum]} { 3969 set patchnum 0 3970 } 3971 set patchfiles($patchnum) $files 3972 3973 # Put the diff in a temporary file for external viewer 3974 if { [llength $showprogram] > 0} { 3975 set patch_outfile "patch${patchnum}.diff" 3976 set w [open $patch_outfile w] 3977 # Or build our own viewer 3978 } else { 3979 set w ".patch:$patchnum" 3980 catch {destroy $w} 3981 toplevel $w 3982 wm title $w "Patch: $d1 to $d2" 3983 frame $w.bar -relief raised -border 2 3984 pack $w.bar -side top -fill x 3985 menubutton $w.bar.file -text File -menu $w.bar.file.m -padx 10 -pady 1 3986 menu $w.bar.file.m -tearoff 0 3987 $w.bar.file.m add command -label Save -command "savepatch $w" 3988 $w.bar.file.m add command -label Close -command "destroy $w" 3989 pack $w.bar.file -side left 3990 menubutton $w.bar.edit -text Edit -menu $w.bar.edit.m -padx 10 -pady 1 3991 menu $w.bar.edit.m -tearoff 0 3992 $w.bar.edit.m add command -label Cut -command "tk_textCut $w.t" 3993 $w.bar.edit.m add command -label Copy -command "tk_textCopy $w.t" 3994 $w.bar.edit.m add command -label Paste -command "tk_textPaste $w.t" 3995 $w.bar.edit.m add command -label Find \ 3996 -command "difffind :patch:$patchnum $w.t" 3997 pack $w.bar.edit -side left 3998 frame $w.f -relief sunk -border 2 3999 label $w.f.l -text "Filename: " 4000 entry $w.f.filename 4001 $w.f.filename insert 0 "patch$patchnum" 4002 pack $w.f.l -side left 4003 pack $w.f.filename -side left -fill x -expand 1 4004 pack $w.f -side top -fill x 4005 text $w.t -yscrollcommand "$w.sb set" 4006 scrollbar $w.sb -command "$w.t yview" 4007 pack $w.sb -side right -fill y 4008 pack $w.t -side left -fill both -expand 1 4009 bind $w <Key-Prior> "$w.t yview scroll -1 p" 4010 bind $w <Key-Next> "$w.t yview scroll 1 p" 4011 } 4012 4013 patchnext $patchnum $w $d1 $d2 0 4014 incr patchnum 4015} 4016 4017# Output lines to either our external patchfile or the internal vieiwer 4018proc lineout {w line} { 4019 if {[string match ".*" $w]} { 4020 $w.t insert end "$line\n" 4021 } else { 4022 puts $w "$line" 4023 } 4024} 4025 4026proc patchnext {pnum w d1 d2 i} { 4027 global patchfiles have_unidiff showprogram patch_outfile nullfile 4028 4029 set contextopt [expr {$have_unidiff ? "-u" : "-c"}] 4030 update 4031 for {} {[set f [lindex $patchfiles($pnum) $i]] != {}} {incr i} { 4032 set p1 [joinname $d1 $f] 4033 set p2 [joinname $d2 $f] 4034 if {[file exists $p1] && [file exists $p2]} { 4035 set fh [open "|diff $contextopt $p1 $p2" r] 4036 } elseif {[file exists $p1] && ! [file exists $p2]} { 4037 set fh [open "|diff $contextopt $p1 $nullfile" r] 4038 } elseif {! [file exists $p1] && [file exists $p2]} { 4039 set fh [open "|diff $contextopt $nullfile $p2" r] 4040 } else { 4041 continue 4042 } 4043 fconfigure $fh -blocking 0 4044 fileevent $fh readable "readpatch $fh $pnum $w $d1 $d2 $i \"$f\"" 4045 return 4046 } 4047 if {[string match ".*" $w]} { 4048 $w.t delete "end - 1c" end 4049 } else { 4050 close $w 4051 eval "exec $showprogram \"$patch_outfile\" &" 4052 # Should we remove the tempfile here? We don't have it if we used 4053 # the internal viewer 4054 } 4055 unset patchfiles($pnum) 4056} 4057 4058proc diffl_out {w d1 d2 f} { 4059 global have_unidiff 4060 set contextopt [expr {$have_unidiff ? "-urN" : "-cr"}] 4061 lineout $w "diff $contextopt [joinname $d1 $f] [joinname $d2 $f]" 4062} 4063 4064proc readpatch {difff pnum w d1 d2 i f} { 4065 global have_unidiff showprogram 4066 set n [gets $difff line] 4067 if {$n < 0} { 4068 if {![eof $difff]} return 4069 catch {close $difff} 4070 patchnext $pnum $w $d1 $d2 [expr $i+1] 4071 return 4072 } 4073 if {[string match "Binary*" $line]} return 4074 if {$have_unidiff} { 4075 if {[string match "---*" $line]} { 4076 diffl_out $w $d1 $d2 $f 4077 } 4078 } else { 4079 if {[string match "\*\*\* ${d1}*" $line]} { 4080 diffl_out $w $d1 $d2 $f 4081 } 4082 } 4083 lineout $w $line 4084} 4085 4086proc savepatch {w} { 4087 set outfile [$w.f.filename get] 4088 if {$outfile == {}} {return} 4089 set outf [open $outfile w] 4090 puts -nonewline $outf [$w.t get 0.0 end] 4091 close $outf 4092 destroy $w 4093} 4094 4095# invoked from the File->Touch menu item 4096proc touchfiles {d} { 4097 global selfile 4098 set files [secondarysel $selfile] 4099 if {$files == {}} { 4100 error_popup "No files selected!" 4101 return 4102 } 4103 set now [clock seconds] 4104 set bad {} 4105 foreach f $files { 4106 set df [file join $d $f] 4107 if {[catch {file mtime $df $now} err]} { 4108 append bad "$df: $err\n" 4109 } 4110 } 4111 if {$bad != {}} { 4112 error_popup "Errors occurred:\n$bad" 4113 } 4114 redifffiles 4115} 4116 4117proc exclfilelist {} { 4118 global exclw nukefiles 4119 if {[info exists exclw] && [winfo exists $exclw]} { 4120 raise $exclw 4121 return 4122 } 4123 toplevel .excl 4124 wm title .excl "Dirdiff: excluded files" 4125 set exclw .excl 4126 frame $exclw.b 4127 listbox $exclw.l -height 10 -width 40 -yscrollcommand "$exclw.sb set" \ 4128 -selectmode single 4129 scrollbar $exclw.sb -command "$exclw.l yview" 4130 entry $exclw.e 4131 pack $exclw.b -side bottom -fill x 4132 pack $exclw.e -side bottom -fill x 4133 pack $exclw.sb -side right -fill y 4134 pack $exclw.l -side left -fill both -expand 1 4135 button $exclw.b.add -text "Add" -padx 20 -command addexcl 4136 button $exclw.b.rem -text "Remove" -command remexcl 4137 button $exclw.b.close -text "Close" -command closeexcl 4138 pack $exclw.b.add -side left -fill x 4139 pack $exclw.b.rem -side left -fill x 4140 pack $exclw.b.close -side right -fill x 4141 bind $exclw.e <Return> "addexcl" 4142 foreach i $nukefiles { 4143 $exclw.l insert end $i 4144 } 4145} 4146 4147proc addexcl {} { 4148 global exclw nukefiles 4149 if {[info exists exclw] && [winfo exists $exclw]} { 4150 set e [$exclw.e get] 4151 if {$e != {}} { 4152 $exclw.l insert end $e 4153 lappend nukefiles $e 4154 $exclw.l see end 4155 } 4156 } 4157} 4158 4159proc remexcl {} { 4160 global exclw nukefiles 4161 if {[info exists exclw] && [winfo exists $exclw]} { 4162 set s [$exclw.l curselection] 4163 if {$s != {}} { 4164 $exclw.l delete $s 4165 set nukefiles [lreplace $nukefiles $s $s] 4166 } 4167 } 4168} 4169 4170proc exclsel {} { 4171 global selfile nukefiles exclw 4172 set files [secondarysel $selfile] 4173 foreach f $files { 4174 set df [string trimright $f /] 4175 if {$df != {}} { 4176 lappend nukefiles $df 4177 if {[info exists exclw] && [winfo exists $exclw]} { 4178 $exclw.l insert end $df 4179 } 4180 } 4181 } 4182 redisplay 4183} 4184 4185proc extprograms {} { 4186 global showprogram diffprogram 4187 toplevel .ext 4188 frame .ext.top 4189 label .ext.top.diffl -text "Diff Viewing/Merging" 4190 entry .ext.top.diffe -textvariable diffprogram 4191 label .ext.top.showl -text "File Viewing" 4192 entry .ext.top.showe -textvariable showprogram 4193 grid .ext.top.diffl -row 0 -column 0 -sticky e 4194 grid .ext.top.diffe -row 0 -column 1 -sticky nsew -pady 4 4195 grid .ext.top.showl -row 1 -column 0 -sticky e 4196 grid .ext.top.showe -row 1 -column 1 -sticky nsew -pady 4 4197 grid columnconfigure .ext.top 0 -weight 0 4198 grid columnconfigure .ext.top 1 -weight 1 4199 pack .ext.top -fill x -expand yes 4200 frame .ext.bot 4201 button .ext.bot.ok -text "OK" \ 4202 -command { 4203 destroy .ext 4204 } 4205 pack .ext.bot .ext.bot.ok -fill x -expand yes 4206} 4207 4208proc closeexcl {} { 4209 global exclw 4210 catch {destroy $exclw} 4211 catch {unset exclw} 4212} 4213 4214proc secondarysel {fname} { 4215 global secsel canvw 4216 set files {} 4217 foreach it [array names secsel] { 4218 lappend files [$canvw itemcget $it -text] 4219 } 4220 if {$files == {}} { 4221 if {$fname == {}} { 4222 return {} 4223 } 4224 set files [list $fname] 4225 } 4226 return [lsort $files] 4227} 4228 4229proc copyselfile {src dst fname confirm} { 4230 global dirs changed 4231 set files [secondarysel $fname] 4232 set n [llength $files] 4233 set changed 0 4234 if {$n == 1} { 4235 copyfile $src $dst $fname $confirm 4236 } else { 4237 if {$confirm} { 4238 set sd [lindex $dirs $src] 4239 set dd [lindex $dirs $dst] 4240 if {![confirm_popup "Copy $n older files from $sd to $dd?"]} { 4241 return 4242 } 4243 } 4244 foreach f $files { 4245 copyfile $src $dst $f 0 4246 } 4247 } 4248 if {$changed} redisplay 4249 after idle selcurfile 4250} 4251 4252proc copyfile {src dst fname confirm} { 4253 global dirs filemode 4254 set sd [lindex $dirs $src] 4255 set dd [lindex $dirs $dst] 4256 set srcf [joinname $sd $fname] 4257 set dstf [joinname $dd $fname] 4258 if {$filemode} { 4259 set msg "$src to $dst" 4260 set copydst $dstf 4261 } else { 4262 set msg "$fname from $sd to $dd" 4263 set copydst [file dirname $dstf] 4264 } 4265 if {$confirm} { 4266 if {![confirm_popup "Copy older $msg?"]} { 4267 return 4268 } 4269 } 4270 set z [string trimright $fname /] 4271 if {$z != $fname} { 4272 copydir $src $dst $z 4273 return 4274 } 4275 scmedit $dstf 4276 if [catch {file copy -force -- $srcf $copydst} err] { 4277 error_popup "Error copying $msg: $err" 4278 } else { 4279 scmnew $dstf 4280 updatecline $src $dst $fname 4281 } 4282} 4283 4284proc copydir {src dst dname} { 4285 global dirs groups alllines 4286 set sn [lindex $dirs $src] 4287 set dn [lindex $dirs $dst] 4288 if [catch {exec cp -p -r $sn/$dname [file dirname $dn/$dname]} err] { 4289 error_popup "Error copying $dname from $sn to $dn: $err" 4290 return 4291 } 4292 foreach f $alllines { 4293 if [string match $dname* $f] { 4294 updatecline $src $dst $f 4295 } 4296 } 4297} 4298 4299proc scmedit {name} { 4300} 4301 4302proc scmnew {name} { 4303} 4304 4305proc removeselfile {dst fname} { 4306 global groupelts dirs changed 4307 set files [secondarysel $fname] 4308 if {$files == {}} return 4309 set nf 0 4310 set nd 0 4311 foreach x $files { 4312 if {[string range $x end end] == "/"} { 4313 incr nd 4314 } else { 4315 incr nf 4316 } 4317 } 4318 set dd [lindex $dirs $dst] 4319 if {$nd + $nf == 1} { 4320 set x [string trimright [joinname $dd $fname] /] 4321 if {![confirm_popup "Remove $x?"]} { 4322 return 4323 } 4324 } else { 4325 set stuff "Remove " 4326 if {$nd > 0} { 4327 if {$nd == 1} { 4328 append stuff "1 directory " 4329 } else { 4330 append stuff "$nd directories " 4331 } 4332 if {$nf > 0} { 4333 append stuff "and " 4334 } 4335 } 4336 if {$nf == 1} { 4337 append stuff "1 file " 4338 } elseif {$nf > 1} { 4339 append stuff "$nf files " 4340 } 4341 append stuff "from $dd?" 4342 if {![confirm_popup $stuff]} { 4343 return 4344 } 4345 } 4346 set changed 0 4347 foreach f $files { 4348 set d [string trimright $f /] 4349 set dstf [joinname $dd $d] 4350 if {$d == $f} { 4351 set bad [catch {file delete $dstf} err] 4352 } else { 4353 set bad [catch {file delete -force $dstf} err] 4354 } 4355 if $bad { 4356 error_popup "Error deleting $dstf: $err" 4357 } else { 4358 updatecline [lindex $groupelts(0) 0] $dst $f 4359 } 4360 } 4361 if {$changed} redisplay 4362 after idle selcurfile 4363} 4364 4365proc confirm_popup msg { 4366 global confirm_ok 4367 set confirm_ok 0 4368 set w .confirm 4369 toplevel $w 4370 wm transient $w . 4371 message $w.m -text $msg -justify center -aspect 400 4372 pack $w.m -side top -fill x -padx 20 -pady 20 4373 button $w.ok -text OK -command "set confirm_ok 1; destroy $w" 4374 pack $w.ok -side left -fill x 4375 button $w.cancel -text Cancel -command "destroy $w" 4376 pack $w.cancel -side right -fill x 4377 bind $w <Visibility> "grab $w; focus $w" 4378 tkwait window $w 4379 return $confirm_ok 4380} 4381 4382proc error_popup msg { 4383 set w .error 4384 toplevel $w 4385 wm transient $w . 4386 message $w.m -text $msg -justify center -aspect 400 4387 pack $w.m -side top -fill x -padx 20 -pady 20 4388 button $w.ok -text OK -command "destroy $w" 4389 pack $w.ok -side bottom -fill x 4390 bind $w <Visibility> "grab $w; focus $w" 4391 tkwait window $w 4392} 4393 4394proc notalldirs {dirs} { 4395 set type "" 4396 foreach d $dirs { 4397 if {[catch {file lstat $d stat} err]} { 4398 puts stderr $err 4399 exit 1 4400 } 4401 if {$type == ""} { 4402 set type $stat(type) 4403 } elseif {$type != $stat(type)} { 4404 puts stderr "Error: $d is a $stat(type) but [lindex $dirs 0] is a $type" 4405 exit 1 4406 } 4407 } 4408 return [expr {$type == "file"}] 4409} 4410 4411proc go {} { 4412 global diffing filemode dirs nextserial 4413 if {[llength $dirs] == 0} {exit 0} 4414 set diffing 0 4415 set nextserial 0 4416 set filemode [notalldirs $dirs] 4417 icons 4418 makewins 4419 initcanv 4420 resetsel 4421 removediffs 4422 update 4423 canvdiffs 4424} 4425 4426proc rediff {} { 4427 initcanv 4428 resetsel 4429 removediffs 4430 update 4431 canvdiffs 4432} 4433 4434proc repackgroups {gr} { 4435 if {[lindex $gr 0] == "dir"} { 4436 return $gr 4437 } 4438 set glist [lindex $gr 1] 4439 set glsort [lsort $glist] 4440 set ng(0) 0 4441 set lg 0 4442 set gc 0 4443 foreach e $glsort { 4444 if {$e != $lg} { 4445 set lg $e 4446 incr gc 4447 set ng($e) $gc 4448 } 4449 } 4450 if {$gc == [lindex $gr 0]} { 4451 return $gr 4452 } 4453 set newlist {} 4454 foreach e $glist { 4455 lappend newlist $ng($e) 4456 } 4457 return [list $gc $newlist] 4458} 4459 4460proc interesting_line {gr} { 4461 global dirinterest dirs showsame 4462 if {$gr == {}} { 4463 return 0 4464 } 4465 if {$showsame} { 4466 return 1 4467 } 4468 set glist [lindex $gr 1] 4469 set i 0 4470 foreach e $glist { 4471 if $dirinterest($i) { 4472 if {[info exists first]} { 4473 if {$e != $first} { 4474 return 1 4475 } 4476 } else { 4477 set first $e 4478 } 4479 } 4480 incr i 4481 } 4482 return 0 4483} 4484 4485proc redisplay {{zapdiffs 0}} { 4486 global canvw canvy canvy0 alllines groups ruletype linespc stringx 4487 global ruletype selfile secsel ycoord filemode redisp_immed 4488 if {$filemode || !($zapdiffs || $redisp_immed)} return 4489 set y [expr {[lindex [$canvw yview] 0] * $canvy}] 4490 set i [textitemat [expr {$stringx+5}] [expr {$y + $linespc/2}]] 4491 set topy 0 4492 set topline {} 4493 if {$i != {}} { 4494 set topline [$canvw itemcget $i -text] 4495 } 4496 if {$zapdiffs} { 4497 removediffs 4498 } else { 4499 set filesel $selfile 4500 set filesecsel [secondarysel $selfile] 4501 } 4502 $canvw delete all 4503 set canvy $canvy0 4504 $canvw conf -scrollregion "0 0 0 1" 4505 catch {unset ycoord} 4506 resetsel 4507 foreach f $alllines { 4508 if {$f == $topline} { 4509 set topy $canvy 4510 } 4511 set gr $groups($f) 4512 if {$gr != {} && [notnuked [string trimright $f /]]} { 4513 set gr [repackgroups $gr] 4514 set groups($f) $gr 4515 if {[interesting_line $gr]} { 4516 displine $gr $f 4517 } 4518 } 4519 } 4520 if {[info exists ruletype]} { 4521 ruleoff $ruletype 4522 } 4523 if {$canvy > 0} { 4524 $canvw yview moveto [expr {$topy * 1.0 / $canvy}] 4525 } else { 4526 $canvw yview moveto 0 4527 } 4528 if {!$zapdiffs} { 4529 foreach f $filesecsel { 4530 set i [itemofname $f] 4531 if {$i != {}} { 4532 addsecsel $i 4533 } 4534 } 4535 set i [itemofname $filesel] 4536 if {$i != {}} { 4537 selectitem $i 4538 addsecsel $i 4539 } 4540 selcurfile 4541 } 4542} 4543 4544proc icons {} { 4545 global agecolors 4546 4547 image create photo ex \ 4548 -format gif -data { 4549R0lGODlhEAANAIAAAAAAAP///yH+Dk1hZGUgd2l0aCBHSU1QACH5BAEAAAEA 4550LAAAAAAQAA0AAAIgjI95ABqcWENSVXMtzE5CR30g5o3PJkYiR05LenauqRQA 4551Ow== 4552} 4553 image create photo folder \ 4554 -format gif -data { 4555R0lGODlhEAANAMIAAISEhMbGxv/si////wAAAAAAAAAAAAAAACH+Dk1hZGUg 4556d2l0aCBHSU1QACH5BAEAAAQALAAAAAAQAA0AAAMoSATM+nAFQUUAUYFZ6W3g 4557II4kyQxd2p1qy7bpC1fyLNQzDusu6P+ABAA7 4558} 4559 image create photo paper \ 4560 -format gif -data { 4561R0lGODlhEAANAKEAAISEhP///8bGxgAAACH+Dk1hZGUgd2l0aCBHSU1QACH5 4562BAEAAAMALAAAAAAQAA0AAAIp3ICpxhcPAxCgufhAoE1jmXRfVDHeKIloaq6s 4563cY4l7M4XasdfrvSIUQAAOw== 4564} 4565 image create photo paper_green \ 4566 -format gif -data { 4567R0lGODlhEAANAMIAAP///4SEhP7/vsbGxgDKAP///////////yH5BAEAAAcALAAAAAAQAA0A 4568AAMoeBfcrnCRSUmwUdZ5Mezb821hBJKecpKBiVLt+KbaG6szvZaf4zOKBAA7 4569} 4570 image create photo paper_yellowgreen \ 4571 -format gif -data { 4572R0lGODlhEAANAMIAAP///4SEhP7/vsbGxgCAAACAQNLmAP///yH5BAEAAAcALAAAAAAQAA0A 4573AAMoeBfcrnCZSU2wUdZ5Mezb821hBJKecpKBiVLt+KbaG6szvZaf4zOKBAA7 4574} 4575 image create photo paper_yellow \ 4576 -format gif -data { 4577R0lGODlhEAANAMIAAP///4SEhPfhAMbGxv///////////////yH5BAEAAAMALAAAAAAQAA0A 4578AAMoOBPcrnCJSUWwUdZ5Mezb821hBJKecpKBiVLt+KbaG6szvZaf4zOKBAA7 4579} 4580 image create photo paper_orange \ 4581 -format gif -data { 4582R0lGODlhEAANAMIAAP///4SEhOxzAMbGxv///////////////yH5BAEAAAMALAAAAAAQAA0A 4583AAMoOBPcrnCJSUWwUdZ5Mezb821hBJKecpKBiVLt+KbaG6szvZaf4zOKBAA7 4584} 4585 image create photo paper_red \ 4586 -format gif -data { 4587R0lGODlhEAANAKEAAISEhOE+IbchAP///yH5BAEAAAMALAAAAAAQAA0AAAIo3ICpxhcPA5DN 4588xQcEZfPK1HQeFo4QUJqbIY4op66W+bJxPbuhwiNGAQA7 4589} 4590 4591 4592 set agecolors(dir) {ex folder} 4593 set agecolors(0) {ex} 4594 set agecolors(1) {ex paper} 4595 set agecolors(2) {ex paper_green paper_red} 4596 set agecolors(3) {ex paper_green paper_yellow paper_red} 4597 set agecolors(4) {ex paper_green paper_yellow paper_orange paper_red} 4598 set agecolors(5) {ex paper_green paper_yellowgreen paper_yellow paper_orange paper_red} 4599} 4600 4601proc midy {bbox} { 4602 return [expr ([lindex $bbox 1] + [lindex $bbox 3]) / 2] 4603} 4604 4605proc search_canvas {} { 4606 global canvw selfile clickitem clickmode clicky 4607 set search $selfile 4608 resetsel 4609 update 4610 set str_items [$canvw find withtag strings] 4611 foreach idx $str_items { 4612 set name [$canvw itemcget $idx -text] 4613 if {[string match "*$search*" $name]} { 4614 set selitem $idx 4615 $canvw select from $idx 0 4616 $canvw select to $idx end 4617 set clickitem $idx 4618 set clicky [midy [$canvw bbox $clickitem]] 4619 set clickmode 1 4620 selcurfile 4621 addsecsel $idx 4622 } 4623 } 4624} 4625 4626if {![info exists dirs]} { 4627 global onlyfiles ctxlines showsame 4628 set dirs {} 4629 set ok 1 4630 set argc [llength $argv] 4631 set moreopts 1 4632 for {set i 0} {$i < $argc} {incr i} { 4633 set arg [lindex $argv $i] 4634 if {$moreopts && [string range $arg 0 0] == "-"} { 4635 switch -regexp -- $arg { 4636 "--" { 4637 set moreopts 0 4638 } 4639 "-a|--all" { 4640 set nukefiles {} 4641 } 4642 "-o|--only" { 4643 incr i 4644 if {$i < $argc} { 4645 lappend onlyfiles [lindex $argv $i] 4646 set nukefiles {} 4647 } else { 4648 puts stderr "no argument given to $arg option" 4649 set ok 0 4650 } 4651 } 4652 "-I|--ignore" { 4653 incr i 4654 if {$i < $argc} { 4655 ignorefile [lindex $argv $i] 4656 } else { 4657 puts stderr "no argument given to $arg option" 4658 set ok 0 4659 } 4660 } 4661 "-r|--rcs" { 4662 if $nofilecmp { 4663 puts stderr "can't use $arg: libfilecmp.so.0.0 couldn't be loaded" 4664 set ok 0 4665 } 4666 set rcsflag "-rcs" 4667 } 4668 "-c|--context" { 4669 incr i 4670 if {$i < $argc} { 4671 set ctxlines [lindex $argv $i] 4672 } else { 4673 puts stderr "no argument given to $arg option" 4674 set ok 0 4675 } 4676 } 4677 "-D|--maxdepth" { 4678 incr i 4679 if {$i < $argc} { 4680 set maxdepth [lindex $argv $i] 4681 } else { 4682 puts stderr "no argument given to $arg option" 4683 set ok 0 4684 } 4685 } 4686 "-b" { set diffbflag "-b" } 4687 "-w" { set diffwflag "-w" } 4688 "-B" { set diffBflag "-B" } 4689 "-i" { set diffiflag "-i" } 4690 "-d" { set diffdflag "-d" } 4691 "-S" { set showsame 1 } 4692 "-C" { set docvsignore 1 } 4693 "-h|--help" { 4694 usage 4695 exit 0 4696 } 4697 default { 4698 puts stderr "unrecognized option $arg" 4699 set ok 0 4700 } 4701 } 4702 } elseif {$arg != {}} { 4703 lappend dirs $arg 4704 } 4705 } 4706 if {$ok && [llength $dirs] == 0} { 4707 # Ask for directories if they weren't on the command line 4708 wm withdraw . 4709 NewDirDialog 4710 #set dirs [list $d0 $d1 $d2 $d3 $d4] 4711 # Prune out the empty entries 4712 set newlist {} 4713 for {set i 0} {$i < [llength $dirs]} {incr i} { 4714 if {[lindex $dirs $i] != {} } { 4715 lappend newlist [lindex $dirs $i] 4716 } 4717 } 4718 set dirs $newlist 4719 if {[llength $dirs] < 2 } { 4720 # Can't user error_popup here without de-iconifying . first 4721 tk_dialog .err "Error" "Need at least 2 directories" error 0 {OK} 4722 set ok 0 4723 } 4724 wm deiconify . 4725 } 4726 if {!$ok} {exit 1} 4727 set newd {} 4728 foreach d $dirs { 4729 set x [glob -nocomplain $d] 4730 if {$x == {}} { 4731 set x $d 4732 } 4733 set newd [concat $newd $x] 4734 } 4735 if {[llength $newd] > 5} { 4736 puts stderr "Error: more than 5 directories or files specified" 4737 exit 1 4738 } 4739 set dirs $newd 4740 set doit 1 4741} 4742 4743if [info exists doit] {go} 4744 4745