"Fossies" - the Fresh Open Source Software Archive

Member "dirdiff-2.1/dirdiff" (19 Apr 2005, 128833 Bytes) of package /linux/privat/old/dirdiff-2.1.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Bash source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

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