#
# This search library code can be called from other bk tcl/tk applications
#
# To add the search feature to a new app, you need to add the following
# lines:
#
# search_widgets .enclosing_frame .widget_to_search
# search_keyboard_bindings
#
# The search_widgets procedure takes two arguments. The first argument
# is the enclosing widget that the search buttons and prompts will be
# packed into. The second argument is the widget that search will do
# its searching in.
# 

proc searchbuttons {button state} \
{
	global	search

	if {$button == "both"} {
		if {[info exists search(next)]} {
			$search(next) configure -state $state
		}
		if {[info exists search(prev)]} {
			$search(prev) configure -state $state
		}
	} elseif {$button == "prev"} { 
		if {[info exists search(prev)]} {
			$search(prev) configure -state $state
		}
	} else {
		if {[info exists search(next)]} {
			$search(next) configure -state $state
		}
	}
}

proc searchdir {dir} \
{
	global	search

	set search(dir) $dir
}

proc search {dir} \
{
	global	search

	searchreset
	set search(dir) $dir
	if {$dir == ":"} {
		$search(menu) configure -text "Goto Line"
		set search(prompt) "Goto Line:"

	} elseif {$dir == "g"} {
		$search(menu) configure -text "Goto Diff"
		set search(prompt) "Goto diff:"
	} else {
		$search(menu) configure -text "Search Text"
		set search(prompt) "Search for:"
	}
	focus $search(text)
	searchbuttons both disabled
}

proc searchreset {} \
{
	global	search

	set string [$search(text) get]
	if {"$string" != ""} {
		set search(lastsearch) $string
		set search(lastlocation) $search(start)
		$search(text) delete 0 end
		if {[info exists search(clear)]} {
			$search(clear) configure -state disabled
		}
		if {[info exists search(recall)] && "$string" != ""} {
			$search(recall) configure -state normal \
			    -text "Recall search"
		}
	}
	if {$search(dir) == "?"} {
		set search(start) "end"
	} else {
		set search(start) "1.0"
	}
	searchbuttons both disabled
	set search(where) $search(start)
	if {[info exists search(status)]} {
		$search(status) configure -text ""
	}
}

proc searchrecall {} \
{
	global	search

	if {[info exists search(lastsearch)]} {
		$search(text) delete 0 end
		$search(text) insert end $search(lastsearch)
		set search(start) $search(lastlocation)
		searchsee $search(lastlocation)
		if {[info exists search(recall)]} {
			$search(recall) configure -state disabled
		}
		if {[info exists search(clear)]} {
			$search(clear) configure -state normal \
			    -text "Clear search"
		}
		searchbuttons both normal
	}
}

proc searchactive {} \
{
	global	search

	set string [$search(text) get]
	if {"$string" != ""} { return 1 }
	return 0
}

proc searchstring {} \
{
	global	search lastDiff

	if {[info exists search(focus)]} { 
		focus $search(focus) 
	}
	# One would think that [0-9][0-9]* would be the more appropriate
	# regex to find an integer... -ask
	set string [$search(text) get]
	if {"$string" == ""} {
		searchreset
		return
	} elseif {("$string" != "") && ($search(dir) == ":")} {
		if {[string match {[0-9]*} $string]} {
		    $search(widget) see "$string.0"
		} elseif {[string match {[0-9]*} $string] || 
		    ($string == "end") || ($string == "last")} {
			$search(widget) see end
		} else {
			$search(status) configure -text "$string not integer"
		}
		return
	} elseif {("$string" != "") && ($search(dir) == "g")} {
		if {[string match {[0-9]*} $string]} {
			catch {$search(widget) see diff-${string}}
			set lastDiff $string
			#set n [$search(widget) mark names]
			#set l [$search(widget) index diff-${string}]
			#displayMessage "l=($l) trying mark=(diff-${string})"
			if {[info procs dot] != ""} { dot }
			return
		} else {
			$search(status) configure -text "$string not integer"
			return
		}
	} else {
		set search(string) $string
		if {[info exists search(clear)]} {
			$search(clear) configure -state normal \
			    -text "Clear search"
		}
	}
	if {[searchnext] == 0} {
		searchreset
		if {[info exists search(status)]} {
			$search(status) configure -text "$string not found"
		}
	} else {
		if {[info exists search(status)]} {
			$search(status) configure -text ""
		}
	}
}

proc searchnext {} \
{
	global	search

	if {![info exists search(string)]} {return}

	if {$search(dir) == "/"} {
		set w [$search(widget) \
		    search -regexp -count l -- \
		    $search(string) $search(start) "end"]
	} else {
		set i ""
		catch { set i [$search(widget) index search.first] }
		if {"$i" != ""} { set search(start) $i }
		set w [$search(widget) \
		    search -regexp -backwards -count l -- \
		    $search(string) $search(start) "1.0"]
	}
	if {"$w" == ""} {
		if {[info exists search(focus)]} { focus $search(focus) }
		if {$search(dir) == "/"} {
			searchbuttons next disabled
		} else {
			searchbuttons prev disabled
		}
		return 0
	}
	searchbuttons both normal
	searchsee $w
	set search(start) [$search(widget) index "$w + $l chars"]
	$search(widget) tag remove search 1.0 end
	$search(widget) tag add search $w "$w + $l chars"
	$search(widget) tag raise search
	if {[info exists search(focus)]} { focus $search(focus) }
	return 1
}

proc gotoLine {} \
{
	global search

	set location ""

	$search(widget) index $location
	searchsee $location
	exit
}

# Default widget scroller, overridden by tools such as difftool
proc searchsee {location} \
{
	global	search

	$search(widget) see $location
}

proc clearOrRecall {} \
{
	global search 

	set which [$search(clear) cget -text]
	if {$which == "Recall search"} {
		searchrecall
	} else {
		searchreset
	}
}

proc search_keyboard_bindings {{nc {}}} \
{
	global search

	if {$nc == ""} {
		bind .                <g>             "search g"
		bind .                <colon>         "search :"
		bind .                <slash>         "search /"
		bind .                <question>      "search ?"
	}
	bind .                <Control-u>     searchreset
	bind .                <Control-r>     searchrecall
	bind $search(text)      <Return>        searchstring
	bind $search(text)      <Control-u>     searchreset
	# In the search window, don't listen to "all" tags.
        bindtags $search(text) [list $search(text) Entry]
}

proc search_init {w s} \
{
	global search app gc

	set search(prompt) "Search for:"
	set search(plabel) $w.prompt
	set search(dir) "/"
	set search(text) $w.search
	set search(menu) $w.smb
	set search(widget) $s
	set search(next) $w.searchNext
	set search(prev) $w.searchPrev
	set search(focus) .
	set search(clear) $w.searchClear
	set search(recall) $w.searchClear
	set search(status) $w.info
}

proc search_widgets {w s} \
{
	global search app gc

	search_init $w $s

	image create photo prevImage \
	    -format gif -data {
R0lGODdhDQAQAPEAAL+/v5rc82OkzwBUeSwAAAAADQAQAAACLYQPgWuhfIJ4UE6YhHb8WQ1u
WUg65BkMZwmoq9i+l+EKw30LiEtBau8DQnSIAgA7
}
	image create photo nextImage \
	    -format gif -data {
R0lGODdhDQAQAPEAAL+/v5rc82OkzwBUeSwAAAAADQAQAAACLYQdpxu5LNxDIqqGQ7V0e659
XhKKW2N6Q2kOAPu5gDDU9SY/Ya7T0xHgTQSTAgA7
}
	label $search(plabel) -font $gc($app.buttonFont) -width 11 \
	    -relief flat \
	    -textvariable search(prompt)

	# XXX: Make into a pulldown-menu! like is sccstool
	menubutton $search(menu) -font $gc($app.buttonFont) -relief raised \
	    -bg $gc($app.buttonColor) -pady $gc(py) -padx $gc(px) \
	    -borderwid $gc(bw) \
	    -text "Search" -width 15 -state normal \
	    -menu $search(menu).menu
	    set m [menu $search(menu).menu]
	    $m add command -label "Search text" -command {
		$search(menu) configure -text "Search text"
		search /
		# XXX
	    }
	    $m add command -label "Goto Diff" -command {
		$search(menu) configure -text "Goto Diff"
		search g
		# XXX
	    }
	    $m add command -label "Goto Line" -command {
		$search(menu) configure -text "Goto Line"
		search :
		# XXX
	    }
	entry $search(text) -width 20 -font $gc($app.buttonFont)
	button $search(prev) -font $gc($app.buttonFont) \
	    -bg $gc($app.buttonColor) \
	    -pady $gc(py) -padx $gc(px) -borderwid $gc(bw) \
	    -image prevImage \
	    -state disabled -command {
		    searchdir ?
		    searchnext
	    }
	button $search(next) -font $gc($app.buttonFont) \
	    -bg $gc($app.buttonColor) \
	    -pady $gc(py) -padx $gc(px) -borderwid $gc(bw) \
	    -image nextImage \
	    -state disabled -command {
		    searchdir /
		    searchnext
	    }
	button $search(clear) -font $gc($app.buttonFont) \
	    -bg $gc($app.buttonColor) \
	    -pady $gc(py) -padx $gc(px) -borderwid $gc(bw) -width 15\
	    -text "Clear search" -state disabled -command { clearOrRecall }
	label $search(status) -width 20 -font $gc($app.buttonFont) -relief flat

	pack $search(menu) -side left -expand 1 -fill y
	pack $search(text) -side left
	pack $search(prev) -side left -fill y
	pack $search(clear) -side left -fill y
	pack $search(next) -side left -fill y
	pack $search(status) -side left -expand 1 -fill x

	$search(widget) tag configure search \
	    -background $gc($app.searchColor) -font $gc($app.fixedBoldFont)
}

proc example_main_widgets {} \
{
	#global	search 

	set search(prompt) ""
	set search(dir) ""
	set search(text) .cmd.t
	set search(focus) .p.top.c
	set search(widget) .p.bottom.t

	frame .cmd -borderwidth 2 -relief ridge
		text $search(text) -height 1 -width 30 -font $font(button)
		label .cmd.l -font $font(button) -width 30 -relief groove \
		    -textvariable search(prompt)

	# Command window bindings.
	bind .p.top.c <slash> "search /"
	bind .p.top.c <question> "search ?"
	bind .p.top.c <n> "searchnext"
	bind $search(text) <Return> "searchstring"
	$search(widget) tag configure search \
	    -background yellow -relief groove -borderwid 0
}

# 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
}
# difflib - view differences; loosely based on fmtool
# Copyright (c) 1999-2000 by Larry McVoy; All rights reserved
# @(#) difflib.tcl 1.24@(#) lm@disks.bitmover.com

proc createDiffWidgets {w} \
{
	global gc app

	# XXX: Need to redo all of the widgets so that we can start being
	# more flexible (show/unshow line numbers, mapbar, statusbar, etc)
	#set w(diffwin) .diffwin
	#set w(leftDiff) $w(diffwin).left.text
	#set w(RightDiff) $w(diffwin).right.text
	frame .diffs
	    frame .diffs.status
		frame .diffs.status.lstat
		frame .diffs.status.llnum
		frame .diffs.status.mstat
		frame .diffs.status.rstat
		frame .diffs.status.rlnum

		label .diffs.status.l \
		    -background $gc($app.oldColor) \
		    -font $gc($app.fixedFont) \
		    -relief sunken -borderwid 2
		label .diffs.status.l_lnum \
		    -background $gc($app.oldColor) \
		    -font $gc($app.fixedFont) \
		    -relief sunken -borderwid 2
		label .diffs.status.r \
		    -background $gc($app.newColor) \
		    -font $gc($app.fixedFont) \
		    -relief sunken -borderwid 2
		label .diffs.status.r_lnum \
		    -background $gc($app.oldColor) \
		    -font $gc($app.fixedFont) \
		    -relief sunken -borderwid 2
		label .diffs.status.middle \
		    -foreground black \
		    -background $gc($app.statusColor) \
		    -font $gc($app.fixedFont) \
		    -wid 15 \
		    -relief sunken -borderwid 2
		pack .diffs.status \
		    .diffs.status.lstat \
		    .diffs.status.mstat \
		    .diffs.status.rstat \
		    -side left -expand true -fill x
		pack configure .diffs.status.lstat -anchor w
		pack configure .diffs.status.rstat -anchor e
		pack .diffs.status.l -in .diffs.status.lstat \
		    -expand 1 -fill x -anchor w
		pack .diffs.status.middle -in .diffs.status.mstat \
		    -expand 1 -fill x
		pack .diffs.status.r -in .diffs.status.rstat \
		    -expand 1 -fill x -anchor e
		pack propagate .diffs.status.lstat 0
		pack propagate .diffs.status.rstat 0

	    text .diffs.left \
		-width $gc($app.diffWidth) \
		-height $gc($app.diffHeight) \
		-bg $gc($app.textBG) \
		-fg $gc($app.textFG) \
		-state disabled \
		-borderwidth 0\
		-wrap none \
		-font $gc($app.fixedFont) \
		-xscrollcommand { .diffs.xscroll set } \
		-yscrollcommand { .diffs.yscroll set }
	    text .diffs.right \
		-width $gc($app.diffWidth) \
		-height $gc($app.diffHeight) \
		-bg $gc($app.textBG) \
		-fg $gc($app.textFG) \
		-state disabled \
		-borderwidth 0 \
		-wrap none \
		-font $gc($app.fixedFont)
	    scrollbar .diffs.xscroll \
		-wid $gc($app.scrollWidth) \
		-troughcolor $gc($app.troughColor) \
		-background $gc($app.scrollColor) \
		-orient horizontal \
		-command { xscroll }
	    scrollbar .diffs.yscroll \
		-wid $gc($app.scrollWidth) \
		-troughcolor $gc($app.troughColor) \
		-background $gc($app.scrollColor) \
		-orient vertical \
		-command { yscroll }

	    grid .diffs.status -row 0 -column 0 -columnspan 5 -stick ew
	    grid .diffs.left -row 1 -column 0 -sticky nsew
	    grid .diffs.yscroll -row 1 -column 1 -sticky ns
	    grid .diffs.right -row 1 -column 2 -sticky nsew
	    grid .diffs.xscroll -row 2 -column 0 -sticky ew
	    grid .diffs.xscroll -columnspan 5
	    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

	    .diffs.left tag configure diff -background $gc($app.oldColor)
	    .diffs.right tag configure diff -background $gc($app.newColor)
	    bind .diffs <Configure> { computeHeight "diffs" }
	    bind .diffs.status <Configure> { reconfigureStatus }
}

proc next {} \
{
	global	diffCount lastDiff DiffsEnd search

	if {[searchactive]} {
		set search(dir) "/"
		searchnext
		return
	}
	if {$diffCount == 0} {
		nextFile
		return
	}
	if {[info exists DiffsEnd($lastDiff)] &&
	    ([visible $DiffsEnd($lastDiff)] == 0)} {
		Page "yview" 1 0
		return
	}
	if {$lastDiff >= $diffCount} {
		nextFile
		return
	}
	incr lastDiff
	dot
}

# Override the prev proc from difflib
proc prev {} \
{
	global	Diffs DiffsEnd lastDiff diffCount search

	if {[searchactive]} {
		set search(dir) "?"
		searchnext
		return
	}
	if {$diffCount == 0} {
		prevFile
		return
	}
	if {[info exists Diffs($lastDiff)] && 
	    ([visible $Diffs($lastDiff)] == 0)} {
		Page "yview" -1 0
		return
	}
	if {$lastDiff <= 1} {
		if {[prevFile] == 0} {return}
		set lastDiff $diffCount
		dot
		while {[info exists Diffs($lastDiff)] &&
		       ([visible $DiffsEnd($lastDiff)] == 0)} {
			Page "yview" 1 0
		}
		return
	}
	incr lastDiff -1
	dot
}

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

proc dot {} \
{
	global	Diffs DiffsEnd diffCount lastDiff

	if {![info exists Diffs($lastDiff)]} {return}
	scrollDiffs $Diffs($lastDiff) $DiffsEnd($lastDiff)
	highlightDiffs $Diffs($lastDiff) $DiffsEnd($lastDiff)
	.diffs.status.middle configure -text "Diff $lastDiff of $diffCount"
	.menu.dot configure -text "Center on diff $lastDiff"
	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 app

	.diffs.left tag delete d
	.diffs.right tag delete d
	.diffs.left tag add d $start $stop
	.diffs.right tag add d $start $stop
	.diffs.left tag configure d -font $gc($app.fixedBoldFont)
	.diffs.right tag configure d -font $gc($app.fixedBoldFont)
}

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


proc scrollDiffs {start stop} \
{
	global	gc app

	# 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($app.diffHeight)} {
		set j [expr {$gc($app.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.left yview scroll $move units
	.diffs.right yview scroll $move units
	.diffs.right xview moveto 0
	.diffs.left xview moveto 0
	.diffs.right see $start
	.diffs.left see $start
}

proc chunks {n} \
{
	global	Diffs DiffsEnd nextDiff

	if {![info exists nextDiff]} {return}
	set l [.diffs.left 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} \
{
	global diffCount

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

proc changed {r l n} \
{
	global diffCount

	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.left insert end "$lc\n" diff
	.diffs.right insert end "$rc\n" diff
	set loc [.diffs.right index end]
	.diffs.right mark set diff-${diffCount} "$loc - 1 line"
	.diffs.right mark gravity diff-${diffCount} left
}

proc left {r l n} \
{
	global diffCount

	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.left insert end "$lc\n" diff
	.diffs.right insert end "$newlines" 
	set loc [.diffs.right index end]
	.diffs.right mark set diff-${diffCount} "$loc - 1 line"
	.diffs.right mark gravity diff-${diffCount} left
}

proc right {r l n} \
{
	global diffCount

	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.left insert end "$newlines" 
	.diffs.right insert end "$rc\n" diff
	set loc [.diffs.right index end]
	.diffs.right mark set diff-${diffCount} "$loc - 1 line"
	.diffs.right mark gravity diff-${diffCount} left
}

# Get the sdiff output. Make sure it contains no \r's from fucking DOS.
proc sdiff {L R} \
{
	global	rmList sdiffw tcl_platform

	set rmList ""

	# On windows, our diff always read in text mode
	# (and write in binary mode). So no need to call bk undos
	# and no need to incure the overhead of calling "grep".
	# cygwin "grep" seems to run in text mode, so it cannot
	# detect CRLF sequence in file anyway.
	#
	# XXX For some reason, Larry's diff --ignore-trailing-cr option
	# XXX have no effect when used in sdiff, need to figure out why.
	if {$tcl_platform(platform) == "windows"} {
		return [open "| $sdiffw \"$L\" \"$R\"" r]
	}

	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]
	}
	catch {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]
	}
	catch {exec bk undos $R > $dotR}
	set rmList [list $dotL $dotR]
	return [open "| $sdiffw \"$dotL\" \"$dotR\""]
}

#
# Show the selected line from the left and the right diff 
# windows above and below one another in the bottom frame
# so that it is easy to see how the lines differ
#
proc stackedDiff {win x y b} \
{
	set curLine [$win index "@$x,$y linestart"]
	#displayMessage "In stackedDiff win=($win) x=($x) y=($y) c=($curLine)"
	if {$curLine == ""} {return}
	set lline [.diffs.left get $curLine "$curLine lineend"]
	set rline [.diffs.right get $curLine "$curLine lineend"]
	set lnum [lindex [split $curLine "."] 0]
	.line.diff configure -state normal
	.line.diff delete 1.0 end
	.line.diff insert end "line $lnum:\n"
	.line.diff insert end "< $lline\n"
	.line.diff insert end "> $rline\n"
	.line.diff configure -state disabled
	return
}

# Displays the flags, modes, and path for files so that the
# user can tell whether the left and right file have been 
# modified, even when the diffs line shows 0 diffs
#
# Also, highlight the differences between the info lines
#
proc displayInfo {lfile rfile {parent {}} {stop {}}} \
{
	
	global app gc

	# Use to keep track of whether a file is a bk file or not so that 
	# we don't bother trying to diff the info lines if not needed.
	set bkfile(left) 1
	set bkfile(right) 1
	set text(left) ""
	set text(right) ""

	.diffs.left tag configure "select" -background $gc($app.infoColor)
	.diffs.right tag configure "select" -background $gc($app.infoColor)
	# 1.0 files do not have a mode line. 
	# XXX: Ask lm if x.0 files have mode lines...
	set dspec1 "{-d:DPN:\n\tFlags = :FLAGS:\n\tMode  = :RWXMODE:\n}"
	set dspec2 "{-d:DPN:\n\tFlags = :FLAGS:\n\n}"

	set files [list left $lfile $parent right $rfile $stop]
	foreach {side f r} $files {
		catch {set fd [open "| bk sfiles -g \"$f\"" r]} err
		if { ([gets $fd fname] <= 0)} {
			set text($side) \
			    "Not a BitKeeper revision controlled file"
			set bkfile($side) 0
		} else {
			if {$r != "1.0"} {
				set p [open "| bk prs -hr$r $dspec1 \"$f\""]
			} else {
				set p [open "| bk prs -hr$r $dspec2 \"$f\""]
			}
			while { [gets $p line] >= 0 } {
				if {$text($side) == ""} {
					set text($side) "$line"
				} else {
					set text($side) "$text($side)\n$line"
				}
			}
			# Get info on a checked out file
			if {$text($side) == ""} {
				# XXX: I did it this fucked up way since
				# file attributes on NT does not return the
				# unix style attributes
				catch {exec ls -l $f} ls
				set perms [lindex [split $ls] 0]
				if {[string length $perms] != 10} {
					set perms "NA"
				}
				set text($side) \
				    "$rfile\n\tFlags = NA\n\tMode = $perms"
			}
			catch {close $p}
		}
		catch {close $fd}
	}
	.diffs.left configure -state normal
	.diffs.right configure -state normal
	.diffs.left delete 1.0 end
	.diffs.right delete 1.0 end
	.diffs.left insert end "$text(left)\n" select
	.diffs.right insert end "$text(right)\n" select
	# Pad out info lines
	if {($bkfile(left) == 0) && ($bkfile(right) == 1)} {
		.diffs.left insert end "\n\n" select
	}
	if {($bkfile(left) == 1) && ($bkfile(right) == 0)} {
		.diffs.right insert end "\n\n" select
	}
	# XXX: Check differences between the info lines
	return
}

# L and R: Names of the left and right files. Might be a temporary
#          file name with the form like: '/tmp/difftool.tcl@1.30-1284'
#
# lname and rname: File name with the revision appended
#
proc readFiles {L R {O {}}} \
{
	global	Diffs DiffsEnd diffCount nextDiff lastDiff dev_null rmList
	global  lname rname finfo app gc
	global  rBoth rDiff rSame nextBoth nextSame maxBoth maxDiff maxSame
	global  types saved done Marks nextMark outputFile

	if {![file exists $L]} {
		displayMessage "Left file ($L) does not exist"
		return 1
	}
	if {![file exists $R]} {
		displayMessage "Right file ($R) does not exist"
		return 1
	}
	.diffs.left configure -state normal
	.diffs.right configure -state normal

	# append time to filename when called by csettool
	# XXX: Probably OK to use same code for difftool, fmtool and csettool???
	if {[info exists finfo(lt)] && ($finfo(lt)!= "")} {
		.diffs.status.l configure -text "$finfo(l) ($finfo(lt))"
		.diffs.status.r configure -text "$finfo(r) ($finfo(rt))"
		balloon_help .diffs.status.l "$finfo(l)\n($finfo(lt))"
		balloon_help .diffs.status.r "$finfo(r)\n($finfo(rt))"
		.diffs.status.middle configure -text "... Diffing ..."
	} elseif {[info exists lname] && ($lname != "")} {
		set lt [clock format [file mtime $L] -format "%X %d%b%y"]
		set rt [clock format [file mtime $R] -format "%X %d%b%y"]
		.diffs.status.l configure -text "$lname ($lt)"
		.diffs.status.r configure -text "$rname ($rt)"
		balloon_help .diffs.status.l "$lname\n($lt)"
		balloon_help .diffs.status.r "$rname\n($rt)"
		.diffs.status.middle configure -text "... Diffing ..."
	} else {
		set l [file tail $L]
		.diffs.status.l configure -text "$l"
		balloon_help .diffs.status.l "$l"
		set r [file tail $R]
		balloon_help .diffs.status.r "$r"
		.diffs.status.r configure -text "$r"
		.diffs.status.middle configure -text "... Diffing ..."
	}
	# fmtool stuff
	if {![catch {.merge.t delete 1.0 end} err]} {
		    .merge.menu.restart config -state normal
		    .merge.menu.skip config -state normal
		    .merge.menu.left config -state normal
		    .merge.menu.right config -state normal
		    # difflib does the delete in displayInfo
		    .diffs.left delete 1.0 end
		    .diffs.right delete 1.0 end
	}; #end fmtool stuff

	. configure -cursor watch
	update
	set lineNo 1; set diffCount 0; set nextDiff 1; set saved 0
	array set DiffsEnd {}
	array set Diffs {}
	set Marks {}; set nextMark 0
	set rBoth {}; set rDiff {}; set rSame {}
	set types {}
	set n 1
	set done 0
	set l [open $L r]
	set r [open $R r]
	set d [sdiff $L $R]
	if {$O != ""} {set outputFile $O}

	gets $d last
	if {[regexp {^Binary files.*differ$} $last]} {
		.diffs.left tag configure warn -background $gc($app.warnColor)
		.diffs.right tag configure warn -background $gc($app.warnColor)
		.diffs.left insert end "Binary Files Differ\n" warn
		.diffs.right insert end "Binary Files Differ\n" warn
		. configure -cursor left_ptr
		set lastDiff 0
		set done 0
		.diffs.status.middle configure -text "Differences"
		catch {close $d}
		return
	}
	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 }
			}
			lappend types $last
			# rBoth is built up this way because the tags stuff
			# collapses adjacent tags together.
			set start [expr {$lineNo - $n}]
			lappend rBoth "$start.0" "$lineNo.0"
			# Ditto for diffs
			if {$last != "S"} {
				lappend rDiff "$start.0" "$lineNo.0"
			} else {
				lappend rSame "$start.0" "$lineNo.0"
			}
			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 }
	}
	lappend types $last
	incr lineNo 1
	# rBoth is built up this way because the tags stuff
	# collapses adjacent tags together.
	set start [expr {$lineNo - $n}]
	lappend rBoth "$start.0" "$lineNo.0"
	# Ditto for diffs
	if {$last != "S"} {
		lappend rDiff "$start.0" "$lineNo.0"
	} else {
		lappend rSame "$start.0" "$lineNo.0"
	}
	catch {.merge.menu.l configure -text "$done / $diffCount resolved"}
	catch {close $r}
	catch {close $l}
	catch {close $d}
	if {"$rmList" != ""} {
		foreach rm $rmList {
			catch {file delete $rm}
		}
	}
	set nextSame 0
	set nextDiff 0
	set nextBoth 0
	set maxSame [expr {[llength $rSame] - 2}]
	set maxDiff [expr {[llength $rDiff] - 2}]
	set maxBoth [expr {[llength $rBoth] - 2}]

	.diffs.left configure -state disabled
	.diffs.right configure -state disabled
	. configure -cursor left_ptr
	.diffs.left configure -cursor left_ptr
	.diffs.right configure -cursor left_ptr

	if {$diffCount > 0} {
		set lastDiff 1
		dot
	} else {
		set lastDiff 0
		set done 0
		#displayMessage "done=($done) diffCount=($diffCount)"
		# XXX: Really should check to see whether status lines
		# are different
		.diffs.status.middle configure -text "No differences"
	}
} ;# readFiles

# --------------- Window stuff ------------------
proc yscroll { a args } \
{
	eval { .diffs.left yview $a } $args
	eval { .diffs.right yview $a } $args
}

proc xscroll { a args } \
{
	eval { .diffs.left xview $a } $args
	eval { .diffs.right xview $a } $args
}

#
# Scrolls page up or down
#
# w     window to scroll 
# xy    yview or xview
# dir   1 or 0
# one   1 or 0
#

proc Page {view dir one} \
{
	set p [winfo pointerxy .]
	set x [lindex $p 0]
	set y [lindex $p 1]
	set w [winfo containing $x $y]
	#puts "window=($w)"
	if {[regexp {^.diffs} $w] || [regexp {^.menu} $w]} {
		page ".diffs" $view $dir $one
		return 1
	}
	if {[regexp {^.l.filelist.t} $w]} {
		page ".diffs" $view $dir $one
		return 1
	}
	if {[regexp {^.merge} $w]} {
		page ".merge" $view $dir $one
		return 1
	}
	return 0
}

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

	if {$w == ".diffs"} {
		if {$xy == "yview"} {
			set lines [expr {$dir * $gc($app.diffHeight)}]
		} else {
			# XXX - should be width.
			set lines 16
		}
	} else {
		if {$xy == "yview"} {
			set lines [expr {$dir * $gc($app.mergeHeight)}]
		} else {
			# XXX - should be width.
			set lines 16
		}
	}
	if {$one == 1} {
		set lines [expr {$dir * 1}]
	} else {
		incr lines -1
	}
	if {$w == ".diffs"} {
		.diffs.left $xy scroll $lines units
		.diffs.right $xy scroll $lines units
	} else {
		.merge.t $xy scroll $lines units
	}
}

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

proc reconfigureStatus {} \
{
	global gc app

	set w [winfo width .diffs.status]
	set mw [winfo width .diffs.status.mstat]
	set w [expr {$w - $mw}]
	set linfo [expr $w * .45]
	set rinfo [expr $w * .45]
	set minfo [expr $w * .10]
	set fh [expr [fontHeight [.diffs.status.l cget -font]] + 6]
	#puts stderr "mw=($mw) w=$w linfo=($linfo) rinfo=$rinfo minfo=($minfo)"
	#puts [pack info .diffs.status.lstat]
	.diffs.status.lstat configure -width $linfo -height $fh
	#.diffs.status.mstat configure $minfo -height 20
	.diffs.status.rstat configure -width $rinfo -height $fh
}

proc computeHeight {w} \
{
	global gc app

	update
	if {$w == "diffs"} {
		set fh [fontHeight [.diffs.left cget -font]]
		set p [winfo height .diffs.left]
		set w [winfo width .]
		set gc($app.diffHeight) [expr {$p / $fh}]
	} else {
		set fh [fontHeight [.merge.t cget -font]]
		set p [winfo height .merge.t]
		set gc($app.mergeHeight) [expr {$p / $fh}]
	}
	return
}
# difftool - view differences; loosely based on fmtool
# Copyright (c) 1999-2000 by Larry McVoy; All rights reserved
# @(#) difftool.tcl 1.54@(#) lm@work.bitmover.com

# --------------- Window stuff ------------------

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

	getConfig "diff"
	option add *background $gc(BG)

	set g [wm geometry .]
	wm title . "Diff Tool"

	if {$tcl_platform(platform) == "windows"} {
		set gc(py) -2; set gc(px) 1; set gc(bw) 2
		if {("$g" == "1x1+0+0") && ("$gc(diff.geometry)" != "")} {
			wm geometry . $gc(diff.geometry)
		}
	} else {
		set gc(py) 1; set gc(px) 4; set gc(bw) 2
		# We iconify here so that the when we finally deiconify, all
		# of the widgets are correctly sized. Fixes irritating 
		# behaviour on ctwm.
	}
	createDiffWidgets .diffs

image create photo prevImage \
    -format gif -data {
R0lGODdhDQAQAPEAAL+/v5rc82OkzwBUeSwAAAAADQAQAAACLYQPgWuhfIJ4UE6YhHb8WQ1u
WUg65BkMZwmoq9i+l+EKw30LiEtBau8DQnSIAgA7
}
image create photo nextImage \
    -format gif -data {
R0lGODdhDQAQAPEAAL+/v5rc82OkzwBUeSwAAAAADQAQAAACLYQdpxu5LNxDIqqGQ7V0e659
XhKKW2N6Q2kOAPu5gDDU9SY/Ya7T0xHgTQSTAgA7
}
	frame .menu
	    button .menu.prev -font $gc(diff.buttonFont) \
		-bg $gc(diff.buttonColor) \
		-pady $gc(py) -padx $gc(px) -borderwid $gc(bw) \
		-image prevImage -state disabled -command {
			searchreset
			prev
		}
	    button .menu.next -font $gc(diff.buttonFont) \
		-bg $gc(diff.buttonColor) \
		-pady $gc(py) -padx $gc(px) -borderwid $gc(bw) \
		-image nextImage -state disabled -command {
			searchreset
			next
		}
	    button .menu.quit -font $gc(diff.buttonFont) \
		-bg $gc(diff.buttonColor) \
		-pady $gc(py) -padx $gc(px) -borderwid $gc(bw) \
		-text "Quit" -command cleanup 
	    button .menu.reread -font $gc(diff.buttonFont) \
		-bg $gc(diff.buttonColor) \
		-pady $gc(py) -padx $gc(px) -borderwid $gc(bw) \
		-text "Reread" -command reread
	    button .menu.help -bg $gc(diff.buttonColor) \
		-pady $gc(py) -padx $gc(px) -borderwid $gc(bw) \
		-font $gc(diff.buttonFont) -text "Help" \
		-command { exec bk helptool difftool & }
	    button .menu.dot -bg $gc(diff.buttonColor) \
		-pady $gc(py) -padx $gc(px) -borderwid $gc(bw) \
		-font $gc(diff.buttonFont) -text "Current diff" \
		-width 15 -command dot
            button .menu.filePrev -font $gc(diff.buttonFont) \
                -bg $gc(diff.buttonColor) \
                -pady $gc(py) -padx $gc(px) -borderwid $gc(bw) \
                -image prevImage \
                -state disabled -command { prevFile }
            button .menu.fileNext -font $gc(diff.buttonFont) \
                -bg $gc(diff.buttonColor) \
                -pady $gc(py) -padx $gc(px) -borderwid $gc(bw) \
                -image nextImage \
                -state normal -command { nextFile }
            menubutton .menu.fmb -font $gc(diff.buttonFont) -relief raised \
                -bg $gc(diff.buttonColor) -pady $gc(py) -padx $gc(px) \
                -borderwid $gc(bw) -text "Files" -width 6 -state normal \
                -menu .menu.fmb.menu

	    pack .menu.quit -side left -fill y
	    pack .menu.help -side left -fill y
	    pack .menu.reread -side left -fill y
	    pack .menu.prev -side left -fill y 
	    pack .menu.dot -side left -fill y
	    pack .menu.next -side left -fill y

	    search_widgets .menu .diffs.right

	#frame .line
	    #text .line.diff \
		#-width [expr $gc(diff.diffWidth) * 2 + $gc(diff.scrollWidth)] \
		#-height 3 \
		#-bg $gc(diff.textBG) -fg $gc(diff.textFG) -state disabled \
		#-borderwidth 0 \
		#-wrap none -font $gc(diff.fixedFont)
	    #pack .line.diff -side left -fill both

	grid .menu -row 0 -column 0 -sticky ew
	grid .diffs -row 1 -column 0 -sticky nsew
	#grid .line -row 2 -column 0 -sticky nsew
	grid rowconfigure .diffs 1 -weight 1
	#grid rowconfigure .line 2 -weight 1
	grid rowconfigure . 0 -weight 0
	grid rowconfigure . 1 -weight 1
	#grid rowconfigure . 2 -weight 0
	grid columnconfigure . 0 -weight 1

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

	.diffs.status.middle configure -text "Welcome to difftool!"

	#bind .diffs.left <Button-1> {stackedDiff %W %x %y "B1"; break}
	#bind .diffs.right <Button-1> {stackedDiff %W %x %y "B1"; break}
	foreach w {.diffs.left .diffs.right} {
		bindtags $w {all Text .}
	}
	computeHeight "diffs"

	$search(widget) tag configure search \
	    -background $gc(diff.searchColor) -font $gc(diff.fixedBoldFont)

	keyboard_bindings
	search_keyboard_bindings
	searchreset
	. configure -background $gc(BG)
	if {("$g" == "1x1+0+0") && ("$gc(diff.geometry)" != "")} {
		wm geometry . $gc(diff.geometry)
	}
}

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

	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.left yview -pickplace 1.0
		.diffs.right yview -pickplace 1.0
	}
	bind all <End> {
		global	lastDiff diffCount

		set lastDiff $diffCount
		dot
		.diffs.left yview -pickplace end
		.diffs.right yview -pickplace end
	}
	bind all	<$gc(diff.quit)>	cleanup
	bind all	<N>			nextFile
	bind all	<P>			prevFile
	bind all	<Control-n>		nextFile
	bind all	<Control-p>		prevFile
	bind all	<n>			next
	bind all	<space>			next
	bind all	<p>			prev
	bind all	<period>		dot
	if {$tcl_platform(platform) == "windows"} {
		bind all <MouseWheel> {
		    if {%D < 0} { next } else { prev }
		}
	} else {
		bind all <Button-4>	prev
		bind all <Button-5>	next
	}
	# In the search window, don't listen to "all" tags.
	bindtags $search(text) { .menu.search Entry . }
}

proc getRev {file rev checkMods} \
{
	global	tmp_dir unique

	set gfile ""
	set f [open "| bk sfiles -g \"$file\"" r]
	if { ([gets $f dummy] <= 0)} {
		puts stderr "$file is not under revision control."
		exit 1
	}
	catch {close $f}
	if {$checkMods} {
		set f [open "| bk sfiles -gc \"$file\"" r]
		if {([gets $f dummy] <= 0)} {
			puts "$file is the same as the checked in version."
			exit 1
		}
		catch {close $f}
	}
	set tmp [file join $tmp_dir [file tail $file]]
	set pid [pid]
	incr unique
	set tmp "$tmp@$rev-$pid$unique"
	if {[catch {exec bk get -qkTG$tmp -r$rev $file} msg]} {
		puts "$msg"
		exit 1
	}
	return $tmp
}

proc reread {} \
{
	global menu

	$menu(widget) invoke $menu(selected)
}

proc usage {} \
{
	global	argv0

	puts "usage:\tbk difftool"
	puts "\tbk difftool file"
	puts "\tbk difftool -r<rev> file"
	puts "\tbk difftool -r<rev> -r<rev2> file"
	puts "\tbk difftool file file2"
	puts "\tbk difftool -"
	exit
}

proc getFiles {} \
{
	global argv0 argv argc dev_null lfile rfile tmp_dir unique
	global gc tcl_platform tmps menu rev1 rev2 Diffs DiffsEnd

	if {$argc > 3} { usage }
	set files [list]
	set tmps [list]
	set rev1 ""
	set rev2 ""
	set Diffs(0) 1.0
	set DiffsEnd(0) 1.0
	set unique 0

	# try doing 'bk sfiles -gc | bk difftool -' to see how this works
	#puts "argc=($argc) argv=($argv)"
	if {$argc == 0} {
		set fd [open "|bk sfiles -gcvU"]
		# Sample output from 'bk sfiles -gcvU'
		# lc   sane.c
		# lc   gui/difflib.tcl
		while {[gets $fd str] >= 0} {
			set fname [string range $str 5 [string length $str]]
			#puts "fname=($fname)"
			set rfile $fname
			set lfile [getRev $rfile "+" 1]
			lappend tmps $lfile
			set t "{$lfile} {$rfile} {$fname} + checked_out"
			lappend files $t
		}
		close $fd
	} elseif {$argc == 1} {
		if {$argv == "-"} { ;# typically from sfiles pipe
			while {[gets stdin fname] >= 0} {
				if {$fname != ""} {
					set rfile $fname
					set lfile [getRev $rfile "+" 1]
					set rev1 "+"
					lappend tmps $lfile
					if {[checkFiles $lfile $rfile]} {
						set t "{$lfile} {$rfile} {$fname} + checked_out"
						lappend files $t
					}
				}
			}
		} else { ;# bk difftool file
			set rfile [lindex $argv 0]

			# Fix Dos path, convert backward slash to forward slash
			if {$tcl_platform(platform) == "windows"} {
				regsub -all "\\\\" $rfile "/" rfile
			}

			set lfile [getRev $rfile "+" 1]
			set rev1 "+"

			if {[checkFiles $lfile $rfile]} {
				set t "{$lfile} {$rfile} {$rfile} + checked_out"
				lappend files $t
			}
			lappend tmps $lfile
		}
	} elseif {$argc == 2} { ;# bk difftool -r<rev> file
		set a [lindex $argv 0]
		if {[regexp -- {-r(.*)} $a junk rev1]} {
			set rfile [lindex $argv 1]
			set lfile [getRev $rfile $rev1 0]
			# If bk file and not checked out, check it out ro
			#displayMessage "lfile=($lfile) rfile=($rfile)"
			if {[exec bk sfiles -g "$rfile"] != ""} {
				if {![file exists $rfile]} {
					#displayMessage "checking out $rfile"
					catch {exec bk get "$rfile"} err
				}
			}
			if {[checkFiles $lfile $rfile]} {
				set t "{$lfile} {$rfile} {$rfile} $rev1"
				lappend files $t
			}
			lappend tmps $lfile
			if {[file exists $rfile] != 1} { usage }
		} else { ;# bk difftool file file2"
			set lfile [lindex $argv 0]
			set rfile [lindex $argv 1]

			# Fix Dos path, convert backward slash to forward slash
			if {$tcl_platform(platform) == "windows"} {
				regsub -all "\\\\" $rfile "/" rfile
				regsub -all "\\\\" $lfile "/" lfile
			}

			if {[file isdirectory $rfile]} {
				set tfile [file tail $lfile]
				#set rfile [file join $rfile $lfile]
				set rfile [file join $rfile $tfile]
				# XXX: Should be a real predicate type func
				if {![file exists $rfile]} {
					catch {exec bk co $rfile} err
				}
			}
			if {[checkFiles $lfile $rfile]} {
				set t "{$lfile} {$rfile} {$lfile}"
				lappend files $t
			}
		}
	} else { ;# bk difftool -r<rev> -r<rev2> file
		set file [lindex $argv 2]
		set a [lindex $argv 0]
		if {![regexp -- {-r(.*)} $a junk rev1]} { usage }
		set lfile [getRev $file $rev1 0]
		lappend tmps $lfile
		set a [lindex $argv 1]
		if {![regexp -- {-r(.*)} $a junk rev2]} { usage }
		set rfile [getRev $file $rev2 0]
		lappend tmps $rfile
		if {[checkFiles $lfile $rfile]} {
			set t "{$lfile} {$rfile} {$file} $rev1 $rev2"
			lappend files $t
		}
	}
	# Now add the menubutton items if necessary
	if {[llength $files] >= 1} {
		wm deiconify .
		set menu(widget) [menu .menu.fmb.menu]
		set item 1
		foreach e $files {
			set lf [lindex $e 0]; set rf [lindex $e 1]
			set fn [lindex $e 2]; set lr [lindex $e 3]
			set rr [lindex $e 4]
			#displayMessage "rf=($rf) lf=($lf)"
			$menu(widget) add command \
			    -label $rf \
			    -command \
				"pickFile \"$lf\" \"$rf\" \"$fn\" $item $lr $rr"
			incr item
		}
		pack configure .menu.filePrev .menu.fmb .menu.fileNext \
		    -side left -fill y -after .menu.help 
		set menu(max) [$menu(widget) index last]
		set menu(selected) 1
		$menu(widget) invoke 1
	} else {
		# didn't find any valid arguments or there weren't any
		# files that needed diffing...
		puts stderr "There were no files available to diff"
		cleanup
	}
}

proc checkFiles {lfile rfile} \
{
	if {[file isfile $lfile] && [file isfile $rfile]} {
		return 1
	}
	if {![file isfile $lfile]} {
		puts stderr \
		    "File \"$lfile\" does not exist or is not a regular file"
		return 0
	}
	if {![file isfile $rfile]} {
		puts stderr \
		    "File \"$rfile\" does not exist or is not a regular file"
		return 0
	}
	puts stderr "Shouldn't get here"
	return 0
}

proc cleanup {} \
{
	global tmps

	foreach tmp $tmps { catch {file delete $tmp} err }
	exit
}

# Called from the menubutton -- updates the arrows and reads the correct file
proc pickFile {lf rf fname item {lr {}} {rr {}}} \
{
	global menu lfile rfile lname rname

	# Set globals so that 'proc reread' knows which file to reread
	set lfile $lf 
	set rfile $rf

	set menu(selected) $item
	if {$menu(selected) == 1} {
		.menu.filePrev configure -state disabled
		.menu.fileNext configure -state normal
	} elseif {$menu(selected) == $menu(max)} {
		.menu.filePrev configure -state normal
		.menu.fileNext configure -state disabled
	} else {
		.menu.filePrev configure -state normal
		.menu.fileNext configure -state normal
	}
	# If doesn't have a rev #, assume looking at non-bk files
	if {$lr != ""} {
		displayInfo $fname $fname $lr $rr
		#displayMessage "$lf $rf fname=($fname) lr=$lr rr=$rr"
		set lname "$fname@$lr"
		set rname "$fname@$rr"
		readFiles $lf $rf
	} else {
		displayInfo $lf $rf $lr $rr
		set lname "$lf"
		set rname "$rf"
		readFiles $lf $rf
	}
	return
}

# Get the previous file when the button is selected -- update the arrow state
proc prevFile {} \
{
	global menu lastFile

	if {$menu(selected) > 1} {
		incr menu(selected) -1
		.menu.fmb.menu invoke $menu(selected)
		#puts "invoking $menu(selected)"
		.menu.filePrev configure -state normal
		return 1
	} else {
		.menu.filePrev configure -state disabled
		.menu.fileNext configure -state normal
	}
	return 0
}

# Get the next file when the button is selected -- update the arrow state
proc nextFile {} \
{
	global menu lastFile

	if {$menu(selected) < $menu(max)} {
		incr menu(selected)
		.menu.fmb.menu invoke $menu(selected)
		#puts "invoking $menu(selected)"
		.menu.filePrev configure -state normal
	} else {
		.menu.fileNext configure -state disabled
	}
}

# Override searchsee definition so we scroll both windows
proc searchsee {location} \
{
	scrollDiffs $location $location
}

bk_init
widgets
getFiles
