# Platform specific setup for tcl scripts
# Copyright (c) 1999 Andrew Chang
# %W% %@%

proc bk_init {} \
{
	global	tcl_platform dev_null tmp_dir wish sdiffw file_rev
	global	file_start_stop file_stop line_rev keytmp file_old_new
	global 	bk_fs env

	if [catch {wm withdraw .} err] {
		puts "DISPLAY variable not set correctly or not running X"
		exit 1
	}

	set sdiffw [list "sdiff" "-w1" ]
	set dev_null "/dev/null"
	set wish "wish"
	set tmp_dir  "/tmp"
	set keytmp "/var/bitkeeper"

	# Stuff related to the bk field seperator: ^A
	set bk_fs |
	set file_old_new {(.*)\|(.*)\|(.*)}
	set line_rev {([^\|]*)\|(.*)}

	set file_start_stop {(.*)@(.*)\.\.(.*)}
	set file_stop {(.*)@([0-9.]+$)}
	set file_rev {(.*)@([0-9].*)}
	set env(BK_GUI) "YES"
}
proc getConfig {prog} \
{
	global tcl_platform gc app

	set app $prog

	if {$tcl_platform(platform) == "windows"} {
		#set _d(fixedFont) {{Lucida Console} 9}
		#set _d(fixedBoldFont) {{Lucida Console} 9 bold}
		set _d(fixedFont) {6x13}
		set _d(fixedBoldFont) {6x13bold}

		#set _d(fixedBoldFont) {helvetica 9 roman bold}
		#set _d(fixedFont -misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-iso8859-1
		#set _d(fixedBoldFont -misc-fixed-bold-r-semicondensed--13-120-75-75-c-60-iso8859-1
		set _d(buttonFont) {helvetica 9 roman bold}
		set _d(cset.leftWidth) 40
		set _d(cset.rightWidth) 80
		set _d(scrollWidth) 18		;# scrollbar width
		set _d(help.scrollWidth) 20	;# helptool scrollbar width
		set _d(fm.activeOldFont) {{Lucida Console} 9 bold}
		set _d(fm.activeNewFont) {{Lucida Console} 9 bold}
		set _d(ci.filesHeight) 10
	} else {
		set _d(fixedFont) {6x13}
		set _d(fixedBoldFont) {6x13bold}
		set _d(buttonFont) {times 12 roman bold}
		set _d(cset.leftWidth) 55
		set _d(cset.rightWidth) 80
		set _d(scrollWidth) 12		;# scrollbar width
		set _d(help.scrollWidth) 14	;# helptool scrollbar width
		set _d(fm.activeOldFont) {6x13bold}
		set _d(fm.activeNewFont) {6x13bold}
		set _d(ci.filesHeight) 9	;# num files to show in top win
		set _d(fm.editor) "fm2tool"
	}

	if {$tcl_platform(platform) == "windows"} {
		set _d(buttonColor) #d4d0c8	;# menu buttons
		set _d(BG) #d4d0c8		;# default background
	} else {
		set _d(buttonColor) #d0d0d0	;# menu buttons
		set _d(BG) #d9d9d9		;# default background
	}

	set _d(backup) ""		;# Make backups in ciedit: XXX NOTDOC 
	set _d(balloonTime) 1000	;# XXX: NOTDOC
	set _d(buttonColor) #d0d0d0	;# menu buttons
	set _d(diffHeight) 30		;# height of a diff window
	set _d(diffWidth) 65		;# width of side by side diffs
	set _d(geometry) ""		;# default size/location
	set _d(listBG) #e8e8e8		;# topics / lists background
	set _d(mergeHeight) 24		;# height of a merge window
	set _d(mergeWidth) 80		;# width of a merge window
	set _d(newColor) lightblue     	;# color of new revision/diff
	set _d(noticeColor) #b0b0e0	;# messages, warnings
	set _d(oldColor) #d070ff     	;# color of old revision/diff
	set _d(mergeColor) lightblue	;# color of merge region
	set _d(searchColor) yellow	;# highlight for search matches
	set _d(selectColor) lightblue	;# current file/item/topic
	set _d(statusColor) lightblue	;# various status windows
	#XXX: Not documented yet
	set _d(infoColor) powderblue	;# color of info line in difflib
	set _d(textBG) white		;# text background
	set _d(textFG) black		;# text color
	set _d(scrollColor) #d9d9d9	;# scrollbar bars
	set _d(troughColor) lightblue	;# scrollbar troughs
	set _d(warnColor) yellow	;# error messages

	set _d(quit)	Control-q	;# binding to exit tool

	set _d(ci.editHeight) 30	;# editor height
	set _d(ci.editWidth) 80		;# editor width
	set _d(ci.excludeColor) red	;# color of the exclude X
	set _d(ci.editor) ciedit	;# editor: ciedit=builtin, else in xterm
	set _d(ci.display_bytes) 8192	;# number of bytes to show in new files
	set _d(ci.commentsHeight) 6	;# height of comment window
	set _d(ci.diffHeight) 30	;# number of lines in the diff window
	set _d(ci.rescan) 0		;# Do a second scan to see if anything
					;# changed. Values 0 - off 1 - on

	set _d(cset.listHeight) 12

	set _d(diff.diffHeight) 50
	set _d(diff.searchColor) lightblue ;# highlight for search matches

	# fmtool fonts: See operating specific section above
	set _d(fm.activeLeftColor) orange  ;# Color of active left region
	set _d(fm.activeRightColor) yellow ;# Color of active right region
	set _d(fm3.comments) 1		;# show comments window
	set _d(fm3.annotate) 1		;# show annotations
	set _d(fm3.firstdiff) -
	set _d(fm3.lastdiff) +
	set _d(fm3.nextdiff) bracketright
	set _d(fm3.prevdiff) bracketleft
	set _d(fm3.nextconflict) braceright
	set _d(fm3.prevconflict) braceleft
	set _d(fm3.undo) u

	set _d(help.linkColor) blue	;# hyperlinks
	set _d(help.topicsColor) orange	;# highlight for topic search matches
	set _d(help.height) 50		;# number of rows to display
	set _d(help.width) 72		;# number of columns to display
	set _d(help.helptext) ""	;# -f<helptextfile> - undocumented
	set _d(help.exact) 0		;# helpsearch, allows partial matches

	set _d(rename.listHeight) 8

	set _d(rev.canvasBG) #9fb6b8	  ;# graph background
	set _d(rev.commentBG) lightblue   ;# background of comment text
	set _d(rev.arrowColor) darkblue   ;# arrow color
	set _d(rev.mergeOutline) darkblue ;# merge rev outlines
	set _d(rev.revOutline) darkblue   ;# regular rev outlines
	set _d(rev.revColor) #9fb6b8	  ;# unselected box fills
	set _d(rev.localColor) green	  ;# local node (for resolve)
	set _d(rev.remoteColor) red	  ;# remote node (for resolve)
	set _d(rev.tagColor) red	  ;# tag box fills
	set _d(rev.selectColor) #adb8f6   ;# highlight color for selected tag
	set _d(rev.dateColor) #181818	  ;# dates at the bottom of graph
	set _d(rev.commentHeight) 5       ;# height of comment text widget
	set _d(rev.textWidth) 92	  ;# width of text windows
	set _d(rev.textHeight) 30	  ;# height of lower window
	set _d(rev.showHistory) "1M"	  ;# History to show in graph on start
	set _d(rev.showRevs) 50		  ;# Num of revs to show in graph 
	# XXX: not documented yet
	set _d(rev.savehistory) 5	  ;# Max # of files to save in file list
	set _d(rev.hlineColor) white	  ;# Color of highlight lines XXX:NOTDOC
	set _d(rev.sccscat) "-aum"	  ;# Options given to sccscat

	set _d(setup.mandatoryColor) #deeaf4 ;# Color of mandatory fields

	set _d(bug.mandatoryColor) #deeaf4 ;# Color of mandatory fields
	set _d(entryColor) white	   ;# Color of mandatory fields

	if {$tcl_platform(platform) == "windows"} {
		package require registry
		set gc(appdir) [registry get {HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders} AppData]
		set gc(bkdir) [file join $gc(appdir) BitKeeper]
		if {![file isdirectory $gc(bkdir)]} { file mkdir $gc(bkdir) }
		set rcfile [file join $gc(bkdir) _bkgui]
	} else {
		set rcfile "~/.bkgui"
		set gc(bkdir) "~"
	}
	if {[file readable $rcfile]} { source $rcfile }

	# Pass one just copies all the defaults into gc unless they are set
	# already by .bkgui rcfile.
	foreach index [array names _d] {
		if {! [info exists gc($index)]} {
			set gc($index) $_d($index)
			#puts "gc\($index) = $_d($index) (default)"
		}
	}

	# Pass to converts from global field to prog.field
	foreach index [array names gc] {
		if {[string first "." $index] == -1} {
			set i "$prog.$index"
			if {![info exists gc($i)]} {
				set gc($i) $gc($index)
				#puts "gc\($i) = $gc($i) from $index"
			}
		}
    	}
}

# Try to find the project root, limiting ourselves to 40 directories
proc cd2root { {startpath {}} } \
{
	set n 40
	if {$startpath != ""} {
		set dir $startpath
	} else {
		set dir "."
	}
	while {$n > 0} {
		set path [file join $dir BitKeeper etc]
		if {[file isdirectory $path]} {
			cd $dir
			return
		}
		set dir [file join $dir ..]
		incr n -1
	}
	return -1
}

proc displayMessage {msg {exit {}}} \
{
	global tcl_platform

	if {$exit != ""} {
		set title "Error"
		set icon "error"
	} else {
		set title "Info"
		set icon "info"
	}
	tk_messageBox -title $title -type ok -icon $icon -message $msg
	if {$exit == 1} {
		exit 1
	} else {
		return
	}
}

# The balloon stuff was taken from the tcl wiki pages and modified by
# ask so that it can take a command pipe to display
proc balloon_help {w msg {cmd {}}} {

	global gc app

	set tmp ""
	if {$cmd != ""} {
		set msg ""
		set fid [open "|$cmd" r]
		while {[gets $fid tmp] >= 0} {
		#	lappend msg $tmp
			set msg "$msg\n$tmp"
		}
	}
	bind $w <Enter> \
	    "after $gc($app.balloonTime) \"balloon_aux %W [list $msg]\""
	bind $w <Leave> \
	    "after cancel \"balloon_aux %W [list $msg]\"
	    after 100 {catch {destroy .balloon_help}}"
    }

proc balloon_aux {w msg} {
	set t .balloon_help
	catch {destroy $t}
	toplevel $t
	wm overrideredirect $t 1
	label $t.l \
	    -text $msg \
	    -relief solid \
	    -padx 5 -pady 2 \
	    -borderwidth 1 \
	    -justify left \
	    -background lightyellow 
	pack $t.l -fill both
	set x [expr [winfo rootx $w]+6+[winfo width $w]/2]
	set y [expr [winfo rooty $w]+6+[winfo height $w]/2]
	wm geometry $t +$x\+$y
	bind $t <Enter> {after cancel {catch {destroy .balloon_help}}}
	bind $t <Leave> "catch {destroy .balloon_help}"
}

#
# Tcl version 8.0.5 doesn't have array unset 
# Consider moving to common lib area?
#
proc array_unset {var} \
{
	upvar #0 $var lvar

	foreach i [array names lvar] {
		#puts "unsetting $var ($i)"
		unset lvar($i)

	}
}

# From a Cameron Laird post on usenet
proc print_stacktrace {} {
	set depth [info level]
	puts "Current call stack shows"
	for {set i 1} {$i < $depth} {incr i} {
		puts "\t[info level $i]"
	}
}
proc _parray {a {pattern *}} {
	upvar 1 $a array
	if {![array exists array]} {
		error "\"$a\" isn't an array"
	}
	set maxl 0
	foreach name [lsort [array names array $pattern]] {
		if {[string length $name] > $maxl} {
			set maxl [string length $name]
		}
	}
	set maxl [expr {$maxl + [string length $a] + 2}]
	set answer ""
	foreach name [lsort [array names array $pattern]] {
		set nameString [format %s(%s) $a $name]
		append answer \
		    [format "%-*s = %s\n" $maxl $nameString $array($name)]
	}
	return $answer
}
# renametool - deal with files which have been renamed/added/deleted
# Copyright (c) 1999 by Larry McVoy; All rights reserved
# @(#) renametool.tcl 1.28@(#) lm@disks.bitmover.com

proc next {} \
{
	global	diffCount lastDiff DiffsEnd

	if {[visible $DiffsEnd($lastDiff)] == 0} {
		Page "yview" 1 0
		return
	}
	if {$lastDiff < $diffCount} {
		incr lastDiff
		dot
	}
}

proc prev {} \
{
	global	Diffs lastDiff

	if {[visible $Diffs($lastDiff)] == 0} {
		Page "yview" -1 0
		return
	}
	if {$lastDiff > 1} {
		incr lastDiff -1
		dot
	}
}

proc visible {index} \
{
	if {[llength [.diffs.r bbox $index]] > 0} {
		return 1
	}
	return 0
}

proc dot {} \
{
	global	Diffs DiffsEnd diffCount lastDiff

	scrollDiffs $Diffs($lastDiff) $DiffsEnd($lastDiff)
	highlightDiffs $Diffs($lastDiff) $DiffsEnd($lastDiff)
	.diffs.status.middle configure -text "Diff $lastDiff of $diffCount"
	if {$lastDiff == 1} {
		.menu.prev configure -state disabled
	} else {
		.menu.prev configure -state normal
	}
	if {$lastDiff == $diffCount} {
		.menu.next configure -state disabled
	} else {
		.menu.next configure -state normal
	}
}

proc highlightDiffs {start stop} \
{
	global	gc

	.diffs.l tag delete d
	.diffs.r tag delete d
	.diffs.l tag add d $start $stop
	.diffs.r tag add d $start $stop
	.diffs.l tag configure d -foreground black -font $gc(rename.fixedBoldFont)
	.diffs.r tag configure d -foreground black -font $gc(rename.fixedBoldFont)
}

proc topLine {} \
{
	return [lindex [split [.diffs.l index @1,1] "."] 0]
}


proc scrollDiffs {start stop} \
{
	global gc	

	# Either put the diff beginning at the top of the window (if it is
	# too big to fit or fits exactly) or
	# center the diff in the window (if it is smaller than the window).
	set Diff [lindex [split $start .] 0]
	set End [lindex [split $stop .] 0]
	set size [expr {$End - $Diff}]
	# Center it.
	if {$size < $gc(rename.diffHeight)} {
		set j [expr {$gc(rename.diffHeight) - $size}]
		set j [expr {$j / 2}]
		set i [expr {$Diff - $j}]
		if {$i < 0} {
			set want 1
		} else {
			set want $i
		}
	} else {
		set want $Diff
	}

	set top [topLine]
	set move [expr {$want - $top}]
	.diffs.l yview scroll $move units
	.diffs.r yview scroll $move units
}

proc chunks {n} \
{
	global	Diffs DiffsEnd nextDiff

	set l [.diffs.l index "end - 1 char linestart"]
	set Diffs($nextDiff) $l
	set e [expr $n + [lindex [split $l .] 0]]
	set DiffsEnd($nextDiff) "$e.0"
	incr nextDiff
}

proc same {r l n} \
{
	set lines {}
	while {$n > 0} {
		gets $l line
		lappend lines $line
		gets $r line
		incr n -1
	}
	set l [join $lines "\n"]
	.diffs.l insert end "$l\n"
	.diffs.r insert end "$l\n";
}

proc changed {r l n} \
{
	chunks $n
	set llines {}
	set rlines {}
	while {$n > 0} {
		gets $l line
		lappend llines $line
		gets $r line
		lappend rlines $line
		incr n -1
	}
	set lc [join $llines "\n"]
	set rc [join $rlines "\n"]
	.diffs.l insert end "$lc\n" diff
	.diffs.r insert end "$rc\n" diff
}

proc left {r l n} \
{
	chunks $n
	set lines {}
	set newlines ""
	while {$n > 0} {
		gets $l line
		lappend lines $line
		set newlines "$newlines\n"
		incr n -1
	}
	set lc [join $lines "\n"]
	.diffs.l insert end "$lc\n" diff
	.diffs.r insert end "$newlines" 
}

proc right {r l n} \
{
	chunks $n
	set lines {}
	set newlines ""
	while {$n > 0} {
		gets $r line
		lappend lines $line
		set newlines "$newlines\n"
		incr n -1
	}
	set rc [join $lines "\n"]
	.diffs.l insert end "$newlines" 
	.diffs.r insert end "$rc\n" diff
}

# Get the sdiff, making sure it has no \r's from fucking dos in it.
proc sdiff {L R} \
{
	global	rmList sdiffw

	set rmList ""
	# we need the extra quote arounf $R $L
	# because win32 path may have space in it
	set a [open "| grep {\r$} \"$L\"" r]
	set b [open "| grep {\r$} \"$R\"" r]
	if { ([gets $a dummy] < 0) && ([gets $b dummy] < 0)} {
		catch { close $a }
		catch { close $b }
		return [open "| $sdiffw \"$L\" \"$R\"" r]
	}
	catch { close $a }
	catch { close $b }
	set dir [file dirname $L]
	if {"$dir" == ""} {
		set dotL .$L
	} else {
		set tail [file tail $L]
		set dotL [file join $dir .$tail]
	}
	exec bk undos $L > $dotL
	set dir [file dirname $R]
	if {"$dir" == ""} {
		set dotR .$R
	} else {
		set tail [file tail $R]
		set dotR [file join $dir .$tail]
	}
	exec bk undos $R > $dotR
	set rmList [list $dotL $dotR]
	return [open "| $sdiffw $dotL $dotR"]
}

proc clear {state} \
{
	.diffs.l configure -state normal
	.diffs.r configure -state normal
	.diffs.status.l configure -text ""
	.diffs.status.r configure -text ""
	.diffs.status.middle configure -text ""
	.diffs.l delete 1.0 end
	.diffs.r delete 1.0 end
	.diffs.l configure -state $state
	.diffs.r configure -state $state
}

proc diffFiles {L R} \
{
	global	Diffs DiffsEnd diffCount nextDiff lastDiff dev_null rmList
	global  tmp_dir

	clear normal
	.diffs.status.l configure -text "$L"
	.diffs.status.r configure -text "$R"

	set lineNo 1
	set diffCount 0
	set nextDiff 1
	array set DiffsEnd {}
	array set Diffs {}
	set n 1
	set l [open "| bk get -kqp \"$L\"" r]
	set tail [file tail $L]
	set tmp [file join $tmp_dir $tail-[pid]]
	set t [open $tmp w]
	while {[gets $l buf] >= 0} {
		puts $t "$buf"
	}
	catch { close $l }
	catch { close $t }
	#puts "L=($L) R=($R)"
	if {![file exists $tmp]} {
		displayMessage "File $tmp does not exist"
		return
	}
	if {![file exists $R]} {
		displayMessage "File $R does not exist"
		catch {file delete $tmp} err
		return
	}
	set l [open $tmp r]
	set r [open $R r]
	set d [sdiff $tmp $R]

	gets $d last
	if {$last == "" || $last == " "} { set last "S" }
	while { [gets $d diff] >= 0 } {
		incr lineNo 1
		if {$diff == "" || $diff == " "} { set diff "S" }
		if {$diff == $last} {
			incr n 1
		} else {
			switch $last {
			    "S"	{ same $r $l $n }
			    "|"	{ incr diffCount 1; changed $r $l $n }
			    "<"	{ incr diffCount 1; left $r $l $n }
			    ">"	{ incr diffCount 1; right $r $l $n }
			}
			set n 1
			set last $diff
		}
	}
	switch $last {
	    "S"	{ same $r $l $n }
	    "|"	{ incr diffCount 1; changed $r $l $n }
	    "<"	{ incr diffCount 1; left $r $l $n }
	    ">"	{ incr diffCount 1; right $r $l $n }
	}
	catch { close $r }
	catch { close $l }
	catch { close $d }
	if {"$rmList" != ""} {
		foreach rm $rmList {
			catch {file delete $rm} err
		}
	}
	.diffs.l configure -state disabled
	.diffs.r configure -state disabled
	if {$diffCount > 0} {
		set lastDiff 1
		dot
	} else {
		set lastDiff 0
		.diffs.status.middle configure -text "No differences"
	}
	catch {file delete $tmp} err
}

proc fillFile {which file} \
{
	if {![file exists $file]} {
		displayMessage "File $file does not exist"
		return
	}
	clear normal
	set f [open $file r]
	set data [read $f]
	$which insert end $data
	catch { close $f }
	.files.l configure -state disabled
	.files.r configure -state disabled
	.diffs.status.r configure -text "$file"

}

proc getFiles {} \
{
	global	leftCount rightCount leftFile rightFile gc

	busy 1
	.files.l configure -state normal
	.files.r configure -state normal
	set leftFile ""
	set rightFile ""
	set leftCount 0
	set rightCount 0
	set left 1
	while {[gets stdin file] >= 0} {
		if {$file == ""} {
			set left 0
			continue
		}
		if {$left == 1} {
			.files.l insert end "$file\n"
			incr leftCount
		} else {
			.files.r insert end "$file\n"
			incr rightCount
		}
	}
	if {$leftCount == 0 && $rightCount == 0} { exit 0 }
	if {$leftCount > $rightCount} {
		set ht $leftCount
	} else {
		set ht $rightCount
	}
	if {$ht > 12} { set ht 12 }
	set diff [expr {$gc(rename.listHeight) - $ht}]
	incr gc(rename.diffHeight) $gc(rename.listHeight)
	incr gc(rename.listHeight) -$diff
	.diffs.l configure -height $gc(rename.diffHeight)
	.diffs.r configure -height $gc(rename.diffHeight)
	.files.l configure -state disabled -height $gc(rename.listHeight)
	.files.r configure -state disabled -height $gc(rename.listHeight)
	if {$leftCount > 0} { Select .files.l leftLine leftFile 1.0 }
	if {$rightCount > 0} { Select .files.r rightLine rightFile 1.0 }
	busy 0
}

proc doDeleteAll {} \
{
	global	leftLine leftFile leftCount

	.files.l tag delete select
	.files.l configure -state normal
	while {$leftCount > 0} {
		set f [.files.l get 1.0 "1.0 lineend"]
		sh "bk rm $f\n"
		.files.l delete 1.0 "1.0 lineend + 1 char"
		incr leftCount -1
	}
	set leftFile ""
	set leftLine 0.0
	.files.l configure -state disabled
	.menu.prev configure -state disabled
	.menu.next configure -state disabled
	.menu.deleteAll configure -state disabled
	.menu.delete configure -state disabled
	.menu.history configure -state disabled
	.menu.guess configure -state disabled
	.menu.rename configure -state disabled
	clear disabled
}

proc DeleteAll {} \
{
	global	isBusy

	if {$isBusy} { return }
	busy 1
	doDeleteAll
	busy 0
}


proc doCreateAll {} \
{
	global	rightLine rightFile rightCount

	.files.r tag delete select
	.files.r configure -state normal
	while {$rightCount > 0} {
		set f [.files.r get 1.0 "1.0 lineend"]
		sh "bk new $f\n"
		.files.r delete 1.0 "1.0 lineend + 1 char"
		incr rightCount -1
	}
	set rightFile ""
	set rightLine 0.0
	.files.r configure -state disabled
	.menu.createAll configure -state disabled
	.menu.create configure -state disabled
	.menu.guess configure -state disabled
	.menu.rename configure -state disabled
	clear disabled
}
proc CreateAll {} \
{
	global	isBusy

	if {$isBusy} { return }
	busy 1
	doCreateAll
	busy 0
}

proc Delete {doit} \
{
	global	leftLine leftFile leftCount rightFile isBusy

	if {$doit == 1} {
		if {$isBusy == 1} { return }
		busy 1
	}
	busy 1
	if {$doit == 1} { sh "bk rm $leftFile\n" }
	.files.l tag delete select
	.files.l configure -state normal
	.files.l delete $leftLine "$leftLine lineend + 1 char"
	incr leftCount -1
	# Reuse that code.
	if {$leftCount == 0} { doDeleteAll; if {$doit == 1} {busy 0}; return }

	Select .files.l leftLine leftFile $leftLine
	if {$doit == 1} {
		if {$leftFile != "" && $rightFile != ""} {
			diffFiles $leftFile $rightFile
			.menu.rename configure -state normal
		} else {
			clear disabled
		}
		.files.l configure -state disabled
		busy 0
	}
}

proc Create {doit} \
{
	global	rightLine rightFile rightCount leftFile isBusy

	if {$doit == 1} {
		if {$isBusy == 1} { return }
		busy 1
	}
	if {$doit == 1} { sh "bk new $rightFile\n" }
	.files.r tag delete select
	.files.r configure -state normal
	.files.r delete $rightLine "$rightLine lineend + 1 char"
	incr rightCount -1
	# Reuse that code.
	if {$rightCount == 0} { doCreateAll; if {$doit == 1} {busy 0}; return }

	Select .files.r rightLine rightFile $rightLine
	if {$doit == 1} {
		if {$leftFile != "" && $rightFile != ""} {
			diffFiles $leftFile $rightFile
			.menu.rename configure -state normal
		} else {
			clear disabled
		}
		.files.r configure -state disabled
		busy 0
	}
}

proc Rename {} \
{
	global	leftFile rightFile isBusy

	if {$isBusy == 1} { return }
	busy 1
	sh "bk mv $leftFile $rightFile\n"
	Create 0
	Delete 0
	if {$leftFile != "" && $rightFile != ""} {
		diffFiles $leftFile $rightFile
		.menu.rename configure -state normal
		.menu.guess configure -state normal
	} else {
		clear disabled
		.menu.rename configure -state disabled
		.menu.guess configure -state disabled
	}
	.files.l configure -state disabled
	.files.r configure -state disabled
	busy 0
}

proc sh {buf} \
{
	global	undoLine gc

	.files.sh tag delete select
	.files.sh configure -state normal
	.files.sh insert end $buf select
	.files.sh configure -state disabled
	.files.sh tag configure select \
	    -background $gc(rename.textBG) \
	    -foreground $gc(rename.textFG) \
	    -relief groove -borderwid 1
	.menu.undo configure -state normal
	.menu.apply configure -state normal
	set undoLine [.files.sh index "end - 2 chars linestart"]
}

proc Undo {} \
{
	global	undoLine leftCount rightCount gc

	.files.sh tag delete select
	set buf [.files.sh get $undoLine "$undoLine lineend"]
	.files.sh configure -state normal
	.files.sh delete $undoLine "$undoLine lineend + 1 char"
	.files.sh configure -state disabled
	if {[regexp {^bk mv (.*) (.*)$} $buf dummy from to]} {
		.files.l configure -state normal
		.files.l insert end "$from\n"
		.files.l configure -state disabled
		.files.r configure -state normal
		.files.r insert end "$to\n"
		.files.r configure -state disabled
		incr leftCount 1
		incr rightCount 1
		.menu.createAll configure -state normal
		.menu.deleteAll configure -state normal
	} elseif {[regexp {^bk rm (.*)$} $buf dummy rm]} {
		.files.l configure -state normal
		.files.l insert end "$rm\n"
		.files.l configure -state disabled
		incr leftCount 1
		.menu.deleteAll configure -state normal
	} elseif {[regexp {^bk new (.*)$} $buf dummy new]} {
		.files.r configure -state normal
		.files.r insert end "$new\n"
		.files.r configure -state disabled
		incr rightCount 1
		.menu.createAll configure -state normal
	}
	set undoLine [.files.sh index "end - 2 chars linestart"]
	set undoFile [.files.sh get $undoLine "$undoLine lineend"]
	if {$undoFile != ""} {
		set l $undoLine
		.files.sh tag add select "$l linestart" "$l lineend + 1 char"
		.files.sh tag configure select \
		    -background $gc(rename.textBG) \
		    -foreground $gc(rename.textFG) \
		    -relief groove -borderwid 1
	} else {
		.menu.undo configure -state disabled
		.menu.apply configure -state disabled
	}
}

proc sccsFile {type file} \
{
	set dir [file dirname $file]
	set tail [file tail $file]
	if {$dir == ""} {
		return [file join SCCS "$type.$tail"]
	} else {
		return [file join $dir SCCS "$type.$tail"]
	}
}

# Try to find a match to the file on the left.
# 1) Try a basename match
# 2) Try a partial basename match (both ways)
proc Guess {} \
{
	global	leftFile rightFile leftCount rightCount guessNext

	if {$leftCount == 0 || $rightCount == 0 || $leftFile == ""} { return }
	set left [file tail $leftFile]

	# Try an exact basename match
	set l [expr {$guessNext + 1}]
	set file [.files.r get "$l.0" "$l.0 lineend"]
	while {$file != ""} {
		set right [file tail $file]
		if {$left == $right} {
			Select .files.r rightLine rightFile $l.0
			diffFiles $leftFile $rightFile
			set guessNext $l
			return 1
		}
		incr l
		set file [.files.r get "$l.0" "$l.0 lineend"]
	}

	# Try a partial basename match, ignoring case
	set l [expr {$guessNext + 1}]
	set file [.files.r get "$l.0" "$l.0 lineend"]
	set L [string tolower $left]
	while {$file != ""} {
		set R [string tolower [file tail $file]]
		if {[string first $L $R] >= 0 || [string first $R $L] >= 0} {
			Select .files.r rightLine rightFile $l.0
			diffFiles $leftFile $rightFile
			set guessNext $l
			return 1
		}
		incr l
		set file [.files.r get "$l.0" "$l.0 lineend"]
	}
	.menu.guess configure -state disabled
	return 0
}

# This needs to try to apply this, checking each file for a destination
# conflict.  If there is one, then leave that file in the sh window and
# go on.
proc Apply {} \
{
	global	undoLine leftCount rightCount QUIET gc

	busy 1
	.files.sh configure -state normal
	set l 1
	set buf [.files.sh get "$l.0" "$l.0 lineend"]
	set NEW [open "|bk new $QUIET -" w]
	while {$buf != ""} {
		if {[regexp {^bk mv (.*) (.*)$} $buf dummy from to]} {
			# want to move the [sp].file by hand, the caller
			# of this tool will check them in.
			set sfrom [sccsFile s $from]
			set pfrom [sccsFile p $from]
			set sto [sccsFile s $to]
			set pto [sccsFile p $to]
			if {[file exists $sto]} {
				set status 1
				set msg "$sto exists"
			} else {
				set dir [file dirname $sto]
				if {[file exists $dir] == 0} {
					file mkdir $dir
				}
				file rename -- $sfrom $sto
				file rename -- $pfrom $pto
				set status 0
				set msg ""
			}
		} elseif {[regexp {^bk rm (.*)$} $buf dummy rm]} {
			set status [catch {exec bk rm -d $rm} msg]
		} elseif {[regexp {^bk new (.*)$} $buf dummy new]} {
			puts $NEW "$new"
			set status 0
			set msg ""
		}
		# puts "buf=$buf status=$status msg=$msg"
		if {$status == 0} {
			.files.sh delete "$l.0" "$l.0 lineend + 1 char"
		} else {
			# XXX - need an error message popup.
			incr l
		}
		set buf [.files.sh get "$l.0" "$l.0 lineend"]
	}
	catch { close $NEW }
	if {$l == 1.0 && $leftCount == 0 && $rightCount == 0} { exit 0 }
	.files.sh tag delete select
	.files.sh configure -state disabled
	if {$l == 1.0} {
		.menu.undo configure -state disabled
		.menu.apply configure -state disabled
		set undoLine 0.0
	} else {
		set undoLine 1.0
		.files.sh tag add select "1.0 linestart" "1.0 lineend + 1 char"
		.files.sh tag configure select \
		    -background $gc(rename.textBG) \
		    -foreground $gc(rename.textFG) \
		    -relief groove -borderwid 1
	}
	busy 0
}

proc history {} \
{
	global	leftFile

	catch {exec bk revtool $leftFile &}
}

# --------------- Window stuff ------------------
proc busy {busy} \
{
	global isBusy

	if {$busy == 1} {
		set isBusy 1
		. configure -cursor watch
		.files.l configure -cursor watch
		.files.r configure -cursor watch
		.files.sh configure -cursor watch
		.diffs.l configure -cursor watch
		.diffs.r configure -cursor watch
		.menu configure -cursor watch
	} else {
		. configure -cursor left_ptr
		.menu configure -cursor left_ptr
		.files.l configure -cursor left_ptr
		.files.r configure -cursor left_ptr
		.files.sh configure -cursor left_ptr
		.diffs.l configure -cursor left_ptr
		.diffs.r configure -cursor left_ptr
		set isBusy 0
	}
	update
}

proc pixSelect {which line file x y} \
{
	set l [$which index "@$x,$y linestart"]

	## Protect against selecting below the end of the list
	if { ($l + 1) < [ $which index "end linestart" ] } {
		Select $which $line $file $l
	}
}

proc Select {which line file l} \
{
	global	leftFile rightFile leftLine rightLine undoLine rightCount
	global	guessNext gc

	set foo [$which get "$l linestart" "$l lineend"]
	if {$foo != ""} {
		set $file $foo
		$which tag delete select
		$which tag add select "$l linestart" "$l lineend + 1 char"
		$which tag configure select \
		    -background $gc(rename.textBG) \
		    -foreground $gc(rename.textFG) \
		    -relief groove -borderwid 1
		$which see $l
		set doDiff 1
		if {$leftFile != ""} {
			.menu.history configure -state normal
			if {$rightCount > 0} {
				set guessNext 0
				.menu.guess configure -state normal
				if {$which == ".files.l" && [Guess] == 1} {
					set doDiff 0
				}
			}
		}
		if {$doDiff == 1 && $leftFile != "" && $rightFile != ""} {
			diffFiles $leftFile $rightFile
			.menu.rename configure -state normal
		}
		if {$leftFile != ""} {
			.menu.delete configure -state normal
			if {$rightCount != 0} {
				.menu.guess configure -state normal
			} else {
				.menu.guess configure -state disabled
			}
		}
		if {$rightFile != ""} { .menu.create configure -state normal }
		if {$file == "undoFile"} { .menu.undo configure -state normal }
	}
	set $line $l
}

proc yscroll { a args } \
{
	eval { .diffs.l yview $a } $args
	eval { .diffs.r yview $a } $args
}

proc xscroll { a args } \
{
	eval { .diffs.l xview $a } $args
	eval { .diffs.r xview $a } $args
}

proc Page {view dir one} \
{
	set p [winfo pointerxy .]
	set x [lindex $p 0]
	set y [lindex $p 1]
	page ".diffs" $view $dir $one
	return 1
}

proc page {w xy dir one} \
{
	global	gc

	if {$xy == "yview"} {
		set lines [expr {$dir * $gc(rename.diffHeight)}]
	} else {
		# XXX - should be width.
		set lines 16
	}
	if {$one == 1} {
		set lines [expr {$dir * 1}]
	} else {
		incr lines -1
	}
	.diffs.l $xy scroll $lines units
	.diffs.r $xy scroll $lines units
}

proc fontHeight {f} \
{
	return [expr {[font metrics $f -ascent] + [font metrics $f -descent]}]
}

proc computeHeight {} \
{
	global	gc

	update
	set f [fontHeight [.diffs.l cget -font]]
	set p [winfo height .diffs.l]
	set gc(rename.diffHeight) [expr {$p / $f}]
}

proc adjustHeight {diff list} \
{
	global	gc

	incr gc(rename.listHeight) $list
	.files.l configure -height $gc(rename.listHeight)
	.files.r configure -height $gc(rename.listHeight)
	.files.sh configure -height $gc(rename.listHeight)
	incr gc(rename.diffHeight) $diff
	.diffs.l configure -height $gc(rename.diffHeight)
	.diffs.r configure -height $gc(rename.diffHeight)
}

proc widgets {} \
{
	global	scroll wish tcl_platform gc d

	if {$tcl_platform(platform) == "windows"} {
		set y 0
		set filesHt 9
	} else {
		set y 1
		set filesHt 7
	}
	getConfig "rename"
	option add *background $gc(BG)

	set g [wm geometry .]
	if {("$g" == "1x1+0+0") && ("$gc(rename.geometry)" != "")} {
		wm geometry . $gc(rename.geometry)
	}
	wm title . "Rename Tool"

	set py 2
	set px 4
	set bw 2
	frame .menu -background $gc(rename.buttonColor)
	    button .menu.prev -font $gc(rename.buttonFont) \
		-bg $gc(rename.buttonColor) \
		-pady $py -padx $px -borderwid $bw \
		-text "<< Diff" -state disabled -command prev
	    button .menu.next -font $gc(rename.buttonFont) \
		-bg $gc(rename.buttonColor) \
		-pady $py -padx $px -borderwid $bw \
		-text ">> Diff" -state disabled -command next
	    button .menu.history -font $gc(rename.buttonFont) \
		-bg $gc(rename.buttonColor) \
		-pady $py -padx $px -borderwid $bw \
		-text "History" -state disabled \
		-command history
	    button .menu.delete -font $gc(rename.buttonFont) \
		-bg $gc(rename.buttonColor) \
		-pady $py -padx $px -borderwid $bw \
		-text "Delete" -state disabled -command "Delete 1"
	    button .menu.deleteAll -font $gc(rename.buttonFont) \
		-bg $gc(rename.buttonColor) \
		-pady $py -padx $px -borderwid $bw \
		-text "Delete All" -command DeleteAll
	    button .menu.guess -font $gc(rename.buttonFont) \
		-bg $gc(rename.buttonColor) \
		-pady $py -padx $px -borderwid $bw \
		-text "Guess" -command Guess 
	    button .menu.rename -font $gc(rename.buttonFont) \
		-bg $gc(rename.buttonColor) \
		-pady $py -padx $px -borderwid $bw \
		-text "Rename" -state disabled -command Rename 
	    button .menu.create -font $gc(rename.buttonFont) \
		-bg $gc(rename.buttonColor) \
		-pady $py -padx $px -borderwid $bw \
		-text "Create" -state disabled -command "Create 1"
	    button .menu.createAll -font $gc(rename.buttonFont) \
		-bg $gc(rename.buttonColor) \
		-pady $py -padx $px -borderwid $bw \
		-text "Create All" -command CreateAll
	    button .menu.undo -font $gc(rename.buttonFont) \
		-bg $gc(rename.buttonColor) \
		-pady $py -padx $px -borderwid $bw \
		-text "Undo" -state disabled -command Undo
	    button .menu.apply -font $gc(rename.buttonFont) \
		-bg $gc(rename.buttonColor) \
		-pady $py -padx $px -borderwid $bw \
		-text "Apply" -state disabled -command Apply
	    button .menu.quit -font $gc(rename.buttonFont) \
		-bg $gc(rename.buttonColor) \
		-pady $py -padx $px -borderwid $bw \
		-text "Quit" -command exit 
	    button .menu.help -bg $gc(rename.buttonColor) \
		-pady $py -padx $px -borderwid $bw \
		-font $gc(rename.buttonFont) -text "Help" \
		-command { exec bk helptool renametool & }
	    pack .menu.prev  -side left
	    pack .menu.next -side left
	    pack .menu.history -side left
	    pack .menu.delete -side left
	    pack .menu.deleteAll -side left
	    pack .menu.guess -side left
	    pack .menu.rename -side left
	    pack .menu.create -side left
	    pack .menu.createAll -side left
	    pack .menu.apply -side left
	    pack .menu.undo -side left
	    pack .menu.quit -side right
	    pack .menu.help -side right

	frame .files
	    label .files.deletes -font $gc(rename.fixedFont) -relief raised \
		-borderwid 1 -background $gc(rename.buttonColor) \
		-text "Deleted files"
	    label .files.creates -font $gc(rename.fixedFont) -relief raised \
		-borderwid 1 -background $gc(rename.buttonColor) \
		-text "Created files"
	    label .files.resolved -font $gc(rename.fixedFont) -relief raised \
		-borderwid 1 -background $gc(rename.buttonColor) \
		-text "Resolved files"
	    text .files.l -height $gc(rename.listHeight) -wid 1 \
		-bg $gc(rename.listBG) -fg $gc(rename.textFG) \
		-state disabled -wrap none -font $gc(rename.fixedFont) \
		-xscrollcommand { .files.xsl set } \
		-yscrollcommand { .files.ysl set }
	    scrollbar .files.xsl -wid $gc(rename.scrollWidth) \
		-troughcolor $gc(rename.troughColor) \
		-background $gc(rename.scrollColor) \
		-orient horizontal \
		-command ".files.l xview"
	    scrollbar .files.ysl -wid $gc(rename.scrollWidth) \
		-troughcolor $gc(rename.troughColor) \
		-background $gc(rename.scrollColor) \
		-orient vertical \
		-command ".files.l yview"
	    text .files.r -height $gc(rename.listHeight) -wid 1 \
		-bg $gc(rename.listBG) -fg $gc(rename.textFG) \
		-state disabled -wrap none -font $gc(rename.fixedFont) \
		-xscrollcommand { .files.xsr set } \
		-yscrollcommand { .files.ysr set }
	    scrollbar .files.xsr -wid $gc(rename.scrollWidth) \
		-troughcolor $gc(rename.troughColor) \
		-background $gc(rename.scrollColor) \
		-orient horizontal \
		-command ".files.r xview"
	    scrollbar .files.ysr -wid $gc(rename.scrollWidth) \
		-troughcolor $gc(rename.troughColor) \
		-background $gc(rename.scrollColor) \
		-orient vertical \
		-command ".files.r yview"
	    text .files.sh -height $gc(rename.listHeight) -wid 1 \
		-bg $gc(rename.listBG) -fg $gc(rename.textFG) \
		-state disabled -wrap none -font $gc(rename.fixedFont) \
		-xscrollcommand { .files.xssh set } \
		-yscrollcommand { .files.yssh set }
	    scrollbar .files.xssh -wid $gc(rename.scrollWidth) \
		-troughcolor $gc(rename.troughColor) \
		-background $gc(rename.scrollColor) \
		-orient horizontal \
		-command ".files.sh xview"
	    scrollbar .files.yssh -wid $gc(rename.scrollWidth) \
		-troughcolor $gc(rename.troughColor) \
		-background $gc(rename.scrollColor) \
		-orient vertical \
		-command ".files.sh yview"
	    grid .files.deletes -row 0 -column 0 -sticky ewns
	    grid .files.creates -row 0 -column 2 -sticky ewns
	    grid .files.resolved -row 0 -column 4 -sticky ewns
	    grid .files.l -row 1 -column 0 -sticky ewns
	    grid .files.ysl -row 0 -rowspan 3 -column 1 -sticky nse 
	    grid .files.xsl -row 2 -column 0 -sticky ew
	    grid .files.r -row 1 -column 2 -sticky ewns
	    grid .files.ysr -row 0 -column 3 -sticky nse -rowspan 3
	    grid .files.xsr -row 2 -column 2 -sticky ew
	    grid .files.sh -row 1 -column 4 -sticky ewns
	    grid .files.yssh -row 0 -column 5 -sticky nse -rowspan 3
	    grid .files.xssh -row 2 -column 4 -sticky ew

	frame .diffs
	    frame .diffs.status
		label .diffs.status.l -background $gc(rename.oldColor) \
		    -font $gc(rename.fixedFont) \
		    -relief sunken -borderwid 2
		label .diffs.status.middle \
		    -background $gc(rename.statusColor) \
		    -font $gc(rename.fixedFont) -wid 26 \
		    -relief sunken -borderwid 2
		label .diffs.status.r -background $gc(rename.newColor) \
		    -font $gc(rename.fixedFont) \
		    -relief sunken -borderwid 2
		grid .diffs.status.l -row 0 -column 0 -sticky ew
		grid .diffs.status.middle -row 0 -column 1
		grid .diffs.status.r -row 0 -column 2 -sticky ew
	    text .diffs.l -width $gc(rename.diffWidth) \
		-bg $gc(rename.textBG) -fg $gc(rename.textFG) \
		-height $gc(rename.diffHeight) \
		-state disabled -wrap none -font $gc(rename.fixedFont) \
		-xscrollcommand { .diffs.xscroll set } \
		-yscrollcommand { .diffs.yscroll set }
	    text .diffs.r -width $gc(rename.diffWidth) \
		-bg $gc(rename.textBG) -fg $gc(rename.textFG) \
		-height $gc(rename.diffHeight) \
		-state disabled -wrap none -font $gc(rename.fixedFont)
	    scrollbar .diffs.xscroll -wid $gc(rename.scrollWidth) \
		-troughcolor $gc(rename.troughColor) \
		-background $gc(rename.scrollColor) \
		-orient horizontal -command { xscroll }
	    scrollbar .diffs.yscroll -wid $gc(rename.scrollWidth) \
		-troughcolor $gc(rename.troughColor) \
		-background $gc(rename.scrollColor) \
		-orient vertical -command { yscroll }
	    grid .diffs.status -row 0 -column 0 -columnspan 3 -stick ew
	    grid .diffs.l -row 1 -column 0 -sticky nsew
	    grid .diffs.yscroll -row 1 -column 1 -sticky ns
	    grid .diffs.r -row 1 -column 2 -sticky nsew
	    grid .diffs.xscroll -row 2 -column 0 -sticky ew
	    grid .diffs.xscroll -columnspan 3

	grid .menu -row 0 -column 0 -sticky we
	grid .files -row 1 -column 0 -sticky nsew
	grid .diffs -row 2 -column 0 -sticky nsew
	grid rowconfigure . 2 -weight 1
	grid rowconfigure .diffs 1 -weight 1
	grid columnconfigure . 0 -weight 1
	grid columnconfigure .files 0 -weight 1
	grid columnconfigure .files 2 -weight 1
	grid columnconfigure .files 4 -weight 1
	grid columnconfigure .diffs.status 0 -weight 1
	grid columnconfigure .diffs.status 2 -weight 1
	grid columnconfigure .diffs 0 -weight 1
	grid columnconfigure .diffs 2 -weight 1
	grid columnconfigure .menu 0 -weight 1

	# smaller than this doesn't look good.
	wm minsize . 700 350

	bind .diffs <Configure> { computeHeight }
	keyboard_bindings
	foreach w {.diffs.l .diffs.r} {
		bindtags $w {all Text .}
	}
	set foo [bindtags .diffs.l]
	computeHeight

	.diffs.l tag configure diff -background $gc(rename.oldColor)
	.diffs.r tag configure diff -background $gc(rename.newColor)
	. configure -background $gc(BG)
	wm deiconify .
}

# Set up keyboard accelerators.
proc keyboard_bindings {} \
{
	global gc

	bind all <Prior> { if {[Page "yview" -1 0] == 1} { break } }
	bind all <Next> { if {[Page "yview" 1 0] == 1} { break } }
	bind all <Up> { if {[Page "yview" -1 1] == 1} { break } }
	bind all <Down> { if {[Page "yview" 1 1] == 1} { break } }
	bind all <Left> { if {[Page "xview" -1 1] == 1} { break } }
	bind all <Right> { if {[Page "xview" 1 1] == 1} { break } }
	bind all <Home> {
		global	lastDiff

		set lastDiff 1
		dot
		.diffs.l yview -pickplace 1.0
		.diffs.r yview -pickplace 1.0
	}
	bind all <End> {
		global	lastDiff diffCount

		set lastDiff $diffCount
		dot
		.diffs.l yview -pickplace end
		.diffs.r yview -pickplace end
	}
	bind all <$gc(rename.quit)>	exit
	bind all <space>	next
	bind all <n>		next
	bind all <p>		prev
	bind all <period>	dot
	bind all <h>		\
	    { if {[.menu.history cget -state] == "normal"} { history } }
	bind all <c>		\
	    { if {[.menu.create cget -state] == "normal"} { Create 1 } }
	bind all <C>		\
	    { if {[.menu.createAll cget -state] == "normal"} { CreateAll } }
	bind all <d>		\
	    { if {[.menu.delete cget -state] == "normal"} { Delete 1 } }
	bind all <D>		\
	    { if {[.menu.deleteAll cget -state] == "normal"} { DeleteAll } }
	bind all <g>		\
	    { if {[.menu.guess cget -state] == "normal"} { Guess } }
	bind all <r>		\
	    { if {[.menu.rename cget -state] == "normal"} { Rename } }
	bind all <a>		\
	    { if {[.menu.apply cget -state] == "normal"} { Apply } }
	bind all <u>		\
	    { if {[.menu.undo cget -state] == "normal"} { Undo } }

	# Adjust relative heights
	bind all <Alt-Up> { adjustHeight 1 -1 }
	bind all <Alt-Down> { adjustHeight -1 1 }

	bind .files.l <ButtonPress> {
		pixSelect .files.l leftLine leftFile %x %y
	}
	bind .files.r <ButtonPress> {
		pixSelect .files.r rightLine rightFile %x %y
	}
	bind .files.sh <ButtonPress> {
		pixSelect .files.sh undoLine undoFile %x %y
	}
	bind .files.r <Double-1> {
		global	rightFile

		pixSelect .files.r rightLine rightFile %x %y
		fillFile .diffs.r $rightFile
		break
	}
}

proc main {} \
{
	global argv0 argv argc QUIET

	set x [lindex $argv 0]
	if {"$x" == "-q"} {
		set QUIET "-q"
	} else {
		set QUIET ""
	}
	bk_init
	widgets
	getFiles
}

main
