wm withdraw .
set ::tool_name revtool
# Copyright 1999-2004,2008-2010,2013 BitMover, Inc
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.

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

proc bk_initPlatform {} \
{
	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 "bk" "ndiff" "--sdiff=1" "--ignore-trailing-cr"]
	set dev_null "/dev/null"
	set wish "wish"
	set tmp_dir  "/tmp"
	if {[info exists env(TMPDIR)] && [file writable $env(TMPDIR)]} {
		set tmp_dir $env(TMPDIR)
	}
	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"
	catch { unset env(BK_NO_GUI_PROMPT) }

	# Determine the bk icon to associate with toplevel windows. If
	# we can't find the icon, don't set the global variable. This
	# way code that needs the icon can check for the existence of
	# the variable rather than checking the filesystem.
	set f [file join [exec bk bin] bk.xbm]
	if {[file exists $f]} {
		set ::wmicon $f
		# N.B. on windows, wm iconbitmap supports a -default option
		# that is not available on unix. Bummer. 
		catch {wm iconbitmap . @$::wmicon}
	}
}
# Copyright 2000-2013,2016 BitMover, Inc
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.

proc gc {var {newValue ""}} \
{
	global	gc app

	## If we got a config var with no APP. prefix, check to see if
	## we have an app-specific config option first and force them
	## to use that if we do.
	if {[info exists app]
	    && ![string match "*.*" $var]
	    && [info exists gc($app.$var)]} {
		set var $app.$var
	}
	if {[llength [info level 0]] == 3} { set gc($var) $newValue }
	return $gc($var)
}

## An array of deprecated options and the warning to display to the
## user if they are found to be using said option.
array set deprecated {
"rev.showHistory"

"The rev.showHistory config option has been removed.
Please see 'bk help config-gui' for rev.showRevs and
rev.showCsetRevs for new options."
}

proc warn_deprecated_options {app} \
{
	global	gc deprecated

	foreach {opt desc} [array get deprecated $app.*] {
		if {![info exists gc($opt)]} { continue }
		puts ""
		foreach line [split $desc \n] {
			puts [string trim $line]
		}
	}
}

proc getConfig {prog} \
{
	global gc app env usergc

	# this causes variables like _RED_, _WHITE_, to exist in this proc
	defineSymbolicColors

	set app $prog

	option add *Label.borderWidth 1 100
	option add *Button.borderWidth 1 100
	option add *Menubutton.borderWidth 1 100
	option add *Menu.tearOff 0 widgetDefault
	option add *Menu.borderWidth 1 widgetDefault
	option add *Menu.highlightThickness 1 widgetDefault
	option add *Menu.activeBorderWidth 1 widgetDefault

	initFonts $app _d

	# colorscheme

	set _d(classicColors) 1		;# default to the old color scheme.

	set _d(tabwidth) 8		;# default width of a tab
	set _d(backup) ""		;# Make backups in ciedit: XXX NOTDOC 
	set _d(buttonColor) $SYSTEMBUTTONFACE	;# menu buttons
	set _d(diffOpts) ""		;# options to pass to diff
	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) $GRAY91		;# topics / lists background
	set _d(mergeHeight) 24		;# height of a merge window
	set _d(mergeWidth) 80		;# width of a merge window
	set _d(newColor) #c4d7c5	;# color of new revision/diff
	set _d(noticeColor) #dbdfe6	;# messages, warnings
	set _d(oldColor) $GRAY88	;# color of old revision/diff
	set _d(searchColor) $ORANGE	;# highlight for search matches
	set _d(selectColor) $LIGHTBLUE	;# current file/item/topic
	set _d(statusColor) $LIGHTBLUE	;# various status windows
	set _d(minsize) 300		;# won't remember geometry if smaller
					 # than this width or height
	#XXX: Not documented yet
	set _d(logoBG) $WHITE		;# background for widget with logo
	set _d(selectBG) $NAVY		;# useful for highlighting text
	set _d(selectFG) $WHITE		;# useful for highlighting text
	set _d(altColumnBG) $BEIGE		;# alternate column background
	set _d(infoColor) $LIGHTYELLOW	;# color of info line in difflib
	set _d(textBG) $WHITE			;# text background
	set _d(textFG) $BLACK			;# text color
	set _d(scrollColor) $GRAY85		;# scrollbar bars
	set _d(troughColor) $LIGHTBLUE	;# scrollbar troughs
	set _d(warnColor) yellow		;# error messages
	set _d(emptyBG) black
	set _d(sameBG) white
	set _d(spaceBG) white
	set _d(changedBG) gray

	set _d(quit)	Control-q	;# binding to exit tool
	set _d(compat_4x) 0		;# maintain compatibility with 4x
					;# quirky bindings
	set _d(highlightOld) $YELLOW2	;# subline highlight color for old
	set _d(highlightNew) $YELLOW2	;# subline highlight color for new
	set _d(highlightsp) $ORANGE	;# subline highlight color in diffs
	set _d(topMargin) 2		;# top margin for diffs in a diff view
	set _d(diffColor) #ededed	;# color of diff lines
	set _d(activeDiffColor) $BKGREEN1 ;# active diff color
	set _d(activeOldColor) $_d(activeDiffColor)
	set _d(activeNewColor) $_d(activeDiffColor)
	set _d(newFont) bkFixedFont
	set _d(oldFont) bkFixedFont
	set _d(activeOldFont) bkFixedFont
	set _d(activeNewFont) bkFixedFont

	set _d(bug.popupBG) $BLUE
	set _d(support.popupBG) $BLUE
	set _d(ci.iconBG) $BKPALEOLIVE	;# background of some icons
	set _d(ci.csetIconBG) $BKBLUE1	;# background of some icons
	set _d(ci.quitSaveBG) $BKSLATEBLUE1	;# "quit but save" button
	set _d(ci.quitSaveActiveBG) $BKSLATEBLUE2	;# "quit but save" button
	set _d(ci.listBG) white	
	set _d(selectColor) #f0f0f0	;# current file/item/topic
	set _d(ci.saveBG) $GRAY94		;# background of save dialog
	set _d(ci.quitNosaveBG) $RED	;# "don't save" button
	set _d(ci.quitNosaveActiveBG) $WHITE ;# "don't save" button
	set _d(ci.dimFG) $GRAY50		;# dimmed text
	set _d(ci.progressBG) $WHITE		;# background of progress bar
	set _d(ci.progressColor) $BKSLATEBLUE1 ;# color of progress bar
	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.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(ci.csetBG) $GRAY94

	set _d(cset.listHeight) 12
	set _d(cset.annotation) ""   ;# annotation options (eg: "-aum")
	set _d(cset.doubleclick) 100 ;# XXX: NOTDOC

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

	set _d(fm.redoBG) $PINK
	set _d(fm3.conflictBG) gray		;# Color for conflict message
	set _d(fm3.unmergeBG) gray	;# Color for unmerged message
	set _d(fm3.annotate) 1		;# show annotations
	set _d(fm3.comments) 1		;# show comments window
	set _d(fm3.escapeButtonFG) $YELLOW	;# foreground of escape button
	set _d(fm3.escapeButtonBG) $BLACK	;# background of escape button
	set _d(fm3.firstDiff) minus
	set _d(fm3.lastDiff) plus
	set _d(fm3.mergeColor) #b4b6cb	;# color of merge choices in merge win
	set _d(fm3.handColor) $_d(fm3.mergeColor) ;# color of hand merged choices
	set _d(fm3.nextConflict) braceright
	set _d(fm3.nextDiff) bracketright
	set _d(fm3.prevConflict) braceleft
	set _d(fm3.prevDiff) bracketleft
	set _d(fm3.sameColor) #efefef	;# color of unchanged line
	set _d(fm3.showEscapeButton) 1	;# show escape button?
	set _d(fm3.spaceColor) $BLACK	;# color of spacer lines
	set _d(fm3.toggleGCA) x		;# key to toggle GCA info
	set _d(fm3.toggleAnnotations) z	;# key to toggle annotations
	set _d(fm3.undo) u
	set _d(fm3.animateScrolling) 1	;# Use an animated scrolling effect
					;# when jumping conflict diff blocks.

	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) 79		;# number of columns to display
	set _d(help.helptext) ""	;# -f<helptextfile> - undocumented
	set _d(help.exact) 0		;# helpsearch, allows partial matches
	set _d(help.scrollbars) RR	;# sides for each scrollbar

	set _d(rename.listHeight) 8

	# N.B. 500ms is the hard-coded constant in tk used to detect
	# double clicks. We need a number slightly larger than that. The
	# book Practical Programming in Tcl/Tk, 4th ed. recommends 600. This
	# results in a noticable delay before a single-click is processed 
	# but there really is no other solution when a double-click must
	# override a single click, or a single-click action will take more
	# than 500ms and therefore preventing double-clicks from ever being
	# noticed.
	set _d(rev.doubleclick) 600  ;# XXX: NOTDOC
	set _d(rev.sashBG) $BLACK
	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) $BKCADETBLUE	;# unselected box fills
	set _d(rev.localColor) $GREEN	;# local node (for resolve)
	set _d(rev.remoteColor) $RED	;# remote node (for resolve)
	set _d(rev.gcaColor) $WHITE		;# gca node (for resolve)
	set _d(rev.tagOutline) $YELLOW	;# outline of tagged nodes
	set _d(rev.badColor) $RED		;# color for "bad" revision numbers
	set _d(rev.selectColor) $BKSTEELBLUE ;# highlight color for selected tag
	set _d(rev.dateLineColor) $LIGHTBLUE ;# line that separates dates
	set _d(rev.dateColor) $BKBLACK1	;# 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.showRevs) 250	  ;# Num of revs to show in graph 
	set _d(rev.showCsetRevs) 50	  ;# Num of revs to show for a cset
	# 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.annotate) "-Aur"	  ;# Options given to annotate

	set _d(setup.stripeColor) $BLUE ;# color of horizontal separator
	set _d(setup.mandatoryColor) $BKSLATEGRAY1 ;# mandatory fields
	set _d(bug.mandatoryColor) $BKSLATEGRAY1 ;# mandatory fields
	set _d(support.mandatoryColor) $BKSLATEGRAY1 ;# mandatory fields
	set _d(entryColor) $WHITE	   ;# Color of input fields

	set _d(search.width)		15
	set _d(search.buttonWidth)	15

	set _d(ignoreWhitespace)	0
	set _d(ignoreAllWhitespace)	0

	set _d(hlPercent)	0.5
	set _d(chopPercent)	0.5

	set _d(windows) 0
	set _d(aqua) 0
	set _d(x11) 0

	switch -exact -- [tk windowingsystem] {
	    win32 {
		set _d(windows) 1
		set _d(handCursor) "hand2"
		set _d(cset.leftWidth) 40
		set _d(cset.rightWidth) 80
		set _d(ci.filesHeight) 8
		set _d(ci.commentsHeight) 7	;# height of comment window
		set _d(buttonColor) $SYSTEMBUTTONFACE	;# menu buttons
		set _d(BG) $SYSTEMBUTTONFACE		;# default background
		# usable space
		set _d(padTop)		0
		set _d(padBottom)	28		; # someday, we'll 
							  # need to figure
							  # out the size
							  # of the taskbar
		set _d(padRight)	0
		set _d(padLeft)		0
		set _d(titlebarHeight)	20
		set rcfile [exec bk dotbk _bkgui config-gui]
	    } 
	    aqua {
		set _d(aqua) 1
		set _d(handCursor) "pointinghand"
		set _d(cset.leftWidth) 40
		set _d(cset.rightWidth) 80
		set _d(search.width) 4
		set _d(search.buttonWidth) 12
		set _d(ci.filesHeight) 8
		set _d(ci.commentsHeight) 7	;# height of comment window
		set _d(buttonColor) $SYSTEMBUTTONFACE	;# menu buttons
		set _d(BG) $SYSTEMBUTTONFACE		;# default background
		set _d(listBG) $WHITE
		#usable space
		set _d(padTop)		22              ; # someday we'll need
							  # to compute the
							  # size of the menubar
		set _d(padBottom)	0
		set _d(padRight)	0
		set _d(padLeft)		0
		set _d(titlebarHeight)	22
		set rcfile [exec bk dotbk .bkgui config-gui]
	    }
	    x11 {
		set _d(x11) 1

		option add *Scrollbar.borderWidth 1 100
		set _d(handCursor) "hand2"
		set _d(cset.leftWidth) 55
		set _d(cset.rightWidth) 80
		set _d(scrollWidth) 12		;# scrollbar width
		set _d(ci.filesHeight) 9	;# num files to show in top win
		set _d(ci.commentsHeight) 8	;# height of comment window
		set _d(fm.editor) "fm2tool"
		set _d(buttonColor) $SYSTEMBUTTONFACE	;# menu buttons
		set _d(BG) $GRAY85		;# default background
		# usable space (all of it in X11)
		set _d(padTop)		0
		set _d(padBottom)	0
		set _d(padRight)	0
		set _d(padLeft)		0
		set _d(titlebarHeight)	0
		if {$::tcl_platform(os) eq "Darwin"} {
			# We might be in X11 under Aqua, so leave room
			# for the menubar
			set _d(padTop)		22
			set _d(titlebarHeight)	22
		}
		set rcfile [exec bk dotbk .bkgui config-gui]
	    }
	    default {
		puts "Unknown windowing system"
		exit
	    }
	}

	set gc(activeNewOnly) 1

	set gc(bkdir) [file dirname $rcfile]
	if {[file readable $rcfile]} {
		source $rcfile
		warn_deprecated_options $app
	}

	## Save a copy of the gc array exactly as the user specified it.
	array set usergc [array get gc]

	## If the user specified some global option in their config-gui
	## file, write that same value into the app-specific value for
	## the current tool.  This ensures that all values from the user
	## overwrite any values we've set in here.
	foreach var [array names usergc] {
		if {[string match "*.*" $var]} { continue }
		set gc($app.$var) $usergc($var)
	}

	if {[info exists gc(classicColors)]} {
		set _d(classicColors) $gc(classicColors)
	}
	set _d($app.classicColors) $_d(classicColors)
	foreach p [list "" "$prog."] {
		if {[info exists gc(${p}classicColors)]} {
			set _d(${p}classicColors) $gc(${p}classicColors)
		}
	}

	if {[string is true -strict $_d($app.classicColors)]} {
		# set "classic" color scheme. Setting it this way
		# still lets users override individual colors by
		# setting both gc(classicColors) _and_ the color they
		# want to change
		set _d(oldColor) #C8A0FF
		set _d(newColor) #BDEDF5
		set _d(activeOldColor) $_d(oldColor)
		set _d(activeNewColor) $_d(newColor)
		set _d(activeOldFont) bkFixedBoldFont
		set _d(activeNewFont) bkFixedBoldFont
		set _d(noticeColor) $BKBLUE1
		set _d(searchColor) $YELLOW
		set _d(infoColor) $POWDERBLUE
		set _d(warnColor) $YELLOW
		set _d(highlight) $YELLOW2
		set _d(diffColor) $GRAY88
		set _d(activeDiffColor) $BKGREEN1
		set _d(fm3.conflictBG) $RED
		set _d(fm3.unmergeBG) $LIGHTYELLOW
		set _d(fm3.mergeColor) $LIGHTBLUE
		set _d(fm3.handColor) $LIGHTYELLOW
		set _d(fm3.sameColor) $BKTURQUOISE1
	}

	## Set these colors regardless of classic or not.
	set _d(diff.activeOldColor) $_d(activeDiffColor)
	set _d(diff.activeNewColor) $_d(activeDiffColor)
	set _d(diff.activeOldFont) bkFixedFont
	set _d(diff.activeNewFont) bkFixedFont

	set _d(cset.activeOldColor) $_d(activeDiffColor)
	set _d(cset.activeNewColor) $_d(activeDiffColor)
	set _d(cset.activeOldFont) bkFixedFont
	set _d(cset.activeNewFont) bkFixedFont

	set _d(fm.activeOldColor) $_d(activeDiffColor)
	set _d(fm.activeNewColor) $_d(activeDiffColor)
	set _d(fm.activeOldFont) bkFixedFont
	set _d(fm.activeNewFont) bkFixedFont

	## If the user specified showRevs but not showCsetRevs, use showRevs
	## for both values for backward compatibility.
	foreach p [list "" "$prog."] {
		if {[info exists gc(${p}showRevs)]
		    && ![info exists gc(${p}showCsetRevs)]} {
			set _d(${p}showCsetRevs) $gc(${p}showRevs)
		}
	}

	if {$prog eq "fm3"} {
		## For backward compatibility, if the user has specified
		## charColor in fm3tool, we'll use that as our subline
		## highlight color if they haven't also specified a
		## highlight color to use.
		foreach p [list "" "$prog."] {
			if {[info exists gc(${p}charColor)]
			    && ![info exists gc(${p}highlight)]} {
				set _d(${p}highlight) $gc(${p}charColor)
			}
		}
	}

	## If the user specified activeDiffColor but didn't give us anything
	## for activeNewColor or activeOldColor, fill in the activeDiffColor
	## for those values.
	foreach p [list "" "$prog."] {
		if {![info exists gc(${p}activeDiffColor)]} { continue }
		if {![info exists gc(${p}activeOldColor)]} {
			set _d(${p}activeOldColor) $gc(${p}activeDiffColor)
		}
		if {![info exists gc(${p}activeNewColor)]} {
			set _d(${p}activeNewColor) $gc(${p}activeDiffColor)
		}
	}

	# Pass one just copies all the defaults into gc unless they are set
	# already by the config file
	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"
			}
		}
    	}

	if {![info exists gc(rev.graphFont)]} {
		if {$gc(fixedFont) eq "bkFixedFont"} {
			set gc(rev.graphFont) $gc(default.fixedFont)
		} else {
			set gc(rev.graphFont) $gc(fixedFont)
		}
	}
	if {![info exists gc(rev.graphBoldFont)]} {
		if {$gc(fixedBoldFont) eq "bkFixedBoldFont"} {
			set gc(rev.graphBoldFont) $gc(default.fixedBoldFont)
		} else {
			set gc(rev.graphBoldFont) $gc(fixedBoldFont)
		}
	}

	foreach var [array names gc *Font] {
		switch -- $gc($var) {
			"default" {
				set gc($var) bkButtonFont
			}
			"default bold" {
				set gc($var) bkBoldFont
			}
			"fixed" {
				set gc($var) bkFixedFont
			}
			"fixed bold" {
				set gc($var) bkFixedBoldFont
			}
		}
	}

	configureFonts $app

	option add *Text.tabStyle wordprocessor

	if {$gc($app.tabwidth) != 8} {
		option add *Text.tabs \
		    [expr {$gc($app.tabwidth) * [font measure bkFixedFont 0]}]
	}
}

proc initFonts {app var} \
{
	upvar 1 $var _d

	## Twiddle the default Tk fonts more to our liking.
	switch -- [tk windowingsystem] {
		"x11" {
			font configure TkTextFont -size -14
			font configure TkDefaultFont -size -14
		}
		"win32" {
			font configure TkFixedFont -size 8
		}
	}

	set font [font configure TkTextFont]
	set bold [dict replace $font -weight bold]

	set fixed     [font configure TkFixedFont]
	set fixedBold [dict replace $fixed -weight bold]

	set fonts [font names]
	if {"bkBoldFont" ni $fonts} {
		font create bkBoldFont {*}$bold
	}
	if {"bkButtonFont" ni $fonts} {
		font create bkButtonFont {*}$font
	}
	if {"bkNoticeFont" ni $fonts} {
		font create bkNoticeFont {*}$bold
	}
	if {"bkFixedFont" ni $fonts} {
		font create bkFixedFont {*}$fixed
	}
	if {"bkFixedBoldFont" ni $fonts} {
		font create bkFixedBoldFont {*}$fixedBold
	}

	set _d(default.boldFont) $bold
	set _d(default.buttonFont) $font
	set _d(default.noticeFont) $bold
	set _d(default.fixedFont) $fixed
	set _d(default.fixedBoldFont) $fixedBold

	set _d(boldFont)	bkBoldFont
	set _d(buttonFont)	bkButtonFont
	set _d(noticeFont)	bkNoticeFont
	set _d(fixedFont)	bkFixedFont
	set _d(fixedBoldFont)	bkFixedBoldFont

	if {[tk windowingsystem] eq "aqua"} {
		bind all <Command-0>     "adjustFontSizes 0"
		bind all <Command-plus>  "adjustFontSizes 1"
		bind all <Command-equal> "adjustFontSizes 1"
		bind all <Command-minus> "adjustFontSizes -1"
	} else {
		bind all <Control-0>     "adjustFontSizes 0"
		bind all <Control-plus>  "adjustFontSizes 1"
		bind all <Control-equal> "adjustFontSizes 1"
		bind all <Control-minus> "adjustFontSizes -1"
	}
}

proc configureFonts {app} \
{
	global	gc usergc

	set res [getScreenSize]
	foreach font {boldFont buttonFont noticeFont fixedFont fixedBoldFont} {
		set name bk[string toupper $font 0]

		## If they have a saved state for this font, use it.
		## Otherwise we use whatever is configured either from
		## initFonts or potentially from config-gui.
		if {[info exists usergc($font)]} {
			set f $usergc($font)
		} elseif {[info exists ::State($font@$res)]} {
			set f $::State($font@$res)
		} else {
			set f $gc($font)
		}
		if {[string index $f 0] ne "-"} { set f [font actual $f] }
		font configure $name {*}$f
		set gc($font) $name
		set gc($app.$font) $name
	}
}

proc adjustFontSizes {n} \
{
	global	gc

	set res [getScreenSize]
	foreach font {fixedFont fixedBoldFont} {
		set name bk[string toupper $font 0]
		if {$n == 0} {
			set opts $gc(default.$font)
		} else {
			set opts [font configure $name]
			set size [dict get $opts -size]
			if {$size >= 0} {
				if {$size <= 6 && $n < 0} { return }
				dict incr opts -size $n
			} else {
				if {$size >= -6 && $n < 0} { return }
				dict incr opts -size [expr {-$n}]
			}
		}
		font configure $name {*}$opts
		set ::State($font@$res) $opts
	}
}

# At one point, the bk guis used symbolic color names to define some
# widget colors. Experience has shown that some color names aren't
# portable across platforms. Bug <2002-12-09-004> shows that the color 
# "darkblue", for instance, doesn't exist on some platforms.
#
# Hard-coding hex values in getConfig() is more portable, but hard
# to read. Thus, this proc defines varibles which can be used in lieu
# of hex values. The names and their definitions are immutable; if you
# want to change a color in a GUI, don't change it here. Define a new
# symbolic name, or pick an existing symbolic name. Don't redefine an
# existing color name.
proc defineSymbolicColors {} \
{
	uplevel {
		# these are taken from X11's rgb.txt file
		set BEIGE		#f5f5dc
		set BLACK		#000000
		set BLUE		#0000ff
		set DARKBLUE		#00008b
		set GRAY50		#7f7f7f
		set GRAY85		#d9d9d9
		set GRAY88		#e0e0e0
		set GRAY91		#e8e8e8
		set GRAY94		#f0f0f0
		set GREEN		#00ff00
		set LIGHTBLUE		#add8e6
		set LIGHTYELLOW	#ffffe0
		set NAVY		#000080
		set ORANGE		#ffa500
		set PINK		#ffc0cb
		set POWDERBLUE	#b0e0e6
		set RED		#ff0000
		set WHITE		#ffffff
		set YELLOW		#ffff00
		set YELLOW2		#fffd56

		# This is used for menubuttons, and is based on the
		# "SystemButtonFace" on windows. 
		if {[tk windowingsystem] eq "win32"} {
#			set SYSTEMBUTTONFACE #d4d0c8
                        set SYSTEMBUTTONFACE systembuttonface
		} elseif {[tk windowingsystem] eq "aqua"} {
			set SYSTEMBUTTONFACE $WHITE
		} else {
			set SYSTEMBUTTONFACE [ttk::style lookup . -background]
		}

		# these are other colors for which no official name exists;
		# there were once hard-coded into getConfig(), but I've
		# given them symbolic names to be consistent with all of
		# the other colors. I tried to visually match them to a
		# similar color in rgb.txt and added a BK prefix
		set BKBLACK1		#181818
		set BKBLUE1		#b0b0e0
		set BKBLUE2		#a8d8e0
		set BKBLUE3		#b4e0ff
		set BKCADETBLUE		#9fb6b8
		set BKGREEN1		#2fedad
		set BKGREEN2		#a2dec3
		set BKPALEOLIVE		#e8f8a6
		set BKPLUM		#dfafdf
		set BKSLATEBLUE1	#a0a0ff
		set BKSLATEBLUE2	#c0c0ff
		set BKSLATEGRAY1	#deeaf4
		set BKSTEELBLUE		#adb8f6
		set BKTURQUOISE1	#1cc7d0
		set BKVIOLET1		#b48cff
	}
}
# Copyright 2011,2016 BitMover, Inc
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
namespace eval ttk::theme::bk {

    package provide ttk::theme::bk 0.1

    variable colors ; array set colors {
	-disabledfg	"#999999"

	-frame  	"#EEEEEE"
        -lighter        "#FBFBFB"
        -dark           "#DEDEDE"
        -darker         "#CDCDCD"
        -darkest        "#979797"
        -pressed        "#C5C5C5"
	-lightest 	"#ffffff"
	-selectbg	"#447BCD"
	-selectfg	"#ffffff"

        -activebutton   "#E5E8ED"
    }

    ttk::style theme create bk -parent clam -settings {
	ttk::style configure "." \
	    -background $colors(-frame) \
	    -foreground black \
	    -bordercolor $colors(-darkest) \
	    -darkcolor $colors(-dark) \
	    -lightcolor $colors(-lighter) \
	    -troughcolor $colors(-darker) \
	    -selectbackground $colors(-selectbg) \
	    -selectforeground $colors(-selectfg) \
	    -selectborderwidth 0 \
	    -font TkDefaultFont \
            -indicatorsize 12 \
	    ;

	ttk::style map "." \
	    -background [list disabled $colors(-frame) \
			     active $colors(-lighter)] \
	    -foreground [list disabled $colors(-disabledfg)] \
	    -selectbackground [list !focus $colors(-darkest)] \
	    -selectforeground [list !focus white] \
	    ;

	ttk::style configure TButton \
            -anchor center -width -8 -padding 1 -relief raised
	ttk::style map TButton \
	    -background [list \
			     disabled $colors(-frame) \
			     pressed $colors(-pressed) \
			     active $colors(-activebutton)] \
	    -lightcolor [list \
                            disabled $colors(-lighter) \
                            pressed "#C5C5C5" \
                            active  "#A9C1E7"] \
	    -darkcolor [list \
                            disabled $colors(-dark) \
                            pressed "#D6D6D6" \
                            active "#7BA1DA"] \
	    ;

	ttk::style configure Toolbutton -anchor center -padding 1 -relief flat
	ttk::style map Toolbutton \
	    -relief [list \
                        disabled flat \
                        selected sunken \
                        pressed  sunken \
                        active   raised] \
	    -background [list \
			     disabled $colors(-frame) \
			     pressed $colors(-pressed) \
			     active $colors(-activebutton)] \
	    -lightcolor [list \
                            pressed "#C5C5C5" \
                            active  "#A9C1E7"] \
	    -darkcolor [list \
                            pressed "#D6D6D6" \
                            active "#7BA1DA"] \
	    ;

	ttk::style configure TCheckbutton \
	    -indicatorbackground "#ffffff" -indicatormargin {1 1 4 1}
	ttk::style configure TRadiobutton \
	    -indicatorbackground "#ffffff" -indicatormargin {1 1 4 1}
	ttk::style map TCheckbutton -indicatorbackground \
	    [list  disabled $colors(-frame)  pressed $colors(-frame)]
	ttk::style map TRadiobutton -indicatorbackground \
	    [list  disabled $colors(-frame)  pressed $colors(-frame)]

	ttk::style configure TMenubutton \
            -width -8 -padding 1 -relief raised

	ttk::style configure TEntry -padding 1 -insertwidth 1
	ttk::style map TEntry \
	    -background [list  readonly $colors(-frame)] \
	    -bordercolor [list  focus $colors(-selectbg)] \
	    -lightcolor [list  focus #6490D2] \
	    -darkcolor [list  focus #60A0FF]

	ttk::style configure TCombobox -padding 1 -insertwidth 1
	ttk::style map TCombobox \
	    -background [list active $colors(-lighter) \
			     pressed $colors(-lighter)] \
	    -fieldbackground [list {readonly focus} $colors(-selectbg)] \
	    -foreground [list {readonly focus} $colors(-selectfg)] \
	    ;

	ttk::style configure TNotebook.Tab -padding {6 0 6 2}
	ttk::style map TNotebook.Tab \
	    -padding [list selected {6 2 6 2}] \
	    -background [list active $colors(-activebutton)] \
	    -lightcolor [list \
                active #6490D2 selected $colors(-lighter) {} $colors(-dark) \
            ] \
	    -darkcolor  [list active #60A0FF] \
	    ;

    	ttk::style configure TLabelframe \
	    -labeloutside true -labelinset 0 -labelspace 2 \
	    -borderwidth 2 -relief raised

	ttk::style configure TProgressbar -background #437BCC \
            -darkcolor #546F98 -lightcolor #467ED7

	ttk::style configure Sash -sashthickness 6 -gripcount 10
    }
}
# tooltip.tcl --
#
#       Balloon help
#
# Copyright (c) 1996-2007 Jeffrey Hobbs
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# 
# RCS: @(#) $Id: tooltip.tcl,v 1.16 2008/12/01 23:37:16 hobbs Exp $
#
# Initiated: 28 October 1996


package require Tk 8.4
package require msgcat

#------------------------------------------------------------------------
# PROCEDURE
#	tooltip::tooltip
#
# DESCRIPTION
#	Implements a tooltip (balloon help) system
#
# ARGUMENTS
#	tooltip <option> ?arg?
#
# clear ?pattern?
#	Stops the specified widgets (defaults to all) from showing tooltips
#
# delay ?millisecs?
#	Query or set the delay.  The delay is in milliseconds and must
#	be at least 50.  Returns the delay.
#
# disable OR off
#	Disables all tooltips.
#
# enable OR on
#	Enables tooltips for defined widgets.
#
# <widget> ?-index index? ?-items id? ?-tag tag? ?message?
#	If -index is specified, then <widget> is assumed to be a menu
#	and the index represents what index into the menu (either the
#	numerical index or the label) to associate the tooltip message with.
#	Tooltips do not appear for disabled menu items.
#	If -item is specified, then <widget> is assumed to be a listbox
#	or canvas and the itemId specifies one or more items.
#	If -tag is specified, then <widget> is assumed to be a text
#	and the tagId specifies a tag.
#	If message is {}, then the tooltip for that widget is removed.
#	The widget must exist prior to calling tooltip.  The current
#	tooltip message for <widget> is returned, if any.
#
# RETURNS: varies (see methods above)
#
# NAMESPACE & STATE
#	The namespace tooltip is used.
#	Control toplevel name via ::tooltip::wname.
#
# EXAMPLE USAGE:
#	tooltip .button "A Button"
#	tooltip .menu -index "Load" "Loads a file"
#
#------------------------------------------------------------------------

namespace eval ::tooltip {
    namespace export -clear tooltip
    variable labelOpts
    variable tooltip
    variable G

    if {![info exists G]} {
        array set G {
            enabled     1
            fade        1
            FADESTEP    0.2
            FADEID      {}
            DELAY       500
            AFTERID     {}
            LAST        -1
            TOPLEVEL    .__tooltip__
        }
        if {[tk windowingsystem] eq "x11"} {
            set G(fade) 0 ; # don't fade by default on X11
        }
    }
    if {![info exists labelOpts]} {
	# Undocumented variable that allows users to extend / override
	# label creation options.  Must be set prior to first registry
	# of a tooltip, or destroy $::tooltip::G(TOPLEVEL) first.
	set labelOpts [list -highlightthickness 0 -relief solid -bd 1 \
			   -background lightyellow -fg black]
    }

    # The extra ::hide call in <Enter> is necessary to catch moving to
    # child widgets where the <Leave> event won't be generated
    bind Tooltip <Enter> [namespace code {
	#tooltip::hide
	variable tooltip
	variable G
	set G(LAST) -1
	if {$G(enabled) && [info exists tooltip(%W)]} {
	    set G(AFTERID) \
		[after $G(DELAY) [namespace code [list _show %W $tooltip(%W) cursor]]]
	}
    }]

    bind Menu <<MenuSelect>>	[namespace code { menuMotion %W }]
    bind Tooltip <Leave>	[namespace code [list hide 1]] ; # fade ok
    bind Tooltip <Any-KeyPress>	[namespace code hide]
    bind Tooltip <Any-Button>	[namespace code hide]
}

proc ::tooltip::tooltip {w args} {
    variable tooltip
    variable G
    switch -- $w {
	clear	{
	    if {[llength $args]==0} { set args .* }
	    clear $args
	}
	delay	{
	    if {[llength $args]} {
		if {![string is integer -strict $args] || $args<50} {
		    return -code error "tooltip delay must be an\
			    integer greater than 50 (delay is in millisecs)"
		}
		return [set G(DELAY) $args]
	    } else {
		return $G(DELAY)
	    }
	}
	fade	{
	    if {[llength $args]} {
		set G(fade) [string is true -strict [lindex $args 0]]
	    }
	    return $G(fade)
	}
	off - disable	{
	    set G(enabled) 0
	    hide
	}
	on - enable	{
	    set G(enabled) 1
	}
	default {
	    set i $w
	    if {[llength $args]} {
		set i [uplevel 1 [namespace code "register [list $w] $args"]]
	    }
	    set b $G(TOPLEVEL)
	    if {![winfo exists $b]} {
		variable labelOpts

		toplevel $b -class Tooltip
		if {[tk windowingsystem] eq "aqua"} {
		    ::tk::unsupported::MacWindowStyle style $b help none
		} else {
		    wm overrideredirect $b 1
		}
		catch {wm attributes $b -topmost 1}
		# avoid the blink issue with 1 to <1 alpha on Windows
		catch {wm attributes $b -alpha 0.99}
		wm positionfrom $b program
		wm withdraw $b
		eval [linsert $labelOpts 0 label $b.label]
		pack $b.label -ipadx 1
	    }
	    if {[info exists tooltip($i)]} { return $tooltip($i) }
	}
    }
}

proc ::tooltip::register {w args} {
    variable tooltip
    set key [lindex $args 0]
    while {[string match -* $key]} {
	switch -- $key {
	    -index	{
		if {[catch {$w entrycget 1 -label}]} {
		    return -code error "widget \"$w\" does not seem to be a\
			    menu, which is required for the -index switch"
		}
		set index [lindex $args 1]
		set args [lreplace $args 0 1]
	    }
	    -item - -items {
                if {[winfo class $w] eq "Listbox"} {
                    set items [lindex $args 1]
                } else {
                    set namedItem [lindex $args 1]
                    if {[catch {$w find withtag $namedItem} items]} {
                        return -code error "widget \"$w\" is not a canvas, or\
			    item \"$namedItem\" does not exist in the canvas"
                    }
                }
		set args [lreplace $args 0 1]
	    }
            -tag {
                set tag [lindex $args 1]
                set r [catch {lsearch -exact [$w tag names] $tag} ndx]
                if {$r || $ndx == -1} {
                    return -code error "widget \"$w\" is not a text widget or\
                        \"$tag\" is not a text tag"
                }
                set args [lreplace $args 0 1]
            }
	    -command {
		set command [lindex $args 1]
		set args [lreplace $args 0 1]
	    }
	    default	{
		return -code error "unknown option \"$key\":\
			should be -command, -index, -items or -tag"
	    }
	}
	set key [lindex $args 0]
    }
    if {[llength $args] != 1} {
	return -code error "wrong # args: should be \"tooltip widget\
		?-index index? ?-items item? ?-tag tag? message\""
    }
    if {$key eq ""} {
	clear $w
    } else {
	if {![winfo exists $w]} {
	    return -code error "bad window path name \"$w\""
	}
	set d [dict create message $key]
	if {[info exists command]} {
	    dict set d command $command
	}
	if {[info exists index]} {
	    set tooltip($w,$index) $d
	    return $w,$index
	} elseif {[info exists items]} {
	    foreach item $items {
		set tooltip($w,$item) $d
		if {[winfo class $w] eq "Listbox"} {
		    enableListbox $w $item
		} else {
		    enableCanvas $w $item
		}
	    }
	    # Only need to return the first item for the purposes of
	    # how this is called
	    return $w,[lindex $items 0]
        } elseif {[info exists tag]} {
            set tooltip($w,t_$tag) $d
            enableTag $w $tag
            return $w,$tag
	} else {
	    set tooltip($w) $d
	    bindtags $w [linsert [bindtags $w] end "Tooltip"]
	    return $w
	}
    }
}

proc ::tooltip::clear {{pattern .*}} {
    variable tooltip
    # cache the current widget at pointer
    set ptrw [winfo containing [winfo pointerx .] [winfo pointery .]]
    foreach w [array names tooltip $pattern] {
	unset tooltip($w)
	if {[winfo exists $w]} {
	    set tags [bindtags $w]
	    if {[set i [lsearch -exact $tags "Tooltip"]] != -1} {
		bindtags $w [lreplace $tags $i $i]
	    }
	    ## We don't remove TooltipMenu because there
	    ## might be other indices that use it

	    # Withdraw the tooltip if we clear the current contained item
	    if {$ptrw eq $w} { hide }
	}
    }
}

proc ::tooltip::show {w msg {i {}}} {
    if {![winfo exists $w]} { return }

    # Use string match to allow that the help will be shown when
    # the pointer is in any child of the desired widget
    if {([winfo class $w] ne "Menu")
	&& ![string match $w* [eval [list winfo containing] \
				   [winfo pointerxy $w]]]} {
	return
    }

    variable G

    after cancel $G(FADEID)
    set b $G(TOPLEVEL)
    # Use late-binding msgcat (lazy translation) to support programs
    # that allow on-the-fly l10n changes
    $b.label configure -text [::msgcat::mc $msg] -justify left
    update idletasks
    set screenw [winfo screenwidth $w]
    set screenh [winfo screenheight $w]
    set reqw [winfo reqwidth $b]
    set reqh [winfo reqheight $b]
    # When adjusting for being on the screen boundary, check that we are
    # near the "edge" already, as Tk handles multiple monitors oddly
    if {$i eq "cursor"} {
	set y [expr {[winfo pointery $w]+20}]
	if {($y < $screenh) && ($y+$reqh) > $screenh} {
	    set y [expr {[winfo pointery $w]-$reqh-5}]
	}
    } elseif {$i ne ""} {
	set y [expr {[winfo rooty $w]+[winfo vrooty $w]+[$w yposition $i]+25}]
	if {($y < $screenh) && ($y+$reqh) > $screenh} {
	    # show above if we would be offscreen
	    set y [expr {[winfo rooty $w]+[$w yposition $i]-$reqh-5}]
	}
    } else {
	set y [expr {[winfo rooty $w]+[winfo vrooty $w]+[winfo height $w]+5}]
	if {($y < $screenh) && ($y+$reqh) > $screenh} {
	    # show above if we would be offscreen
	    set y [expr {[winfo rooty $w]-$reqh-5}]
	}
    }
    if {$i eq "cursor"} {
	set x [winfo pointerx $w]
    } else {
	set x [expr {[winfo rootx $w]+[winfo vrootx $w]+
		     ([winfo width $w]-$reqw)/2}]
    }
    # only readjust when we would appear right on the screen edge
    if {$x<0 && ($x+$reqw)>0} {
	set x 0
    } elseif {($x < $screenw) && ($x+$reqw) > $screenw} {
	set x [expr {$screenw-$reqw}]
    }
    if {[tk windowingsystem] eq "aqua"} {
	set focus [focus]
    }
    # avoid the blink issue with 1 to <1 alpha on Windows, watch half-fading
    catch {wm attributes $b -alpha 0.99}
    wm geometry $b +$x+$y
    wm deiconify $b
    raise $b
    if {[tk windowingsystem] eq "aqua" && $focus ne ""} {
	# Aqua's help window steals focus on display
	after idle [list focus -force $focus]
    }
}

proc ::tooltip::_show {w d {i ""}} {
    set message [dict get $d message]
    if {[dict exists $d command]} {
	set message [uplevel #0 [dict get $d command]]
	if {$message eq ""} { return }
    }
    show $w $message $i
}

proc ::tooltip::menuMotion {w} {
    variable G

    if {$G(enabled)} {
	variable tooltip

        # Menu events come from a funny path, map to the real path.
        set m [string map {"#" "."} [winfo name $w]]
	set cur [$w index active]

	# The next two lines (all uses of LAST) are necessary until the
	# <<MenuSelect>> event is properly coded for Unix/(Windows)?
	if {$cur == $G(LAST)} return
	set G(LAST) $cur
	# a little inlining - this is :hide
	after cancel $G(AFTERID)
	catch {wm withdraw $G(TOPLEVEL)}
	if {[info exists tooltip($m,$cur)] || \
		(![catch {$w entrycget $cur -label} cur] && \
		[info exists tooltip($m,$cur)])} {
	    set G(AFTERID) [after $G(DELAY) \
		    [namespace code [list _show $w $tooltip($m,$cur) cursor]]]
	}
    }
}

proc ::tooltip::hide {{fadeOk 0}} {
    variable G

    after cancel $G(AFTERID)
    after cancel $G(FADEID)
    if {$fadeOk && $G(fade)} {
	fade $G(TOPLEVEL) $G(FADESTEP)
    } else {
	catch {wm withdraw $G(TOPLEVEL)}
    }
}

proc ::tooltip::fade {w step} {
    if {[catch {wm attributes $w -alpha} alpha] || $alpha <= 0.0} {
        catch { wm withdraw $w }
        catch { wm attributes $w -alpha 0.99 }
    } else {
	variable G
        wm attributes $w -alpha [expr {$alpha-$step}]
        set G(FADEID) [after 50 [namespace code [list fade $w $step]]]
    }
}

proc ::tooltip::wname {{w {}}} {
    variable G
    if {[llength [info level 0]] > 1} {
	# $w specified
	if {$w ne $G(TOPLEVEL)} {
	    hide
	    destroy $G(TOPLEVEL)
	    set G(TOPLEVEL) $w
	}
    }
    return $G(TOPLEVEL)
}

proc ::tooltip::listitemTip {w x y} {
    variable tooltip
    variable G

    set G(LAST) -1
    set item [$w index @$x,$y]
    if {$G(enabled) && [info exists tooltip($w,$item)]} {
	set G(AFTERID) [after $G(DELAY) \
		[namespace code [list _show $w $tooltip($w,$item) cursor]]]
    }
}

# Handle the lack of <Enter>/<Leave> between listbox items using <Motion>
proc ::tooltip::listitemMotion {w x y} {
    variable tooltip
    variable G
    if {$G(enabled)} {
        set item [$w index @$x,$y]
        if {$item ne $G(LAST)} {
            set G(LAST) $item
            after cancel $G(AFTERID)
            catch {wm withdraw $G(TOPLEVEL)}
            if {[info exists tooltip($w,$item)]} {
                set G(AFTERID) [after $G(DELAY) \
                   [namespace code [list _show $w $tooltip($w,$item) cursor]]]
            }
        }
    }
}

# Initialize tooltip events for Listbox widgets
proc ::tooltip::enableListbox {w args} {
    if {[string match *listitemTip* [bind $w <Enter>]]} { return }
    bind $w <Enter> +[namespace code [list listitemTip %W %x %y]]
    bind $w <Motion> +[namespace code [list listitemMotion %W %x %y]]
    bind $w <Leave> +[namespace code [list hide 1]] ; # fade ok
    bind $w <Any-KeyPress> +[namespace code hide]
    bind $w <Any-Button> +[namespace code hide]
}

proc ::tooltip::itemTip {w args} {
    variable tooltip
    variable G

    set G(LAST) -1
    set item [$w find withtag current]
    if {$G(enabled) && [info exists tooltip($w,$item)]} {
	set G(AFTERID) [after $G(DELAY) \
		[namespace code [list _show $w $tooltip($w,$item) cursor]]]
    }
}

proc ::tooltip::enableCanvas {w args} {
    if {[string match *itemTip* [$w bind all <Enter>]]} { return }
    $w bind all <Enter> +[namespace code [list itemTip $w]]
    $w bind all <Leave>	+[namespace code [list hide 1]] ; # fade ok
    $w bind all <Any-KeyPress> +[namespace code hide]
    $w bind all <Any-Button> +[namespace code hide]
}

proc ::tooltip::tagTip {w tag} {
    variable tooltip
    variable G
    set G(LAST) -1
    if {$G(enabled) && [info exists tooltip($w,t_$tag)]} {
        if {[info exists G(AFTERID)]} { after cancel $G(AFTERID) }
        set G(AFTERID) [after $G(DELAY) \
            [namespace code [list _show $w $tooltip($w,t_$tag) cursor]]]
    }
}

proc ::tooltip::enableTag {w tag} {
    if {[string match *tagTip* [$w tag bind $tag]]} { return }
    $w tag bind $tag <Enter> +[namespace code [list tagTip $w $tag]]
    $w tag bind $tag <Leave> +[namespace code [list hide 1]] ; # fade ok
    $w tag bind $tag <Any-KeyPress> +[namespace code hide]
    $w tag bind $tag <Any-Button> +[namespace code hide]
}

package provide tooltip 1.4.4
# Copyright 1999-2006,2008-2016 BitMover, Inc
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.

if {[info exists ::env(BK_DEBUG_GUI)]} {
	proc InCommand {} {
		uplevel {puts "[string repeat { } [expr {[info level] - 1}]][info level 0]"}
	}

	proc newproc {name args body} {
		set body "InCommand\n$body"
		realproc $name $args $body
	}

	rename proc realproc
	rename newproc proc
}

if {![info exists ::env(BK_GUI_LEVEL)]
    || ![string is integer -strict $::env(BK_GUI_LEVEL)]} {
	set ::env(BK_GUI_LEVEL) 0
}
incr ::env(BK_GUI_LEVEL)

proc bk_toolname {} {
	if {[info exists ::tool_name]} {
		return $::tool_name
	}
	return [file tail [info script]]
}

proc bk_toplevel {} {
	if {[bk_toolname] eq "citool"} { return ".citool" }
	return "."
}

proc bk_initTheme {} \
{
	switch -- [tk windowingsystem] {
		"aqua" {
			set bg "systemSheetBackground"
		}

		"x11" {
			ttk::setTheme bk
		}
	}

	set bg [ttk::style lookup . -background]

	. configure -background $bg
	option add *background	$bg

	option add *Frame.background	$bg
	option add *Label.background	$bg
	option add *Toplevel.background	$bg
	option add *Listbox.background	#FFFFFF
	option add *Entry.background	#FFFFFF
	option add *Entry.borderWidth	1
	option add *Text.background	#FFFFFF
	## Work around a Tk bug in OS X.
	if {[tk windowingsystem] == "aqua"} {
		option add *Menu.background systemMenu
	}

	## Make the ReadOnly tag
	foreach event [bind Text] {
		set script [bind Text $event]
		if {[regexp -nocase {text(paste|insert|transpose)} $script]
		    || [regexp -nocase {%W (insert|delete|edit)} $script]} {
			continue
		}
		set script [string map {tk_textCut tk_textCopy} $script]
		bind ReadonlyText $event $script
	}
	bind ReadonlyText <Up>	    "%W yview scroll -1 unit; break"
	bind ReadonlyText <Down>    "%W yview scroll  1 unit; break"
	bind ReadonlyText <Left>    "%W xview scroll -1 unit; break"
	bind ReadonlyText <Right>   "%W xview scroll  1 unit; break"
	bind ReadonlyText <Prior>   "%W yview scroll -1 page; break"
	bind ReadonlyText <Next>    "%W yview scroll  1 page; break"
	bind ReadonlyText <Home>    "%W yview moveto 0; break"
	bind ReadonlyText <End>	    "%W yview moveto 1; break"
}

proc bk_init {} {
	set tool [bk_toolname]

	bk_initPlatform

	bk_initTheme

	## Include our tool name and Toplevel tags for .
	bindtags . [list $tool . Toplevel all]

	## Remove default Tk mouse wheel bindings.
	foreach event {MouseWheel 4 5} {
		foreach mod {"" Shift- Control- Command- Alt- Option-} {
			catch {bind Text <$mod$event> ""}
			catch {bind Listbox <$mod$event> ""}
		}
	}

	## Mouse wheel bindings
	if {[tk windowingsystem] eq "x11"} {
		bind all <4> {scrollMouseWheel %W y %X %Y -1}
		bind all <5> {scrollMouseWheel %W y %X %Y  1}
		bind all <Shift-4> {scrollMouseWheel %W x %X %Y -1}
		bind all <Shift-5> {scrollMouseWheel %W x %X %Y  1}

		bind wheel <4> {scrollMouseWheel %W y %X %Y -1}
		bind wheel <5> {scrollMouseWheel %W y %X %Y  1}
		bind wheel <Shift-4> {scrollMouseWheel %W x %X %Y -1}
		bind wheel <Shift-5> {scrollMouseWheel %W x %X %Y  1}
	} else {
		bind all <MouseWheel> {scrollMouseWheel %W y %X %Y %D}
		bind all <Shift-MouseWheel> {scrollMouseWheel %W x %X %Y %D}

		bind wheel <MouseWheel> {scrollMouseWheel %W y %X %Y %D}
		bind wheel <Shift-MouseWheel> {scrollMouseWheel %W x %X %Y %D}
	}

	if {[tk windowingsystem] eq "aqua"} {
		event add <<Redo>> <Command-Shift-z> <Command-Shift-Z>
	}

	bind Entry  <KP_Enter> {event generate %W <Return>}
	bind TEntry <KP_Enter> {event generate %W <Return>}
}

# 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 cd2product {{path ""}} {
	set cmd [list exec bk root]
	if {$path ne ""} { lappend cmd $path }
	if {[catch { cd [{*}$cmd] } err]} {
		puts "Could not change directory to product root."
		exit 1
	}
}

proc resolveSymlink {filename} {
	catch {
		set original_path [file dirname $filename]
		set link_path [file readlink $filename]
		set filename [file join $original_path $link_path]
		# once we upgrade to tcl 8.4 we should also call 
		# [file normalize]...
	}
	return $filename
}

proc displayMessage {msg {exit {}}} \
{
	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 \
	    -parent [bk_toplevel]
	if {$exit == 1} {
		exit 1
	} else {
		return
	}
}

proc message {message args} \
{
	if {[dict exists $args -exit]} {
		set exit [dict get $args -exit]
		dict unset args -exit
	}

	if {![dict exists $args -parent]} {
		dict set args -parent [bk_toplevel]
	}

	set forceGui 0
	if {[dict exists $args -gui]} {
	    set forceGui 1
	    dict unset args -gui
	}

	if {!$forceGui && ([info exists ::env(BK_REGRESSION)]
	    || ($::env(BK_GUI_LEVEL) == 1
		&& $::tcl_platform(platform) ne "windows"))} {
		if {[info exists ::env(BK_REGRESSION)]
		    && $::env(BK_GUI_LEVEL) > 1} {
			append message " (LEVEL: $::env(BK_GUI_LEVEL))"
		}
		puts stderr $message
	} else {
		tk_messageBox {*}$args -message $message
	}

	if {[info exists exit]} {
		exit $exit
	}
}

# usage: centerWindow pathName ?width height?
#
# If width and height are supplied the window will be set to
# that size and that size will be used to compute the location
# of the window. Otherwise the requested width and height of the
# window will be used.
proc centerWindow {w args} \
{

	set w [winfo toplevel $w]

	if {[llength $args] > 0} {
		set width [lindex $args 0]
		set height [lindex $args 1]
	} else {
		set width [winfo reqwidth $w]
		set height [winfo reqheight $w]
	}
	set x [expr {round(([winfo vrootwidth $w] - $width) /2)}]
	set y [expr {round(([winfo vrootheight $w] - $height) /2)}]

	wm geometry $w +${x}+${y}
}

# this proc attempts to center a given line number in a text widget;
# similar to the widget's "see" option but with the requested line
# always centered, if possible. The text widget "see" command only
# attempts to center a line if it is "far out of view", so we first
# try to scroll the requested line as far away as possible, then
# scroll it back. Kludgy, but it seems to work.
proc centerTextLine {w line} \
{
	set midline "[expr {int([$w index end-1c] / 2)}].0"
	if {$line > $midline} {
		$w see 1.0
	} else {
		$w see end
	}
	update idletasks
	$w see $line
}

# 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 tmpfile {name} \
{
	global	tmp_dir tmp_files tmp_filecount

	set prefix [file join $tmp_dir "bk_${name}_[pid]"]
	set filename "${prefix}_[incr tmp_filecount].tmp"
	while {[file exists $filename]} {
		set filename "${prefix}_[incr tmp_filecount].tmp"
	}
	lappend tmp_files $filename
	return $filename
}

## Setup a trace to cleanup any temporary files as we exit.
proc cleanupTmpfiles {args} \
{
	catch {
		global	tmp_files
		foreach file $tmp_files {
			file delete -force $file
		}
	}
}
trace add exec exit enter cleanupTmpfiles

proc loadState {appname} \
{
	catch {::appState load $appname ::State}
}

proc saveState {appname} \
{
	catch {::appState save $appname ::State}
}

proc getScreenSize {{w .}} \
{
	return [winfo vrootwidth $w]x[winfo vrootheight $w]
}

proc trackGeometry {w1 w2 width height} \
{	
	global	gc app

	# The event was caused by a different widget
	if {$w1 ne $w2} {return}

	# We don't want to save the geometry if the user maximized
	# the window, so only save if it's a 'normal' resize operation.
	# XXX: Only works on MS Windows
	if {[wm state $w1] eq "normal"} {
		set min $gc($app.minsize)
		set res [getScreenSize $w1]
		if {$width < $min || $height < $min} {
			debugGeom "Geometry ${width}x${height} too small"
			return
		}
		# We can't get width/height from wm geometry because if the 
		# app is gridded, we'll get grid units instead of pixels.
		# The parameters (%w %h) however, seem to 
		# be correct on all platforms.
		foreach {- - ox x oy y} [goodGeometry [wm geometry $w1]] {break}
		set ::State(geometry@$res) "${width}x${height}${ox}${x}${oy}${y}"
		debugGeom "Remembering $::State(geometry@$res)"
	}
}

# See if a geometry string is good. Returns a list with 
# [width, height, ox, x, oy , y] where ox and oy are the sign
# of the geometry string (+|-)
proc goodGeometry {geometry} \
{
	if {[regexp \
    	    {(([0-9]+)[xX]([0-9]+))?(([\+\-])([\+\-]?[0-9]+)([\+\-])([\+\-]?[0-9]+))?} \
	    $geometry - - width height - ox x oy y]} {
		return [list $width $height $ox $x $oy $y]
	}
	return ""
}

proc debugGeom {args} \
{
	global env

	if {[info exists env(BK_DEBUG_GEOMETRY)]} {
		puts stderr [join $args " "]
	}
}

proc restoreGeometry {app {w .}} \
{
	global State gc env

	debugGeom "start"
	# track geometry changes 
	bindtags $w [concat "geometry" [bindtags $w]]
	bind geometry <Configure> [list trackGeometry $w %W %w %h]

	set rwidth [winfo vrootwidth $w]
	set rheight [winfo vrootheight $w]
	set res ${rwidth}x${rheight}
	debugGeom "res $res"

	# get geometry from the following priority list (most to least)
	# 1. -geometry on the command line (which means ::geometry)
	# 2. _BK_GEOM environment variable
	# 3. State(geometry@res) (see loadState && saveState)
	# 4. gc(app.geometry) (see config.tcl)
	# 5. App request (whatever Tk wants)
	# We stop at the first usable geometry...

	if {[info exists ::geometry] && 
	    ([set g [goodGeometry $::geometry]] ne "")} {
		debugGeom "Took ::geometry"
	} elseif {[info exists env(_BK_GEOM)] &&
	    ([set g [goodGeometry $env(_BK_GEOM)]] ne "")} {
		debugGeom "Took _BK_GEOM"
	} elseif {[info exists State(geometry@$res)] &&
	    ([set g [goodGeometry $State(geometry@$res)]] ne "")} {
		debugGeom "Took State"
	} elseif {[info exists gc($app.geometry)] &&
	    ([set g [goodGeometry $gc($app.geometry)]] ne "")} {
		debugGeom "Took app.geometry"
	}
	
	# now get the variables
	if {[info exists g]} {
		foreach {width height ox x oy y} $g {break}
		debugGeom "config: $width $height $ox $x $oy $y"
	} else {
		set width ""
		set x ""
	}
	
	if {$width eq ""} {
		# We need to call update to force the recalculation of
		# geometry. We're assuming the state of the widget is
		# withdrawn so this won't cause a screen update.
		update
		set width [winfo reqwidth $w]
		set height [winfo reqheight $w]
	}
	
	if {$x eq ""} {
		foreach {- - ox x oy y} [goodGeometry [wm geometry $w]] {break}
	}
	debugGeom "using: $width $height $ox $x $oy $y"
	
	# The geometry rules are different for each platform.
	# E.g. in Mac OS X negative positions for the geometry DO NOT
	# correspond to the lower right corner of the app, it's ALWAYS
	# the top left corner. (This will change with Tk-8.4.12 XXX)
	# Thus, we ALWAYS specify the geometry as top left corner for
	# BOTH the app and the screen. The math may be harder, but it'll
	# be right.

	# Usable space
	set ux $gc(padLeft)
	set uy $gc(padTop)
	set uwidth [expr {$rwidth - $gc(padLeft) - $gc(padRight)}]
	set uheight [expr {$rheight - $gc(padTop) 
	    - $gc(padBottom) - $gc(titlebarHeight)}]
	debugGeom "ux: $ux uy: $uy uwidth: $uwidth uheight: $uheight"
	debugGeom "padLeft $gc(padLeft) padRight $gc(padRight)"
	debugGeom "padTop $gc(padTop) padBottom $gc(padBottom)"
	debugGeom "titlebarHeight $gc(titlebarHeight)"

	# Normalize the app's position. I.e. (x, y) is top left corner of app
	if {$ox eq "-"} {set x [expr {$rwidth - $x - $width}]}
	if {$oy eq "-"} {set y [expr {$rheight - $y - $height}]}

	if {![info exists env(BK_GUI_OFFSCREEN)]} {
		# make sure 100% of the GUI is visible
		debugGeom "Size start $width $height"
		set width [expr {($width > $uwidth)?$uwidth:$width}]
		set height [expr {($height > $uheight)?$uheight:$height}]
		debugGeom "Size end $width $height"

		debugGeom "Pos start $x $y"
		if {$x < $ux} {set x $ux}
		if {$y < $uy} {set y $uy}
		if {($x + $width) > ($ux + $uwidth)} {
			debugGeom "1a $ox $x $oy $y"
			set x [expr {$ux + $uwidth - $width}]
			debugGeom "1b $ox $x $oy $y"
		}
		if {($y + $height) > ($uy + $uheight)} {
			debugGeom "2a $ox $x $oy $y"
			set y [expr {$uy + $uheight - $height}]
			debugGeom "2b $ox $x $oy $y"
		}
		debugGeom "Pos end $x $y"
	} else {
		debugGeom "Pos start offscreen $x $y"
		# make sure at least some part of the window is visible
		# i.e. we don't care about size, only position
		# if the app is offscreen, we pull it so that 1/10th of it
		# is visible
		if {$x > ($ux + $uwidth)} {
			set x [expr {$ux + $uwidth - int($uwidth/10)}]
		} elseif {($x + $width) < $ux} {
			set x $ux
		}
		if {$y > ($uy + $uheight)} {
			set y [expr {$uy + $uheight - int($uheight/10)}]
		} elseif {($y + $height) < $uy} {
			set y $uy
		}
		debugGeom "Pos end offscreen $x $y"
	}


	# Since we are setting the size of the window we must turn
	# geometry propagation off
	catch {grid propagate $w 0}
	catch {pack propagate $w 0}

	debugGeom "${width}x${height}"
	# Don't use [wm geometry] for width and height because it 
	# treats the arguments as grid units if the widget is in grid mode.
	$w configure -width $width -height $height

	debugGeom "+$x +$y"
	wm geometry $w +${x}+${y}
}

# this removes hardcoded newlines from paragraphs so that the paragraphs
# will wrap when placed in a widget that wraps (such as the description
# of a step)
proc wrap {text} \
{
	if {$::tcl_version >= 8.2} {
		set text [string map [list \n\n \001 \n { }] $text]
		set text [string map [list \001 \n\n] $text]
	} else {
		regsub -all "\n\n" $text \001 text
		regsub -all "\n" $text { } text
		regsub -all "\001" $text \n\n text
	}
	return $text
}

# get a message from the bkmsg.doc message catalog
proc getmsg {key args} \
{
	# do we want to return something like "lookup failed for xxx"
	# if the lookup fails? What we really need is something more
	# like real message catalogs, where I can supply messages that
	# have defaults.
	set data ""
	set cmd [list bk getmsg $key]
	if {[llength $args] > 0} {
		lappend cmd [lindex $args 0]
	}
	set err [catch {set data [eval exec $cmd]}]
	return $data
}

# usage: bgExec ?options? command ?arg? ?arg ..?
#
# this command exec's a program, waits for it to finish, and returns
# the exit code of the exec'd program.  Unlike a normal "exec" call, 
# while the pipe is running the event loop is active, allowing the 
# calling GUI to be refreshed as necessary. However, this proc will 
# not allow the user to interact with the calling program until it 
# returns, by doing a grab on an invisible window.
#
# Upon completion, stdout from the command is available in the global
# variable bgExec(stdout), and stderr is in bgExec(stderr)
#
#
# Options:
# 
# -output proc
#
#    proc is the name of a proc to be called whenever output is
#    generated by the command. The proc will be called with two
#    arguments: the file descriptor (useful as a unique identifier) and
#    the data that was read in.
#
# example: 
#
#    text .t ; pack .t
#    proc showOutput {f string} {
#        .t insert end $string
#        return $string
#    }
#    set exitStatus [bgExec -output showOutput ls]
#
# Side effects:
#
# while running, this creates a temporary window named .__grab__<fd>,
# where <fd> is the file description of the open pipe

namespace eval ::bgExec {}
interp alias {} ::bgExec {} ::bgExec::bgExec

proc ::bgExec::bgExec {args} \
{
	global bgExec errorCode

	set outhandler ""
	while {[llength $args] > 1} {
		set arg [lindex $args 0]
		switch -exact -- $arg {
			-output {
				set outhandler [lindex $args 1]
				set args [lrange $args 2 end]
			}
			--	{
				set args [lrange $args 1 end]
				break
			}
			default	{break}
		}
	}

	set stderrFile [tmpfile "bgexec-stderr"]
	set run_fd [open |[list {*}$args 2> $stderrFile] "r"]
	fconfigure $run_fd -blocking false
	fileevent $run_fd readable [namespace code [list readFile $run_fd]]

	set bgExec(handler) $outhandler
	set bgExec(stdout) ""
	set bgExec(stderr) ""
	set bgExec(status) 0

	# Create a small, invisible window, and do a grab on it
	# so the user can't interact with the main program.
	set grabWin .__grab__$run_fd
	frame $grabWin -width 1 -height 1 -background {} -borderwidth 0
	place $grabWin -relx 1.0 -x -2 -rely 1.0 -y -2
	after idle "if {\[winfo exists $grabWin]} {grab $grabWin}"

	# This variable is set by the code that gets run via the 
	# fileevent handler when we get EOF on the pipe.
	vwait bgExec(status)

	catch {destroy $grabWin}

	# The pipe must be reconfigured to blocking mode before
	# closing, or close won't wait for the process to end. If
	# close doesn't wait, we can't get the exit status.
	fconfigure $run_fd -blocking true
	set ::errorCode [list NONE]
	catch {close $run_fd}
	if {[info exists ::errorCode] && 
	    [lindex $::errorCode 0] == "CHILDSTATUS"} {
		set exitCode [lindex $::errorCode 2]
	} else {
		set exitCode 0
	}

	if {[file exists $stderrFile]} {
		set f [open $stderrFile r]
		set bgExec(stderr) [read $f]
		close $f
		file delete $stderrFile
	}

	unset bgExec(handler)
	unset bgExec(status)

	return $exitCode
}

proc ::bgExec::handleOutput {f string} \
{
	global bgExec

	if {[info exists bgExec(handler)] && $bgExec(handler) != ""} {
		set tmp [$bgExec(handler) $f $string]
		append bgExec(stdout) $tmp
	} else {
		append bgExec(stdout) $string
	}
}

proc ::bgExec::readFile {f} \
{
	global bgExec

	# The channel is readable; try to read it.
	set status [catch { gets $f line } result]

	if { $status != 0 } {
		# Error on the channel
		set bgExec(status) $status

	} elseif { $result >= 0 } {
		# Successfully read the channel
		handleOutput $f "$line\n"

	} elseif { [eof $f] } {
		# End of file on the channel
		set bgExec(status) 1

	} elseif { [fblocked $f] } {
		# Read blocked.  Just return

	} else {
		# Something else; should never happen.
		set bgExec(status) 2
	}
}

proc popupMessage {args} \
{
	if {[llength $args] == 1} {
		set option ""
		set message [lindex $args 0]
	} else {
		set option [lindex $args 0]
		set message [lindex $args 1]
	}

	# export BK_MSG_GEOM so the popup will show in the right
	# place...
	if {[winfo viewable .] || [winfo viewable .citool]} {
		set x [expr {[winfo rootx .] + 40}]
		set y [expr {[winfo rooty .] + 40}]
		set ::env(BK_MSG_GEOM) "+${x}+${y}"
	}

	set tmp [tmpfile msg]
	set fp [open $tmp w]
	puts $fp $message
	close $fp

	# hopefully someday we'll turn the msgtool code into a library
	# so we don't have to exec. For now, though, exec works just fine.
	if {[info exists ::env(BK_REGRESSION)]} {
		# we are running in test mode; spew to stderr
		puts stderr $message
	} else {
		exec bk msgtool {*}$option -F $tmp
	}
}

# License Functions

proc checkLicense {license licsign1 licsign2 licsign3} \
{
	global dev_null

	# bk _eula -v has the side effect of popping up a messagebox
	# warning the user if the license is invalid. 
	set f [open "|bk _eula -v > $dev_null" w]
	puts $f "
	    license: $license
	    licsign1: $licsign1
	    licsign2: $licsign2
	    licsign3: $licsign3
	"

	set ::errorCode NONE
	catch {close $f}
		      
	if {($::errorCode == "NONE") || 
	    ([lindex $::errorCode 0] == "CHILDSTATUS" &&
	     [lindex $::errorCode 2] == 0)} {
		return 1
	}
	return 0
}

# Side Effect: the license data is put in the environment variable BK_CONFIG
proc getEulaText {license licsign1 licsign2 licsign3 text} \
{
	global env
	upvar $text txt

	# need to override any config currently in effect...
	set BK_CONFIG "logging:none!;"
	append BK_CONFIG "license:$license!;"
	append BK_CONFIG "licsign1:$licsign1!;"
	append BK_CONFIG "licsign2:$licsign2!;"
	append BK_CONFIG "licsign3:$licsign3!;"
	append BK_CONFIG "single_user:!;single_host:!;"
	set env(BK_CONFIG) $BK_CONFIG
	set r [catch {exec bk _eula -u} txt]
	if {$r} {set txt ""}
	return $r
}

proc normalizePath {path} \
{
	return [file join {*}[file split $path]]
}

# run 'script' for each line in the text widget
# binding 'var' to the contents of the line
# e.g.
#
# EACH_LINE .t myline {
#	puts $myline
# }
#
# would dump the contents of the text widget on stdout
# Note that 'myline' will still exist after the script
# is done. Also, if 'myline' existed before EACH_LINE
# is called, it will be stomped on.
proc EACH_LINE {widget var script} {
	upvar 1 $var line
	set lno 1.0
	while {[$widget compare $lno < [$widget index end]]} {
		set line [$widget get $lno "$lno lineend"]
		set lno [$widget index "$lno + 1 lines"]
		# careful, the script must be run at the end
		# because of 'continue' and 'break'
		uplevel 1 $script
	}
}

# Aqua stuff

proc AboutAqua {} \
{
	if {[winfo exists .aboutaqua]} {return}
	set version [exec bk version]
	toplevel .aboutaqua
	wm title .aboutaqua ""
	frame .aboutaqua.f
	::tk::unsupported::MacWindowStyle style .aboutaqua document {closeBox}
	label .aboutaqua.f.title \
	    -text "The BitKeeper Configuration Management System" \
	    -font {Helvetica 14 bold} \
	    -justify center
	label .aboutaqua.f.v \
	    -text $version \
	    -font {Helvetica 12 normal} \
	    -justify left
	label .aboutaqua.f.copyright \
	    -text "Copyright 2015 BitKeeper Inc." \
	    -font {Helvetica 11 normal} \
	    -justify center
	grid .aboutaqua.f.title -pady 2
	grid .aboutaqua.f.v -pady 2
	grid .aboutaqua.f.copyright -pady 2 -sticky we
	grid .aboutaqua.f  -padx 20 -pady 20 -sticky nswe
}

proc AquaMenus {} \
{
	menu .mb
	. configure -menu .mb
	menu .mb.apple -tearoff 0
	.mb.apple add command -label "About BitKeeper" -command AboutAqua
	.mb add cascade -menu .mb.apple
	menu .mb.help -tearoff 0
	.mb add cascade -menu .mb.help
	.mb.help add command \
	    -label "BitKeeper Help" -command {exec bk helptool &}
}

# Mac OS X needs a _real_ menubar 
if {[tk windowingsystem] eq "aqua"} {
	AquaMenus
}

proc GetTerminal {} {
	set term xterm
	if {[info exists ::env(TERMINAL)]} { set term $::env(TERMINAL) }
	if {[auto_execok $term] eq ""} { return }
	return $term
}

proc isComponent {path} {
	catch {exec bk repotype [file dirname $path]} res
	return [string equal $res "component"]
}

proc isChangeSetFile {path} {
	if {[file tail $path] eq "ChangeSet"
	    && [file isdir [file join [file dirname $path] BitKeeper etc]]} {
		return 1
	}
	return 0
}

proc sccsFile {type file} {
	return [file join [file dirname $file] SCCS $type.[file tail $file]]
}

proc sccsFileExists {type file} {
	set file [sccsFile $type $file]
	if {[catch {exec bk _test -f $file}]} { return 0 }
	return 1
}

proc inComponent {} {
    catch {exec bk repotype} res
    return [string equal $res "component"]
}

proc inRESYNC {} {
    set dir [file tail [exec bk root -S]]
    return [string equal $dir "RESYNC"]
}

## Attach any number of widgets (usually 2 diff widgets) to a single scrollbar.
## We remember the list of widgets for a given scrollbar and then make sure
## those widgets stay in sync when one of them is scrolled.
proc attachScrollbar {sb args} \
{
	global	gc

	set xy x
	if {[$sb cget -orient]  eq "vertical"} { set xy y }

	## Configure the scrollbar to call our custom scrolling function.
	$sb configure -command [list scrollWidgets $sb ${xy}view]

	## Keep track of which widgets are attached to this scrollbar
	## and then tell each widget what its new X/Y scrollcommand is.
	dict set gc(scrollbar.widgets) $sb $args
	foreach w $args {
		$w configure -${xy}scrollcommand [list setScrollbar $sb $w]
	}
}

## This gets called when you actually manipulate the scrollbar itself.  We
## just take the scrollbar, grab the list of widgets associated with it
## and scroll them all with the command given.
proc scrollWidgets {sb args} \
{
	global	gc

	## Just scroll everyone attached to the scrollbar with the same
	## command.
	foreach widg [dict get $gc(scrollbar.widgets) $sb] {
		$widg {*}$args
	}
}

## This gets called by an attached widget anytime something in the widget
## view has changed and it wants to update the scrollbar to tell it where
## it should be.  This happens on things like mousewheel movement and drag
## scrolling.
##
## Since the widget being controlled will already be moving by the proper
## amount, we just take any other widget in our list and make it match the
## exact coordinates that the primary widget is already at.
proc setScrollbar {sb w first last} \
{
	global	gc

	## Tell the scrollbar what to look like.
	$sb set $first $last
	if {![dict exists $gc(scrollbar.widgets) $sb]} { return }

	## Grab the current coordinates for the primary widget being scrolled.
	set x [lindex [$w xview] 0]
	set y [lindex [$w yview] 0]

	## Move all widgets that aren't the primary widget to the same point.
	foreach widg [dict get $gc(scrollbar.widgets) $sb] {
		if {$widg eq $w} { continue }
		$widg xview moveto $x
		$widg yview moveto $y
	}
}

proc scrollMouseWheel {w dir x y delta} \
{
	set widg [winfo containing $x $y]
	if {$widg eq ""} { set widg $w }

	switch -- [tk windowingsystem] {
	    "aqua"  { set delta [expr {-$delta}] }
	    "x11"   { set delta [expr {$delta * 3}] }
	    "win32" { set delta [expr {($delta / 120) * -3}] }
	}

	## If we fail to scroll the widget the mouse is
	## over for some reason, just scroll the widget
	## with focus.
	if {[catch {$widg ${dir}view scroll $delta units}]} {
		catch {$w ${dir}view scroll $delta units}
	}
}

proc isBinary { filename } \
{
    global	gc

    set fd [open $filename rb]
    set x  [read $fd $gc(ci.display_bytes)]
    catch {close $fd}
    return [regexp {[\x00-\x08\x0b\x0e-\x1f]} $x]
}

proc display_text_sizes {{onOrOff ""}} {
	if {$onOrOff ne ""} { set ::display_text_sizes $onOrOff }
	return $::display_text_sizes
}

set ::display_text_sizes on

proc displayTextSize {text w h} \
{
	if {!$::display_text_sizes} { return }
	if {![info exists ::textWidgets($text,w)]} { return }

	set oldW $::textWidgets($text,w)
	set oldH $::textWidgets($text,h)

	## Check to see if size has changed.
	if {abs($w - $oldW) <= 2 && abs($h - $oldH) <= 2} { return }

	set ::textWidgets($text,w) $w
	set ::textWidgets($text,h) $h

	## Don't do anything on the initial draw.
	if {$oldW == 0 && $oldH == 0} { return }

	if {[info exists ::textSize($text)]} {
		after cancel $::textSize($text)
	}

	if {$w <= 1 && $h <= 1} { return }

	set font  [$text cget -font]
	set fontW [font measure $font 0]
	set fontH [dict get [font metrics $font] -linespace]

	set cwidth  [expr {$w / $fontW}]
	set cheight [expr {$h / $fontH}]

	if {$cwidth <= 1 || $cheight <= 1} { return }

	set label $text.__size
	place $label -x 0 -y 0
	$label configure -text "${cwidth}x${cheight}"

	set ::textSize($text) [after 1000 [list hideTextDisplaySize $text]]
}

proc hideTextDisplaySize {w} \
{
	place forget $w.__size
}

## Trace the text command to grab new text widgets as they are
## created and add bind their <Configure> event to show text
## size when they are changed.
proc traceTextWidget {cmd code widget event} \
{
	set ::textWidgets($widget,w) 0
	set ::textWidgets($widget,h) 0

	## Bind the <Map> event so that the first time the text widget
	## is drawn, we configure our display text size popups.  Note
	## that the reason we do this is so that we don't display the
	## text size popups on the initial draw of the widget but only
	## after they've been resized at some point by the user.
	bind $widget <Map> {
	    bind %W <Map> ""
	    bind %W <Configure> "displayTextSize %%W %%w %%h"
	}
	label $widget.__size -relief solid -borderwidth 1 -background #FEFFE6
}
trace add exec text leave traceTextWidget


## This is actually overriding a core Tk proc that is called whenever
## the X11 paste selection code is called.  Where that code moves the
## insertion cursor before pasting, we just want to paste where the
## insert cursor already is.
proc ::tk::TextPasteSelection {w x y} \
{
    if {![catch {::tk::GetSelection $w PRIMARY} sel]} {
	    set oldSeparator [$w cget -autoseparators]
	    if {$oldSeparator} {
		    $w configure -autoseparators 0
		    $w edit separator
	    }
	    $w insert insert $sel
	    if {$oldSeparator} {
		    $w edit separator
		    $w configure -autoseparators 1
	    }
    }
    if {[$w cget -state] eq "normal"} {
	    focus $w
    }
}

## Override another Tk core proc.  Tk seems to think that on X11 we should
## not delete any current selection when pasting.  The more modern behavior
## is to always replace any current selection with the clipboard contents.
proc ::tk_textPaste {w} \
{
	global tcl_platform
	if {![catch {::tk::GetSelection $w CLIPBOARD} sel]} {
		set oldSeparator [$w cget -autoseparators]
		if {$oldSeparator} {
			$w configure -autoseparators 0
			$w edit separator
		}
		catch { $w delete sel.first sel.last }
		$w insert insert $sel
		if {$oldSeparator} {
			$w edit separator
			$w configure -autoseparators 1
		}
	}
}

#lang L
typedef struct hunk {
	int	li, ri;		/* left/right indices */
	int	ll, rl;		/* left/right lengths */
} hunk;


/*
 *    chg   index
 *    0
 *    0
 *    1 <--- a
 *    1
 *    1
 *    0 <--- b
 *    0
 *    0 <--- c
 *    1
 *    1
 *    1 <--- d
 *    0
 */
void
shrink_gaps(string S, int &chg[])
{
	int	i, n;
	int	a, b, c, d;
	int	a1, b1, c1, d1;

	n = length(chg);
	i = 0;
	/* Find find non-zero line for 'a' */
	while ((i < n) && (chg[i] == 0)) i++;
	if (i == n) return;
	a = i;
	/* Find next zero line for 'b' */
	while ((i < n) && (chg[i] == 1)) i++;
	if (i == n) return;
	b = i;

	while (1) {
		/* The line before the next 1 is 'c' */
		while ((i < n) && (chg[i] == 0)) i++;
		if (i == n) return;
		c = i - 1;

		/* The last '1' is 'd' */
		while ((i < n) && (chg[i] == 1)) i++;
		/* hitting the end here is OK */
		d = i - 1;

	again:
		/* try to close gap between b and c */
		a1 = a; b1 = b; c1 = c; d1 = d;
		while ((b1 <= c1) && (S[a1] == S[b1])) {
			a1++;
			b1++;
		}
		while ((b1 <= c1) && (S[c1] == S[d1])) {
			c1--;
			d1--;
		}

		if (b1 > c1) {
			/* Bingo! commit it */
			while (a < b) chg[a++] = 0;  /* erase old block */
			a = a1;
			while (a < b1) chg[a++] = 1;  /* write new block */
			a = a1;
			b = b1;
			while (d > c) chg[d--] = 0;
			d = d1;
			while (d > c1) chg[d--] = 1;
			c = c1;
			d = d1;

			/*
			 * now search back for previous block and start over.
			 * The last gap "might" be closable now.
			 */
			--a;
			c = a;
			while ((a > 0) && (chg[a] == 0)) --a;
			if (chg[a] == 1) {
				/* found a previous block */
				b = a+1;
				while ((a > 0) && (chg[a] == 1)) --a;
				if (chg[a] == 0) ++a;
				/*
				 * a,b nows points at the previous block
				 * and c,d points at the newly merged block
				 */
				goto again;
			} else {
				/*
				 * We were already in the first block so just 
				 * go on.
				 */
				a = a1;
				b = d+1;
			}
		} else {
			a = c+1;
			b = d+1;
		}
	}

}

/*
 * Move any remaining diff blocks align to whitespace boundaries if
 * possible. Adapted from code by wscott in another RTI.
 */
void
align_blocks(string S, int &chg[])
{
	int	a, b;
	int	n;

	n = length(chg);
	a = 0;
	while (1) {
		int	up, down;

		/*
		 * Find a sections of 1's bounded by 'a' and 'b'
		 */
		while ((a < n) && (chg[a] == 0)) a++;
		if (a >= n) return;
		b = a;
		while ((b < n) && (chg[b] == 1)) b++;
		/* b 'might' be at end of file */

		/* Find the maximum distance it can be shifted up */
		up = 0;
		while ((a-up > 0) && (S[a-1-up] == S[b-1-up]) &&
		    (chg[a-1-up] == 0)) {
			++up;
		}
		/* Find the maximum distance it can be shifted down */
		down = 0;
		while ((b+down < n) && (S[a+down] == S[b+down]) &&
		    (chg[b+down] == 0)) {
			++down;
		}
		if (up + down > 0) {
			int	best = 65535;
			int	bestalign = 0;
			int	i;

			/* for all possible alignments ... */
			for (i = -up; i <= down; i++) {
				int	a1 = a + i;
				int	b1 = b + i;
				int	cost = 0;

				/* whitespace at the beginning costs 2 */
				while (a1 < b1 && isspace(S[a1])) {
					cost += 2;
					++a1;
				}

				/* whitespace at the end costs only 1 */
				while (b1 > a1 && isspace(S[b1-1])) {
					cost += 1;
					--b1;
				}
				/* Any whitespace in the middle costs 3 */
				while (a1 < b1) {
					if (isspace(S[a1])) {
						cost += 3;
					}
					++a1;
				}
				/*
				 * Find the alignment with the lowest cost and
				 * if all things are equal shift down as far as
				 * possible.
				 */
				if (cost <= best) {
					best = cost;
					bestalign = i;
				}
			}
			if (bestalign != 0) {
				int	a1 = a + bestalign;
				int	b1 = b + bestalign;

				/* remove old marks */
				while (a < b) chg[a++] = 0;
				/* add new marks */
				while (a1 < b1) chg[a1++] = 1;
				b = b1;
			}
		}
		a = b;
	}
}

/*
 * Align the hunks such that if we find one char in common between
 * changed regions that are longer than one char, we mark the single
 * char as changed even though it didn't. This prevents the sl highlight
 * from matching stuff like foo|b|ar to a|b|alone #the b is common.
 */
hunk[]
align_hunks(string A, string B, hunk[] hunks)
{
	hunk	h, h1, nhunks[];
	int	x, y, lastrl, lastll;

	x = y = lastll = lastrl = 0;
	foreach (h in hunks) {
		if ((((h.li - x) <= h.ll) && ((h.li - x) <= lastll) &&
			isalpha(A[x..h.li - 1])) ||
		    (((h.ri - y) <= h.rl) && ((h.ri - y) <= lastrl) &&
			 isalpha(B[y..h.ri - 1]))) {
			h1.li = x;
			h1.ri = y;
			h1.ll = (h.li - x) + h.ll;
			h1.rl = (h.ri - y) + h.rl;
		} else {
			h1.li = h.li;
			h1.ri = h.ri;
			h1.ll = h.ll;
			h1.rl = h.rl;
		}
		lastll = h1.ll;
		lastrl = h1.rl;
		x = h.li + h.ll;
		y = h.ri + h.rl;
		push(&nhunks, h1);
	}
	return (nhunks);
}

/*
 * Compute the shortest edit distance using the algorithm from
 * "An O(NP) Sequence Comparison Algorithm" by Wu, Manber, and Myers.
 */
hunk[]
diff(string A, string B)
{
	int	M = length(A);
	int	N = length(B);
	int	D;
	int	reverse = (M > N) ? 1: 0;
	int	fp[], path[];
	struct {
		int	x;
		int	y;
		int	k;
	}	pc[];
	struct {
		int	x;
		int	y;
	}	e[];
	int	x, y, ya, yb;
	int	ix, iy;
	int	i, k, m, p, r;
	int	chgA[], chgB[], itmp[];
	string	tmp;
	hunk	hunks[], h;

	if (reverse) {
		tmp = A;
		A = B;
		B = tmp;
		M = length(A);
		N = length(B);
	}

	p = -1;
	fp = lrepeat(M+N+3, -1);
	path = lrepeat(M+N+3, -1);
	m = M + 1;
	D = N - M;

	do {
		p++;
		for (k = -p; k <= (D - 1); k++) {
			ya = fp[m+k-1] + 1;
			yb = fp[m+k+1];
			if (ya > yb) {
				fp[m+k] = y = snake(A, B, k, ya);
				r = path[m+k-1];
			} else {
				fp[m+k] = y = snake(A, B, k, yb);
				r = path[m+k+1];
			}
			path[m+k] = length(pc);
			push(&pc, {y - k, y, r});
		}
		for (k = D + p; k >= (D + 1); k--) {
			ya = fp[m+k-1] + 1;
			yb = fp[m+k+1];
			if (ya > yb) {
				fp[m+k] = y = snake(A, B, k, ya);
				r = path[m+k-1];
			} else {
				fp[m+k] = y = snake(A, B, k, yb);
				r = path[m+k+1];
			}
			path[m+k] = length(pc);
			push(&pc, {y - k, y, r});
		}
		ya = fp[m+D-1] + 1;
		yb = fp[m+D+1];
		if (ya > yb) {
			fp[m+D] = y = snake(A, B, D, ya);
			r = path[m+D-1];
		} else {
			fp[m+D] = y = snake(A, B, D, yb);
			r = path[m+D+1];
		}
		path[m+D] = length(pc);
		push(&pc, {y - D, y, r});
	} while (fp[m+D] < N);
	r = path[m+D];
	e = {};
	while (r != -1) {
		push(&e, {pc[r].x, pc[r].y});
		r = pc[r].k;
	}

	ix = iy = 0;
	x = y = 0;
	chgA = lrepeat(M, 0);
	chgB = lrepeat(N, 0);
	for (i = length(e)-1; i >= 0; i--) {
		while (ix < e[i].x || iy < e[i].y) {
			if (e[i].y - e[i].x > y - x) {
				chgB[iy] = 1;
				iy++; y++;
			} else if (e[i].y - e[i].x < y - x) {
				chgA[ix] = 1;
				ix++; x++;
			} else {
				ix++; x++; iy++; y++;
			}
		}
	}
	if (reverse) {
		tmp = A;
		A = B;
		B = tmp;
		itmp = chgA;
		chgA = chgB;
		chgB = itmp;
	}
	M = length(A);
	N = length(B);

	/* Now we need to minimize the changes by closing gaps */
	shrink_gaps(A, &chgA);
	shrink_gaps(B, &chgB);
	align_blocks(A, &chgA);
	align_blocks(B, &chgB);

	/* edit script length: D + 2 * p */
	for (x = 0, y = 0; (x < M) || (y < N); x++, y++) {
		if (((x < M) && chgA[x]) || ((y < N) && chgB[y])) {
			h.li = x;
			h.ri = y;
			for (; (x < M) && chgA[x]; x++);
			for (; (y < N) && chgB[y]; y++);
			h.ll = x - h.li;
			h.rl = y - h.ri;
			push(&hunks, h);
		}
	}
	hunks = align_hunks(A, B, hunks);
	return(hunks);
}

int
snake(string A, string B, int k, int y)
{
	int	x;
	int	M = length(A);
	int	N = length(B);

	x = y - k;
	while ((x < M) && (y < N) && (A[x] == B[y])) {
		x++;
		y++;
	}
	return (y);
}

int
slhSkip(hunk hunks[], int llen, string left, int rlen, string right)
{
	/* 
	 * If the subline highlight is more than this fraction
	 * of the line length, skip it. 
	 */
	float	hlfactor = gc("hlPercent");
	/*
	 * If the choppiness is more than this fraction of 
	 * line length, skip it.
	 */
	float	chopfactor = gc("chopPercent");

	/*
	 * Highlighting too much? Don't bother.
	 */
	if (llen > (hlfactor*length(left)) ||
	    rlen > (hlfactor*length(right))) {
		return (1);
	}
	/*
	 * Too choppy? Don't bother
	 */
	if ((length(hunks) > (chopfactor*length(left))) ||
	    (length(hunks) > (chopfactor*length(right)))) {
		return (1);
	}
	return (0);
}

// Do subline highlighting on two side-by-side diff widgets.
void
highlightSideBySide(widget left, widget right, string start, string stop, int prefix)
{
	int	i, line;
	string	llines[] = split(/\n/, (string)Text_get(left, start, stop));
	string	rlines[] = split(/\n/, (string)Text_get(right, start, stop));
	hunk	hunks[], h;
	int	llen, rlen;
	int	loff, roff;
	int	allspace;
	string	sl, sr;

	line = idx2line(start);
	for (i = 0; i < length(llines); ++i, ++line) {
		if ((llines[i][0..prefix] == " ") ||
		    (rlines[i][0..prefix] == " ")) continue;
		hunks = diff(llines[i][prefix..END], rlines[i][prefix..END]);
		unless (defined(hunks)) continue;
		llen = rlen = 0;
		allspace = 1;
		foreach (h in hunks) {
			llen += h.ll;
			rlen += h.rl;
			sl = llines[i][prefix+h.li..prefix+h.li+h.ll-1];
			sr = rlines[i][prefix+h.ri..prefix+h.ri+h.rl-1];
			if (sl != "") allspace = allspace && isspace(sl);
			if (sr != "") allspace = allspace && isspace(sr);
		}
		unless (allspace) {
			if (slhSkip(hunks,
			    llen, llines[i], rlen, rlines[i])) continue;
			foreach (h in hunks) {
				Text_tagAdd(left, "highlightold",
				    "${line}.${prefix + h.li}",
				    "${line}.${prefix + h.li + h.ll}");
				Text_tagAdd(right, "highlightnew",
				    "${line}.${prefix + h.ri}",
				    "${line}.${prefix + h.ri + h.rl}");
			}
		} else {
			loff = roff = 0;
			foreach (h in hunks) {
				h.li += loff;
				h.ri += roff;
				sl = Text_get(left,
				    "${line}.${prefix + h.li}",
				    "${line}.${prefix + h.li + h.ll}");
				sl = String_map({" ", "\u2423"}, sl);
				loff += length(sl);
				Text_tagAdd(left, "userData",
				    "${line}.${prefix + h.li}",
				    "${line}.${prefix + h.li + h.ll}");
				Text_insert(left,
				    "${line}.${prefix + h.li + h.ll}",
				    sl, "highlightsp bkMetaData");
				sr = Text_get(right,
				    "${line}.${prefix + h.ri}",
				    "${line}.${prefix + h.ri + h.rl}");
				sr = String_map({" ", "\u2423"}, sr);
				roff += length(sr);
				Text_tagAdd(right, "userData",
				    "${line}.${prefix + h.ri}",
				    "${line}.${prefix + h.ri + h.rl}");
				Text_insert(right,
				    "${line}.${prefix + h.ri + h.rl}",
				    sr, "highlightsp bkMetaData");
			}
		}
	}
}

// Do subline highlighting on stacked diff output in a single text widget.
void
highlightStacked(widget w, string start, string stop, int prefix)
{
	string	line;
	string	lines[];
	int	l = 0, hunkstart = 0;
	string	addlines[], sublines[];

	lines = split(/\n/, (string)Text_get(w, start, stop));
	/*
	 * Since the diffs are stacked, we don't want to highlight regions
	 * that are too big.
	 */
	//	if (length(lines) > 17) return;
	foreach (line in lines) {
		++l;
		if (line[0] == "+") {
			push(&addlines, line[prefix..END]);
			if (!hunkstart) hunkstart = l;
			if (l < length(lines)) continue;
		}
		if (line[0] == "-") {
			push(&sublines, line[prefix..END]);
			if (!hunkstart) hunkstart = l;
			if (l < length(lines)) continue;
		}
		if (defined(addlines) && defined(sublines)) {
			int	i;
			hunk	h, hunks[];
			int	lineA, lineB;
			int	llen, rlen;

			for (i = 0; hunkstart < l; ++hunkstart, ++i) {
				unless (defined(addlines[i])) break;
				unless (defined(sublines[i])) break;
				if (strlen(sublines[i]) > 1000 ||
				    strlen(addlines[i]) > 1000) break;
				hunks = diff(sublines[i], addlines[i]);
				lineA = hunkstart;
				lineB = hunkstart + length(sublines);
				unless (defined(hunks)) continue;
				llen = rlen = 0;
				foreach (h in hunks) {
					llen += h.ll;
					rlen += h.rl;
				}

				if (slhSkip(hunks,
				    llen, sublines[i], rlen, addlines[i])) {
					continue;
				}

				foreach (h in hunks) {
					Text_tagAdd(w, "highlightold",
					    "${lineA}.${h.li+prefix}",
					    "${lineA}.${h.li + h.ll +prefix}");
					Text_tagAdd(w, "highlightnew",
					    "${lineB}.${h.ri + prefix}",
					    "${lineB}.${h.ri + h.rl +prefix}");
				}
			}
		}
		hunkstart = 0;
		addlines = undef;
		sublines = undef;
	}
}

// getUserText
//
// Get data from a text widget as it actually is from the user. This means
// hiding any special characters or other bits we've inserted into the user's
// view and just returning them the real data.
//
// Currently this is only used for highlighted spaces as a result of the
// subline highlighting code, but this is where we want to add stuff in
// the future anytime we alter the user's view of the data.
string
getUserText(widget w, string idx1, string idx2)
{
	string	data;

	// Hide any BK characters we've inserted into the view and
	// show the actual user data as it was inserted.
	Text_tagConfigure(w, "userData", elide: 0);
	Text_tagConfigure(w, "bkMetaData", elide: 1);
	data = Text_get(w, displaychars: idx1, idx2);
	Text_tagConfigure(w, "userData", elide: 1);
	Text_tagConfigure(w, "bkMetaData", elide: 0);
	return (data);
}

/*
 * Windows gui doesn't have a stdout and stderr.
 * A straight system("foo") won't run foo because of this.
 * So put in a string and let the user know it happened.
 */
int
bk_system(string cmd)
{
	string	out, err;
	int	rc;

	if (!defined(rc = system(cmd, undef, &out, &err))) {
		tk_messageBox(title: "bk system",
			      message: "command: ${cmd}\n" . stdio_lasterr);
		return (undef);
	}
	if ((defined(out) && (out != "")) ||
	    (defined(err) && (err != ""))) {
		if (defined(out)) out = "stdout:\n" . out;
		if (defined(err)) err = "stderr:\n" . err;
		if (rc) {
			bk_error("bk system",
				 "command:\n${cmd}\n"
				 "${out}"
				 "${err}");
		} else {
			bk_message("bk system",
				 "command:\n${cmd}\n"
				 "${out}"
				 "${err}");
		}
	}
	return (rc);
}

/*
 * given "line.col" return just line
 */
int
idx2line(string idx)
{
	return ((int)split(/\./, idx)[0]);
}

void
configureDiffWidget(string app, widget w, ...args)
{
	string	which = args[0];

	// Old diff tag.
	Text_tagConfigure(w, "oldDiff",
	    font: gc("${app}.oldFont"),
	    background: gc("${app}.oldColor"));

	// New diff tag.
	Text_tagConfigure(w, "newDiff",
	    font: gc("${app}.newFont"),
	    background: gc("${app}.newColor"));

	if (defined(which)) {
		string	oldOrNew = which;

		// Standard diff tag.
		Text_tagConfigure(w, "diff",
		    font: gc("${app}.${oldOrNew}Font"),
		    background: gc("${app}.${oldOrNew}Color"));

		// Active diff tag.
		if (!gc("${app}.activeNewOnly") || oldOrNew == "new") {
			oldOrNew[0] = String_toupper(oldOrNew[0]);
			Text_tagConfigure(w, "d",
			    font: gc("${app}.active${oldOrNew}Font"),
			    background: gc("${app}.active${oldOrNew}Color"));
		}
	}

	// Highlighting tags.
	Text_tagConfigure(w, "select", background: gc("${app}.selectColor"));
	Text_tagConfigure(w, "highlightold",
			  background: gc("${app}.highlightOld"));
	Text_tagConfigure(w, "highlightnew",
			  background: gc("${app}.highlightNew"));
	Text_tagConfigure(w, "highlightsp",
	    background: gc("${app}.highlightsp"));
	Text_tagConfigure(w, "userData", elide: 1);
	Text_tagConfigure(w, "bkMetaData", elide: 0);

	// Message tags.
	Text_tagConfigure(w, "warning", background: gc("${app}.warnColor"));
	Text_tagConfigure(w, "notice", background: gc("${app}.noticeColor"));

	// Various other diff tags.
	Text_tagConfigure(w, "empty", background: gc("${app}.emptyBG"));
	Text_tagConfigure(w, "same", background: gc("${app}.sameBG"));
	Text_tagConfigure(w, "space", background: gc("${app}.spaceBG"));
	Text_tagConfigure(w, "changed", background: gc("${app}.changedBG"));

	if (defined(which)) {
		Text_tagConfigure(w, "minus",
		    background: gc("${app}.${which}Color"));
		Text_tagConfigure(w, "plus",
		    background: gc("${app}.${which}Color"));
		if (!gc("${app}.activeNewOnly") || which == "new") {
			Text_tagRaise(w, "d");
		}
	}

	Text_tagRaise(w, "highlightold");
	Text_tagRaise(w, "highlightnew");
	Text_tagRaise(w, "highlightsp");
	Text_tagRaise(w, "sel");
}

private int	debug{string};
private	FILE	debugf = undef;

void
debug_enter(string cmd, string op)
{
	unless (cmd) return;

	op = op;
	debug{cmd} = Clock_microseconds();
	fprintf(debugf, "ENTER ${cmd}\n");
	flush(debugf);
}

void
debug_leave(string cmd, int code, string result, string op)
{
	float	t;

	unless (cmd) return;

	op = op;
	code = code;
	result = result;
	if (defined(debug{cmd})) {
		t = Clock_microseconds() - debug{cmd};
		undef(debug{cmd});
	}

	if (defined(t)) {
		fprintf(debugf, "LEAVE ${cmd} (${t} usecs)\n");
	} else {
		fprintf(debugf, "LEAVE ${cmd}\n");
	}
	flush(debugf);
}

void
debug_init(string var)
{
	string	proc, procs[];

	unless (defined(var) && length(var)) return;
	if (var =~ m|^/|) debugf = fopen(var, "w");
	unless (defined(debugf)) debugf = stderr;

	procs = Info_procs("::*");
	foreach (proc in procs) {
		if (proc =~ /^::auto_/) continue;
		if (proc =~ /^::debug_/) continue;
		if (proc =~ /^::unknown/) continue;
		if (proc =~ /^::fprintf/) continue;
		Trace_addExec(proc, "enter", &debug_enter);
		Trace_addExec(proc, "leave", &debug_leave);
	}
}

string
bk_repogca(int standalone, string url, string &err)
{
	string	gca;
	string	opts = "--only-one";

	if (standalone) opts .= " -S";
	if (url && length(url)) opts .= " '${url}'";
	if (system("bk repogca ${opts}", undef, &gca, &err) != 0) {
		return (undef);
	}
	return (trim(gca));
}

void
bk_message(string title, string message)
{
	if (defined(getenv("BK_REGRESSION"))) {
		puts("stdout", message);
	} else {
		tk_messageBox(title: title, message: message);
	}
}

void
bk_error(string title, string message)
{
	if (defined(getenv("BK_REGRESSION"))) {
		puts("stderr", message);
	} else {
		tk_messageBox(title: title, message: message);
	}
}

void
bk_die(string message, int exitCode)
{
	bk_message("BitKeeper", message);
	exit(exitCode);
}

void
bk_dieError(string message, int exitCode)
{
	bk_error("BitKeeper Error", message);
	exit(exitCode);
}

void
bk_usage()
{
	string	usage;
	string	tool = basename(Info_script());

	system("bk help -s ${tool}", undef, &usage, undef);
	puts(usage);
	exit(1);
}
#lang tcl
# Copyright 2000,2003-2005,2011,2016 BitMover, Inc
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.

#
# 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 searchdisable {} \
{
	global search

	searchbuttons both disabled
	$search(menu) configure -state disabled
	$search(text) configure -state 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
}

# initiates a new search on the given string starting at the given index
proc searchnew {direction string {startIndex ""}} {
	global search 

	search $direction

	$search(text) delete 0 end
	$search(text) insert 0 $string

	if {$startIndex != ""} {
		set search(start) $startIndex
	} elseif {$search(dir) == "?"} {
		set search(start) "end"
	} else {
		set search(start) "1.0"
	}

	searchstring
}

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) == ":")} {
		set i [$search(widget) index "end-1c linestart"]
		set end [lindex [split $i .] 0]
		if {$string == "end" || $string == "last"} {
			set string $end
		}
			
		if {[string match {[0-9]*} $string]} {
			if {[$search(widget) compare "$string.0" > "end-1c"]} {
				set msg "beyond end of data"
				$search(status) configure -text $msg
			} else {
				$search(widget) tag remove search 1.0 end
				$search(widget) tag add search \
				    "$string.0" "$string.end+1c"
				$search(widget) tag raise search
				searchsee $string.0
			}
		} 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) TEntry]
}

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 env

	search_init $w $s

	set prevImage [image create photo \
			   -file $env(BK_BIN)/gui/images/previous.gif]
	set nextImage [image create photo \
			   -file $env(BK_BIN)/gui/images/next.gif]
	ttk::label $search(plabel) -width 11 -textvariable search(prompt)

	# XXX: Make into a pulldown-menu! like is sccstool
	ttk::menubutton $search(menu) -text "Search" -menu $search(menu).menu
	    set m [menu $search(menu).menu]
	    if {$gc(aqua)} {$m configure -tearoff 0}
	    $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
	    }
	ttk::entry $search(text) -width 20
	ttk::button $search(prev) -image $prevImage -state disabled -command {
	    searchdir ?
	    searchnext
	}
	ttk::button $search(next) -image $nextImage -state disabled -command {
	    searchdir /
	    searchnext
	}
	ttk::button $search(clear) -text "Clear search" -state disabled \
	    -command { clearOrRecall }
	ttk::label $search(status) -width 20

	pack $search(menu) -side left -anchor w
	pack $search(text) -side left -padx 2
	pack $search(prev) -side left -padx 1
	pack $search(clear) -side left -padx 1
	pack $search(next) -side left -padx 1
	pack $search(status) -side left -expand 1 -fill x -padx {2 0}

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

proc example_main_widgets {} \
{
	global gc app
	#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 $gc($app.searchColor) -relief groove -borderwid 0
}

# Copyright 2002-2003,2015-2016 BitMover, Inc
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
# This file contains code to read and write application-specific state
# information
#
# usage: ::appState load "appname" arrayVariableName
#          fills array with app-specific keys and values
#
#        ::appStore save "appname" arrayVariableName ?version?
#           writes the array data to a persistent store for the
#           given application, in a format consistent with the version
#           number given
#
# A file read by these routines must have a line that looks like
# "data format version 1.0". At a later date we may support other versions
# as necessary.
#

# this is the primary application interface to these functions; all other
# functions are intended to be called only internally by this code
namespace eval ::appState {
	variable filename
	array set filename {}
}

proc ::appState {command app varname} \
{

	catch {uplevel ::appState::$command $app $varname} result
	return $result
}

proc ::appState::load {app varname {filename {}}} \
{

	upvar $varname state

	if {$filename == {}} {
		set filename [::appState::filename $app]
	}

	if {![file exists $filename]} {
		error "file doesn't exist: \"$filename\""

	} elseif {![file readable $filename]} {
		error "file not readable: \"$filename\""
	}

	if {[catch {
		set f [open $filename r]
		# reading the data in one block is much quicker than
		# reading one line at a time...
		set data [split [read $f [file size $filename]] \n]
		close $f
	} result]} {
		error "unexpected error: $result"
	}
	
	set version [::appState::getVersion data]

	set versionCommands [info commands ::appState::load-$version]

	if {[llength $versionCommands] == 1} {
		set state(Version) $version
		return [::appState::load-$version data state]
	} else {
		return 0
	}
}

proc ::appState::load-1.0 {datavar statevar} \
{
	upvar $datavar data
	upvar $statevar state

	set last [expr {[llength $data] - 1}]
	for {set i 0} {$i <= $last} {incr i} {
		set item [lindex $data $i]
		if {[regexp {^define ([^ ]+) (.*)} $item -> key value]} {
			set key [string trim $key]
			set value [string trim $value]
			set state($key) $value
		}
	}
}

proc ::appState::filename {app} \
{
	global tcl_platform
	variable filename

	# N.B. 'bk dotbk' has the side effect of moving the old config
	# files to the new location (old=prior to 3.0.2). 
	if {![info exists filename($app)]} {
		set new $app.rc
		if {[string equal $::tcl_platform(platform) "windows"]} {
			set old [file join _bkgui.d $app.rc]
		} else {
			set old [file join .bkgui.d $app.rc]
		}
		set filename($app) [exec bk dotbk $old $new]
	}

	return $filename($app)
}

proc ::appState::save {app statevar {version 1.0} {filename ""}} \
{
	upvar $statevar state

	if {$filename == ""} {
		set filename [::appState::filename $app]
	}

	# make sure the directory exists; if not, attempt to create it
	# Note that "file mkdir" is smart enough to do nothing if the
	# directory already exists, but it will throw an error if a file
	# exists with the same name as the directory.
	if {[catch {file mkdir [file dirname $filename]} result]} {
		error "unable to create directory:\
		       \"[file dirname $filename]\""
	}

	# If the directory still doesn't exist, punt
	if {![file isdirectory [file dirname $filename]]} {
		error "not a directory: \
		       \"[file dirname $filename]\""

	}

	# Danger Will Robinson! If you change the format of the line
	# that beings "data format version", be sure to change the
	# the getVersion proc appropriately...
	set f [open $filename w]
	puts $f "# This file was automatically generated by $app\
		 \n# [clock format [clock seconds]]\n\
		 \ndata format version $version\n"

	foreach key [lsort [array names state]] {
		if {[string match $key "Version"]} continue
		if {[string first \n $state($key)]>= 0} {
			puts $f "define $key <<END\n$state($key)\n<<END"
		} else {
			puts $f "define $key $state($key)"
		}
	}
	close $f

	return 1
}

# reads and discards all data up to and including a line that looks 
# like 'data format version <version number>'. The <version number> 
# is returned.
proc ::appState::getVersion {datavar} \
{
	upvar $datavar data

	set version 1.0
	set i 1
	set regex {data format version +(.*)$}
	foreach line $data {
		if {[regexp $regex $line -> version]} {
			# strip all data prior to and including the
			# version statement
			set data [lrange $data $i end]
			break
		}
	}

	return $version
}
	
# Copyright 1998-2006,2008-2016 BitMover, Inc
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.

# revtool - a tool for viewing SCCS files graphically.

array set month {
	""	"bad"
	"01"	"JAN"
	"02"	"FEB"
	"03"	"MAR"
	"04"	"APR"
	"05"	"MAY"
	"06"	"JUN"
	"07"	"JUL"
	"08"	"AUG"
	"09"	"SEP"
	"10"	"OCT"
	"11"	"NOV"
	"12"	"DEC"
}


proc main {} \
{
	global	env
	wm title . "revtool"

	set ::shift_down 0
	set ::tooltipAfterId ""

	bk_init
	
	arguments

	loadState rev
	widgets
	restoreGeometry rev
	
	after idle [list wm deiconify .]
	after idle [list focus -force .]

	startup
}

# Return width of text widget
proc wid {id} \
{
	global w

	set bb [$w(graph) bbox $id]
	set x1 [lindex $bb 0]
	set x2 [lindex $bb 2]
	return [expr {$x2 - $x1}]
}

# Returns the height of the graph canvas
proc ht {id} \
{
	global w

	set bb [$w(graph) bbox $id]
	if {$bb == ""} {return 200}
	set y1 [lindex $bb 1]
	set y2 [lindex $bb 3]
	return [expr {$y2 - $y1}]
}

proc drawAnchor {x1 y1 x2 y2} {
	global w gc

	# this gives the illusion of a sunken node
	$w(graph) create line $x2 $y1 $x2 $y2 $x1 $y2 \
	    -fill #f0f0f0 -tags anchor -width 1 \
	    -capstyle projecting

	set y $y2
	foreach incr {3 3 3 } {
		incr x1 $incr
		incr x2 -$incr
		incr y $incr
		$w(graph) create line $x1 $y $x2 $y \
		    -fill $gc(rev.revOutline) -tags anchor 
	}

}
#
# Set highlighting on the bounding box containing the revision number
#
# revision - (default style box) gc(rev.revOutline)
# merge -
# bad - do a "bad" rectangle (red, unless user changes gc(rev.badColor))
# arrow - do a $arrow outline
# old - do a rectangle in gc(rev.oldColor)
# new - do a rectangle in gc(rev.newColor)
# gca - do a black rectangle -- used for GCA
# tagged - draw an outline in gc(rev.tagOutline)
#
# id may be a canvas object id (an integer) or a tag (typically a 
# revision number or revision-user pair)
proc highlight {id type {rev ""}} \
{
	global gc w

	if {![string is integer $id]} {
		# The id is a tag rather than a canvas object id.
		# In such a case we want to find the id of the text 
		# object associated with the tag. 
		set id [textbox $id]
	}
	catch {set bb [$w(graph) bbox $id]} err
	#puts "In highlight: id=($id) err=($err)"
	# If node to highlight is not in view, err=""; if some other
	# unexpected error, bb might not be defined so we need to bail.
	if {$err == ""} { return "$err" }
	if {![info exists bb]} return
	# Added a pixel at the top and removed a pixel at the bottom to fix 
	# lm complaint that the bbox was touching the characters at top
	# -- lm doesn't mind that the bottoms of the letters touch, though
	#puts "id=($id)"
	set x1 [lindex $bb 0]
	set y1 [expr {[lindex $bb 1] - 1}]
	set x2 [lindex $bb 2]
	set y2 [expr {[lindex $bb 3] - 1}]

	set bg {}
	switch $type {
	    tagged {
		    set bg [$w(graph) create rectangle $x1 $y1 $x2 $y2 \
				-outline $gc(rev.tagOutline) \
				-width 1 \
				-tags [list $rev revision tagged]]
	    }
	    anchor {
		    drawAnchor $x1 $y1 $x2 $y2
		}
	    revision {\
		#puts "highlight: revision ($rev)"
 		set bg [$w(graph) create rectangle $x1 $y1 $x2 $y2 \
 		    -fill $gc(rev.revColor) \
 		    -outline $gc(rev.revOutline) \
 		    -width 1 -tags [list $rev revision]]}
	    merge   {\
		#puts "highlight: merge ($rev)"
		set bg [$w(graph) create rectangle $x1 $y1 $x2 $y2 \
		    -fill $gc(rev.revColor) \
		    -outline $gc(rev.mergeOutline) \
		    -width 1 -tags [list $rev revision]]}
	    arrow   {\
		#puts "highlight: arrow ($rev)"
		set bg [$w(graph) create rectangle $x1 $y1 $x2 $y2 \
		    -outline $gc(rev.arrowColor) -width 1]}
	    bad     {\
		#puts "highlight: bad ($rev)"
		set bg [$w(graph) create rectangle $x1 $y1 $x2 $y2 \
		    -outline $gc(rev.badColor) -width 1.5 -tags "$rev"]}
	    old  {
		#puts "highlight: old ($rev) id($id)"
		set bg [$w(graph) create rectangle $x1 $y1 $x2 $y2 \
			    -outline $gc(rev.revOutline) \
			    -fill $gc(rev.oldColor) \
			    -tags old]
	    }
	    new   {\
		set bg [$w(graph) create rectangle $x1 $y1 $x2 $y2 \
		    -outline $gc(rev.revOutline) -fill $gc(rev.newColor) \
		    -tags new]}
	    local   {\
		set bg [$w(graph) create rectangle $x1 $y1 $x2 $y2 \
		    -outline $gc(rev.revOutline) -fill $gc(rev.localColor) \
		    -width 2 -tags local]}
	    remote   {\
		set bg [$w(graph) create rectangle $x1 $y1 $x2 $y2 \
		    -outline $gc(rev.revOutline) -fill $gc(rev.remoteColor) \
		    -width 2 -tags remote]}
	    gca  {
		set bg [$w(graph) create rectangle $x1 $y1 $x2 $y2 \
			    -outline black -width 2 -fill $gc(rev.gcaColor) \
			    -tags gca]
	    }
	}

	if {$type ne "anchor"} {
		$w(graph) lower $bg revtext
	}

	return $bg
}

# find the id of the textbox for the given tag, if there is one.
proc textbox {tag} {
	global w
	set tagspec "revtext&&$tag"
	set items [$w(graph) find withtag $tagspec]
	if {[llength $items] > 0} {
		return [lindex $items 0]
	}
	return $tag
}

# This is used to adjust around the text a little so that things are
# clumped together too much.
proc chkSpace {x1 y1 x2 y2} \
{
	global w

	incr y1 -8
	incr y2 8
	return [$w(graph) find overlapping $x1 $y1 $x2 $y2]
}

#
# Build arrays of revision to date mapping and
# serial number to rev.
#
# These arrays are used to help place date separators in the graph window
#
proc revMap {file} \
{
	global rev2date serial2rev dev_null revX rev2serial r2p

	#set dspec "-d:I:-:P: :DS: :Dy:/:Dm:/:Dd:/:TZ: :UTC-FUDGE:"
	set dspec "-d:I:-:P: :DS: :UTC: :UTC-FUDGE:"
	set fid [open "|bk prs -nh {$dspec} \"$file\" 2>$dev_null" "r"]
# puts "bk prs -nh {$dspec} \"$file\""
	while {[gets $fid s] >= 0} {
# puts "$s"
		set rev [lindex $s 0]
		foreach {r p} [split $rev -] {set r2p($r) $p}
# puts "rev=$rev"
		if {![info exists revX($rev)]} {continue}
# puts "revX=revX($rev)"
		set serial [lindex $s 1]
		set date [lindex $s 2]
		scan $date {%4s%2s%2s} yr month day
		set date "$yr/$month/$day"
		set utc [lindex $s 3]
		#puts "rev: ($rev) utc: $utc ser: ($serial) date: ($date)"
		set rev2date($rev) $date
# puts "set rev2date($rev) $date"
		set serial2rev($serial) $rev
		set rev2serial($rev) $serial
	}
	catch { close $fid }
}

proc orderSelectedNodes {reva revb} \
{
	global rev1 rev2 rev2rev_name w rev2serial

 	if {[info exists rev2rev_name($reva)]} {
 		set reva $rev2rev_name($reva)
 	}
 	if {[info exists rev2rev_name($revb)]} {
 		set revb $rev2rev_name($revb)
 	}

	if {![info exists rev2serial($reva)] ||
	    ![info exists rev2serial($revb)]} {
		return
	}

	if {$rev2serial($reva) < $rev2serial($revb)} {
		set rev2 [getRev new $revb]
		set rev1 [getRev old $reva]
	} else {
		set rev2 [getRev new $reva]
		set rev1 [getRev old $revb]
	}
}

# Diff between a rev and its parent, or between the two highlighted
# nodes
proc doDiff {{difftool 0}} \
{
	global w file rev1 rev2 anchor

	set rev ""
	set b ""
	if {![info exists anchor] || $anchor == ""} return

	if {[string match *-* $anchor]} {
		# anchor is wrong (1.223-lm) instead of just 1.223
		set anchor [lindex [split $anchor -] 0]
	}
	set r $anchor

	# No second rev? Get the parent
	if {![info exists rev2] || "$rev2" == "$rev1" || "$rev2" == ""} {
		set rev2 $anchor
		set rev1 [exec bk prs -d:PARENT: -hr${r} $file]
	}

	orderSelectedNodes $rev1 $rev2
	busy 1

	if {$difftool} {
		difftool $file $rev1 $rev2
		return
	}

	set base [file tail $file]

	if {$base eq "ChangeSet"} {
		csetdiff2
	} else {
		displayDiff $rev1 $rev2
	}

	return
}

#
# Highlights the specified revision in the text body and moves scrolls
# it into view. Called from startup.
#
proc highlightTextRev {rev file} \
{
	global w dev_null

	set tline 1.0
	if {[catch {exec bk prs -hr$rev -d:I: $file 2>$dev_null} out]} {
		displayMessage "Error: ($file) rev ($rev) is not valid"
		return
	}
	set found [$w(aptext) search -regexp "$rev," 1.0]
	# Move the found line into view
	if {$found != ""} {
		set l [lindex [split $found "."] 0]
		set tline "$l.0"
		$w(aptext) see $tline
	}
	$w(aptext) tag add "select" "$tline" "$tline lineend + 1 char"
}

# 
# Center the selected bitkeeper tag in the middle of the canvas
#
# When called from the mouse <B1> binding, the x and y value are set
# When called from the mouse <B2> binding, the doubleclick var is set to 1
# When called from the next/previous buttons, only the line variable is set
#
# bindtype can be one of: 
#
#    B1 - calls getLeftRev
#    B3 - calls getRightRev
#    D1 - if in annotate, brings up revtool, else gets file annotation
#
proc selectTag {win {x {}} {y {}} {bindtype {}}} \
{
	global curLine cdim gc file dev_null dspec rev2rev_name ttype
	global w rev1 errorCode comments_mapped firstnode

	if {[info exists fname]} {unset fname}

	$win tag remove "select" 1.0 end
	set curLine [$win index "@$x,$y linestart"]
	set line [$win get $curLine "$curLine lineend"]
	busy 1

	# Search for annotated file output or annotated diff output
	# display comment window if we are in annotated file output
	switch -regexp -- $ttype {
	    "^annotated$" {
	    	if {![regexp {^(.*)[ \t]+([0-9]+\.[0-9.]+)(.*)\|} \
		    $line match fname rev the_rest]} {
			busy 0
			return
		}
		set deleted ""
		if {[regexp {^-[dx]([^ \t]+)} $the_rest match deleted]} {
			set rev $deleted
		}
		# set global rev1 so that r2c and csettool know which rev
		# to view when a line is selected. Line has precedence over
		# a selected node
		set rev1 $rev
		$w(aptext) configure -height 15
		$w(ctext) configure -height $gc(rev.commentHeight) 
		$w(aptext) configure -height 50
		set comments_mapped [winfo ismapped $w(ctext)]
		if {$bindtype == "B1"} {
			commentsWindow show
			set prs [open "| bk prs {$dspec} -hr$rev \"$file\" 2>$dev_null"]
			filltext $w(ctext) $prs 1 "ctext"
			set wht [winfo height $w(cframe)]
			set cht [font metrics $gc(rev.graphFont) -linespace]
			set adjust [expr {int($wht) / $cht}]
			#puts "cheight=($wht) char_height=($cht) adj=($adjust)"
			if {($curLine > $adjust) && ($comments_mapped == 0)} {
				$w(aptext) yview scroll $adjust units
			}
		}
	    }
	    "^.*_prs$" {
		# walk backwards up the screen until we find a line with a 
		# revision number (if in cset prs) or filename@revision 
		# if in specific file prs output
		catch {unset rev}
		# Handle the case were we are looking at prs for the cset
		regexp {^(.*)@([0-9]+\.[0-9.]+),.*} $line match fname rev

		# Handle the case where we are looking at prs for the
		# files contained in a cset (i.e. when double clicking
		# on a node in the cset graph).
		# example:
		# src/t/t.delta
		#   1.38 01/07/18 10:24:46 awc@etp3.bitmover.com +3 -4
		#   Make the test case for "bk delta -L" more portable
		regexp {^\ +([0-9]+\.[0-9.]+)\ [0-9]+/[0-9]+/[0-9]+\ .*} \
		    $line match rev

		while {![info exists rev]} {
			set curLine [expr $curLine - 1.0]
			if {$curLine == "0.0"} {
				# This pops when trying to select the cset
				# comments for the ChangeSet file
				#puts "Error: curLine=$curLine"
				busy 0
				return
			}
			set line [$win get $curLine "$curLine lineend"]
			regexp {^ *(.*)@([0-9]+\.[0-9.]+),.*} \
			    $line m fname rev
			regexp \
			    {^\ +([0-9]+\.[0-9.]+)\ [0-9]+/[0-9]+/[0-9]+\ .*} \
			    $line m rev
		}
		$win see $curLine
	    }
	    "^sccs$" {
		catch {unset rev}
		regexp {^.*D\ ([0-9]+\.[0-9.]+)\ .*} $line match rev
		while {![info exists rev]} {
			set curLine [expr $curLine - 1.0]
			if {$curLine == "0.0"} {
				#puts "Error: curLine=$curLine"
				busy 0
				return
			}
			set line [$win get $curLine "$curLine lineend"]
			regexp {^.*D\ ([0-9]+\.[0-9.]+)\ .*} $line match rev
		}
		$win see $curLine
	    }
	    default {
		    puts stderr "Error -- no such type as ($ttype)"
	    }
	}
	$win tag add "select" "$curLine" "$curLine lineend + 1 char"

	# If in cset prs output, get the filename and start a new revtool
	# on that file.
	#
	# Assumes that the output of prs looks like:
	#
	# filename.c
	#   1.8 10/09/99 .....
	#
	if {$ttype == "cset_prs"} {
		set prevLine [expr $curLine - 1.0]
		set fname [$win get $prevLine "$prevLine lineend"]
		regsub -- {^  } $fname "" fname
		if {($bindtype == "B1") && ($fname != "") && ($fname != "ChangeSet")} {
			catch {exec bk revtool -r$rev $fname &} err
		}
		busy 0
		return
	}
	set name [$win get $curLine "$curLine lineend"]
	if {$name == ""} { puts "Error: name=($name)"; busy 0; return }
	if {[info exists rev2rev_name($rev)]} {
		set revname $rev2rev_name($rev)
	} else {
		# node is not in the view, get and display it, but
		# don't mess with the lower windows.

		set parent [exec bk prs -d:PARENT:  -hr${rev} $file]
		if {$parent != 0} { 
			set prev $parent
		} else {
			set prev $rev
		}
		listRevs "-c${prev}.." "$file"
		revMap "$file"
		dateSeparate
		setScrollRegion
		set first [$w(graph) gettags $firstnode]
		$w(graph) xview moveto 0 
		set hrev [lineOpts $rev]
		set rc [highlight $hrev "old"]
		set revname $rev2rev_name($rev)
		if {$revname != ""} {
			.menus.cset configure -state normal
			centerRev $revname
			set id [$w(graph) gettag $revname]
			if {$id == ""} { busy 0; return }
			if {$bindtype == "B1" || $bindtype == "D1"} {
				getLeftRev $id
			} elseif {$bindtype == "B3"} {
				diff2 0 $id
			}
			if {($bindtype == "D1") && ($ttype != "annotated")} {
				selectNode "id" $id
			}
		} 
		# XXX: This can be done cleaner -- coalesce this
		# one and the bottom if into one??
		if {($ttype != "annotated") && ($bindtype == "D1")} {
			selectNode "rev" $rev
		} elseif {($ttype == "annotated") && ($bindtype == "D1")} {
			set rev1 $rev
			if {"$file" == "ChangeSet"} {
				csettool
			} else {
				r2c
			}
		}
		currentMenu
		busy 0
		return
	}
	# center the selected revision in the canvas
	if {$revname != ""} {
		centerRev $revname
		set id [$w(graph) gettag $revname]
		if {$id == ""} { busy 0; return }
		if {$bindtype == "B1" || $bindtype == "D1"} {
			getLeftRev $id
		} elseif {$bindtype == "B3"} {
			diff2 0 $id
		}
		if {($bindtype == "D1") && ($ttype != "annotated")} {
			selectNode "id" $id
		}
		currentMenu
	} else {
		#puts "Error: tag not found ($line)"
		busy 0
		return
	}
	if {($bindtype == "D1") && ($ttype == "annotated")} {
		set rev1 $rev
		if {"$file" == "ChangeSet"} {
	    		csettool
		} else {
			r2c
		}
	}
	busy 0
	return
} ;# proc selectTag

# Always center nodes vertically, but don't center horizontally unless
# node not in view.
#
# revname:  revision-username (e.g. 1.832-akushner)
#
proc centerRev {revname {doit 0}} \
{
	global cdim w afterId

	if {!$doit} {
		catch {after cancel $afterId}
		set afterId [after idle [list centerRev $revname 1]]
		return
	}
	set bbox [$w(graph) bbox $revname]
	set b_x1 [lindex $bbox 0]
	set b_x2 [lindex $bbox 2]
	set b_y1 [lindex $bbox 1]
	set b_y2 [lindex $bbox 3]

	#displayMessage "b_x1=($b_x1) b_x2=($b_x2) b_y1=($b_y1) b_y2=($b_y2)"
	#displayMessage "cdim_x=($cdim(s,x1)) cdim_x2=($cdim(s,x2))"
	# cdim_y=($cdim(s,y1)) cdim_y2=($cdim(s,y2))"

	set rev_y2 [lindex [$w(graph) coords $revname] 1]
	set cheight [$w(graph) cget -height]
	set ydiff [expr $cheight / 2]
	set yfract [expr ($rev_y2 - $cdim(s,y1) - $ydiff) /  \
	    ($cdim(s,y2) - $cdim(s,y1))]
	$w(graph) yview moveto $yfract

	# XXX: Not working the way I would like
	#if {($b_x1 >= $cdim(s,x1)) && ($b_x2 <= $cdim(s,x2))} {return}

	# XXX:
	# If you go adding tags to the revisions, the index to 
	# rev_x2 might need to be modified
	set rev_x2 [lindex [$w(graph) coords $revname] 0]
	set cwidth [$w(graph) cget -width]
	set xdiff [expr $cwidth / 2]
	set xfract [expr ($rev_x2 - $cdim(s,x1) - $xdiff) /  \
	    ($cdim(s,x2) - $cdim(s,x1))]
	$w(graph) xview moveto $xfract
}

# Separate the revisions by date with a vertical bar
# Prints the date on the bottom of the pane
#
# Walks down an array serial numbers and places bar when the date
# changes
#
proc dateSeparate { } \
{

	global serial2rev rev2date revX revY ht screen gc w app
	global month

	set curday ""
	set prevday ""
	set lastx 0

	# Adjust height of screen by adding text height
	# so date string is not so scrunched in
	set miny [expr {$screen(miny) - $ht}]

	# 12 is added to maxy to accomdate the little anchor glyph
	set maxy [expr {$screen(maxy) + $ht + 12}]

	# Try to compensate for date text size when canvas is small
	if { $maxy < 50 } { set maxy [expr {$maxy + 15}] }

	# set y-position of text
	set ty [expr {$maxy - $ht}]

	if {[array size serial2rev] <= 1} {return}

	foreach ser [lsort -integer [array names serial2rev]] {

		set rev $serial2rev($ser)
		set date $rev2date($rev)

		#puts "s#: $ser rv: $rev d: $date X:$revX($rev) Y:$revY($rev)" 
		set curday $rev2date($rev)
		if {[string compare $prevday $curday] == 0} {
			#puts "SAME: cur: $curday prev: $prevday $rev $nrev"
		} else {
			set x $revX($rev)
			set date_array [split $prevday "/"]
			set mon [lindex $date_array 1]
			set day [lindex $date_array 2]
			set yr [lindex $date_array 0]
			set tz [lindex $date_array 3]
			set tmon $month($mon)
			set date "$day$tmon\n$yr\n$tz"

			if {$mon != ""} {
				# place vertical line short distance behind 
				# the revision bbox
				set lx [ expr {$x - 15}]
				set lid \
				    [$w(graph) create line $lx $miny $lx $maxy \
				    -width 1 \
				    -fill $gc(rev.dateLineColor) \
				    -tags date_line]
				$w(graph) lower $lid

				# Attempt to center datestring between verticals
				set tx [expr {$x - (($x - $lastx)/2) - 13}]
				$w(graph) create text $tx $ty \
				    -fill $gc(rev.dateColor) \
				    -justify center \
				    -anchor n -text "$date" \
				    -font $gc(rev.graphFont) \
				    -tags date_text
			}
			set prevday $curday
			set lastx $x
		}
	}
	set date_array [split $curday "/"]
	set mon [lindex $date_array 1]
	set day [lindex $date_array 2]
	set yr [lindex $date_array 0]
	set tz [lindex $date_array 3]
	set tmon $month($mon)
	set date "$day$tmon\n$yr\n$tz"

	set tx [expr {$screen(maxx) - (($screen(maxx) - $x)/2) + 20}]
	$w(graph) create text $tx $ty -anchor n \
		-fill $gc(rev.dateColor) \
		-text "$date" -font $gc(rev.graphFont) \
		-tags date_text
}

# Add the revs starting at location x/y.
proc addline {y xspace ht l} \
{
	global	bad wid revX revY gc merges parent line_rev screen
	global  stacked rev2rev_name w firstnode firstrev

	set last -1
	set ly [expr {$y - [expr {$ht / 2}]}]

# puts "$l"
	foreach word $l {
		# Figure out if we have another parent.
		# 1.460.1.3-awc-890|1.459.1.2-awc-889
		set m 0
		foreach {a b} [split $word |] {}
		if {$b ne ""} {
			splitRev $a trev tuser serial tagged
			set rev "$trev-$tuser"
			splitRev $b revb userb serialb taggedb
			set rev2 "$revb-$userb"
			set parent($rev) "$revb-$userb"
			lappend merges $rev
			set m 1
		} else {
			splitRev $word trev tuser serial tagged
			set rev "$trev-$tuser"
		}
		set rev2rev_name($trev) $rev
		# determing whether to make revision box two lines 
		if {$stacked} {
			set txt "$tuser\n$trev"
		} else {
			set txt $rev
		}
		set x [expr {$xspace * $serial}]
		set b [expr {$x - 2}]
		if {$last > 0} {
			set a [expr {$last + 2}]
			$w(graph) create line $a $ly $b $ly \
			    -arrowshape {4 4 2} -width 1 \
			    -fill $gc(rev.arrowColor) -arrow last \
			    -tag "l_$trev pline"
		}
		if {$tuser eq "BAD"} {
			set id [$w(graph) create text $x $y \
			    -fill $gc(rev.badColor) \
			    -anchor sw -text "$txt" -justify center \
			    -font $gc(rev.graphBoldFont) \
			    -tags "$trev revtext"]
			highlight $id "bad" $trev
			incr bad
		} else {
			set id [$w(graph) create text $x $y -fill #241e56 \
			    -anchor sw -text "$txt" -justify center \
			    -font $gc(rev.graphBoldFont) \
			    -tags "$rev revtext"]
			#ballon_setup $trev
			if {![info exists firstnode]} { 
				set firstnode $id 
				set firstrev $trev
			}
			if {$m == 1} { 
				highlight $id "merge" $rev
			} else {
				highlight $id "revision" $rev
			}
		}
		if {$tagged} {
			highlight $id tagged $rev
		}
		#puts "ADD $word -> $rev @ $x $y"
		#if {$m == 1} { highlight $id "arrow" }

		if { $x < $screen(minx) } { set screen(minx) $x }
		if { $x > $screen(maxx) } { set screen(maxx) $x }
		if { $y < $screen(miny) } { set screen(miny) $y }
		if { $y > $screen(maxy) } { set screen(maxy) $y }
		
		set revX($rev) $x
# puts "set revX($rev) $x"
		set revY($rev) $y
		set lastwid [wid $id]
		set wid($rev) $lastwid
		set last [expr {$x + $lastwid}]
	}
	if {![info exists merges]} { set merges [list] }
}

# print the line of revisions in the graph.
# Each node is anchored with its sw corner at x/y
# The saved locations in rev{X,Y} are the southwest corner.
# All nodes use up the same amount of space, $w.
proc line {s width ht} \
{
	global	wid revX revY gc where yspace line_rev screen w

	set last ""; set first ""
	# space for node and arrow
	set xspace [expr {$width + 8}]
	set l [split $s]
	if {$s == ""} {return}

	# Figure out the length of the whole list
	# The length is determined by the first and last serial numbers.
	set word [lindex $l 1]
	if {[regexp $line_rev $word dummy a] == 1} { set word $a }
	splitRev $word revision programmer first dummy
	set head "$revision-$programmer"
	set word [lindex $l end]
	if {[regexp $line_rev $word dummy a] == 1} { set word $a }
	splitRev $word dummy dummy last dummy
	if {($last == "") || ($first == "")} {return}
	set diff [expr {$last - $first}]
	incr diff
	set len [expr {$xspace * $diff}]

	# Now figure out where we can put the list.
	set word [lindex $l 0]
	if {[regexp $line_rev $word dummy a] == 1} { set word $a }
	splitRev $word revision programmer last dummy
	set rev "$revision-$programmer"

	# If there is no parent, life is easy, just put it at 0/0.
	if {[info exists revX($rev)] == 0} {
		addline 0 $xspace $ht $l
		return
	}
	# Use parent node on the graph as a starting point.
	# px/py are the sw of the parent; x/y are the sw of the new branch.
	set px $revX($rev)
	set py $revY($rev)

	set pmid [expr {$wid($rev) / 2}]

	# Figure out if we have placed any related branches to either side.
	# If so, limit the search to that side.
	set revs [split $rev .]
	set trunk [join [list [lindex $revs 0] [lindex $revs 1]] .]
	if {[info exists where($trunk)] == 0} {
		set prev ""
	} else {
		set prev $where($trunk)
	}
	# Go look for a space to put the branch.
	set x1 [expr {$first * $xspace}]
	set y 0
	while {1 == 1} {
		# Try below.
		if {"$prev" != "above"} {
			set y1 [expr {$py + $y + $yspace}]
			set x2 [expr {$x1 + $len}]
			set y2 [expr {$y1 + $ht}]
			if {[chkSpace $x1 $y1 $x2 $y2] == {}} {
				set where($trunk) "below"
				break
			}
		}
		# Try above.
		if {"$prev" != "below"} {
			set y1 [expr {$py - $ht - $y - $yspace}]
			set x2 [expr {$x1 + $len}]
			set y2 [expr {$y1 + $ht}]
			if {[chkSpace $x1 $y1 $x2 $y2] == {}} {
				set where($trunk) "above"
				incr py -$ht
				break
			}
		}
		incr y $yspace
	}
	set x [expr {$first * $xspace}]
	set y $y2
	addline $y $xspace $ht [lrange $l 1 end ]
	incr px $pmid
	set x $revX($head)
	set y $revY($head)
	incr y [expr {$ht / -2}]
	incr x -4
	regsub -- {-.*} $rev "" rnum
	regsub -- {-.*} $head "" hnum
	set id [$w(graph) create line $px $py $x $y -arrowshape {4 4 4} \
	    -width 1 -fill $gc(rev.arrowColor) -arrow last \
	    -tags "l_$rnum-$hnum l_$hnum hline"]
	#puts "rnum=($rnum) head=($head)"
	$w(graph) lower $id
} ;# proc line

# Create a merge arrow, which might have to go below other stuff.
proc mergeArrow {m ht} \
{
	global	bad merges parent wid revX revY gc w

	set b $parent($m)
	if {!([info exists revX($b)] && [info exists revY($b)])} {return}
	if {!([info exists revX($m)] && [info exists revY($m)])} {return}
	set px $revX($b)
	set py $revY($b)
	set x $revX($m)
	set y $revY($m)

	# Make the top of one point to the bottom of the other
	if {$y > $py} {
		incr y -$ht
	} else {
		incr py -$ht
	}
	# If we are pointing backwards, then point at .s
	if {$x < $px} {
		incr x [expr {$wid($m) / 2}]
	} elseif {$px < $x} {
		incr px $wid($b)
	} else {
		incr x 2
		incr px 2
	}
	#puts "m=($m) b=($b)"
	regsub -- {-.*} $m "" mnum
	regsub -- {-.*} $b "" bnum
	$w(graph) lower [$w(graph) create line $px $py $x $y \
	    -arrowshape {4 4 4} -width 1 -fill $gc(rev.arrowColor) \
	    -arrow last -tags "l_$bnum-$mnum mline" ]
}

#
# Sets the scrollable region so that the lines are revision nodes
# are viewable
#
proc setScrollRegion {} \
{
	global cdim w

	set bb [$w(graph) bbox date_line revision first]
	set x1 [expr {[lindex $bb 0] - 10}]
	set y1 [expr {[lindex $bb 1] - 10}]
	set x2 [expr {[lindex $bb 2] + 20}]
	set y2 [expr {[lindex $bb 3] + 10}]

	$w(graph) create text $x1 $y1 -anchor nw -text "  " -tags outside
	$w(graph) create text $x1 $y2 -anchor sw -text "  " -tags outside
	$w(graph) create text $x2 $y1 -anchor ne -text "  " -tags outside
	$w(graph) create text $x2 $y2 -anchor se -text "  " -tags outside
	#puts "nw=$x1 $y1 sw=$x1 $y2 ne=$x2 $y1 se=$x2 $y2"
	set bb [$w(graph) bbox outside]
	$w(graph) configure -scrollregion $bb
	$w(graph) xview moveto 1
	$w(graph) yview moveto 0
	$w(graph) yview scroll 4 units

	# The cdim array keeps track of the size of the scrollable region
	# and the entire canvas region
	set bb_all [$w(graph) bbox all]
	set a_x1 [expr {[lindex $bb_all 0] - 10}]
	set a_y1 [expr {[lindex $bb_all 1] - 10}]
	set a_x2 [expr {[lindex $bb_all 2] + 20}]
	set a_y2 [expr {[lindex $bb_all 3] + 10}]
	set cdim(s,x1) $x1; set cdim(s,x2) $x2
	set cdim(s,y1) $y1; set cdim(s,y2) $y2
	set cdim(a,x1) $a_x1; set cdim(a,x2) $a_x2
	set cdim(a,y1) $a_y1; set cdim(a,y2) $a_y2
	#puts "bb_all=>($bb_all)"
}

proc listRevs {r file} \
{
	global	bad Opts merges dev_null ht screen stacked gc w
	global	errorCode bk_fs

	set screen(miny) 0
	set screen(minx) 0
	set screen(maxx) 0
	set screen(maxy) 0
	set lines ""
	set n ""
	set merges [list]

	$w(graph) delete all
	$w(graph) configure -scrollregion {0 0 0 0}

	# Put something in the corner so we get our padding.
	# XXX - should do it in all corners.
	#$w(graph) create text 0 0 -anchor nw -text " "

	set errorCode [list]
	if {$gc(rev.tagOutline) == ""} {
		set opt ""
	} else {
		set opt "-T"
	}
	set d [open "| bk _lines $Opts(line) $opt \"$r\" \"$file\"" "r"]
	# puts "bk _lines $Opts(line) $r $opt \"$file\" 2>$dev_null"
	set len 0
	set big ""
	while {[gets $d s] >= 0} {
		lappend lines $s
		foreach word [split $s] {
			# Figure out if we have another parent.
			set node [split $word $bk_fs]
			set word [lindex $node 0]

			# figure out whether name or revision is the longest
			# so we can find the largest text string in the list
			splitRev $word rev programmer serial tagged

			set revlen [string length $rev]
			set namelen [string length $programmer]

			if {$stacked} {
				if {$revlen > $namelen} { 
					set txt $rev
					set l $revlen
				} else {
					set txt $programmer
					set l $namelen
				}
			} else {
				set txt $word
				set l [string length $word]
			}
			if {($l > $len) && ([string first '-BAD' $rev] == -1)} {
				set len $l
				set big $txt
			}
		}
	}
	catch {close $d} err

	# lines: no such delta ``1.6000'' in SCCS/s.ChangeSet
	if {$err != ""} {
		set rev [string range $r 2 end]
		if {[string match "lines: Can't find date $rev*" $err]} {
			puts stderr "revtool: no such delta ``$rev'' in $file"
		} else {
			puts stderr $err
		}
		exit 1
    	}

	set len [font measure $gc(rev.graphBoldFont) "$big"]
	set ht [font metrics $gc(rev.graphBoldFont) -ascent]
	incr ht [font metrics $gc(rev.graphBoldFont) -descent]

	set ht [expr {$ht * 2}]
	set len [expr {$len + 10}]
	set bad 0

	# If the time interval arg to 'bk _lines' is too short, bail out
	if {$lines == ""} {
		return 1
	}
	foreach s $lines {
		line $s $len $ht
	}
	if {[info exists merges]} {
		foreach m $merges {
			mergeArrow $m $ht
		}
	}
	if {$bad != 0} {
		wm title . "revtool: $file -- $bad bad revs"
	}
	set_tooltips
	return 0
} ;# proc listRevs

# this routine is used to parse the output of "bk _lines". 
# It sets variables in the callers context for revision, username, 
# serial number, and whether the node has a tag or not. 
# "rev" in this context is a string in the form revision-user-serial
# If the string ends with an asterisk, this indicates the rev has a
# tag
# note that all but the first argument are variable names in the
# caller's context.
proc splitRev {rev revVar nameVar serialVar haveTagVar} \
{
	upvar $revVar revision $nameVar name $serialVar serial
	upvar $haveTagVar haveTag

	if {[string index $rev end] == "*"} {
		set haveTag 1
		set rev [string range $rev 0 end-1]
	} else {
		set haveTag 0
	}
	set i [string first "-" $rev]
	set j [string last "-" $rev]
	set revision [string range $rev 0 [expr {$i-1}]]
	set name [string range $rev [expr {$i+1}] [expr {$j-1}]]
	set serial [string range $rev [expr {$j+1}] end]
}

# Highlight the graph edges connecting the node to its children an parents
#
proc highlightAncestry {rev1} \
{
	global	w gc fname dev_null

	# Reset the highlighted graph edges to the default color
	$w(graph) itemconfigure "pline" -fill $gc(rev.arrowColor)
	$w(graph) itemconfigure "mline" -fill $gc(rev.arrowColor)
	$w(graph) itemconfigure "hline" -fill $gc(rev.arrowColor)

	if {$rev1 == ""} return

	set dspec {-dKIDS\n:KIDS:\nKID\n:KID:\nMPD\n:MPARENT:\n}
	if {[catch {exec bk prs -hr$rev1 $dspec $fname} tmp]} {
		return 
	}
	# the result of the split should always be an even number of
	# elements, but doing the foreach rather than an "array set"
	# is more forgiving if that's not the case.
	foreach {name value} [split $tmp \n] {
		set attrs($name) $value
	}

	# Highlight the kids
	foreach r [split $attrs(KIDS)] {
		$w(graph) itemconfigure "l_$rev1-$r" -fill $gc(rev.hlineColor)
	}
	# Highlight the kid (XXX: There was a reason why I did this)
	if {$attrs(KID) ne ""} {
		$w(graph) \
		    itemconfigure "l_$attrs(KID)" -fill $gc(rev.hlineColor)
	}
	# NOTE: I am only interested in the first MPARENT
	set mpd [split $attrs(MPD)]
	if {[llength $mpd] >= 1} {
		$w(graph) itemconfigure "l_$mpd-$rev1" -fill $gc(rev.hlineColor)
	}
	$w(graph) itemconfigure "l_$rev1" -fill $gc(rev.hlineColor)
}

# If called from the button selection mechanism, we give getLeftRev a
# handle to the graph revision node
#
proc getLeftRev { {id {}} } \
{
	global	rev1 rev2 w gc fname dev_null file dashs

	unsetNodes
	.menus.cset configure -state disabled -text "View Changeset "
	set rev1 [getRev "old" $id]
	setAnchor [getRev "anchor" $id]

	highlightAncestry $rev1

	if {$rev1 != ""} {
		if {$file eq "ChangeSet"} {
			set info $rev1
		} else {
			set here ""
			if {$dashs} { set here "-S" }
			catch {exec bk r2c {*}$here -r$rev1 $file} info
		}
		#puts "info=($info)"
		if {$info == ""} {
			.menus.cset configure \
			    -state disabled \
			    -text "Not in a CSET"
		} else {
			.menus.cset configure \
			    -state normal \
			    -text "View Changeset "
		}
		.menus.difftool configure -state normal
	}
	if {[info exists rev2]} { unset rev2 }
}

proc getRightRev { {id {}} } \
{
	global	anchor rev1 rev2 file w rev2rev_name dashs

	$w(graph) delete new old
	set rev2 [getRev "unknown" $id]

	if {$rev2 == ""} {
		# The assumption is, the user must have clicked somewhere 
		# other than over a node
		unsetNodes
		return
	}

	if {$rev2 == $rev1} {
		highlight $rev2 old
	} else {
		highlight $rev2 new
	}

	if {![info exists anchor]} {
		setAnchor $rev2
	}

	orderSelectedNodes $anchor $rev2

	if {$rev2 != ""} {
		.menus.difftool configure -state normal
		if {$file eq "ChangeSet"} {
			set info $rev2
		} else {
			set here ""
			if {$dashs} { set here "-S" }
			catch {exec bk r2c {*}$here -r$rev2 $file} info
		}
		if {$info == ""} {
			.menus.cset configure \
			    -state disabled \
			    -text "Not in a CSET"
		} else {
			.menus.cset configure \
			    -state normal \
			    -text "View Changesets"
		}
	}
}

proc setAnchor {rev} \
{
	global anchor

	set anchor $rev
	if {$anchor == ""} return
	.menus.difftool configure -state normal
	highlight $anchor "anchor"
}

proc unsetNodes {} \
{
	global rev1 rev2 anchor w

	set rev1 ""
	set rev2 ""
	set anchor ""
	$w(graph) delete anchor new old
	.menus.difftool configure -state disabled
	highlightAncestry ""
}

proc getId {} \
{
	global w

	set tags [$w(graph) gettags current]
	# Don't want to create boxes around items that are not
	# graph nodes
	if {([lsearch $tags date_*] >= 0) || ([lsearch $tags l_*] >= 0)} {
		set id ""
	} else {
		set id [lindex $tags 0]
	}

	return $id
}

# Returns the revision number (without the -username portion)
proc getRev {type {id {}} } \
{
	global w anchor merge

	if {$id == ""} {
		set id [getId]
		if {$id == ""} return
	}
	set id [lindex $id 0]
	if {("$id" == "current") || ("$id" == "")} { return "" }
	if {$id == "anchor"} {set id $anchor}
	$w(graph) select clear
	set hl 1
	catch {
		set r [lindex [split $id -] 0]
		if {$r eq $merge(G) || $r eq $merge(l) || $r eq $merge(r)} {
			set hl 0
		}
	}
	if {$hl} {highlight $id $type}
	regsub -- {-.*} $id "" id
	return $id
}

# msg -- optional argument -- use msg to pass in text to print
# if file handle f returns no data
#
proc filltext {win f clear {msg {}}} \
{
	global	search w file ttype displaying

	set diffs 0
	if {$displaying eq "diffs"} {
		set diffs 1
	}

	set annotated 0
	if {$ttype eq "annotated"} {
		set annotated 1
		set apatt {^(.+?\s+)([0-9dx.-]+)(\s+)\|(.*)$}
		set dpatt {([0-9.]+)(-[dx])([0-9.]+)}
	}

	if {$clear == 1} { $win delete 1.0 end }
	while { [gets $f str] >= 0 } {
		set line $str

		set tag ""
		if {$diffs && [string index $str 0] eq "+"} {
			set tag "newDiff"
		} elseif {$diffs && [string index $str 0] eq "-"} {
			set tag "oldDiff"
		}

		if {$annotated && [regexp $apatt $str -> user rev sp rest]} {
			if {[set del [regexp $dpatt $rev -> r1 mk r2]]} {
				set tag "oldDiff"
			}
			$win insert end $user $tag

			if {$del} {
				$win insert end \
				    $r1 "$tag link link-[incr i]" \
				    $mk $tag \
				    $r2 "$tag link link-[incr i]"
			} else {
				$win insert end $rev "$tag link link-[incr i]"
			}
			set str "$sp|$rest"
		}
		$win insert end "$str\n" $tag
	}
	catch {close $f} ignore
	if {[info exists line]} {
		if {$diffs} {
			set x [string first "|" $line]
			highlightStacked $win 1.0 end [incr x]
		}
	} else {
		if {$clear && $msg ne ""} {
			$win insert end $msg
		}
	}

	set_tooltips
	if {$clear == 1} { busy 0 }
	searchreset
	set search(prompt) "Welcome"
}

#
# Called from B1 binding -- selects a node and prints out the cset info
#
proc prs {{id ""} } \
{
	global file rev1 dspec dev_null search w diffpair ttype 
	global sem lock chgdspec dashs

	set lock "inprs"

	getLeftRev $id
	if {"$rev1" != ""} {
		set diffpair(left) $rev1
		set diffpair(right) ""
		busy 1
		if {[isChangeSetFile $file]} {
			set S ""
			if {$dashs} { set S "-S" }
			set cmd "|bk changes $S {$chgdspec} -evr$rev1"
			set ttype "cset_prs"
			if {[file dirname $file] ne "."} {
				append cmd " [file dirname $file]"
			}
			append cmd " 2>$dev_null"
		} else {
			set cmd "|bk prs {$dspec} -r$rev1 \"$file\" 2>$dev_null"
			set ttype "file_prs"
		}
		set prs [open $cmd]
		filltext $w(aptext) $prs 1 "prs output"
	} else {
		set search(prompt) "Click on a revision"
	}
	# Set up locking state machine so that prs and selectNode aren't
	# running at the same time.
	if {$sem == "show_sccslog"} {
		set lock "outprs"
		selectNode "id"
		set sem "start"
	} elseif {$sem == "start"} {
		set lock "outprs"
	}
}

# Display the history for the changeset or the file in the bottom 
# text panel.
#
# Arguments 
#   opt     'tag' only print the history items that have tags. 
#	    '-rrev' Print history from this rev onwards
#
# XXX: Larry overloaded 'opt' with a revision. Probably not the best...
#
proc history {{opt {}}} \
{
	global file dspec dev_null w ttype

	commentsWindow hide
	busy 1
	if {$opt == "tags"} {
		set tags \
"-d\$if(:TAG:){:DPN:@:I:, :Dy:-:Dm:-:Dd: :T::TZ:, :P:\$if(:HT:){@:HT:}\\n\$each(:C:){  (:C:)\\n}\$each(:TAG:){  TAG: (:TAG:)\\n}\\n}"
		set f [open "| bk prs -h {$tags} \"$file\" 2>$dev_null"]
		set ttype "file_prs"
		filltext $w(aptext) $f 1 "There are no tags for $file"
	} else {
		set f [open "| bk prs -h {$dspec} $opt \"$file\" 2>$dev_null"]
		set ttype "file_prs"
		filltext $w(aptext) $f 1 "There is no history"
	}
}

#
# Displays the raw SCCS/s. file in the lower text window. bound to <s>
#
proc sfile {} \
{
	global file w ttype

	busy 1
	set sfile [exec bk sfiles $file]
	set f [open "|[list bk _scat $sfile]"]
	set ttype "sccs"
	filltext $w(aptext) $f 1 "No sfile data"
}

#
# Displays the annotate output in the lower text window. bound to <c>
#
proc annotate {} \
{
	global	file w ttype gc displaying

	busy 1
	set fd [open "| bk annotate -w -R $gc(rev.annotate) \"$file\"" r]
	set ttype "annotated"
	set displaying "annotations"
	filltext $w(aptext) $fd 1 "No annotate data"
}



#
# Displays annotated file listing or changeset listing in the bottom 
# text widget 
#
proc selectNode { type {val {}}} \
{
	global file dev_null rev1 rev2 w ttype sem lock gc

	if {[info exists lock] && ($lock == "inprs")} {
		set sem "show_sccslog"
		return
	}
	if {$type == "id"} {
		#getLeftRev $val
	} elseif {$type == "rev"} {
		set rev1 $val
	}
	if {![info exists rev1] || "$rev1" == ""} { return }
	busy 1
	set base [file tail $file]
	if {$base != "ChangeSet"} {
		set Aur $gc(rev.annotate)
		set r [lindex [split $rev1 "-"] 0]
		set get [open "| bk get $Aur -kPr$r \"$file\" 2>$dev_null"]
		set ttype "annotated"
		filltext $w(aptext) $get 1 "No annotation"
		return
	}
	set rev2 $rev1
	switch $type {
	    id		{ csetdiff2 }
	    rev		{ csetdiff2 $rev1 }
	}
}

proc difftool {file r1 r2} \
{
	global	dashs

	if {$file eq "ChangeSet"} {
		set here ""
		if {$dashs} { set here "-S" }
		catch {exec bk difftool {*}$here -r$r1 -r$r2 &} err
	} else {
		catch {exec bk difftool -r$r1 -r$r2 $file &} err
	}
	busy 0
}

proc csettool {} \
{
	global rev1 rev2 file dashs

	if {[info exists rev1] != 1} { return }
	if {[info exists rev2] != 1} { set rev2 $rev1 }
	if {[string equal $rev1 $rev2]} {
		set revs -r$rev1
	} else {
		set revs -r$rev1..$rev2
	}
	set S ""
	if {$dashs} { set S "-S" }
	catch {exec bk csettool {*}$S $revs &} err
}

proc diff2 {difftool {id {}} } \
{
	global file rev1 rev2 dev_null bk_cset w

	if {![info exists rev1] || ($rev1 == "")} { return }
	if {$difftool == 0} { getRightRev $id }
	if {"$rev2" == ""} { return }

	set base [file tail $file]
	if {$base == "ChangeSet"} {
		csetdiff2
		return
	}
	busy 1
	if {$difftool == 1} {
		difftool $file $rev1 $rev2
		return
	}
	displayDiff $rev1 $rev2
}

# Display the difference text between two revisions. 
proc displayDiff {rev1 rev2} \
{
	global file w dev_null ttype gc

	# We get no rev1 when rev2 is 1.1
	if {$rev1 == ""} { set rev1 "1.0" }
	set Aur $gc(rev.annotate)
	set diffs [open "| bk diffs --who-deleted -h $Aur \
		-r$rev1 -r$rev2 $file"]
	diffs $diffs
	searchreset
	busy 0
	set ttype "annotated"
}

# hrev : revision to highlight
proc gotoRev {f hrev} \
{
	global anchor rev1 rev2 gc dev_null

	set rev1 $hrev
	revtool $f $hrev
	set hrev [lineOpts $hrev]
	set anchor [getRev "anchor" $hrev]
	set rev1 [getRev "old" $hrev]
#	highlight $anchor "anchor"
#	highlight $hrev "old"
	catch {exec bk prs -hr$hrev -d:I:-:P: $f 2>$dev_null} out
	if {$out != ""} {centerRev $out}
	if {[info exists rev2]} { unset rev2 }
}

proc currentMenu {} \
{
	global file gc rev1 rev2 bk_fs dev_null 
	global fileEventHandle currentMenuList dashs

	$gc(fmenu) entryconfigure "Current Changeset*" \
	    -state disabled
	if {$file != "ChangeSet"} {return}

	if {![info exists rev1] || $rev1 == ""} {return}
	$gc(fmenu) entryconfigure "Current Changeset*" \
	    -state normal

	if {![info exists rev2] || ($rev2 == "") || $rev2 == $rev1} { 
		set end ""
		$gc(fmenu) entryconfigure "Current Changeset*" \
		    -label "Current Changeset"
	} else {
		# don't want to modify global rev2 in this procedure
		set end "..$rev2"
		$gc(fmenu) entryconfigure "Current Changeset*" \
		    -label "Current Changesets"
	}
	busy 1
	revtool_cd2root
	set currentMenuList {}
	$gc(current) delete 0 end
	$gc(current) add command -label "Computing..." -state disabled

	# close any previously opened pipe
	if {[info exists fileEventHandle]} {
		catch {close $fileEventHandle}
	}
	set S ""
	if {$dashs} { set S "-S" }
	set fileEventHandle \
	    [open "| bk changes $S -nd:DPN:@:I: -fv -er$rev1$end"]

	fconfigure $fileEventHandle -blocking false
	fileevent $fileEventHandle readable \
	    [list updateCurrentMenu $fileEventHandle]

	busy 0
	return
}

# this reads one line from a pipe and saves the data to a list. 
# When no more data is available this proc will be called with 
# cleanup set to 1 at which time it will close the pipe and 
# create the menu.
proc updateCurrentMenu {fd {cleanup 0}} \
{
	global bk_fs gc
	global currentMenuList
	global fileEventHandle

	if {$cleanup} {
		catch {close $fd}
		$gc(current) delete 0 end
		$gc(fmenu) entryconfigure "Current Changeset*" -state normal
		if {[llength $currentMenuList] > 0} {
			foreach item [lsort $currentMenuList] {
				foreach {f rev} [split $item @] {break;}
				$gc(current) add command \
				    -label $item \
				    -command [list gotoRev $f $rev]
			} 
		} else {
			$gc(current) add command \
			    -label "(no files)" \
			    -state disabled
		}
		return
	}
		
	set status [catch {gets $fd r} result]
	if {$status != 0} {
		# error on the channel
		updateCurrentMenu $fd 1

	} elseif {$result >= 0} {
		# successful read
		if {![string match {ChangeSet@*} $r]} {
			lappend currentMenuList $r
		}

	} elseif {[eof $fd]} {
		updateCurrentMenu $fd 1

	} elseif {[fblocked $fd]} {
		# blocked; no big deal. 

	} else {
		# should never happen. But if it does...
		updateCurrentMenu $fd 1
	}
}

#
# Display the comments for the changeset and all of the files that are
# part of the cset
#
# Arguments:
#   rev  -- Revision number (optional)
#	    If rev is set, ignores globals rev1 and rev2
#
#
# If rev not set, uses globals rev1 and rev2 that are set by get{Left,Right} 
#
proc csetdiff2 {{rev {}}} \
{
	global file rev1 rev2 Opts dev_null w ttype anchor
	global chgdspec dashs

	busy 1
	if {$rev != ""} {
		set revs $rev
		set rev1 $rev
		set rev2 $rev
		set anchor $rev1
	} else {
		if {[string equal $rev1 $rev2]} {
			set revs $rev1
		} else {
			set revs $rev1..$rev2
		}
	}
	$w(aptext) delete 1.0 end
	$w(aptext) insert end "ChangeSet history for $revs\n\n"

	set S ""
	if {$dashs} { set S "-S" }
	set revs [open "|bk changes $S {$chgdspec} -fv -er$revs"]
	filltext $w(aptext) $revs 0 "sccslog for files"
	set ttype "cset_prs"
	catch {close $revs}
	busy 0
}

# Bring up csettool for a given set of revisions as selected by the mouse
proc r2c {} \
{
	global file rev1 rev2 errorCode dashs

	# if the following is true it means there's nothing selected
	# so we should just do nothing. 
	if {![info exists rev1] || $rev1 == ""} return

	busy 1
	set csets ""
	set c ""
	set errorCode [list]
	set here ""
	if {$dashs} { set here "-S" }
	if {$file == "ChangeSet"} {
		busy 0
		csettool
		return
	}
	# XXX: When called from "View Changeset", rev1 has the name appended
	#      need to track down the reason -- this is a hack
	set rev1 [lindex [split $rev1 "-"] 0]
	if {[info exists rev2] && ![string equal $rev1 $rev2]} {
		set revs [open "| bk prs -nhfr$rev1..$rev2 -d:I: \"$file\""]
		while {[gets $revs r] >= 0} {
			catch {set c [exec bk r2c {*}$here -r$r "$file"]} err 
			if {[lindex $errorCode 2] == 1} {
				displayMessage \
				    "Unable to find ChangeSet information for $file@$r"
				busy 0
				catch {close $revs} err
				return
			}
			if {$csets == ""} {
				set csets $c
			} else {
				set csets "$csets,$c"
			}
		}
		catch {close $revs} err
	} else {
		#displayMessage "rev1=($rev1) file=($file)"
		catch {set csets [exec bk r2c {*}$here -r$rev1 "$file"]} c
		if {[lindex $errorCode 2] == 1} {
			displayMessage \
			    "Unable to find ChangeSet information for $file@$rev1"
			busy 0
			return
		}
	}
	set S ""
	if {$dashs} { set S "-S" }
	catch {exec bk csettool {*}$S -r$csets -f$file@$rev1 &}
	busy 0
}

proc diffs {diffs} \
{
	global	ttype displaying w

	set ttype "annotated"
	set displaying "diffs"
	filltext $w(aptext) $diffs 1
}

proc done {} \
{
	exit
}

proc busy {busy} \
{
	global	w currentBusyState

	# No reason to do any work if the state isn't changing. This
	# actually makes a subtle performance boost.
	if {[info exists currentBusyState] &&
	    $busy == $currentBusyState} {
		return
	}
	set currentBusyState $busy

	if {$busy == 1} {
		. configure -cursor watch
		$w(graph) configure -cursor watch
		$w(aptext) configure -cursor watch
	} else {
		. configure -cursor left_ptr
		$w(graph) configure -cursor left_ptr
		$w(aptext) configure -cursor left_ptr
	}

	# only need to call update if we are transitioning to the
	# busy state; becoming "unbusy" will take care of itself
	# when the GUI goes idle. Another subtle performance boost.
	if {$busy} {update idletasks}
	focus $w(graph)
}

proc widgets {} \
{
	global	search Opts gc stacked d w dspec wish yspace
	global  fname app ttype sem chgdspec

	set sem "start"
	set ttype ""
	set dspec \
"-d:DPN:@:I:, :Dy:-:Dm:-:Dd: :T::TZ:, :P:\$if(:HT:){@:HT:}\\n\$each(:C:){  (:C:)\\n}\$each(:TAGS:){  TAG: (:TAGS:)\\n}\\n"
	# this one is used when calling 'bk changes'; its distinguishing
	# feature is slighly different indentation and the fact that the
	# filename is on a line by itself. The key bindings for changeset
	# history depend on this (see selectTag)
	set chgdspec \
"-d\$if(:DPN:!=ChangeSet){  }:DPN:\\n    :I: :Dy:/:Dm:/:Dd: :T: :P:\$if(:HT:){@:HT:} +:LI: -:LD: \\n\$each(:C:){    (:C:)\\n}\$each(:TAGS:){  TAG: (:TAGS:)\\n}\\n"
	set Opts(line) "-u -t"
	set yspace 20
	# graph		- graph canvas window
	# cframe	- comment frame	
	# ctext		- comment text window (pops open)
	# apframe	- annotation/prs frame
	# aptext	- annotation window
	set w(panes)	.p
	set w(graph)	.p.top.c
	set w(cframe)	.p.c
	set w(ctext)	.p.c.t
	set w(cclose)	.p.c.t.close
	set w(apframe)	.p.b
	set w(aptext)	.p.b.t
	set stacked 1

	getConfig "rev"

	set gc(bw) 1
	if {$gc(windows)} {
		set gc(py) 0; set gc(px) 1
		set gc(histfile) [file join $gc(bkdir) "_bkhistory"]
	} elseif {$gc(aqua)} {
		set gc(py) 1; set gc(px) 12
		set gc(histfile) [file join $gc(bkdir) ".bkhistory"]
	} else {
		set gc(py) 1; set gc(px) 4
		set gc(histfile) [file join $gc(bkdir) ".bkhistory"]
	}

	image create photo iconClose -file $::env(BK_BIN)/gui/images/close.png

	ttk::frame .menus
	    ttk::button .menus.quit -text "Quit" -command done
	    ttk::button .menus.help -text "Help" -command {
		exec bk helptool revtool &
	    }
	    ttk::menubutton .menus.mb -text "Select Range" -menu .menus.mb.menu
		set m [menu .menus.mb.menu]
		if {$gc(aqua)} {$m configure -tearoff 0}
		$m add command -label "Last Day" \
		    -command {revtool $fname -1D}
		$m add command -label "Last 2 Days" \
		    -command {revtool $fname -2D}
		$m add command -label "Last 3 Days" \
		    -command {revtool $fname -3D}
		$m add command -label "Last 4 Days" \
		    -command {revtool $fname -4D}
		$m add command -label "Last 5 Days" \
		    -command {revtool $fname -5D}
		$m add command -label "Last 6 Days" \
		    -command {revtool $fname -6D}
		$m add command -label "Last Week" \
		    -command {revtool $fname -1W}
		$m add command -label "Last 2 Weeks" \
		    -command {revtool $fname -2W}
		$m add command -label "Last 3 Weeks" \
		    -command {revtool $fname -3W}
		$m add command -label "Last 4 Weeks" \
		    -command {revtool $fname -4W}
		$m add command -label "Last 5 Weeks" \
		    -command {revtool $fname -5W}
		$m add command -label "Last 6 Weeks" \
		    -command {revtool $fname -6W}
		$m add command -label "Last 2 Months" \
		    -command {revtool $fname -2M}
		$m add command -label "Last 3 Months" \
		    -command {revtool $fname -3M}
		$m add command -label "Last 6 Months" \
		    -command {revtool $fname -6M}
		$m add command -label "Last 9 Months" \
		    -command {revtool $fname -9M}
		$m add command -label "Last Year" \
		    -command {revtool $fname -1Y}
		$m add command -label "All Changes" \
		    -command {revtool $fname ..}
	    ttk::button .menus.cset -text "View Changeset " -command r2c \
		-state disabled
	    ttk::button .menus.difftool -text "Diff tool" -command "doDiff 1" \
		-state disabled
	    ttk::menubutton .menus.fmb -text "Select File" -menu .menus.fmb.menu
		set gc(fmenu) [menu .menus.fmb.menu]
		if {$gc(aqua)} {$gc(fmenu) configure -tearoff 0}
		set gc(current) $gc(fmenu).current
		$gc(fmenu) add command -label "Open new file..." \
		    -command openNewFile
		$gc(fmenu) add command -label "Changeset History" \
		    -command openChangesetHistory
		$gc(fmenu) add separator
		$gc(fmenu) add cascade -label "Current Changeset" \
		    -menu $gc(current)
		menu $gc(current) 
		pack .menus.quit .menus.fmb .menus.mb \
		    .menus.difftool .menus.cset \
		    -side left -fill y -padx 1
		pack .menus.help -side right -fill y -padx 1

	ttk::panedwindow .p
	    ttk::frame .p.top
		ttk::scrollbar .p.top.xscroll -orient horizontal \
		    -command "$w(graph) xview"
		ttk::scrollbar .p.top.yscroll -orient vertical \
		    -command "$w(graph) yview"
		canvas $w(graph) -width 500 \
	    	    -borderwidth 1 \
	    	    -highlightthickness 0 \
		    -background $gc(rev.canvasBG) \
		    -xscrollcommand ".p.top.xscroll set" \
		    -yscrollcommand ".p.top.yscroll set"

		grid .p.top.yscroll -row 0 -column 1 -sticky ns
		grid .p.top.xscroll -row 1 -column 0 -sticky ew
		grid $w(graph)      -row 0 -column 0 -sticky nsew
		grid rowconfigure    .p.top 0 -weight 1
		grid rowconfigure    .p.top 1 -weight 0
		grid columnconfigure .p.top 0 -weight 1
		grid columnconfigure .p.top 1 -weight 0
		
	    # change comment window
	    ttk::frame .p.c
		text .p.c.t -width $gc(rev.textWidth) \
		    -cursor "" \
		    -borderwidth 1 \
		    -height $gc(rev.commentHeight) \
		    -font $gc(rev.fixedFont) \
		    -xscrollcommand { .p.c.xscroll set } \
		    -yscrollcommand { .p.c.yscroll set } \
		    -bg $gc(rev.commentBG) -fg $gc(rev.textFG) -wrap none \
		    -insertwidth 0 -highlightthickness 0
		ttk::scrollbar .p.c.xscroll -orient horizontal \
		    -command { .p.c.t xview }
		ttk::scrollbar .p.c.yscroll -orient vertical \
		    -command { .p.c.t yview }
		grid .p.c.t       -row 0 -column 0 -sticky nsew
		grid .p.c.yscroll -row 0 -column 1 -sticky ns
		grid .p.c.xscroll -row 1 -column 0 -sticky ew
		grid rowconfigure    .p.c .p.c.t -weight 1
		grid columnconfigure .p.c .p.c.t -weight 1
	    label $w(cclose) -background $gc(rev.commentBG) \
		-image iconClose -cursor $gc(handCursor)
	    bind $w(cclose) <1> "commentsWindow hide"
	    bind .p.c <Enter> "commentsWindow showButton"
	    bind .p.c <Leave> "commentsWindow hideButton"

	    # prs and annotation window
	    ttk::frame .p.b
		text .p.b.t -width $gc(rev.textWidth) \
		    -borderwidth 1 \
		    -height $gc(rev.textHeight) \
		    -font $gc(rev.fixedFont) \
		    -xscrollcommand { .p.b.xscroll set } \
		    -yscrollcommand { .p.b.yscroll set } \
		    -bg $gc(rev.textBG) -fg $gc(rev.textFG) -wrap none \
		    -insertwidth 0 -highlightthickness 0
		ttk::scrollbar .p.b.xscroll -orient horizontal \
		    -command { .p.b.t xview }
		ttk::scrollbar .p.b.yscroll -orient vertical \
		    -command { .p.b.t yview }


		grid .p.b.t       -row 0 -column 0 -sticky nsew
		grid .p.b.yscroll -row 0 -column 1 -sticky ns
		grid .p.b.xscroll -row 1 -column 0 -sticky ew
		grid rowconfigure    .p.b .p.b.t -weight 1
		grid columnconfigure .p.b .p.b.t -weight 1

	.p add .p.top
	.p add .p.b -weight 1

	ttk::frame .cmd 
	search_widgets .cmd $w(aptext)
	# Make graph the default window to have the focus
	set search(focus) $w(graph)

	$w(aptext) tag configure "link" -foreground blue -underline 1
	$w(aptext) tag bind "link" <ButtonRelease-1> "click_rev %W"
	bind $w(aptext) <Motion> "mouse_motion %W"

	grid .menus -row 0 -column 0 -sticky ew -pady 2
	grid .p -row 1 -column 0 -sticky ewns
	grid .cmd -row 2 -column 0 -sticky ew -pady 2
	grid rowconfigure . 1 -weight 1
	grid columnconfigure . 0 -weight 1
	grid columnconfigure .cmd 0 -weight 1
	grid columnconfigure .cmd 1 -weight 2

	# schedule single-click for the future in case a double-click
	# comes along. Otherwise the single-click processing could take
	# so long the double-click is never noticed as a double-click.
	bind $w(graph) <1> {
		set id [getId]
		set ::afterId [after $gc(rev.doubleclick) [format {
			busy 1
			commentsWindow hide
			prs %%s
			currentMenu
			busy 0
		} [list $id]]]
	}
	bind $w(graph) <Double-1> {
		busy 1
		if {[info exists ::afterId]} {
			after cancel $::afterId
			unset ::afterId
		}
		set id [getId]
		getLeftRev $id
		if {$rev1 != ""} {
			set diffpair(left) $rev1
			set diffpair(right) ""
			selectNode "id"
			currentMenu
		}
		busy 0
	}

	bind $w(graph) <3>		{ diff2 0; currentMenu; break }
	if {$gc(aqua)} {
		bind $w(graph) <Command-1>  { diff2 0; currentMenu; break}
	}
	bind $w(graph) <Button-2>	{ history; break }

	# global bindings
	bind BK <a>		{ selectNode "id" ; break }
	bind BK <C>		{ r2c; break }
	bind BK <h>		"history"
	bind BK <t>		"history tags"
	bind BK <d>		"doDiff"
	bind BK <s>		"sfile"
	bind BK <c>		"annotate"
	bind BK <Prior>		"$w(aptext) yview scroll -1 pages"
	bind BK <Next>		"$w(aptext) yview scroll  1 pages"
	bind BK <space>		"$w(aptext) yview scroll  1 pages"
	bind BK <Up>		"$w(aptext) yview scroll -1 units"
	bind BK <Down>		"$w(aptext) yview scroll  1 units"
	bind BK <Home>		"$w(aptext) yview -pickplace 1.0"
	bind BK <End>		"$w(aptext) yview -pickplace end"
	bind BK <Control-b>	"$w(aptext) yview scroll -1 pages"
	bind BK <Control-f>	"$w(aptext) yview scroll  1 pages"
	bind BK <Control-e>	"$w(aptext) yview scroll  1 units"
	bind BK <Control-y>	"$w(aptext) yview scroll -1 units"

	bind BK <Shift-Prior>	"$w(graph) yview scroll -1 pages"
	bind BK <Shift-Next>	"$w(graph) yview scroll  1 pages"
	bind BK <Shift-Up>	"$w(graph) yview scroll -1 units"
	bind BK <Shift-Down>	"$w(graph) yview scroll  1 units"
	bind BK <Shift-Left>	"$w(graph) xview scroll -1 pages"
	bind BK <Shift-Right>	"$w(graph) xview scroll  1 pages"
	bind BK <Left>		"$w(graph) xview scroll -1 units"
	bind BK <Right>		"$w(graph) xview scroll  1 units"
	bind BK <Shift-Home>	"$w(graph) xview moveto 0"
	bind BK <Shift-End>	"$w(graph) xview moveto 1.0"
	bind BK <Control-c>	"#"
	if {$gc(aqua)} {
		bind BK <Command-c> "#"
		bind . <Command-q> done
		bind . <Command-w> done
	}
	$search(widget) tag configure search \
	    -background $gc(rev.searchColor) -font $gc(rev.fixedBoldFont)
	search_keyboard_bindings
	bind . <n>	{
	    set search(dir) "/"
	    searchnext
	}
	bind . <p>	{
	    set search(dir) "?"
	    searchnext
	}
	searchreset

	bind $w(aptext) <Double-1> "break"
	bind $w(aptext) <Double-ButtonRelease-1> "textDoubleButton1 %W %x %y"
	bind $w(aptext) <ButtonPress-1> "textButtonPress1 %W %x %y"
	bind $w(aptext) <ButtonRelease-1> "textButtonRelease1 %W %x %y"

	if {$gc(aqua)} {
		bind $w(aptext) <Button-2> { selectTag %W %x %y "B3"; break}
		bind $w(aptext) <Command-1> {selectTag %W %x %y "B3"; break}
	} else {
		bind $w(aptext) <Button-3> { selectTag %W %x %y "B3"; break}
	}

	configureDiffWidget $app $w(aptext)
               
	bindtags $w(graph) [concat BK [bindtags $w(graph)]]
	bindtags $w(aptext) [list BK $w(aptext) ReadonlyText . all]
	bindtags $w(ctext)  [list BK $w(ctext) ReadonlyText . all]

	# In the search window, don't listen to "all" tags. (This is now done
	# in the search.tcl lib) <remove if all goes well> -ask
	#bindtags $search(text) { .cmd.search Entry }
	bind all <$gc(rev.quit)>	"done"

	bind all <KeyPress-Shift_L> revtool_shift_down
	bind all <KeyRelease-Shift_L> revtool_shift_up

	focus $w(graph)
} ;# proc widgets

proc textButtonPress1 {w x y} \
{
	set ::clicked_rev 0
	set ::selection [$w tag ranges sel]
}

proc textButtonRelease1 {w x y} \
{
	global	gc

	## If there was a selection when they first clicked, don't
	## fire the click event.  This will clear the selection without
	## accidentally firing our button event and pulling the rug out
	## from under them.
	if {[info exists ::selection] && [llength $::selection]} { return }

	if {$::clicked_rev} { return }

	## If they selected any text, don't fire the click event.
	if {[llength [$w tag ranges sel]]} { return }
	set ::afterId [after $gc(rev.doubleclick) [list selectTag $w $x $y B1]]
}

proc textDoubleButton1 {w x y} \
{
	if {[info exists ::afterId]} {
		after cancel $::afterId
		unset ::afterId
	}
	selectTag $w $x $y D1
	return -code break
}

proc commentsWindow {action} \
{
	global w comments_mapped

	switch -- $action {
		"hide" {
			catch {$w(panes) forget $w(cframe)}
			set comments_mapped 0
		}

		"show" {
			$w(panes) insert 1 $w(cframe)
			set comments_mapped 1
		}

		"hideButton" {
			place forget $w(cclose)
		}

		"showButton" {
			place $w(cclose) -relx 1.0 -y 0 -anchor ne
		}
	}
}

proc selectFile {} \
{
	global gc fname

	set file [tk_getOpenFile]
	if {$file == ""} {return}
	catch {set f [open "| bk sfiles -g \"$file\"" r]} err
	if { ([gets $f fname] <= 0)} {
		set rc [tk_dialog .new "Error" "$file is not under revision control.\nPlease select a revision controled file" "" 0 "Cancel" "Select Another File" "Exit BitKeeper"]
		if {$rc == 2} {exit} elseif {$rc == 1} { selectFile }
	}
	catch {close $f}
	return $fname
}

proc get_line_rev {lineno} \
{
	global	w
	set line [$w(aptext) get $lineno.0 $lineno.end]
	if {[regexp {^(.*)[ \t]+([0-9]+\.[0-9.]+).*\|} $line -> user rev]} {
		return $rev
	}
}

proc mouse_motion {win} {
	global	gc redrev file

	set tags [$win tag names current]
	set tag  [lsearch -inline $tags link-*]
	if {[info exists redrev] && $tag ne $redrev} {
		$win tag configure $redrev -foreground blue
		unset redrev
	}

	after cancel $::tooltipAfterId

	if {"link" in $tags} {
		set redrev $tag
		$win configure -cursor $gc(handCursor)
		$win tag configure $redrev -foreground red

		set rev [$win get $tag.first $tag.last]
		set msg [exec bk log -r$rev $file]
		set cmd [list tooltip::show $win $msg cursor]
		if {$::shift_down} {
			eval $cmd
		} else {
			set ::tooltipAfterId [after 500 $cmd]
		}
	} else {
		$win configure -cursor ""
	}
}

proc click_rev {win} {
	set ::clicked_rev 1
	set_curLine current
	set tag [lsearch -inline [$win tag names current] link-*]
	set rev [$win get $tag.first $tag.last]
	jump_to_rev $rev
}

proc set_curLine {index} \
{
	global	w curLine

	set curLine [$w(aptext) index "$index linestart"]
	$w(aptext) tag remove "select" 1.0 end
	$w(aptext) tag add "select" "$curLine" "$curLine lineend + 1 char"
}

proc jump_to_rev {rev} \
{
	global	gc w dspec dev_null file rev1 curLine rev2rev_name

	if {![info exists rev2rev_name($rev)]} {
		global	file firstnode

		## The given rev is not in our current graph.
		## Get it and jump to it.

		set parent [exec bk prs -d:PARENT: -hr${rev} $file]
		set prev [expr {($parent == 0) ? $rev : $parent}]
		listRevs "-c${prev}.." $file
		revMap $file
		dateSeparate
		setScrollRegion
		$w(graph) xview moveto 0 
	}

	if {![info exists rev2rev_name($rev)]} { return }

	set rev1 $rev
	set revname $rev2rev_name($rev)
	centerRev $revname
	set id [$w(graph) gettag $revname]
	if {$id ne ""} { getLeftRev $id }

	$w(aptext) configure -height 15
	$w(ctext) configure -height $gc(rev.commentHeight) 
	$w(aptext) configure -height 50
	set comments_mapped [winfo ismapped $w(ctext)]
	commentsWindow show
	set prs [open [list |bk prs $dspec -hr$rev $file 2>$dev_null]]
	filltext $w(ctext) $prs 1 "No comments found."

	set wht [winfo height $w(cframe)]
	set cht [font metrics $gc(rev.graphFont) -linespace]
	set adjust [expr {int($wht) / $cht}]
	if {($curLine > $adjust) && ($comments_mapped == 0)} {
		$w(aptext) yview scroll $adjust units
	}
}

proc openChangesetHistory {} \
{
	global diffpair

	# diffpair isn't unset by the 'revtool' proc (and
	# making it do so is a non-trivial change to a bunch
	# of startup logic) but it needs to be reset before
	# calling that proc or it might try to diff
	# non-existent revs in the selected file.
	if {[info exists diffpair]} {unset diffpair}
	revtool_cd2root
	revtool ChangeSet
}

proc openNewFile {} \
{
	global diffpair

	set fname [selectFile]
	if {$fname != ""} {
		if {[info exists diffpair]} {unset diffpair}
		revtool $fname
	}
}

proc revtool_cd2root {} \
{
	global	dashs
	
	if {$dashs} {
		cd2root
	} else {
		cd2product
	}
}

# Arguments:
#  lfname	filename that we want to view history
#  R		Revision, time period, or number of revs that we want to view
proc revtool {lfname {R {}}} \
{
	global	bad revX revY search dev_null rev2date serial2rev w r2p
	global  Opts gc file rev2rev_name cdim firstnode fname
	global  merge diffpair firstrev
	global	rev1 rev2 anchor

	# Set global so that other procs know what file we should be
	# working on. Need this when menubutton is selected
	set fname $lfname
	
	busy 1
	$w(graph) delete all
	if {[info exists revX]} { unset revX }
	if {[info exists revY]} { unset revY }
	if {[info exists anchor]} {unset anchor}
	if {[info exists rev1]} { unset rev1 }
	if {[info exists rev2]} { unset rev2 }
	if {[info exists rev2date]} { unset rev2date }
	if {[info exists serial2rev]} { unset serial2rev }
	if {[info exists rev2rev_name]} { unset rev2rev_name }
	if {[info exists firstnode]} { unset firstnode }
	if {[info exists firstrev]} { unset firstrev}

	set bad 0
	set file [exec bk sfiles -g $lfname 2>$dev_null]
	if {"$file" == ""} {
		displayMessage "No such file \"$lfname\" rev=($R) \nPlease \
select a new file to view"
		set lfname [selectFile]
		if {$lfname == ""} { exit }
		set file [exec bk sfiles -g $lfname 2>$dev_null]
	}
	if {[catch {exec bk root -R $file} proot]} {
		wm title . "revtool: $file $R"
	} else {
		wm title . "revtool: $proot: $file $R"
	}
	if {[info exists merge(G)] && ($merge(G) != "")} {
		set gca $merge(G)
	} else {
		set gca ""
	}
	if {$R == ""} {
		if {$gca != ""} {
			set R "-c$gca.."
		} elseif {[file tail $file] eq "ChangeSet"} {
			set R "-n$gc(rev.showCsetRevs)"
		} else {
			set R "-n$gc(rev.showRevs)"
		}
	} elseif {[regexp -- {^-[crRn]} $R] == 0} {
		set R "-R${R}"
	}
	# If valid time range given, do the graph
	if {[listRevs $R "$file"] == 0} {
		revMap "$file"
		dateSeparate
		setScrollRegion
		set first [$w(graph) gettags $firstnode]
		history "-r$firstrev.."
	} else {
		set ago ""
		catch {set ago [exec bk prs -hr+ -d:AGE: $lfname]}
		if {[lindex $::errorCode 2] != 0} {exit [lindex $::errorCode 2]}
		# XXX: Highlight this in a different color? Yellow?
		$w(aptext) delete 1.0 end
		$w(aptext) insert end  "Error: No data within the given time\
period; please choose a longer amount of time.\n
The file $lfname was last modified ($ago) ago."
		revtool $lfname ..
	}
	# Now make sure that the last/gca node is visible in the canvas "
	if {$gca != ""} {
		set r $gca
	} else {
		set r +
	}
	if {[info exists r2p($r)]} {
		centerRev "$r-$r2p($r)"
	}
	# Make sure we don't lose the highlighting when we do a select Range
	if {[info exists merge(G)] && ($merge(G) != "")} {
 		set gca [lineOpts $merge(G)]
 		highlight $gca "gca"
 		set rev2 [lineOpts $merge(r)]
 		highlight $rev2 "remote"
 		set rev1 [lineOpts $merge(l)]
 		highlight $rev1 "local"
		setAnchor $gca
	} else {
		if {[info exists diffpair(left)] && ($diffpair(left) != "")} {
			set rev1 [lineOpts $diffpair(left)]
			highlightAncestry $diffpair(left)
			centerRev $rev1
			setAnchor $rev1
			highlight $rev1 "old"
			getLeftRev $rev1
		}
		if {[info exists diffpair(right)] && ($diffpair(right) != "")} {
			set rev2 [lineOpts $diffpair(right)]
			highlight $rev2 "new"
			orderSelectedNodes $anchor $rev2
		}
	}
	set search(prompt) "Welcome"
	focus $w(graph)
	currentMenu
	busy 0
	return
} ;#revtool

#
# rev1	- left-side revision (or revision to warp to on startup)
# rev2	- right-side revision
# gca	- greatest common ancestor
#
proc arguments {} \
{
	global rev1 rev2 dfile argv argc fname gca errorCode
	global searchString startingLineNumber dashs

	set rev1 ""
	set rev2 ""
	set gca ""
	set fname ""
	set dfile ""
	set fnum 0
	set dashs 0
	set argindex 0

	while {$argindex < $argc} {
		set arg [lindex $argv $argindex]
		switch -regexp -- $arg {
		    "^-r.*" {
			if {$rev2 != ""} {
				puts stderr "Only one -r allowed"
				exit
			}
			set rev2 [string range $arg 2 end]
		    }
		    "^-l.*" {
			if {$rev1 != ""} {
				puts stderr "Only one -l allowed"
				exit
			}
			set rev1 [string range $arg 2 end]
		    }
		    "^-d.*" {
			set dfile [string range $arg 2 end]
		    }
		    {^\+[0-9]+$} {
			    set startingLineNumber \
				[string range $arg 1 end]
		    }
		    {^-/.+/?$} {
			    # we're a bit forgiving and don't strictly
			    # require the trailing slash. 
			    if {![regexp -- {-/(.+)/$} $arg -- searchString]} {
				    set searchString \
					[string range $arg 2 end]
			    }
		    }
		    "^-S$" - "^--standalone$" {
			set dashs 1
		    }
		    "^-.*" {
			catch {exec bk help -s revtool} usage
			puts "Invalid option $arg"
			puts $usage
			exit 1
		    }
		    default {
		    	incr fnum
			set opts(file,$fnum) $arg
		    }
		}
		incr argindex
	}
	set arg [lindex $argv $argindex]

	if {"$rev1" == "" && "$rev2" != ""} {
		set rev1 $rev2
		set rev2 ""
	}

	if {$fnum > 1} {
		puts stderr "Error: Incorrect argument or too many arguments."
		exit 1
	} elseif {$fnum == 0} {
		revtool_cd2root
		# This should match the CHANGESET path defined in sccs.h
		set fname ChangeSet
		catch {exec bk sane -r} err
		if {[lindex $errorCode 2] == 1} {
			displayMessage "$err" 0
			exit 1
		}
	} elseif {$fnum == 1} {
		set fname $opts(file,1)

		catch {file type $fname} ftype
		if {[string equal $ftype "link"] && 
		    [string equal [exec bk sfiles -g $fname] ""]} {
			set fname [resolveSymlink $fname]
		}
		if {[file isdirectory $fname]} {
			catch {cd $fname} err
			if {$err != ""} {
				displayMessage "Unable to cd to $fname"
				exit 1
			}
			revtool_cd2root
			# This should match the CHANGESET path defined in sccs.h
			set fname ChangeSet
			catch {exec bk sane} err
			if {[lindex $errorCode 2] == 1} {
				displayMessage "$err" 0
				exit 1
			}
		} else {
			if {[exec bk sfiles -g "$fname"] == ""} {
				puts stderr \
				  "\"$fname\" is not a revision controlled file"
				displayMessage \
				    "\"$fname\" not a bk controlled file"
				exit
			}
		}
	}
	if {($rev2 != "") && ($rev1 != "")} {
		# XXX - this is where we drop the -i/-x stuff on the floor
		# if it is a complicated GCA.
		if {[catch {exec bk gca -r$rev1 -r$rev2 $fname} tmp]} {
			puts stderr \
			    "either $rev1 or $rev2 is not a valid revision"
			exit 1
		}
		set gca [lindex [split $tmp] 0]
	}
} ;# proc arguments

# Return the revision and user name (1.147.1.1-akushner) so that
# we can manipulate tags
proc lineOpts {rev} \
{
	global	Opts file

	set f [open "| bk _lines $Opts(line) \"-r$rev\" \"$file\""]
	gets $f rev
	catch {close $f} err
	return $rev
}


# merge: if we were started by resolve, make sure we don't lose track of
#	 the gca, local, and remote when we do a select range
proc startup {} \
{
	global fname rev2rev_name w rev1 rev2 gca errorCode gc dev_null
	global file merge diffpair dfile
	global percent preferredGraphSize
	global startingLineNumber searchString
	global	curLine
	global	displaying

	set displaying ""

	if {$gca != ""} {
		set merge(G) $gca
		set merge(l) $rev1
		set merge(r) $rev2
		revtool $fname
	} else {
		if {$rev1 != ""} {set diffpair(left) $rev1}
		if {$rev2 != ""} {set diffpair(right) $rev2}
		revtool $fname $rev1
	}
	if {[info exists startingLineNumber] ||
	    [info exists searchString]} {

		# if the user is viewing the history of a file we want
		# to display the annotated listing before doing the 
		# search or goto-line. We won't do this for the ChangeSet
		# file
		set base [file tail $file]
		if {![string equal $base "ChangeSet"]} {
			if {![info exists rev1]} {
				set rev1 [exec bk prs -hr+ -d:I:-:P: $file]
			}
			# XXX - this needs some sort of anchor logic
			selectNode id
			highlight $rev1 "old"
		}

		if {[info exists startingLineNumber]} {
			if {![info exists searchString]} {
				searchnew : $startingLineNumber
			}
			set curLine $startingLineNumber.0
			centerTextLine $w(aptext) $curLine
			set rev [get_line_rev $startingLineNumber]
			jump_to_rev $rev
		} else {
			set index 1.0
		}

		if {[info exists searchString]} {
			after idle [list searchnew / $searchString $index]
		}

	} elseif {[info exists diffpair(left)] &&
	    [info exists diffpair(right)]} {
		# We never get here, -lA -rB will always set GCA.  Bummer.
		doDiff
	} elseif {[info exists rev1]} {
		selectNode id
	}
	if {[info exists dfile] && ($dfile != "")} {
		printCanvas
	}

	bind . <Destroy> {
		if {[string match %W "."]} {
			saveState rev
		}
	}
}

#
# Requires the ImageMagick convert program to be on the system.
# XXX: Have option to save as postscript if convert not available
#
proc printCanvas {} \
{
	global w dfile

	puts stderr "dumping file=($dfile)"
	update
	set x0 0
	set y0 0
	set x1 [winfo width $w(graph)]
	set y1 [winfo height $w(graph)]
	foreach {x0 y0 x1 y1} [$w(graph) bbox all] {}
	puts stderr "{x0 y0 x1 y1}={$x0 $y0 $x1 $y1}"
	set width [expr {$x1-$x0}]
	set h [expr {$y1-$y0}]
	set fd [open "|convert - $dfile" w]
	$w(graph) postscript -channel $fd -x $x0 -y $y0 \
	    -width $width -height $h
	#puts [$w(graph) postscript -x $x0 -y $y0 \
	#    -width $width -height $h]
	catch { close $fd } err
	exit
}

proc revtool_popup_rev {win} {
	global	w file

	if {$win eq $w(graph)} {
	    set tags [$win gettags current]
	    lassign [split [lindex $tags 0] -] rev user
	} elseif {$win eq $w(aptext)} {
	    set tags [$win tag names current]
	    set tag [lsearch -inline $tags link-*]
	    set rev [$win get $tag.first $tag.last]
	}

	return [exec bk log -r$rev $file]
}

proc revtool_shift_down {} \
{
	set ::shift_down 1
	tooltip::tooltip fade 0
	tooltip::tooltip delay 50
}

proc revtool_shift_up {} \
{
	set ::shift_down 0
	tooltip::tooltip fade 1
	tooltip::tooltip delay 500
}

proc set_tooltips {} \
{
	global	w

	tooltip::tooltip $w(graph) -items "revision" \
	    -command [list revtool_popup_rev $w(graph)] "#"
	tooltip::tooltip $w(graph) -items "revtext" \
	    -command [list revtool_popup_rev $w(graph)] "#"
	tooltip::tooltip $w(aptext) -tag "link" \
	    -command [list revtool_popup_rev $w(aptext)] "#"
}

main
