#!/bin/sh
# Tcl ignores the next line \
exec wish "$0" -- "${1+$@}"

# Copyright (C) 1999-2001 Paul Mackerras.  All rights reserved.
# This program is free software; it may be used, copied, modified
# and distributed under the terms of the GNU General Public Licence,
# either version 2, or (at your option) any later version.

set nofilecmp [catch {load libfilecmp.so.0.0}]
set rcsflag {}
set diffbflag {}
set diffBflag {}
set diffiflag {}
set diffwflag {}
set diffdflag {}
set ctxlines 3
set showsame 0
set underlinetabs 0
set bitkeeper 0
set bkgetmode " "
set redisp_immed 1
set nukefiles {*.o *~ *.orig CVS *.a *.link *.old *.save .depend .*.flags SCCS}

set agecolors(dir) {black white}
set agecolors(0) {black}
set agecolors(1) {black green}
set agecolors(2) {black green red}
set agecolors(3) {black green yellow red}
set agecolors(4) {black green yellow orange red}
set agecolors(5) {black green #d0ff00 yellow orange red}

set bgcolors(2) {x green "#ff8080"}
set bgcolors(3) {x green yellow "#ff8080"}
set bgcolors(4) {x green yellow orange "#ff8080"}
set bgcolors(5) {x green "#e0ff90" yellow orange "#ff8080"}

set linespc 15
set numlines 20
set canvy0 0
set canvy 0
set canvx 0
set blotw 12
set bloth 12
set blotspc 15

proc ignorefile pat {
    global nukefiles
    if {$pat == "!"} {
	set nukefiles {}
    } else {
	lappend nukefiles $pat
    }
}

catch {source ~/.dirdiff}

proc usage {} {
    puts stderr {Usage: dirdiff [options]... dir1 dir2 ...

Options:
   -a, --all		don't exclude any files
   -o, --only pattern	only process files matching pattern
   -I, --ignore pattern	don't process files matching pattern
   -r, --rcs		ignore differences in RCS strings
   -t, --bktag		ignore differences in Bitkeeper strings
   -c, --context num	set number of lines of context to show
   -b, -w, -B, -i, -d	pass these on to diff(1)
   -S			show files that are the same in the file list
   -K			Bitkeeper support

Note: dirdiff needs to be able to load the libfilecmp.so.0.0 shared library
for the -r or -t flags to work.}
}

if {![info exists dirs]} {
    global onlyfiles ctxlines showsame
    set dirs {}
    set ok 1
    set argc [llength $argv]
    set moreopts 1
    for {set i 0} {$i < $argc} {incr i} {
	set arg [lindex $argv $i]
	if {$moreopts && [string range $arg 0 0] == "-"} {
	    switch -regexp -- $arg {
		"--" {
		    set moreopts 0
		}
		"-a|--all" {
		    set nukefiles {}
		}
		"-o|--only" {
		    incr i
		    if {$i < $argc} {
			lappend onlyfiles [lindex $argv $i]
			set nukefiles {}
		    } else {
			puts stderr "no argument given to $arg option"
			set ok 0
		    }
		}
		"-I|--ignore" {
		    incr i
		    if {$i < $argc} {
			ignorefile [lindex $argv $i]
		    } else {
			puts stderr "no argument given to $arg option"
			set ok 0
		    }
		}
		"-r|--rcs" {
		    if $nofilecmp {
			puts stderr "can't use $arg: libfilecmp.so.0.0 couldn't be loaded"
			set ok 0
		    }
		    set rcsflag "-rcs"
		}
		"-t|--bktag" {
		    if $nofilecmp {
			puts stderr "can't use $arg: libfilecmp.so.0.0 couldn't be loaded"
			set ok 0
		    }
		    set rcsflag "-bk"
		}
		"-c|--context" {
		    incr i
		    if {$i < $argc} {
			set ctxlines [lindex $argv $i]
		    } else {
			puts stderr "no argument given to $arg option"
			set ok 0
		    }
		}
		"-b" { set diffbflag "-b" }
		"-w" { set diffwflag "-w" }
		"-B" { set diffBflag "-B" }
		"-i" { set diffiflag "-i" }
		"-d" { set diffdflag "-d" }
		"-S" { set showsame 1 }
		"-K" { set bitkeeper 1 }
		"-h|--help" {
		    usage
		    exit 0
		}
		default {
		    puts stderr "unrecognized option $arg"
		    set ok 0
		}
	    }
	} elseif {$arg != {}} {
	    lappend dirs [string trimright $arg /]
	}
    }
    if {$ok && [llength $dirs] == 0} {
	usage
	set ok 0
    }
    if {!$ok} {exit 1}
    set doit 1
}

proc addfiles {sd} {
    global dirs stat onlyfiles statinfo fserial nextserial
    global filetype filesize filetime
    foreach d $dirs {
	foreach f [lsort [glob -nocomplain $d/$sd* $d/$sd.*]] {
	    set fs $sd[file tail $f]
	    set wantim 0
	    if [notnuked $fs] {
		if {[catch {file lstat $f stat}] == 0} {
		    if {$stat(type) == "file"} {
			if [info exists onlyfiles] {
			    foreach o $onlyfiles {
				if [string match $o $fs] {
				    set wantim 1
				    break
				}
			    }
			} else {
			    set wantim 1
			}
		    } elseif {$stat(type) == "directory"} {
			append fs /
			set wantim 1
		    }
		}
	    }
	    if {$wantim} {
		if {![info exists files($fs)]} {
		    set fserial($fs) [incr nextserial]
		    set files($fs) 1
		}
		set filetype($f) $stat(type)
		set filesize($f) $stat(size)
		set filetime($f) $stat(mtime)
	    }
#	    update
	}
    }
    return [lsort [array names files]]
}

# Called to re-lstat a given file across all directories
proc updatefileinfo {f} {
    global dirs filetype filesize filetime

    foreach d $dirs {
	set df [joinname $d $f]
	if {[catch {file lstat $df stat}] == 0} {
	    set filetype($df) $stat(type)
	    set filesize($df) $stat(size)
	    set filetime($df) $stat(mtime)
	} else {
	    catch {unset filetype($df)}
	}
    }
}

# Returns 1 if we are interested in this file, i.e. if it isn't
# matched by something in the exclude list
proc notnuked {f} {
    global nukefiles
    set ft [file tail $f]
    if {$ft == "." || $ft == ".."} {
	return 0
    }
    foreach n $nukefiles {
	if {[string match $n $f] || [string match $n $ft]} {
	    return 0
	}
    }
    return 1
}

proc joinname {dir f} {
    global filemode
    if {$filemode} {
	return $dir
    }
    return [file join $dir $f]
}

proc fileisa {f t} {
    global filetype
    return [expr {[info exists filetype($f)] && $filetype($f) == $t}]
}

proc diffages {f showsame} {
    global dirs nofilecmp rcsflag filesize filetime
    set numgroups 0
    set notexist {}
    set doesexist {}
    foreach d $dirs {
	set sameas($d) {}
	set group($d) 0
	set fname [joinname $d $f]
	if {![fileisa $fname "file"]} {
	    set fd [file dirname $fname]
	    if {$fd == "." || [fileisa $fd "directory"]} {
		lappend notexist $d
	    }
	} else {
	    lappend doesexist $d
	    set fsize($d) $filesize($fname)
	    set fmtime($d) $filetime($fname)
	    foreach d2 $dirs {
		if {$d2 == $d} break
		if {$sameas($d2) != "" || $group($d2) == 0} continue
		if {$fsize($d) == $fsize($d2) \
			&& $fmtime($d) == $fmtime($d2)} {
		    set notsame 0
		} elseif {$rcsflag != "" || $fsize($d) == $fsize($d2)} {
		    set fname2 [joinname $d2 $f]
		    if $nofilecmp {
			set notsame [catch {exec cmp -s $fname $fname2}]
		    } else {
			set same 0
			catch {
			    set same [eval filecmp $rcsflag $fname $fname2]
			}
			set notsame [expr !$same]
		    }
		} else {
		    set notsame 1
		}
		if {$notsame == 0} {
		    set sameas($d) $d2
		    set g $group($d2)
		    set group($d) $g
		    lappend groupelts($g) $d
		    if {$fmtime($d) > $gmtime($g)} {
			set gmtime($g) $fmtime($d)
		    }
		    break
		}
	    }
	    if {$sameas($d) == ""} {
		incr numgroups
		set group($d) $numgroups
		set groupelts($numgroups) $d
		set gmtime($numgroups) $fmtime($d)
	    }
	}
    }
    if {!$showsame && $numgroups == 1 && $notexist == ""} {
	return {}
    }
    set glist {}
    for {set g 1} {$g <= $numgroups} {incr g} {
	lappend glist [list [format "%.8x" $gmtime($g)] $g]
    }
    set grank(0) 0
    set rank 1
    foreach xx [lsort -decreasing $glist] {
	set g [lindex $xx 1]
	set grank($g) $rank
	incr rank
    }
    set res {}
    foreach d $dirs {
	lappend res $grank($group($d))
    }
    return [list $numgroups $res]
}

proc subdirgroups {sd} {
    global dirs
    set nummiss 0
    set groups {}
    foreach d $dirs {
	set fn [joinname $d $sd]
	if {![fileisa $fn "directory"]} {
	    set pd [file dirname $sd]
	    lappend groups 0
	    set fnp [joinname $d $pd]
	    if {$pd == "." || [fileisa $fnp "directory"]} {
		incr nummiss
	    }
	} else {
	    lappend groups 1
	}
    }
    if {$nummiss == 0} {
	return {}
    }
    return [list dir $groups]
}

set stringx 8

proc initcanv {} {
    global canvw canvx canvy canvy0 linespc stringx
    global dirs arroww blotspc blotw ycoord
    $canvw delete all
    $canvw yview moveto 0
    $canvw conf -scrollregion {0 0 0 1}
    catch {unset ycoord}
    set canvy $canvy0
    if {![info exists arroww]} {
	set stringx [expr $blotspc + 8]
	return
    }
    set numdirs [llength $dirs]
    set stringx [expr $numdirs * $blotspc + 8]
    $arroww delete all
    set arrowh [expr ($numdirs+1) * $linespc]
    $arroww conf -height $arrowh
    set y 0
    set yoff [expr $linespc / 2]
    set x [expr $canvx + 3 + ($blotw / 2)]
    set x2 [expr $stringx - 3]
    foreach d $dirs {
	set y2 [expr $y + $yoff]
	set t [$arroww create line $x $arrowh $x $y2 $x2 $y2 \
		-width 2 -arrow first]
	$arroww addtag arrows withtag $t
	set t [$arroww create text $stringx $y -text $d -anchor nw]
	$arroww addtag strings withtag $t
	incr y $linespc
	incr x $blotspc
    }
}

proc addcline {blots str} {
    global canvy canvx linespc stringx blotw bloth blotspc canvw ycoord
    set x [expr $canvx+1]
    set y [expr $canvy+1]
    foreach b $blots {
	set t [$canvw create rectangle $x $y [expr $x+$blotw] \
		[expr $y+$bloth] -fill $b]
	$canvw addtag blots withtag $t
	incr x $blotspc
    }
    set t [$canvw create text $stringx $canvy -anchor nw -text $str]
    $canvw addtag strings withtag $t
    set ycoord($str) $canvy
    incr canvy $linespc
    set vis [lindex [$canvw yview] 1]
    $canvw conf -scrollregion "0 0 0 $canvy"
    if {$vis >= 1.0} {
	$canvw yview moveto 1
    }
}

proc displine {groups name} {
    global agecolors
    set ng [lindex $groups 0]
    set cols $agecolors($ng)
    set blots {}
    foreach g [lindex $groups 1] {
	lappend blots [lindex $cols $g]
    }
    addcline $blots $name
}

proc dispfilelines {groups} {
    global agecolors dirs
    set ng [lindex $groups 0]
    set cols $agecolors($ng)
    set n 0
    foreach g [lindex $groups 1] {
	addcline [lindex $cols $g] [lindex $dirs $n]
	incr n
    }
}

proc ruleoff {stopped} {
    global canvw canvy linespc ruletype
    set y [expr $canvy + $linespc/2]
    set color black
    if {$stopped} {set color red}
    $canvw create line 0 $y [$canvw cget -width] $y -width 2 -fill $color
    incr canvy $linespc
    set vis [lindex [$canvw yview] 1]
    $canvw conf -scrollregion "0 0 0 $canvy"
    if {$vis >= 1.0} {
	$canvw yview moveto 1
    }
    set ruletype $stopped
}

proc updatecline {si di f} {
    global ycoord canvw blotspc bloth blotw groups
    global filemode dirs
    if {$filemode} {
	set fs [lindex $dirs $si]
	set fd [lindex $dirs $di]
	if {![info exists ycoord($fs)] || ![info exists ycoord($fd)]} return
	set ys [expr $ycoord($fs) + 2]
	set yd [expr $ycoord($fd) + 2]
	set xs 2
	set xd 2
    } else {
	if {![info exists ycoord($f)]} return
	set ys [expr $ycoord($f) + 2]
	set yd $ys
	set xs [expr $si * $blotspc + 2]
	set xd [expr $di * $blotspc + 2]
    }
    set ts [$canvw find overlapping $xs $ys \
	    [expr $xs+$blotw-2] [expr $ys+$bloth-2]]
    set td [$canvw find overlapping $xd $yd \
	    [expr $xd+$blotw-2] [expr $yd+$bloth-2]]
    if {$ts != "" && $td != ""} {
	$canvw itemconf $td -fill [$canvw itemcget $ts -fill]
    }
    set ng [lindex $groups($f) 0]
    set g [lindex $groups($f) 1]
    set groups($f) [list $ng [lreplace $g $di $di [lindex $g $si]]]
}

proc refreshcline {f} {
    global ycoord canvw blotspc bloth blotw groups
    global agecolors
    if {![info exists ycoord($f)]} return
    set y [expr $ycoord($f) + 2]
    set ng [lindex $groups($f) 0]
    set cols $agecolors($ng)
    set x 2
    foreach g [lindex $groups($f) 1] {
	set t [$canvw find overlapping $x $y \
		[expr $x+$blotw-2] [expr $y+$bloth-2]]
	if {$t != ""} {
	    $canvw itemconf $t -fill [lindex $cols $g]
	}
	incr x $blotspc
    }
}

proc makepatchmenu {base} {
    global dirs
    menu $base.p -tearoff 0
    foreach d1 $dirs {
	foreach d2 $dirs {
	    if {$d1 == $d2} continue
	    $base.p add command -label "$d1 to $d2" \
		    -command "makepatch $d1 $d2"
	}
    }
    $base add cascade -label "Make patch" -menu $base.p
}

proc maketouchmenu {base} {
    global dirs
    menu $base.t -tearoff 0
    foreach d $dirs {
	$base.t add command -label $d -command "touchfiles $d"
    }
    $base add cascade -label "Touch" -menu $base.t
}

proc makebkgetmenu {base} {
    global dirs bitkeeper
    menu $base.g -tearoff 0
    foreach d $dirs {
	$base.g add command -label $d -command "bkgetfiles $d"
    }
    $base add cascade -label "BK get" -menu $base.g \
	    -state [expr {$bitkeeper? "normal": "disabled"}]
}

proc makewins {} {
    global canvw numlines linespc arroww diffbut copybut filelabel nofilecmp
    global filemode dirs dirinterest

    # Make the menu bar and the menu items in it
    frame .bar -relief raised -border 2
    pack .bar -side top -fill x
    menubutton .bar.file -text File -menu .bar.file.m -padx 10 -pady 1
    menu .bar.file.m -tearoff 0
    .bar.file.m add command -label "Rediff" -command rediff
    if {!$filemode} {
	.bar.file.m add command -label "Redisplay" -command redisplay
    }
    makepatchmenu .bar.file.m
    maketouchmenu .bar.file.m
    makebkgetmenu .bar.file.m
    .bar.file.m add command -label "Stop" -command "set stopped 1"
    .bar.file.m add separator
    .bar.file.m add command -label "Quit" -command "set stopped 1; destroy ."
    pack .bar.file -side left
    set diffbut .bar.diff
    menubutton $diffbut -text Diff -menu $diffbut.m -padx 10 -pady 1
    menu $diffbut.m -tearoff 0
    $diffbut.m add command -label "All" -command difffiles
    pack $diffbut -side left
    set copybut .bar.copy
    menubutton $copybut -text Copy -menu $copybut.m -padx 10 -pady 1
    menu $copybut.m -tearoff 0
    pack $copybut -side left

    # make the filename display bar
    if {!$filemode} {
	frame .file -relief sunk -border 2
	set filelabel .file.name
	label $filelabel -padx 7 -text "File: "
	pack $filelabel -side left -fill x
	pack .file -side top -fill x
    }

    # make the frame containing the 2 canvases (one for the top section
    # containing the directory names, one for the files) and the scrollbar
    # in file mode the top section is omitted
    frame .cf
    if {$filemode} {
	set numlines [llength $dirs]
    }
    canvas .cf.c -height [expr $numlines * $linespc] \
	    -yscrollincr $linespc -yscrollcommand ".csb set"
    set canvw .cf.c
    if {!$filemode} {
	canvas .cf.d -height [expr 3 * $linespc]
	set arroww .cf.d
	pack .cf.d -side top -fill x
    }
    pack .cf.c -side bottom -fill both -expand 1
    scrollbar .csb -command "$canvw yview"
    pack .csb -side right -fill y
    pack .cf -side left -fill both -expand 1

    # set up event bindings on the main canvas
    bind $canvw <1> {selcanvline %x %y 0}
    bind $canvw <Shift-1> {selcanvline %x %y 1}
    bind $canvw <B1-Motion> {selcanvline %x %y 2}
    bind $canvw <ButtonRelease-1> {selcurfile}
    bind $canvw <ButtonRelease-4> "$canvw yview scroll -5 u"
    bind $canvw <ButtonRelease-5> "$canvw yview scroll 5 u"
    bind $canvw <2> "$canvw scan mark 0 %y"
    bind $canvw <B2-Motion> "$canvw scan dragto 0 %y"
    bind $canvw <Double-Button-1> "showsomediff 0"
    $canvw conf -scrollregion {0 0 0 1}
    if {!$filemode} {
	bind . N "diffnextfile 1"
	bind . P "diffnextfile -1"
    }
    bind . C copydifffile
    bind . <Key-Return> "showsomediff 0"
    bind . <Key-Prior> "$canvw yview scroll -1 p"
    bind . <Key-Next> "$canvw yview scroll 1 p"
    bind . <Key-Delete> "$canvw yview scroll -1 p"
    bind . <Key-BackSpace> "$canvw yview scroll -1 p"
    bind . <Key-space> "$canvw yview scroll 1 p"
    bind . <Key-Up> "$canvw yview scroll -1 u"
    bind . <Key-Down> "$canvw yview scroll 1 u"
    bind . Q "set stopped 1; destroy ."

    # Options menu
    global rcsflag diffiflag diffwflag diffbflag diffBflag diffdflag
    global bitkeeper
    menubutton .bar.options -text Options -menu .bar.options.m -padx 10 -pady 1
    menu .bar.options.m -tearoff 0
    pack .bar.options -side left
    .bar.options.m add radiobutton -label "Literal comparison" \
	    -variable rcsflag -value " " \
	    -state [expr {$nofilecmp? "disabled": "normal"}]
    .bar.options.m add radiobutton -label "Ignore differences in RCS strings" \
	    -variable rcsflag -value "-rcs" \
	    -state [expr {$nofilecmp? "disabled": "normal"}]
    .bar.options.m add radiobutton -label "Ignore differences in BK tags" \
	    -variable rcsflag -value "-bk" \
	    -state [expr {$nofilecmp? "disabled": "normal"}]
    .bar.options.m add checkbutton -label "Show files that are identical" \
	    -variable showsame
    .bar.options.m add checkbutton -label "Bitkeeper support" \
	    -variable bitkeeper \
	    -command bkchange
    menu .bar.options.m.bkmode -tearoff 0
    .bar.options.m.bkmode add radiobutton -label "Expand keywords" \
	    -variable bkgetmode -value " "
    .bar.options.m.bkmode add radiobutton -label "Don't expand keywords" \
	    -variable bkgetmode -value "k"
    .bar.options.m.bkmode add radiobutton -label "Check out for editing" \
	    -variable bkgetmode -value "e"
    .bar.options.m add cascade -label "BK get mode" \
	    -menu .bar.options.m.bkmode \
	    -state [expr {$bitkeeper? "normal": "disabled"}]
    .bar.options.m add checkbutton -label "Redisplay immediately" \
	    -variable redisp_immed
    .bar.options.m add command -label "Excluded files..." -command exclfilelist
    .bar.options.m add command -label "Diff options..." -command diffoptions
    .bar.options.m add command -label "Save" -command saveoptions

    .bar.options.m add separator
    set i 0
    foreach d $dirs {
	set dirinterest($i) 1
	.bar.options.m add checkbutton -label "Show $d" \
		-variable dirinterest($i) -command maybe_redisplay
	incr i
    }

    # Help menu
    menubutton .bar.help -text Help -menu .bar.help.m -padx 10 -pady 1
    menu .bar.help.m -tearoff 0
    pack .bar.help -side right
    .bar.help.m add command -label "About dirdiff" -command about
    .bar.help.m add command -label "Show help text" -command helptext
}

proc bkchange {} {
    global bitkeeper
    set state [expr {$bitkeeper? "normal": "disabled"}]
    .bar.options.m entryconf "BK*" -state $state
    .bar.file.m entryconf "BK*" -state $state
}

proc about {} {
    set w .about
    if {[winfo exists $w]} {
	raise $w
	return
    }
    toplevel $w
    wm title $w "About dirdiff"
    message $w.m -text {
Dirdiff version 1.5

Copyright  1999-2001 Paul Mackerras

Use and redistribute under the terms of the GNU General Public License

(CVS $Revision: 1.37 $)} \
	    -justify center -aspect 400
    pack $w.m -side top -fill x -padx 20 -pady 20
    button $w.ok -text Close -command "destroy $w"
    pack $w.ok -side bottom
}

proc helptext {} {
    set w .help
    if {[winfo exists $w]} {
	raise $w
	return
    }
    toplevel $w
    wm title $w "Dirdiff help"
    text $w.t -font {Times -14} -yscrollcommand "$w.sb set" -wrap word
    scrollbar $w.sb -command "$w.t yview"
    pack $w.sb -side right -fill y
    pack $w.t -side left -fill both -expand 1
    bind $w <Key-Prior> "$w.t yview scroll -1 p"
    bind $w <Key-BackSpace> "$w.t yview scroll -1 p"
    bind $w <Key-Delete> "$w.t yview scroll -1 p"
    bind $w b "$w.t yview scroll -1 p"
    bind $w B "$w.t yview scroll -1 p"
    bind $w <Key-Up> "$w.t yview scroll -1 u"
    bind $w <Key-Down> "$w.t yview scroll 1 u"
    bind $w d "$w.t yview scroll \[expr \"int(\[$w.t cget -height\]/2)\"\] u"
    bind $w D "$w.t yview scroll \[expr \"int(\[$w.t cget -height\]/2)\"\] u"
    bind $w u "$w.t yview scroll \[expr \"int(-\[$w.t cget -height\]/2)\"\] u"
    bind $w U "$w.t yview scroll \[expr \"int(-\[$w.t cget -height\]/2)\"\] u"
    bind $w q "destroy $w"
    bind $w Q "destroy $w"
    $w.t insert end {Dirdiff instructions.

Dirdiff compares all the files in up to five directories.  There is one \
column in the main window for each directory.

Each file is shown with a coloured square indicating its status.  Files \
are like leaves on a deciduous tree: the newest ones are green, and then \
they turn yellow, orange, and red as they get older.  Missing files are \
black, and directories are white.

Double-click a file to show differences between two versions.  By default, \
the first and last versions are compared, but this can be changed by the \
'Diff' menu in the main window.  

You can select several files to copy or to make a patch by shift-clicking.

In the diff window, check the boxes on the left margin for changes you \
want to preserve, and then choose 'Merge' to move those changes into one \
of the files.  Alternatively, choose 'Copy' in the main window to copy \
across the whole file, replacing any changes.

'Make patch' produces a file describing the changes between the files that \
can be applied by the patch tool.  You can edit the patch before saving, \
and may wish to add explanatory text, instructions, or patch(1) Prereq \
lines at the beginning.  To save the patch, enter a filename in the patch \
window relative to the current directory, and choose 'Save'.  This will \
also close the window.

If you are sending out patches, then the "from" directory should be the \
original version of the source.  Try to make sure that the two files have \
the same number of leading directories.  See the patch(1) man page for \
more information.
    }

    $w.t conf -state disabled
}

proc filediffs {} {
    global groups selitem fserial
    updatefileinfo .
    set groups(.) [set gr [diffages . 1]]
    set fserial(.) 1
    dispfilelines $gr
    clearsecsel
    selcurfile
}

proc diffsin {sd} {
    global groups stopped showsame alllines
    foreach f [addfiles $sd] {
	if {$stopped} return
	lappend alllines $f
	set d [string trimright $f /]
	if {$d == $f} {
	    set groups($f) [set gr [diffages $f $showsame]]
	    if [interesting_line $gr] {
		displine $gr $f
	    }
	} else {
	    set groups($f) [set gr [subdirgroups $d]]
	    if [interesting_line $gr] {
		displine $gr $f
	    }
	    diffsin $f
	}
	catch update
    }
}

proc canvdiffs {} {
    global canvw groups stopped filemode alllines
    global filetype filetime filesize
    set stopped 0
    set alllines {}
    catch {unset filetype}
    catch {unset filetime}
    catch {unset filesize}
    initcanv
    if {$filemode} {
	filediffs
    } else {
	diffsin {}
	if {[catch update]} return
	ruleoff $stopped
    }
    if {[catch update]} return
    if {[lindex [$canvw yview] 1] >= 1.0} {
	$canvw yview moveto 0
    }
}

proc textitemat {x y} {
    global canvw
    foreach i [$canvw find overlapping $x $y [expr $x+50] $y] {
	if {[$canvw type $i] == "text"} {
	    return $i
	}
    }
    return {}
}

proc selcanvline {x y tipe} {
    global canvw stringx selitem secsel clickitem groups selfile clickmode
    global filemode
    if {$filemode} return
    set x [expr $stringx+5]
    set y [$canvw canvasy $y]
    set it [textitemat $x $y]
    if {$it == {}} return
    if {$tipe == 0} {
	# click, no shift
	clearsecsel
	set selitem $it
	$canvw select from $it 0
	$canvw select to $it end
	set clickitem $it
	set clickmode 1
	selcurfile
	addsecsel $it
    } elseif {$tipe == 1} {
	# shift-click
	set clickitem $it
	if {$it != $selitem} {
	    if {![info exists secsel($it)]} {
		set clickmode 1
		addsecsel $it
	    } else {
		set clickmode 0
		remsecsel $it
	    }
	}
    } elseif {$tipe == 2} {
	foreach i [eval $canvw find overlapping [$canvw bbox $clickitem $it]] {
	    if {[$canvw type $i] == "text"} {
		set f [$canvw itemcget $i -text]
		if {$groups($f) == $groups($selfile)} {
		    if {$clickmode && ![info exists secsel($i)]} {
			addsecsel $i
		    } elseif {!$clickmode && [info exists secsel($i)]} {
			remsecsel $i
		    }
		}
	    }
	}
    }
}

proc addsecsel {it} {
    global canvw secsel
    set t [eval $canvw create rect [$canvw bbox $it] -outline {{}} \
	    -tags secsel -fill [$canvw cget -selectbackground]]
    $canvw lower $t
    set secsel($it) $t
}

proc remsecsel {it} {
    global canvw secsel
    $canvw delete $secsel($it)
    unset secsel($it)
}

proc clearsecsel {} {
    global canvw secsel
    $canvw delete secsel
    catch {unset secsel}
}

proc selnextline {inc} {
    global canvw selitem linespc stringx canvy filemode
    if {$filemode} {
	if {$inc != 0} {
	    return 0
	}
	selcurfile
	return 1
    }
    if {$selitem == ""} {
	return 0
    }
    set y [expr [lindex [$canvw bbox $selitem] 1] + $linespc * $inc + 5]
    set x [expr $stringx+5]
    set i [textitemat $x $y]
    if {$i == ""} {
	return 0
    }
    clearsecsel
    set selitem $i
    $canvw select from $i 0
    $canvw select to $i end
    set bbox [$canvw bbox $i]
    set y [expr {([lindex $bbox 1] + [lindex $bbox 3]) / 2.0}]
    set ytop [expr {($y - $linespc / 2.0) / $canvy}]
    set ybot [expr {($y + $linespc / 2.0) / $canvy}]
    set wnow [$canvw yview]
    if {$ytop < [lindex $wnow 0]} {
	$canvw yview moveto $ytop
    } elseif {$ybot > [lindex $wnow 1]} {
	set wh [expr {[lindex $wnow 1] - [lindex $wnow 0]}]
	$canvw yview moveto [expr {$ybot - $wh}]
    }
    selcurfile
    addsecsel $i
    return 1
}

proc calcgroupelts {f} {
    global groupelts numgroups groups
    set gr $groups($f)
    set numgroups [lindex $gr 0]
    if {$numgroups == "dir"} {
	set numgroups 1
    }
    set gr [lindex $gr 1]
    for {set g 0} {$g <= $numgroups} {incr g} {
	set groupelts($g) {}
    }
    set i 0
    foreach g $gr {
	lappend groupelts($g) $i
	incr i
    }
}

proc selcurfile {} {
    global canvw selitem filelabel selfile groups filemode
    global groupelts diffbut copybut numgroups
    if {!$filemode} {
	if {$selitem == ""} return
	set selfile [$canvw itemcget $selitem -text]
    } else {
	set selfile .
    }
    calcgroupelts $selfile
    set x [string trimright $selfile /]
    if {$x == $selfile} {
	if {[info exists filelabel]} {
	    $filelabel conf -text "File: $selfile"
	}
	confdiffbutfile
	confcopybutfile
    } else {
	if {[info exists filelabel]} {
	    $filelabel conf -text "Directory: $x"
	}
	$diffbut conf -state disabled
	confcopybutdir
    }
}

proc confdiffbutfile {} {
    global diffbut numgroups dirs selfile groupelts filemode
    $diffbut.m delete 0 end
    if {$numgroups == 1} {
	set xi [lindex $groupelts(1) 0]
	if {$xi != ""} {
	    set x [lindex $dirs $xi]
	    $diffbut.m add command -label "Show $x" \
		    -command "showfile $x $selfile"
	}
    } elseif {$numgroups > 1} {
	for {set gn 1} {$gn < $numgroups} {incr gn} {
	    set yi [lindex $groupelts($gn) 0]
	    if {$yi == ""} continue
	    set y [lindex $dirs $yi]
	    for {set go [expr $gn + 1]} {$go <= $numgroups} {incr go} {
		set xi [lindex $groupelts($go) 0]
		if {$xi == ""} continue
		set x [lindex $dirs $xi]
		$diffbut.m add command -label "$x vs. $y" \
			-command "diff2 $x $y $selfile"
	    }
	}
    }
    if {!$filemode} {
	$diffbut.m add separator
	$diffbut.m add command -label "Rediff selected file(s)" \
		-command "redifffiles"
    }
    $diffbut conf -state normal
}

proc confcopybutfile {} {
    global copybut groupelts numgroups selfile dirs
    $copybut.m delete 0 end
    set numdirs [llength $dirs]
    set srcs {}
    set rev {}
    for {set gn 1} {$gn <= $numgroups} {incr gn} {
	set srcs [concat $srcs $groupelts($gn)]
	set src [lindex $groupelts($gn) 0]
	if {$src == ""} continue
	set x [lindex $dirs $src]
	for {set dst 0} {$dst < $numdirs} {incr dst} {
	    if {[lsearch $srcs $dst] < 0} {
		set y [lindex $dirs $dst]
		$copybut.m add command -label "$x -> $y" \
			-command "copyselfile $src $dst $selfile 0"
	    }
	}
    }
    set needsep 1
    for {set gn $numgroups} {$gn >= 1} {incr gn -1} {
	set src [lindex $groupelts($gn) 0]
	if {$src == ""} continue
	set x [lindex $dirs $src]
	for {set gd 1} {$gd < $gn} {incr gd} {
	    foreach dst $groupelts($gd) {
		set y [lindex $dirs $dst]
		if $needsep {
		    $copybut.m add separator
		    set needsep 0
		}
		$copybut.m add command -label "$x -> $y" \
			-command "copyselfile $src $dst $selfile 1"
	    }
	}
    }
    if {$groupelts(0) != {}} {
	set needsep 1
	for {set gn 1} {$gn <= $numgroups} {incr gn} {
	    foreach dst $groupelts($gn) {
		set x [lindex $dirs $dst]
		if $needsep {
		    $copybut.m add separator
		    set needsep 0
		}
		$copybut.m add command -label "Remove from $x" \
			-command "removeselfile $dst $selfile"
	    }
	}
    }
    $copybut conf -state normal
}

proc confcopybutdir {} {
    global copybut groupelts selfile dirs
    $copybut.m delete 0 end
    set srcs $groupelts(1)
    set dsts $groupelts(0)
    if {$srcs != {} && $dsts != {}} {
	foreach s $srcs {
	    set x [lindex $dirs $s]
	    foreach d $dsts {
		set y [lindex $dirs $d]
		$copybut.m add command -label "$x -> $y" \
			-command "copydir $s $d [string trimright $selfile /]"
	    }
	}
	$copybut.m add separator
	foreach s $srcs {
	    set x [lindex $dirs $s]
	    $copybut.m add command -label "Remove $x" \
		    -command "removedir $s [string trimright $selfile /]"
	}
    }
    $copybut conf -state normal
}

proc resetsel {} {
    global selitem selfile filelabel diffbut copybut
    global canvw
    set selitem {}
    set selfile {}
    $canvw select clear
    if {[info exists filelabel]} {
	$filelabel conf -text "File: "
    }
    $diffbut conf -state disabled
    $copybut conf -state disabled
    removediffs
}

proc removediffs {} {
    global texttop textw diffing difff
    catch {destroy $texttop}
    catch {unset texttop}
    catch {unset textw}
    catch {close $difff}
    set diffing 0
}

proc showfile {d f} {
    global textw difflist texttop mergebut
    if {!([info exists textw] && [winfo exists $textw])} {
	maketextw
    } else {
	raise $texttop
    }
    set fn [joinname $d $f]
    wm title $texttop "Contents of $fn"
    set difflist {}
    $mergebut.m delete 0 end
    $textw conf -state normal -tabs {}
    $textw delete 0.0 end
    set nl {}
    set f [open $fn r]
    set n [gets $f line]
    while {$n >= 0} {
	$textw insert end "$nl$line"
	set nl "\n"
	set n [gets $f line]
    }
    close $f
    $textw conf -state disabled
}

proc redifffiles {} {
    global groups showsame selfile
    set files [secondarysel $selfile]
    foreach f $files {
	updatefileinfo $f
	set groups($f) [diffages $f 1]
	refreshcline $f
    }
    selcurfile
}

proc diff2 {d1 d2 f} {
    global textw groups dirs numgroups bgcolors selfile difflist texttop
    global difff lno diffdirs diffiflag diffwflag diffbflag diffBflag diffdflag
    global ctxlines diffoldcolor diffnewcolor difffile charwidth mergebut
    global diffing filemode
    set ds [list $d1 $d2]
    if {$diffing} {
	if {$ds == $diffdirs && $f == $difffile} return
	catch {close $difff}
    }
    set diffdirs $ds
    set difffile $f
    if {![info exists textw] || ![winfo exists $textw]} {
	maketextw
    }
    if {$filemode} {
	wm title $texttop "Differences"
    } else {
	wm title $texttop "Differences: $f"
    }
    set difflist {}
    $mergebut.m delete 0 end
    $textw conf -state normal
    $textw delete 0.0 end
    set charwidth [font measure [$textw cget -font] n]
    $textw conf -tabs "[expr 4*$charwidth]p left [expr 12*$charwidth]p left"
    set group [lindex $groups($selfile) 1]
    set i1 [lindex $group [lsearch $dirs $d1]]
    set i2 [lindex $group [lsearch $dirs $d2]]
    set x $bgcolors($numgroups)
    $textw tag delete [$textw tag names]
    set diffoldcolor [lindex $x $i1]
    set diffnewcolor [lindex $x $i2]
    $textw tag conf d1 -back $diffoldcolor
    $textw tag conf d2 -back $diffnewcolor
    $textw tag conf sep -back blue
    $textw tag conf ul -underline 1
    $textw tag lower sep
    set path1 [joinname $d1 $f]
    set path2 [joinname $d2 $f]
    set diffopts "-U $ctxlines $diffiflag $diffwflag $diffbflag $diffBflag $diffdflag"
    set difff [open "|diff $diffopts $path1 $path2" r]
    set diffing 1
    set lno 1
    catch {unset oldin}
    catch {unset newin}
    global linegroups linegroupnum linegrouplast lineinfo
    catch {unset linegroups}
    set linegroupnum 0
    set linegrouplast 0
    catch {unset lineinfo}
    global file1lnum file2lnum incline lineinfo
    set file1lnum 0
    set file2lnum 0
    catch {unset incline}
    catch {unset lineinfo}
    fconfigure $difff -blocking 0
    fileevent $difff readable "readdiff $difff"
}

proc readdiff {f} {
    global difff lno textw difflist
    global incline lineinfo underlinetabs
    global linegroups linegroupnum linegrouplast
    global file1lnum file2lnum diffing
    if {$f != $difff} {
	catch {close $f}
	return
    }
    set n [gets $difff line]
    if {$n < 0} {
	if {![eof $difff]} return
	catch {close $difff}
	set diffing 0
	if {$lno > 1} {
	    $textw delete "end - 1c" end
	    set t [$textw tag names "end - 1l"]
	    if {$t != ""} {
		$textw tag add $t "end - 1l" end
	    }
	}
	$textw conf -state disabled
	if {$lno > 3} {
	    global mergebut diffdirs difffile
	    global groups dirs diffmtime
	    set j 0
	    set group [lindex $groups($difffile) 1]
	    foreach i {0 1} {
		set g [lindex $group [lsearch $dirs [lindex $diffdirs $i]]]
		set k 0
		foreach gx $group {
		    if {$gx == $g} {
			set f [lindex $dirs $k]
			$mergebut.m add command -label "update $f" \
				-command [list diffmerge $i $j $f]
			set path [joinname $f $difffile]
			set diffmtime($path) [file mtime $path]
			incr j
		    }
		    incr k
		}
	    }
	}
	return
    }
    set x [string index $line 0]
    if {$x == "@" && [regexp { -([0-9,]+) .*\+([0-9,]+) } $line z r1 r2]} {
	set line "\t            $r1        $r2       "
	set file1lnum [string range $r1 0 [expr [string wordend $r1 0]-1]]
	set file2lnum [string range $r2 0 [expr [string wordend $r2 0]-1]]
	lappend difflist $lno
	set line [string range $line 1 end]
	$textw insert end "$line\n"
	set lend [$textw index "$lno.0 + 1l"]
	set i1 [$textw index "$lno.16 + [string length $r1] c"]
	set i2 [$textw index "$i1 + 8c + [string length $r2] c"]
	$textw tag add sep $lno.0 $lno.8
	$textw tag add d1 $lno.8 $i1
	$textw tag add d2 $i1 $i2
	$textw tag add sep $i2 $lend
	set linegrouplast 0
	incr lno
	return
    }
    set ix 1
    if {($x == "-" || $x == "+") && $lno > 3} {
	set incline($lno) 0
	if {!$linegrouplast} {
	    incr linegroupnum
	    set linegroups($linegroupnum) {}
	    set linegrouplast 1
	}
	lappend linegroups($linegroupnum) $lno
	checkbutton $textw.inc$lno -variable incline($lno) \
		-font {Courier -10} -cursor top_left_arrow \
		-padx 2 -pady 0 -highlightthickness 0
	$textw window create end -window $textw.inc$lno
	bind $textw.inc$lno "<Shift-Button-1>" \
		"$textw.inc$lno toggle; togglegroup $linegroupnum $lno; break"
	bind $textw.inc$lno "<Any-Button-3>" \
		"$textw.inc$lno toggle; togglegroup $linegroupnum $lno"
	set ix 2
	set line [string range $line 1 end]
	set lineinfo($lno) [list $file1lnum $file2lnum [expr {$x=="+"}] $line]
    } elseif {$x == "-" || $x == "+"} {
	set line [string trimleft $line $x]
    } elseif {$x == " "} {
	set line [string range $line 1 end]
    }
    $textw insert end "\t"
    if {$underlinetabs} {
	set col 0
	set trailb [string length [string trimright $line]]
	while {[set tpos [string first "\t" $line]] >= 0} {
	    if {$tpos > 0} {
		$textw insert end [string range $line 0 [expr $tpos-1]]
		if {$trailb < $tpos} {
		    $textw tag add ul $lno.[expr $ix+$trailb] \
			    $lno.[expr $ix+$tpos]
		    set trailb 0
		} else {
		    set trailb [expr $trailb-$tpos]
		}
		incr ix $tpos
		incr col $tpos
	    }
	    set nsp [expr {8 - ($col & 7)}]
	    $textw insert end [string range "         " 1 $nsp] ul
	    set line [string range $line [expr $tpos+1] end]
	    incr ix $nsp
	    incr col $nsp
	    if {$trailb > 0} {incr trailb -1}
	}
	$textw insert end "$line\n"
	set tpos [string length $line]
	if {$trailb < $tpos} {
	    $textw tag add ul $lno.[expr $ix+$trailb] $lno.[expr $ix+$tpos]
	}
    } else {
	$textw insert end "$line\n"
    }
    set lend [$textw index "$lno.0 + 1l"]
    if {$x == "-"} {
	$textw tag add d1 $lno.0 $lend
    } elseif {$x == "+"} {
	$textw tag add d2 $lno.0 $lend
    } else {
	set linegrouplast 0
    }
    if {$linegrouplast} {
	$textw tag add bindtag$lno $lno.0 $lend
	$textw tag bind bindtag$lno "<Button-1>" \
		"$textw.inc$lno toggle; break"
	$textw tag bind bindtag$lno "<Shift-Button-1>" \
		"$textw.inc$lno toggle; togglegroup $linegroupnum $lno; break"
	$textw tag bind bindtag$lno "<Any-Button-3>" \
		"$textw.inc$lno toggle; togglegroup $linegroupnum $lno; break"
    }
    if {$x != "+"} {incr file1lnum}
    if {$x != "-"} {incr file2lnum}
    incr lno
}

proc togglegroup {group lno} {
    global incline linegroups textw
    if $incline($lno) {
	set state select
    } else {
	set state deselect
    }
    foreach l $linegroups($group) {
	$textw.inc$l $state
    }
}

proc invertbuttons {} {
    global incline textw
    foreach l [array names incline] {
	set incline($l) [expr {1 - $incline($l)}]
    }
}

proc mergelist {} {
    global incline lineinfo lno
    set mlist {}
    for {set i 1} {$i <= $lno} {incr i} {
	if {[info exists incline($i)]} {
	    lappend mlist [list $incline($i) $lineinfo($i)]
	}
    }
    return $mlist
}

proc diffmerge {ix j dir} {
    global diffdirs difffile diffmtime fserial
    global dirs diffoldcolor diffnewcolor
    set infile [joinname $dir $difffile]
    if {$diffmtime($infile) != [file mtime $infile]} {
	error_popup "File $infile has changed since the diff was performed."
	return
    }
    set mlist [mergelist]

    set di [lsearch -exact $dirs $dir]
    set fi $fserial($difffile)
    set w ".merge:$di:$fi"
    catch {destroy $w}
    toplevel $w
    wm title $w "Dirdiff: merged $infile"
    frame $w.bar -relief raised -border 2
    pack $w.bar -side top -fill x
    menubutton $w.bar.file -text File -menu $w.bar.file.m -padx 10 -pady 1
    menu $w.bar.file.m -tearoff 0
    $w.bar.file.m add command -label Save -command "savemerge $w"
    $w.bar.file.m add command -label Close -command "destroy $w"
    pack $w.bar.file -side left
    menubutton $w.bar.edit -text Edit -menu $w.bar.edit.m -padx 10 -pady 1
    menu $w.bar.edit.m -tearoff 0
    $w.bar.edit.m add command -label Cut -command "tk_textCut $w.t"
    $w.bar.edit.m add command -label Copy -command "tk_textCopy $w.t"
    $w.bar.edit.m add command -label Paste -command "tk_textPaste $w.t"
    $w.bar.edit.m add command -label Find \
	    -command "difffind :merge:$di:$fi $w.t"
    pack $w.bar.edit -side left
    frame $w.f -relief sunk -border 2
    entry $w.f.filename
    $w.f.filename insert 0 $infile
    pack $w.f.filename -side left -fill x -expand 1
    pack $w.f -side top -fill x
    text $w.t -yscrollcommand "$w.sb set"
    scrollbar $w.sb -command "$w.t yview"
    pack $w.sb -side right -fill y
    pack $w.t -side left -fill both -expand 1
    bind $w <Key-Prior> "$w.t yview scroll -1 p"
    bind $w <Key-Next> "$w.t yview scroll 1 p"
    set cols [list $diffoldcolor $diffnewcolor]
    $w.t tag conf insl -back [lindex $cols [expr {1 - $ix}]]
    $w.t tag conf ndel -back [lindex $cols $ix]

    set inf [open $infile r]
    set l 1
    foreach mm $mlist {
	set inc [lindex $mm 0]
	set m [lindex $mm 1]
	set tl [lindex $m $ix]
	if {!$inc} {
	    if {[lindex $m 2] == $ix} {
		while {$l < $tl} {
		    if {[gets $inf line] < 0} return
		    $w.t insert end $line
		    $w.t insert end \n
		    incr l
		}
		if {[gets $inf line] < 0} return
		$w.t insert end $line ndel
		$w.t insert end \n ndel
		incr l
	    }
	    continue
	}
	while {$l < $tl} {
	    if {[gets $inf line] < 0} return
	    $w.t insert end $line
	    $w.t insert end \n
	    incr l
	}
	if {[lindex $m 2] != $ix} {
	    # insert this line
	    $w.t insert end [lindex $m 3] insl
	    $w.t insert end \n insl
	} else {
	    # delete this line
	    if {[gets $inf line] < 0} return
	    incr l
	}
    }
    while {[gets $inf line] >= 0} {
	$w.t insert end $line
	$w.t insert end \n
    }
    # delete last newline
    catch {$w.t delete "end - 1c" end}
    close $inf
}

proc savemerge {w} {
    set infile [$w.f.filename get]
    if {$infile == {}} {return}
    set tmpfile "$infile.tmp"
    set tf [open $tmpfile w]
    puts -nonewline $tf [$w.t get 0.0 end]
    close $tf
    bkedit $infile
    file rename -force $infile $infile.orig
    file rename $tmpfile $infile
    destroy $w
    redifffiles
}

proc nextdiff {} {
    global textw difflist
    set ltop [expr int([$textw index @0,0])]
    foreach l $difflist {
	if {$l > $ltop} {
	    $textw yview $l.0
	    break
	}
    }
}

proc prevdiff {} {
    global textw difflist
    set ltop [expr int([$textw index @0,0])]
    set lprev {}
    foreach l $difflist {
	if {$l >= $ltop} {
	    if {$lprev != {}} {
		$textw yview $lprev.0
	    }
	    break
	}
	set lprev $l
    }
}

proc diffnextfile {inc} {
    global diffdirs selfile numgroups groups dirs textw
    global canvy ycoord canvw
    if {!([info exists textw] && [winfo exists $textw])} return
    if {![selnextline $inc] || $numgroups <= 1 || ![info exists diffdirs]} {
	return
    }
    set d1 [lindex $diffdirs 0]
    set d2 [lindex $diffdirs 1]
    set group [lindex $groups($selfile) 1]
    set i1 [lindex $group [lsearch $dirs $d1]]
    set i2 [lindex $group [lsearch $dirs $d2]]
    if {$i1 == 0 || $i2 == 0 || $i1 == $i2} return
    if {$i1 < $i2} {
	set x $d1
	set d1 $d2
	set d2 $x
    }
    diff2 $d1 $d2 $selfile
}

proc showsomediff {inc} {
    global diffdirs difffile selfile numgroups groups dirs textw
    global canvy ycoord canvw groupelts dirinterest
    if {![selnextline $inc]} return
    if {[lindex $groups($selfile) 0] == "dir"} return

    if {$numgroups <= 1} {
	set xi [lindex $groupelts(1) 0]
	if {$xi != ""} {
	    showfile [lindex $dirs $xi] $selfile
	}
	return
    }

    set group [lindex $groups($selfile) 1]

    set g1 1
    set g2 1
    if {[info exists diffdirs] && [info exists difffile]} {
	set d1 [lindex $diffdirs 0]
	set d2 [lindex $diffdirs 1]
	set i1 [lsearch $dirs $d1]
	set i2 [lsearch $dirs $d2]
	set g1 [lindex $group $i1]
	set g2 [lindex $group $i2]
	if {$difffile != $selfile} {
	    # looking at a different file from last time,
	    # try to do the same diff
	    if {$g1 > 0 && $g2 > 0 && $g1 != $g2 \
		    && $dirinterest($i1) && $dirinterest($i2)} {
		diff2 $d1 $d2 $selfile
		return
	    }
	    set g1 1
	    set g2 1
	}
	# else looking at the same file as last time,
	# do the next diff
	if {$g2 < $g1} {
	    set x $g1
	    set g1 $g2
	    set g2 $x
	}
    }

    # work out which groups are interesting (have interesting dirs)
    for {set g 0} {$g <= $numgroups} {incr g} {
	set groupinterest($g) {}
	foreach i $groupelts($g) {
	    if $dirinterest($i) {
		set groupinterest($g) $i
		break
	    }
	}
    }

    set ncomb [expr {$numgroups * ($numgroups - 1) / 2}]
    for {} {$ncomb > 0} {incr ncomb -1} {
	if {[incr g2] > $numgroups} {
	    if {[incr g1] >= $numgroups} {
		set g1 1
	    }
	    set g2 [expr {$g1 + 1}]
	}
	if {$groupelts($g1) != {} && $groupelts($g2) != {} \
		&& $groupinterest($g1) != {} && $groupinterest($g2) != {}} {
	    set d1 [lindex $dirs $groupinterest($g1)]
	    set d2 [lindex $dirs $groupinterest($g2)]
	    diff2 $d1 $d2 $selfile
	    return
	}
    }
}

proc copydifffile {} {
    global diffdirs selfile groups dirs
    if {![info exists diffdirs]} return
    set d1 [lindex $diffdirs 0]
    set d2 [lindex $diffdirs 1]
    if {[lindex $groups($selfile) 0] == "dir"} return
    set group [lindex $groups($selfile) 1]
    set n1 [lsearch $dirs $d1]
    set n2 [lsearch $dirs $d2]
    set i1 [lindex $group $n1]
    set i2 [lindex $group $n2]
    if {$i1 == 0 || $i2 == 0 || $i1 == $i2} return
    copyfile $n2 $n1 $selfile 0
}

proc maketextw {} {
    global textw texttop mergebut filemode
    toplevel .diffs
    wm title .diffs "Differences"
    frame .diffs.bar -relief sunken -border 2
    pack .diffs.bar -side top -fill x
    button .diffs.bar.rediff -text Rediff -command "diffnextfile 0"
    pack .diffs.bar.rediff -side left
    button .diffs.bar.options -text Options -command diffoptions
    pack .diffs.bar.options -side left
    button .diffs.bar.find -text Find -command "difffind :diffs .diffs.t"
    pack .diffs.bar.find -side left
    menubutton .diffs.bar.merge -text Merge -menu .diffs.bar.merge.m -padx 10
    menu .diffs.bar.merge.m -tearoff 0
    pack .diffs.bar.merge -side left
    if {!$filemode} {
	button .diffs.bar.next -text "Next file" -command "diffnextfile 1"
	pack .diffs.bar.next -side left
	button .diffs.bar.prev -text "Previous file" -command "diffnextfile -1"
	pack .diffs.bar.prev -side left
    }
    button .diffs.bar.invert -text "Invert" -command "invertbuttons"
    pack .diffs.bar.invert -side left
    set texttop .diffs
    set textw .diffs.t
    set mergebut .diffs.bar.merge
    text $textw -width 84 -height 32 -yscrollcommand ".diffs.sb set"
    scrollbar .diffs.sb -command "$textw yview"
    pack .diffs.sb -side right -fill y
    pack $textw -side left -fill both -expand 1
    bind .diffs <Key-Prior> "$textw yview scroll -1 p"
    bind .diffs b "$textw yview scroll -1 p"
    bind .diffs B "$textw yview scroll -1 p"
    bind .diffs <Key-BackSpace> "$textw yview scroll -1 p"
    bind .diffs <Key-Delete> "$textw yview scroll -1 p"
    bind .diffs <Key-Next> "$textw yview scroll 1 p"
    bind .diffs <Key-space> "$textw yview scroll 1 p"
    bind .diffs <Key-Up> "$textw yview scroll -1 u"
    bind .diffs <Key-Down> "$textw yview scroll 1 u"
    bind .diffs d "$textw yview scroll \[expr \"int(\[$textw cget -height\]/2)\"\] u"
    bind .diffs D "$textw yview scroll \[expr \"int(\[$textw cget -height\]/2)\"\] u"
    bind .diffs u "$textw yview scroll \[expr \"int(-\[$textw cget -height\]/2)\"\] u"
    bind .diffs U "$textw yview scroll \[expr \"int(-\[$textw cget -height\]/2)\"\] u"
    bind .diffs n nextdiff
    bind .diffs p prevdiff
    if {!$filemode} {
	bind .diffs N "diffnextfile 1"
	bind .diffs P "diffnextfile -1"
    }
    bind .diffs q removediffs
    bind .diffs Q "set stopped 1; destroy ."
    bind .diffs <Key-Home> "$textw yview 1.0"
    bind .diffs g "$textw yview 1.0"
    bind .diffs <Key-End> "$textw yview -pickplace \[$textw index end\]"
    bind .diffs G "$textw yview -pickplace \[$textw index end\]"
    bind .diffs C copydifffile
}

proc diffoptions {} {
    global optionw diffiflag diffwflag diffbflag diffBflag diffdflag
    if {[info exists optionw] && [winfo exists $optionw]} {
	raise $optionw
	return
    }
    set optionw .options
    toplevel $optionw
    wm title .options "Dirdiff options"
    checkbutton $optionw.diffiflag -text "Ignore case" \
	    -offvalue "" -onvalue "-i" -anchor w
    pack $optionw.diffiflag -side top -fill x
    checkbutton $optionw.diffwflag -text "Ignore all white space" \
	    -offvalue "" -onvalue "-w" -anchor w
    pack $optionw.diffwflag -side top -fill x
    checkbutton $optionw.diffbflag -text "Ignore amount of white space" \
	    -offvalue "" -onvalue "-b" -anchor w
    pack $optionw.diffbflag -side top -fill x
    checkbutton $optionw.diffBflag -text "Ignore blank lines" \
	    -offvalue "" -onvalue "-B" -anchor w
    pack $optionw.diffBflag -side top -fill x
    checkbutton $optionw.diffdflag -text "Minimize diffs" \
	    -offvalue "" -onvalue "-d" -anchor w
    pack $optionw.diffdflag -side top -fill x
    checkbutton $optionw.ultabs -text "Underline tabs" -anchor w \
	    -variable underlinetabs
    pack $optionw.ultabs -side top -fill x
    frame $optionw.ctx
    pack $optionw.ctx -side top
    label $optionw.ctx.l -text "Lines of context: "
    pack $optionw.ctx.l -side left
    entry $optionw.ctx.v -width 5 -textvariable ctxlines
    pack $optionw.ctx.v -side left
    button $optionw.save -text "Save options" -command saveoptions
    pack $optionw.save -side top -fill x
    frame $optionw.space -height 6
    pack $optionw.space -side top -fill x
    button $optionw.dismiss -text "Dismiss" -command "destroy $optionw"
    pack $optionw.dismiss -side bottom -fill x
    bind $optionw <Return> "destroy $optionw"
}

proc saveoptions {} {
    global rcsflag diffiflag diffwflag diffbflag diffBflag diffdflag
    global ctxlines showsame underlinetabs bitkeeper nukefiles redisp_immed
    set f [open "~/.dirdiff" w]
    puts $f [list set rcsflag $rcsflag]
    puts $f [list set diffiflag $diffiflag]
    puts $f [list set diffwflag $diffwflag]
    puts $f [list set diffbflag $diffbflag]
    puts $f [list set diffBflag $diffBflag]
    puts $f [list set diffdflag $diffdflag]
    puts $f [list set ctxlines $ctxlines]
    puts $f [list set showsame $showsame]
    puts $f [list set underlinetabs $underlinetabs]
    puts $f [list set bitkeeper $bitkeeper]
    puts $f [list set bkgetmode $bkgetmode]
    puts $f [list set redisp_immed $redisp_immed]
    puts $f [list set nukefiles $nukefiles]
    close $f
}

proc difffind {tag txt} {
    global dfindw$tag igncase$tag diffiflag regexp$tag backwards$tag
    if {[info exists dfindw$tag] && [winfo exists [set dfindw$tag]]} {
	raise [set dfindw$tag]
	return
    }
    set w .find$tag
    set dfindw$tag $w
    toplevel $w
    wm title $w "Dirdiff: Find"
    frame $w.f
    pack $w.f -side top -fill x -expand 1
    button $w.f.b -text "Find:" -command [list dofind $tag $txt $w]
    bind $w <Return> [list dofind $tag $txt $w]
    pack $w.f.b -side left
    entry $w.f.e
    pack $w.f.e -side right
    if {![info exists igncase$tag]} {
	set igncase$tag [expr {$diffiflag != {}}]
    }
    checkbutton $w.case -variable igncase$tag -text "Ignore case" -anchor w
    pack $w.case -side top -fill x
    checkbutton $w.regexp -variable regexp$tag -text "Regular expression" \
	    -anchor w
    pack $w.regexp -side top -fill x
    checkbutton $w.backwards -variable backwards$tag \
	    -text "Search backwards" -anchor w
    pack $w.backwards -side top -fill x
    button $w.close -text "Close" -command "destroy $w"
    pack $w.close -side top -fill x
}

proc dofind {tag txt w} {
    global dfindw$tag igncase$tag regexp$tag backwards$tag
    if {![winfo exists $txt]} return
    set w [set dfindw$tag]
    set str [$w.f.e get]
    if {$str == {}} return
    set back [set backwards$tag]
    # By default, start the search from the insertion point.
    # If there is a selection, start from the end of the selection for
    # a forwards search, or from the beginning for a backwards search.
    set start [$txt index insert]
    if {[$txt tag ranges sel] != {}} {
	if {$back} {
	    set start [$txt index sel.first]
	} else {
	    set start [$txt index sel.last]
	}
    }
    set opts {}
    if {$back} {
	lappend opts "-backwards"
    }
    if {[set regexp$tag]} {
	lappend opts "-regexp"
    }
    if {[set igncase$tag]} {
	lappend opts "-nocase"
    }
    set pos [eval $txt search $opts -count count -- [list $str] $start]
    if {$pos == {}} {
	bell
	return
    }
    set epos "$pos + $count c"
    $txt mark set insert $epos
    $txt tag remove sel 0.0 end
    $txt tag add sel $pos $epos
    $txt see $epos
    $txt see $pos
}

proc makepatch {d1 d2} {
    global patchnum selfile patchfiles
    set files [secondarysel $selfile]
    if {$files == {}} {
	error_popup "No files selected!"
	return
    }
    if {![info exists patchnum]} {
	set patchnum 0
    }
    set patchfiles($patchnum) $files
    set w ".patch:$patchnum"
    catch {destroy $w}
    toplevel $w
    wm title $w "Patch: $d1 to $d2"
    frame $w.bar -relief raised -border 2
    pack $w.bar -side top -fill x
    menubutton $w.bar.file -text File -menu $w.bar.file.m -padx 10 -pady 1
    menu $w.bar.file.m -tearoff 0
    $w.bar.file.m add command -label Save -command "savepatch $w"
    $w.bar.file.m add command -label Close -command "destroy $w"
    pack $w.bar.file -side left
    menubutton $w.bar.edit -text Edit -menu $w.bar.edit.m -padx 10 -pady 1
    menu $w.bar.edit.m -tearoff 0
    $w.bar.edit.m add command -label Cut -command "tk_textCut $w.t"
    $w.bar.edit.m add command -label Copy -command "tk_textCopy $w.t"
    $w.bar.edit.m add command -label Paste -command "tk_textPaste $w.t"
    $w.bar.edit.m add command -label Find \
	    -command "difffind :patch:$patchnum $w.t"
    pack $w.bar.edit -side left
    frame $w.f -relief sunk -border 2
    label $w.f.l -text "Filename: "
    entry $w.f.filename
    $w.f.filename insert 0 "patch$patchnum"
    pack $w.f.l -side left
    pack $w.f.filename -side left -fill x -expand 1
    pack $w.f -side top -fill x
    text $w.t -yscrollcommand "$w.sb set"
    scrollbar $w.sb -command "$w.t yview"
    pack $w.sb -side right -fill y
    pack $w.t -side left -fill both -expand 1
    bind $w <Key-Prior> "$w.t yview scroll -1 p"
    bind $w <Key-Next> "$w.t yview scroll 1 p"
    patchnext $patchnum $w $d1 $d2 0
    incr patchnum
}

proc patchnext {pnum w d1 d2 i} {
    global patchfiles
    update
    for {} {[set f [lindex $patchfiles($pnum) $i]] != {}} {incr i} {
	set p1 [joinname $d1 $f]
	set p2 [joinname $d2 $f]
	if {[file exists $p1]} {
	    if {[file exists $p2]} {
		set fh [open "|diff -u $p1 $p2" r]
		fconfigure $fh -blocking 0
		fileevent $fh readable "readpatch $fh $pnum $w $d1 $d2 $i $f"
		return
	    }
	    makenxpatch $w $p1 $p2 -
	} else {
	    if {[file exists $p2]} {
		makenxpatch $w $p1 $p2 +
	    }
	}
    }
    $w.t delete "end - 1c" end
    unset patchfiles($pnum)
}

proc makenxpatch {w p1 p2 c} {
    $w.t insert end "diff -urN $p1 $p2\n"
    set fmt "%a %b %d %H:%M:%S %Y"
    set d1 0
    if {$c == "-"} {
	set f [open $p1 r]
	set d1 [file mtime $p1]
    }
    $w.t insert end "--- $p1\t[clock format $d1 -format $fmt]\n"
    set d2 0
    if {$c == "+"} {
	set f [open $p2 r]
	set d2 [file mtime $p2]
    }
    $w.t insert end "+++ $p2\t[clock format $d2 -format $fmt]\n"
    set pos [$w.t index end-1c]
    set nl 0
    while {[gets $f line] >= 0} {
	incr nl
	$w.t insert end "$c$line\n"
    }
    catch {close $f}
    if {$c == "-"} {
	$w.t insert $pos "@@ -1,$nl +0,0 @@\n"
    } else {
	$w.t insert $pos "@@ -0,0 +1,$nl @@\n"
    }
}

proc readpatch {difff pnum w d1 d2 i f} {
    set n [gets $difff line]
    if {$n < 0} {
	if {![eof $difff]} return
	catch {close $difff}
	patchnext $pnum $w $d1 $d2 [expr $i+1]
	return
    }
    if {[string match "Binary*" $line]} return
    if {[string match "---*" $line]} {
	$w.t insert end "diff -urN [joinname $d1 $f] [joinname $d2 $f]\n"
    }
    $w.t insert end $line
    $w.t insert end "\n"
}

proc savepatch {w} {
    set outfile [$w.f.filename get]
    if {$outfile == {}} {return}
    set outf [open $outfile w]
    puts -nonewline $outf [$w.t get 0.0 end]
    close $outf
    destroy $w
}

# invoked from the File->Touch menu item
proc touchfiles {d} {
    global selfile
    set files [secondarysel $selfile]
    if {$files == {}} {
	error_popup "No files selected!"
	return
    }
    set now [clock seconds]
    set bad {}
    foreach f $files {
	set df [file join $d $f]
	if {[catch {file mtime $df $now} err]} {
	    append bad "$df: $err\n"
	}
    }
    if {$bad != {}} {
	error_popup "Errors occurred:\n$bad"
    }
    redifffiles
}

# invoked from the File->BK get menu item
proc bkgetfiles {d} {
    global selfile bkgetmode
    set files [secondarysel $selfile]
    if {$files == {}} {
	error_popup "No files selected!"
	return
    }
    set bad {}
    set flag "-qT"
    if {$bkgetmode != " "} {
	append flag $bkgetmode
    }
    foreach f $files {
	set df [file join $d $f]
	if {[catch {exec bk get $flag $df} err]} {
	    append bad "$df: $err\n"
	}
    }
    if {$bad != {}} {
	error_popup "Errors occurred:\n$bad"
    }
    redifffiles
}

proc exclfilelist {} {
    global exclw nukefiles
    if {[info exists exclw] && [winfo exists $exclw]} {
	raise $exclw
	return
    }
    toplevel .excl
    wm title .excl "Dirdiff: excluded files"
    set exclw .excl
    frame $exclw.b
    listbox $exclw.l -height 10 -width 40 -yscrollcommand "$exclw.sb set" \
	    -selectmode single
    scrollbar $exclw.sb -command "$exclw.l yview"
    entry $exclw.e
    pack $exclw.b -side bottom -fill x
    pack $exclw.e -side bottom -fill x
    pack $exclw.sb -side right -fill y
    pack $exclw.l -side left -fill both -expand 1
    button $exclw.b.add -text "Add" -padx 20 -command addexcl
    button $exclw.b.rem -text "Remove" -command remexcl
    button $exclw.b.close -text "Close" -command closeexcl
    pack $exclw.b.add -side left -fill x
    pack $exclw.b.rem -side left -fill x
    pack $exclw.b.close -side right -fill x
    bind $exclw.e <Return> "addexcl"
    foreach i $nukefiles {
	$exclw.l insert end $i
    }
}

proc addexcl {} {
    global exclw nukefiles
    if {[info exists exclw] && [winfo exists $exclw]} {
	set e [$exclw.e get]
	if {$e != {}} {
	    $exclw.l insert end $e
	    lappend nukefiles $e
	    $exclw.l see end
	}
    }
}

proc remexcl {} {
    global exclw nukefiles
    if {[info exists exclw] && [winfo exists $exclw]} {
	set s [$exclw.l curselection]
	if {$s != {}} {
	    $exclw.l delete $s
	    set nukefiles [lreplace $nukefiles $s $s]
	}
    }
}

proc closeexcl {} {
    global exclw
    catch {destroy $exclw}
    catch {unset exclw}
}

proc secondarysel {fname} {
    global secsel canvw
    set files {}
    foreach it [array names secsel] {
	lappend files [$canvw itemcget $it -text]
    }
    if {$files == {}} {
	if {$fname == {}} {
	    return {}
	}
	set files [list $fname]
    }
    return [lsort $files]
}

proc copyselfile {src dst fname confirm} {
    global dirs
    set files [secondarysel $fname]
    set n [llength $files]
    if {$n == 1} {
	copyfile $src $dst $fname $confirm
    } else {
	if {$confirm} {
	    set sd [lindex $dirs $src]
	    set dd [lindex $dirs $dst]
	    if {![confirm_popup "Copy $n older files from $sd to $dd?"]} {
		return
	    }
	}
	foreach f $files {
	    copyfile $src $dst $f 0
	}
    }
    selcurfile
}

proc copyfile {src dst fname confirm} {
    global dirs bitkeeper filemode
    set sd [lindex $dirs $src]
    set dd [lindex $dirs $dst]
    set srcf [joinname $sd $fname]
    set dstf [joinname $dd $fname]
    if {$filemode} {
	set msg "$src to $dst"
	set copydst $dstf
    } else {
	set msg "$fname from $sd to $dd"
	set copydst [file dirname $dstf]
    }
    if {$confirm} {
	if {![confirm_popup "Copy older $msg?"]} {
	    return
	}
    }
    bkedit $dstf
    if [catch {file copy -force -- $srcf $copydst} err] {
	error_popup "Error copying $msg: $err"
    } else {
	updatecline $src $dst $fname
	if {$bitkeeper} {
	    # make file writable if it isn't already
	    set perm [file attr $dstf -perm]
	    if {($perm & 0200) == 0} {
		file attr $dstf -perm [expr {$perm | 0200}]
	    }
	}
    }
}

proc bkedit {name} {
    global bitkeeper
    if {!$bitkeeper} return
    set sfile [file join [file dirname $name] SCCS "s.[file tail $name]"]
    if {[file isfile $sfile] && ![file writable $name]} {
	if [catch {exec bk edit -q $name} err] {
	    error_popup "Warning: couldn't check out $name: $err"
	}
    }
}

proc removeselfile {dst fname} {
    global groupelts dirs
    set files [secondarysel $fname]
    set n [llength $files]
    set dd [lindex $dirs $dst]
    if {$n == 1} {
	if {![confirm_popup "Remove [joinname $dd $fname]?"]} {
	    return
	}
    } else {
	if {![confirm_popup "Remove $n files from $dd?"]} {
	    return
	}
    }
    foreach f $files {
	set dstf [joinname $dd $f]
	if [catch {file delete $dstf} err] {
	    error_popup "Error deleting $dstf: $err"
	} else {
	    updatecline [lindex $groupelts(0) 0] $dst $f
	}
    }
    selcurfile
}

proc copydir {src dst dname} {
    global dirs groups alllines
    set sn [lindex $dirs $src]
    set dn [lindex $dirs $dst]
    if [catch {exec cp -p -r $sn/$dname [file dirname $dn/$dname]}] {
	error_popup "Error copying $dname from $sn to $dn: $err"
	return
    }
    foreach f $alllines {
	if [string match $dname* $f] {
	    updatecline $src $dst $f
	}
    }
    selcurfile
}

proc removedir {dst dname} {
    global groupelts dirs
    set dd [lindex $dirs $dst]
    if {![confirm_popup "Remove $dd/$dname?"]} {
	return
    }
    if [catch {file delete -force $dd/$dname} err] {
	error_popup "Error deleting $dd/$dname: $err"
    } else {
	updatecline [lindex $groupelts(0) 0] $dst $dname
	selcurfile
    }
}

proc confirm_popup msg {
    global confirm_ok
    set confirm_ok 0
    set w .confirm
    toplevel $w
    wm transient $w .
    message $w.m -text $msg -justify center -aspect 400
    pack $w.m -side top -fill x -padx 20 -pady 20
    button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
    pack $w.ok -side left -fill x
    button $w.cancel -text Cancel -command "destroy $w"
    pack $w.cancel -side right -fill x
    bind $w <Visibility> "grab $w; focus $w"
    tkwait window $w
    return $confirm_ok
}

proc error_popup msg {
    set w .error
    toplevel $w
    wm transient $w .
    message $w.m -text $msg -justify center -aspect 400
    pack $w.m -side top -fill x -padx 20 -pady 20
    button $w.ok -text OK -command "destroy $w"
    pack $w.ok -side bottom -fill x
    bind $w <Visibility> "grab $w; focus $w"
    tkwait window $w
}

proc notalldirs {dirs} {
    set type ""
    foreach d $dirs {
	if {[catch {file lstat $d stat} err]} {
	    puts stderr $err
	    exit 1
	}
	if {$type == ""} {
	    set type $stat(type)
	} elseif {$type != $stat(type)} {
	    puts stderr "Error: $d is a $stat(type) but [lindex $dirs 0] is a $type"
	    exit 1
	}
    }
    return [expr {$type == "file"}]
}

proc go {} {
    global diffing filemode dirs nextserial
    if {[llength $dirs] == 0} {exit 0}
    set diffing 0
    set nextserial 0
    set filemode [notalldirs $dirs]
    makewins
    initcanv
    resetsel
    update
    canvdiffs
}

proc rediff {} {
    initcanv
    resetsel
    update
    canvdiffs
}

proc repackgroups {gr} {
    if {[lindex $gr 0] == "dir"} {
	return $gr
    }
    set glist [lindex $gr 1]
    set glsort [lsort $glist]
    set ng(0) 0
    set lg 0
    set gc 0
    foreach e $glsort {
	if {$e != $lg} {
	    set lg $e
	    incr gc
	    set ng($e) $gc
	}
    }
    if {$gc == [lindex $gr 0]} {
	return $gr
    }
    set newlist {}
    foreach e $glist {
	lappend newlist $ng($e)
    }
    return [list $gc $newlist]
}

proc interesting_line {gr} {
    global dirinterest dirs
    if {$gr == {}} {
	return 0
    }
    set glist [lindex $gr 1]
    set i 0
    foreach e $glist {
	if $dirinterest($i) {
	    if {[info exists first]} {
		if {$e != $first} {
		    return 1
		}
	    } else {
		set first $e
	    }
	}
	incr i
    }
    return 0
}

proc redisplay {} {
    global canvw canvy canvy0 alllines groups ruletype
    $canvw delete all
    set canvy $canvy0
    $canvw conf -scrollregion "0 0 0 1"
    resetsel
    foreach f $alllines {
	set gr $groups($f)
	if {$gr != {}} {
	    set gr [repackgroups $gr]
	    set groups($f) $gr
	    if {[interesting_line $gr]} {
		displine $gr $f
	    }
	}
    }
    if [info exists ruletype] {
	ruleoff $ruletype
    }
}

proc maybe_redisplay {} {
    global redisp_immed
    if $redisp_immed redisplay
}

if [info exists doit] {go}
