wm withdraw .
set ::tool_name fmtool
# 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 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 2000-2003,2005,2009-2011,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.

# difflib - view differences; loosely based on fmtool

proc createDiffWidgets {w} \
{
	global gc app

	# XXX: Need to redo all of the widgets so that we can start being
	# more flexible (show/unshow line numbers, mapbar, statusbar, etc)
	#set w(diffwin) .diffwin
	#set w(leftDiff) $w(diffwin).left.text
	#set w(RightDiff) $w(diffwin).right.text
	ttk::frame .diffs
	    ttk::frame .diffs.status
		ttk::separator .diffs.status.topsep -orient horizontal
		ttk::label .diffs.status.l -font $gc($app.fixedFont) -anchor c
		ttk::separator .diffs.status.s1 -orient vertical
		ttk::label .diffs.status.r -font $gc($app.fixedFont)  -anchor c
		ttk::separator .diffs.status.s2 -orient vertical
		ttk::label .diffs.status.middle -font $gc($app.fixedFont)
		ttk::separator .diffs.status.bottomsep -orient horizontal

		grid .diffs.status.topsep -row 0 -column 0 -sticky ew \
		    -columnspan 5
		grid .diffs.status.l -row 1 -column 0 -sticky ew
		grid .diffs.status.s1 -row 1 -column 1 -sticky ns
		grid .diffs.status.middle -row 1 -column 2 -padx 10
		grid .diffs.status.s2 -row 1 -column 3 -sticky ns
		grid .diffs.status.r -row 1 -column 4 -sticky ew
		grid .diffs.status.bottomsep -row 2 -column 0 -sticky ew \
		    -columnspan 5

		grid columnconfigure .diffs.status .diffs.status.l -weight 1
		grid columnconfigure .diffs.status .diffs.status.r -weight 1

	    text .diffs.left \
		-width $gc($app.diffWidth) \
		-height $gc($app.diffHeight) \
		-bg $gc($app.textBG) \
		-fg $gc($app.textFG) \
		-pady 0 \
		-borderwidth 0\
		-wrap none \
		-insertwidth 0 \
		-highlightthickness 0 \
		-font $gc($app.fixedFont) \
		-xscrollcommand { .diffs.xscroll set } \
		-yscrollcommand { .diffs.yscroll set }
	    text .diffs.right \
		-width $gc($app.diffWidth) \
		-height $gc($app.diffHeight) \
		-bg $gc($app.textBG) \
		-fg $gc($app.textFG) \
		-pady 0 \
		-borderwidth 0 \
		-insertwidth 0 \
		-highlightthickness 0 \
		-wrap none \
		-font $gc($app.fixedFont)
	    ttk::scrollbar .diffs.xscroll -orient horizontal -command xscroll
	    ttk::scrollbar .diffs.yscroll -orient vertical -command yscroll

	    bindtags .diffs.left  [list .diffs.left ReadonlyText . all]
	    bindtags .diffs.right [list .diffs.right ReadonlyText . all]

	    grid .diffs.status -row 0 -column 0 -columnspan 3 -stick ew
	    grid .diffs.left -row 1 -column 0 -sticky nsew
	    grid .diffs.yscroll -row 1 -column 1 -sticky ns
	    grid .diffs.right -row 1 -column 2 -sticky nsew
	    grid .diffs.xscroll -row 2 -column 0 -sticky ew -columnspan 3

	    grid rowconfigure    .diffs .diffs.left -weight 1
	    grid columnconfigure .diffs .diffs.left -weight 1
	    grid columnconfigure .diffs .diffs.right -weight 1

	    attachScrollbar .diffs.xscroll .diffs.left .diffs.right
	    attachScrollbar .diffs.yscroll .diffs.left .diffs.right

	    configureDiffWidget $app .diffs.left  old
	    configureDiffWidget $app .diffs.right new

	    bind .diffs <Configure> { computeHeight "diffs" }

	    foreach w {.diffs.left .diffs.right} {
		    bind $w <<Copy>> "diff_textCopy %W;break"
		    selection handle -t UTF8_STRING $w [list GetXSelection $w]
	    }
}

proc next {} \
{
	global	diffCount lastDiff Diffs DiffsEnd search

	if {[searchactive]} {
		set search(dir) "/"
		searchnext
		return
	}
	if {$diffCount == 0} {
		nextFile
		return
	}

	set win   .diffs.left
	set start $Diffs($lastDiff)
	set stop  $DiffsEnd($lastDiff)
	if {![visible $stop] && [inView $win $start $stop]} {
		yscroll page 1
		return
	}

	if {$lastDiff >= $diffCount} {
		nextFile
		return
	}

	incr lastDiff
	dot
}

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

	if {[searchactive]} {
		set search(dir) "?"
		searchnext
		return
	}
	if {$diffCount == 0} {
		prevFile
		return
	}

	set win   .diffs.left
	set start $Diffs($lastDiff)
	set stop  $DiffsEnd($lastDiff)
	if {![visible $start] && [inView $win $start $stop]} {
		yscroll page -1
		return
	}

	if {$lastDiff <= 1} {
		if {[prevFile] == 0} {return}
		set lastDiff $diffCount
		if {[info exists DiffsEnd($lastDiff)]} {
			dot
			yscroll see $DiffsEnd($lastDiff)
		}
		return
	}
	incr lastDiff -1
	dot
	yscroll see $DiffsEnd($lastDiff)
}

proc visible {args} \
{
	if {[llength $args] == 2} {
		lassign $args win index
	} elseif {[llength $args] == 1} {
		set win .diffs.left
		set index [lindex $args 0]
	}

	if {[llength [$win bbox $index]] > 0} { return 1 }
	return 0
}

proc inView {win first last} {
	set top [topLine $win]
	set bot [bottomLine $win]
	set l1  [idx2line [$win index $first]]
	set l2  [idx2line [$win index $last]]

	if {$l1 < $top && $l2 < $top} { return 0 }
	if {$l1 > $bot && $l2 > $bot} { return 0 }
	return 1
}

proc dot {} \
{
	global	Diffs DiffsEnd diffCount lastDiff

	if {![info exists Diffs($lastDiff)]} {return}
	scrollDiffs $Diffs($lastDiff) $DiffsEnd($lastDiff)
	highlightDiffs $Diffs($lastDiff) $DiffsEnd($lastDiff)
	.diffs.status.middle configure -text "Diff $lastDiff of $diffCount"
	.menu.dot configure -text "Center on diff $lastDiff"
	if {$lastDiff == 1} {
		.menu.prev configure -state disabled
	} else {
		.menu.prev configure -state normal
	}
	if {$lastDiff == $diffCount} {
		.menu.next configure -state disabled
	} else {
		.menu.next configure -state normal
	}

	# this lets calling programs know that a different file was
	# diffed, or a different diff was selected for the current
	# file. 
	event generate . <<DiffChanged>>
}

proc highlightDiffs {start stop} \
{
	global	gc app

	.diffs.left tag remove d 1.0 end
	.diffs.right tag remove d 1.0 end
	set line1 [idx2line $start]
	set line2 [idx2line $stop]
	for {set i $line1} {$i <= $line2} {incr i} {
		.diffs.left tag add d $i.1 $i.end+1c
		.diffs.right tag add d $i.1 $i.end+1c
	}
}

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

proc bottomLine {{win ".diffs.left"}} \
{
	set h [expr {[winfo height $win] - 1}]
	return [lindex [split [$win index @1,$h] "."] 0]
}

proc scrollDiffs {start stop args} \
{
	set force 0
	if {[dict exists $args -force]} { set force [dict get $args -force] }

	set main .diffs.left
	if {[dict exists $args -win]} { set main [dict get $args -win] }
	set other .diffs.[expr {$main eq ".diffs.left" ? "right" : "left"}]

	if {$force
	    || ![visible $main $start-1line] || ![visible $main $stop+1line]} {
		scrollToTop $main $start
		syncTextWidgets $main $other
	}
}

proc scrollToTop {win index {withMargin 1}} \
{
	# Put the index at the top of the text widget minus the top margin.
	set line [idx2line [$win index $index]]
	$win xview moveto 0
	scrollLineToTop $win $line $withMargin
}

proc scrollLineToTop {win line {withMargin 0}} \
{
	global	gc app

	set top   [topLine $win]
	set delta [expr {$line - $top}]
	if {$withMargin} { set delta [expr {$delta - $gc($app.topMargin)}] }

	$win yview scroll $delta units
}

proc syncTextWidgets {master args} \
{
	set x [lindex [$master xview] 0]
	set y [lindex [$master yview] 0]
	foreach slave $args {
		$slave xview moveto $x
		$slave yview moveto $y
	}
}

proc sdiff {L R} \
{
	global	sdiffw gc

	set opts $gc(diffOpts)
	if {[string is true -strict $gc(ignoreWhitespace)]} {
		append opts " -b"
	}
	if {[string is true -strict $gc(ignoreAllWhitespace)]} {
		append opts " -w"
	}
	return [open "|$sdiffw $opts -- \"$L\" \"$R\"" r]
}

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

	set diffInfo(lfile) $lfile
	set diffInfo(rfile) $rfile

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

	.diffs.left tag configure "select" -background $gc($app.oldColor) \
	    -borderwidth 1 -relief solid -lmargin1 5 -spacing1 2 -spacing3 2
	.diffs.right tag configure "select" -background $gc($app.newColor) \
	    -borderwidth 1 -relief solid -lmargin1 5 -spacing1 2 -spacing3 2
	# 1.0 files do not have a mode line. 
	# XXX: Ask lm if x.0 files have mode lines...
	set dspec1 "{-d:DPN:\\n\tFlags = :FLAGS:\\n\tMode  = :RWXMODE:\\n}"
	set dspec2 "{-d:DPN:\\n\tFlags = :FLAGS:\\n\\n}"

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

proc md52rev {file md5} \
{
	if {[catch {exec bk prs -r$md5 -d:REV: $file} res]} { return $md5 }
	return [lindex [split $res \n] end]
}

# L and R: Names of the left and right files. Might be a temporary
#          file name with the form like: '/tmp/difftool.tcl@1.30-1284'
#
# lname and rname: File name with the revision appended
#
proc readFiles {L R {O {}}} \
{
	global  lname rname finfo app gc
	global	diffCount lastDiff
	global	Diffs DiffsEnd diffInfo

	if {![file exists $L]} {
		displayMessage "Left file ($L) does not exist"
		return 1
	}
	if {![file exists $R]} {
		displayMessage "Right file ($R) does not exist"
		return 1
	}

	# append time to filename when called by csettool
	# XXX: Probably OK to use same code for difftool, fmtool and csettool???
	if {[info exists finfo(lt)] && ($finfo(lt)!= "")} {
		.diffs.status.l configure -text "$finfo(l) ($finfo(lt))"
		.diffs.status.r configure -text "$finfo(r) ($finfo(rt))"
		.diffs.status.middle configure -text "... Diffing ..."
	} elseif {[info exists lname] && ($lname != "")} {
		set lt [clock format [file mtime $L] -format "%X %d %b %y"]
		set rt [clock format [file mtime $R] -format "%X %d %b %y"]
		lassign [split $lname |] file rev
		if {[info exists diffInfo(lfile)]} { set file $diffInfo(lfile) }
		set rev [md52rev $file $rev]
		.diffs.status.l configure -text "$file $rev ($lt)"
		lassign [split $rname |] file rev
		if {[info exists diffInfo(rfile)]} { set file $diffInfo(rfile) }
		set rev [md52rev $file $rev]
		.diffs.status.r configure -text "$file $rev ($rt)"
		.diffs.status.middle configure -text "... Diffing ..."
	} else {
		set l [file tail $L]
		.diffs.status.l configure -text "$l"
		set r [file tail $R]
		.diffs.status.r configure -text "$r"
		.diffs.status.middle configure -text "... Diffing ..."
	}

	. configure -cursor watch
	update idletasks

	set d [sdiff $L $R]
	set data [read $d]
	if {[catch {close $d} err why]} {
		set code [dict get $why -errorcode]
		set code [lindex $code 0]
		if {$code ne "CHILDSTATUS"} {
			displayMessage "diff: $err: $code"
			return 1
		}
	}

	set lastDiff 0
	if {[regexp {^Binary files.*differ} $data]} {
		.diffs.left tag configure warn -background $gc($app.warnColor)
		.diffs.right tag configure warn -background $gc($app.warnColor)
		.diffs.left insert end "Binary Files Differ\n" {warn junk}
		.diffs.right insert end "Binary Files Differ\n" {warn junk}
		. configure -cursor left_ptr
		.diffs.status.middle configure -text "Differences"
		return
	}

	set l [open $L r]
	set r [open $R r]
	set left  .diffs.left
	set right .diffs.right

	set lineNo 1
	set diffCount 0
	set blockStart 1
	set lineCount [lindex [split [$left index end-1c] .] 0]
	foreach diff [split $data \n] {
		if {$diff eq "" || $diff eq " "} { set diff "S" }

		switch -- $diff {
		    "S" {
			## same
			$left  insert end " " {space junk}
			$left  insert end [gets $l]\n
			$right insert end " " {space junk}
			$right insert end [gets $r]\n
		    }
		    "|" {
			## changed
			$left  insert end "-" {minus junk}
			$left  insert end [gets $l]\n diff
			$right insert end "+" {plus junk}
			$right insert end [gets $r]\n diff
		    }
		    "<" {
			## left
			$left  insert end "-" {minus junk}
			$left  insert end [gets $l]\n diff
			$right insert end " " {empty junk}
			$right insert end \n same
		    }
		    ">" {
			## right
			$left  insert end " " {empty junk}
			$left  insert end \n same
			$right insert end "+" {plus junk}
			$right insert end [gets $r]\n diff
		    }
		}

		if {![info exists last]} { set last $diff }
		if {($diff ne $last) && ($diff eq "S" || $last eq "S")} {
			## We've changed diff blocks.  We only want to
			## mark the previous block if it wasn't a Same block.
			if {$last ne "S"} {
				incr diffCount
				set blockEnd [expr {$lineCount - 1}]
				set Diffs($diffCount) $blockStart.0
				set DiffsEnd($diffCount) $blockEnd.end
				highlightSideBySide .diffs.left .diffs.right \
				    $blockStart.0 $blockEnd.end 1
			}
			set blockStart $lineCount
		}

		incr lineNo
		incr lineCount
		set last $diff
	}

	catch {close $r}
	catch {close $l}

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

	foreach tag {select space empty plus minus} {
	    .diffs.left  tag raise $tag sel
	    .diffs.right tag raise $tag sel
	}

	if {$diffCount > 0} {
		set lastDiff 1
		dot
	} else {
		.diffs.status.middle configure -text "No differences"
	}
} ;# readFiles

# --------------- Window stuff ------------------
# this is used to save/restore the current view; handy when 
# programs cause the diff to be redone for the same files (think:
# turning annotations on/off in csettool)
proc diffView {{viewData {}}} \
{
	global lastDiff

	if {$viewData == {}} {
		lappend result [.diffs.left  xview]
		lappend result [.diffs.left  yview]
		lappend result [.diffs.right xview]
		lappend result [.diffs.right yview]
		lappend result $lastDiff

	} else {
		
		# The user may have centered on a diff then scrolled
		# around, so the call to dot resets the notion of the
		# current diff, then we manually scroll back to 
		# what the user was looking at.
		set lastDiff [lindex $viewData 4]
		dot

		.diffs.left  xview moveto [lindex [lindex $viewData 0] 0]
		.diffs.left  yview moveto [lindex [lindex $viewData 1] 0]
		.diffs.right xview moveto [lindex [lindex $viewData 2] 0]
		.diffs.right yview moveto [lindex [lindex $viewData 3] 0]

		set result {}
	}

	return $result
}

proc yscroll { a args } \
{
	if {$a eq "see"} {
		.diffs.left  see {*}$args
		.diffs.right see {*}$args
	} elseif {$a eq "page"} {
		set win .diffs.left
		set top [topLine $win]
		set bot [bottomLine $win]
		set h   [winfo height $win]

		lassign [$win bbox @1,1] x y w lineHeight
		set pageHeight [expr {$bot - $top + 1}]

		## If the window height is not an exact multiple of the
		## height of the visible lines, we'll determine whether
		## the last visible line is visible enough to count.
		## If not, we'll move one less line.
		if {($pageHeight * $lineHeight) >= ($h + ($lineHeight / 3))} {
		    incr pageHeight -1
		}

		set n [lindex $args 0]
		set scroll [expr {(($pageHeight - 2) * $lineHeight) * $n}]
		yscroll scroll $scroll pixels
	} else {
		.diffs.left  yview $a {*}$args
		.diffs.right yview $a {*}$args
	}
}

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

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

proc Page {view dir one} \
{
	global app

	# fmtool wants different windows to scroll depending on where
	# the mouse pointer is; other tools aren't quite so particular.
	if {"$app" == "fm"} {
		set p [winfo pointerxy .]
		set x [lindex $p 0]
		set y [lindex $p 1]
		set w [winfo containing $x $y]
		#puts "window=($w)"
		if {[regexp {^.merge} $w]} {
			page ".merge" $view $dir $one
			return 1
		} else {
			page ".diffs" $view $dir $one
			return 1
		}
	}
	page ".diffs" $view $dir $one
	return 1
}

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

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

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

proc computeHeight {w} \
{
	global gc app

	update
	if {$w == "diffs"} {
		set fh [fontHeight [.diffs.left cget -font]]
		set p [winfo height .diffs.left]
		set w [winfo width .]
		set gc($app.diffHeight) [expr {$p / $fh}]
	} else {
		set fh [fontHeight [.merge.t cget -font]]
		set p [winfo height .merge.t]
		set gc($app.mergeHeight) [expr {$p / $fh}]
	}
	return
}

proc getTextSelection {w} \
{
	## Hide all the diff junk, get the characters that are actually
	## displayed and then put the diff junk back.  Without doing an
	## update in between, the text widget will never even show that
	## anything is happening.
	if {[catch {
		$w tag configure junk -elide 1
		set data [$w get -displaychars -- sel.first sel.last]
		$w tag configure junk -elide 0
	} err]} { return -code error $err }
	return $data
}

proc GetXSelection {w offset max} {
    if {![catch {getTextSelection $w} data]} { return $data }
}

proc diff_textCopy {w} \
{
	if {[catch {getTextSelection $w} data]} { return }

	## Set it in the clipboard.
	clipboard clear  -displayof $w
	clipboard append -displayof $w $data
}
# Copyright 2011-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.

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

	if {![file exists $L]} {
		displayMessage "Left file ($L) does not exist"
		return 1
	}
	if {![file exists $R]} {
		displayMessage "Right file ($R) does not exist"
		return 1
	}

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

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

	gets $d last
	if {[regexp {^Binary files.*differ$} $last]} {
		.diffs.left tag configure warn -background $gc($app.warnColor)
		.diffs.right tag configure warn -background $gc($app.warnColor)
		.diffs.left insert end "Binary Files Differ\n" warn
		.diffs.right insert end "Binary Files Differ\n" warn
		. configure -cursor left_ptr
		set lastDiff 0
		set done 0
		.diffs.status.middle configure -text "Differences"
		catch {close $d}
		return
	}

	set l [open $L r]
	set r [open $R r]
	if {$last == "" || $last == " "} { set last "S" }
	while { [gets $d diff] >= 0 } {
		incr lineNo 1
		if {$diff == "" || $diff == " "} { set diff "S" }
		if {$diff == $last} {
			incr n 1
		} else {
			switch $last {
			    "S"	{ same $r $l $n }
			    "|"	{ incr diffCount 1; changed $r $l $n }
			    "<"	{ incr diffCount 1; left $r $l $n }
			    ">"	{ incr diffCount 1; right $r $l $n }
			}
			lappend types $last
			# rBoth is built up this way because the tags stuff
			# collapses adjacent tags together.
			set start [expr {$lineNo - $n}]
			lappend rBoth "$start.0" "$lineNo.0"
			# Ditto for diffs
			if {$last != "S"} {
				lappend rDiff "$start.0" "$lineNo.0"
			} else {
				lappend rSame "$start.0" "$lineNo.0"
			}
			set n 1
			set last $diff
		}
	}
	switch $last {
	    "S"	{ same $r $l $n }
	    "|"	{ incr diffCount 1; changed $r $l $n }
	    "<"	{ incr diffCount 1; left $r $l $n }
	    ">"	{ incr diffCount 1; right $r $l $n }
	}
	lappend types $last
	incr lineNo 1
	# rBoth is built up this way because the tags stuff
	# collapses adjacent tags together.
	set start [expr {$lineNo - $n}]
	lappend rBoth "$start.0" "$lineNo.0"
	# Ditto for diffs
	if {$last != "S"} {
		lappend rDiff "$start.0" "$lineNo.0"
	} else {
		lappend rSame "$start.0" "$lineNo.0"
	}
	catch {.merge.menu.l configure -text "$done / $diffCount resolved"}
	catch {close $r}
	catch {close $l}
	catch {close $d}
	set nextSame 0
	set nextDiff 0
	set nextBoth 0
	set maxSame [expr {[llength $rSame] - 2}]
	set maxDiff [expr {[llength $rDiff] - 2}]
	set maxBoth [expr {[llength $rBoth] - 2}]

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

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

proc chunks {n} \
{
	global	Diffs DiffsEnd nextDiff

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

proc same {r l n} \
{
	global diffCount

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

proc changed {r l n} \
{
	global diffCount

	chunks $n
	set llines {}
	set rlines {}
	while {$n > 0} {
		gets $l line
		lappend llines $line
		gets $r line
		lappend rlines $line
		incr n -1
	}
	set lc [join $llines "\n"]
	set rc [join $rlines "\n"]
	.diffs.left insert end "$lc\n" diff
	.diffs.right insert end "$rc\n" diff
	set loc [.diffs.right index end]
	.diffs.right mark set diff-${diffCount} "$loc - 1 line"
	.diffs.right mark gravity diff-${diffCount} left
}

proc left {r l n} \
{
	global diffCount

	chunks $n
	set lines {}
	set newlines ""
	while {$n > 0} {
		gets $l line
		lappend lines $line
		set newlines "$newlines\n"
		incr n -1
	}
	set lc [join $lines "\n"]
	.diffs.left insert end "$lc\n" diff
	.diffs.right insert end "$newlines" 
	set loc [.diffs.right index end]
	.diffs.right mark set diff-${diffCount} "$loc - 1 line"
	.diffs.right mark gravity diff-${diffCount} left
}

proc right {r l n} \
{
	global diffCount

	chunks $n
	set lines {}
	set newlines ""
	while {$n > 0} {
		gets $r line
		lappend lines $line
		set newlines "$newlines\n"
		incr n -1
	}
	set rc [join $lines "\n"]
	.diffs.left insert end "$newlines" 
	.diffs.right insert end "$rc\n" diff
	set loc [.diffs.right index end]
	.diffs.right mark set diff-${diffCount} "$loc - 1 line"
	.diffs.right mark gravity diff-${diffCount} left
}
# Copyright 1998-2006,2011-2012,2014-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.

# fm - a file merging program

# --------------- data structures -------------
# == DIFFS ==
# The list of chunks of text, both diffs and common, is in rBoth,
# 	is indexed by nextBoth, which can't be bigger than maxBoth
# The list of diffs is in rDiff,
# 	is indexed by nextDiff, which can't be bigger than maxDiff
# The list of common text is in rSame,
# 	is indexed by nextSame, which can't be bigger than maxSame
# The list of diff types, "S", "|", "<", ">", is in types and is used
#	to notice that the thing we are adding is actually nothing.
#	Think "foo <    "  and we select right.
#
# We walk forward (and backward) through rBoth, looking at the
# current position in each of rDiff and rSame to figure out who
# is next.
# At the end (start) of all functions, either
#	$rDiff[$nextDiff] == $rBoth[$nextBoth]
# OR	$rSame[$nextSame] == $rBoth[$nextBoth]
#
# == MARKS ==
# As we add stuff to the merge window, each insertion is marked.  The
# marks are named $something$count where count is the sequence number of
# the insertion and something is {same|left|right}.  The mark is at the
# beginning of the text.  The marks are saved, in first to last order, in
# $Marks.  The mark counter, which is really $nextBoth/2, is $nextMark.

# --------------- actions ------------------

# Undo the last diff added and everything that follows it.
# XXX - does not yet check the texts for changes - that would be nice.
proc undo {} \
{
	global rBoth rDiff rSame nextBoth nextDiff nextSame
	global maxBoth maxDiff maxSame nextMark Marks LastDelete
	global done

	if {$done == 0} {return}
	if {[llength $Marks] < 1} { return }
	set m [pop Marks]
	if {! [string match Skipped* $m]} {
		set LastDelete [.merge.t get $m "end - 1 char"]
		.merge.t delete $m "end - 1 char"
	}
	if {[string match same* $m]} {
		incr nextSame -2
		incr nextBoth -2

		# Do it again because we are looking for a diff
		if {[llength $Marks] > 1} { undo }
	} else {
		incr nextDiff -2
		incr nextBoth -2
		resolved -1
		if {! [string match Skipped* $m]} {
			.merge.menu.redo configure -state normal
		}
	}
	selectDiff $rBoth $nextBoth
	#dumpLists Undo ""
}

# Redo the last diff, it was something they wanted.
# This is a lot like useDiff except we are stuffing in the thing
# we deleted (which might have been edited).
proc redo {} \
{
	global nextBoth nextDiff rDiff LastDelete
	global gc app

	set state [.merge.menu.redo cget -state]
	if {$state == "disabled"} { return }
	incr nextBoth 2
	incr nextDiff 2
	.merge.t insert end $LastDelete {tmp redo}
	.merge.t tag configure redo -background $gc($app.redoBG)
	saveMark redo
	resolved 1
	next
	.merge.menu.redo configure -state disabled
}

# If the next is a same chunk, add it in the merge window.
# Finally, scroll down to next diff.
proc next {} \
{
	global rBoth rDiff rSame nextBoth nextDiff nextSame
	global maxBoth maxDiff maxSame

	if {$nextBoth > $maxBoth} {
		return
	}
	set Same [lindex $rSame $nextSame]
	set Both [lindex $rBoth $nextBoth]
	if {$Both == $Same} {
		#dumpLists NEXT Same
		useSame
	} else {
		#dumpLists NEXT Diff
	}

	# If that was it, we're outta here.
	if {$nextBoth > $maxBoth} { return }

	# OK, there is a diff, slide down to it.
	selectDiff $rDiff $nextDiff
}

proc dumpLists {A B} {
	global rBoth rDiff rSame nextBoth nextDiff nextSame
	global maxBoth maxDiff maxSame

	set Same [lindex $rSame $nextSame]
	set Diff [lindex $rDiff $nextDiff]
	set Both [lindex $rBoth $nextBoth]
	puts "$A S($nextSame): $Same D($nextDiff): $Diff B($nextBoth): $Both -> $B"
	puts -nonewline "B: "
	for {set i $nextBoth} {$i <= $maxBoth} {incr i 2} {
		set j [expr {$i + 1}]
		set a [lindex $rBoth $i]
		set b [lindex $rBoth $j]
		puts -nonewline "$a,$b "
	}
	puts ""
	puts -nonewline "S: "
	for {set i $nextSame} {$i <= $maxSame} {incr i 2} {
		set j [expr {$i + 1}]
		set a [lindex $rSame $i]
		set b [lindex $rSame $j]
		puts -nonewline "$a,$b "
	}
	puts ""
	puts -nonewline "D: "
	for {set i $nextDiff} {$i <= $maxDiff} {incr i 2} {
		set j [expr {$i + 1}]
		set a [lindex $rDiff $i]
		set b [lindex $rDiff $j]
		puts -nonewline "$a,$b "
	}
	puts "\n"
}

# We're moving forward, stuff the same data into the merge window
proc useSame {} \
{
	global rBoth rDiff rSame nextBoth nextDiff nextSame
	global maxBoth maxDiff maxSame

	incr nextBoth 2
	set a [lindex $rSame $nextSame]; incr nextSame 1
	set b [lindex $rSame $nextSame]; incr nextSame 1
	set Text [.diffs.left get $a $b]
	.merge.t insert end $Text tmp
	saveMark same
}

# Use the diff that is at the nextDiff.
proc useDiff {which color} \
{
	global maxBoth nextBoth nextSame nextDiff rBoth rSame rDiff types

	if {$nextBoth > $maxBoth} { return; }

	focus .

	# Wipe out the redo button, we no longer have anything.
	.merge.menu.redo configure -state disabled

	# See if it is an empty diff; if so, just call skip and return.
	set type [expr {$nextBoth / 2}]
	set type [lindex $types $type]
	if {$which == "left"} {
		if {$type == ">"} { skip; return }
	} else {
		if {$type == "<"} { skip; return }
	}

	set Same [lindex $rSame $nextSame]
	set Diff [lindex $rDiff $nextDiff]
	set Both [lindex $rBoth $nextBoth]
	# puts "DIFF S: $Same D: $Diff B: $Both USES $which"
	incr nextBoth 2
	set a [lindex $rDiff $nextDiff]; incr nextDiff 1
	set b [lindex $rDiff $nextDiff]; incr nextDiff 1
	set Text [getUserText .diffs.$which $a $b]
	set Here [.merge.t index end]

	.merge.t insert end $Text [list tmp $which]
	.merge.t tag configure $which -background $color

	saveMark $which
	resolved 1
	next
	# What I want is to have the first line of the new stuff at the top
	# of the merge window.
	.merge.t see $Here
	set Here [expr {[lindex [split $Here .] 0] - 1}]
	set top [lindex [split [.merge.t index @1,1] .] 0]
	.merge.t yview scroll [expr {$Here - $top}] units
}

# Skip the current diff.  Isn't this easy?
proc skip {} \
{
	global nextBoth nextDiff maxBoth nextMark Marks

	if {$nextBoth > $maxBoth} { return }
	incr nextBoth 2
	incr nextDiff 2
	set m "Skipped$nextMark"; incr nextMark 1
	set Here [.merge.t index end]
	.merge.t mark set $m $Here
	lappend Marks $m
	resolved 1
	next
	.merge.t see $Here
}

proc useLeft {} { global gc; useDiff "left" $gc(fm.diffColor) }
proc useRight {} { global gc; useDiff "right" $gc(fm.diffColor) }

proc saveMark {which} \
{
	global	nextMark Marks

	# Save the mark at the beginning of the text and in the list
	set m "$which$nextMark"; incr nextMark 1
	.merge.t mark set $m [.merge.t index tmp.first]
	.merge.t tag delete tmp
	lappend Marks $m
	.merge.t yview moveto 1
}

proc selectFiles {} \
{
	global lfile rfile outputFile dev_null

	set lfile [tk_getOpenFile -title "Select Left File"] ;
	if {("$lfile" == "")} return;
 	set t [clock format [file mtime $lfile] -format "%r %D"]
	.diffs.status.l configure -text "$lfile ($t)"
	set fd [open $lfile r]
	.diffs.left insert end  [read $fd]
	close $fd
	set rfile [tk_getOpenFile -title "Select Right File"];
	if {("$rfile" == "")} return;
	readFiles $lfile $rfile $outputFile
	resolved 0
	next
}

proc selectOutFile {} \
{
	global outputFile

	set outputFile [tk_getSaveFile -title "Select Output File" ]
	.merge.l config -text "$outputFile"
}

proc diffStart {list idx} {
	return [lindex $list $idx]
}

proc diffEnd {list idx} {
	return [lindex $list [incr idx]]
}

# overrides proc from difflib.tcl
proc highlightDiffs {} \
{
	global	rDiff gc app

	foreach {Diff End} $rDiff {
		.diffs.left  tag add diff $Diff $End
		.diffs.right tag add diff $Diff $End
		highlightSideBySide .diffs.left .diffs.right $Diff $End 0
	}
	configureDiffWidget $app .diffs.left  old
	configureDiffWidget $app .diffs.right new
}

# overrides 'dot' from difflib.tcl
proc dot {} \
{
	highlightDiffs
	#.diffs.status.middle configure -text "Diff $lastDiff of $diffCount"
	.diffs.status.middle configure -text ""
}

proc selectDiff {list diff} \
{
	global	rDiff nextDiff gc app

	set start [diffStart $list $diff]
	set end   [diffEnd $list $diff]

	scrollDiffs $start $end

	# Highlight the diff in question so that we can see it.
	foreach w {.diffs.left .diffs.right} {
		$w tag remove d 1.0 end
		$w tag add d $start $end
	}
}

proc resolved {n} \
{
	global done diffCount
	incr done $n
	.merge.menu.l configure -text "$done / $diffCount resolved"
	# prettier as a 'case' stmt? -ask
	if {($done == 0) && ($diffCount == 0)} { ;# case with no differences
		.merge.menu.save configure -state normal
		.merge.menu.left configure -state disabled
		.merge.menu.right configure -state disabled
		.merge.menu.skip configure -state disabled
	} elseif {$done == 0} { ;# not started yet
		.merge.menu.undo configure -state disabled
		.merge.menu.redo configure -state disabled
		.merge.menu.left configure -state normal
		.merge.menu.right configure -state normal
	} elseif {$done == $diffCount} { ;# we are done
		.merge.menu.save configure -state normal
		.merge.menu.left configure -state disabled
		.merge.menu.right configure -state disabled
		.merge.menu.skip configure -state disabled
	} else { ;# we still have some to go...
		.merge.menu.save configure -state disabled
		.merge.menu.left configure -state normal
		.merge.menu.right configure -state normal
		.merge.menu.skip configure -state normal
	}
	if {$n > 0} {
		.merge.menu.undo configure -state normal
	}
}

proc cmd_done {} \
{
	global done diffCount saved exiting

	if {[info exists exiting]} {return}
	set exiting 1
	.merge.menu.quit configure -state disabled
	if {$done == 0} { exit }
	if {$done < $diffCount} {
		confirm_done \
		    "Only $done out of $diffCount merged" "Keep merging"
	} elseif {$saved == 0} {
		confirm_done "Discard all $done merges?" "Cancel"
	} else {
		exit
	}
}

# Pop the last item from the array and return it
proc pop {array} \
{
	upvar $array a
	set i [llength $a]
	if {$i > 0} {
		incr i -1
		set m [lindex $a $i]
		set a [lreplace $a $i $i]
		return $m
	}
	return {}
}

# Return the last item in an array without popping it
proc last {array} \
{
	upvar $array a
	set i [llength $a]
	if {$i > 0} {
		incr i -1
		return [lindex $a $i]
	}
	return {}
}

# --------------- diffs ------------------

proc save {} \
{
	global	saved done diffCount outputFile

	if {$done < $diffCount} {
		displayMessage "Haven't resolved all diffs"
		return
	}
	.merge.menu.save configure -state disabled
	if {("$outputFile" == "")} selectOutFile
	while {("$outputFile" == "")} {
		set ans [tk_messageBox -icon warning -type yesno -default no \
		    -message "No output file selected\nQuit without saving?"]
		if {("$ans" == "yes")} {exit 0}
		selectOutFile
	}
	set o [open $outputFile w]
	set Text [.merge.t get 1.0 "end - 1 char"]
	set len [expr {[string length $Text] - 1}]
	set last [string index $Text $len]
	if {"$last" == "\n"} {
		puts -nonewline $o $Text
	} else {
		puts $o $Text
	}
	catch {close $o} err
	exit 0
}

proc height {w} \
{
	global	scroll gc

	set jump 2
	if {$w == ".diffs"} {
		if {$gc(fm.mergeHeight) < $jump} { return }
		incr gc(fm.diffHeight) $jump
		incr gc(fm.mergeHeight) -$jump
	} else {
		if {$gc(fm.diffHeight) < $jump} { return }
		incr gc(fm.diffHeight) -$jump
		incr gc(fm.mergeHeight) $jump
	}
	.diffs.left configure -height $gc(fm.diffHeight)
	.diffs.right configure -height $gc(fm.diffHeight)
	.merge.t configure -height $gc(fm.mergeHeight)
	if {$gc(fm.diffHeight) < $gc(fm.mergeHeight)} {
		set scroll $gc(fm.diffHeight)
	} else {
		set scroll $gc(fm.mergeHeight)
	}
}

proc widgets {L R O} \
{
	global	scroll wish gc d app

	getConfig "fm"

	set g [wm geometry .]
	if {$gc(fm.diffHeight) < $gc(fm.mergeHeight)} {
		set scroll $gc(fm.diffHeight)
	} else {
		set scroll $gc(fm.mergeHeight)
	}
	keyboard_bindings
	wm title . "File Merge"

	ttk::frame .diffs
	    ttk::frame .diffs.status
		ttk::label .diffs.status.l 
		ttk::label .diffs.status.r
		ttk::label .diffs.status.middle 
		grid .diffs.status.l -row 0 -column 0 -sticky ew
		grid .diffs.status.middle -row 0 -column 1
		grid .diffs.status.r -row 0 -column 2 -sticky ew
	    text .diffs.left -width $gc(fm.diffWidth) \
		-height $gc(fm.diffHeight) \
		-background $gc(fm.textBG) -fg $gc(fm.textFG) \
		-wrap none -font $gc(fm.fixedFont) \
		-insertwidth 0 -highlightthickness 0 \
		-xscrollcommand { .diffs.xscroll set } \
		-yscrollcommand { .diffs.yscroll set }
	    text .diffs.right -width $gc(fm.diffWidth) \
		-height $gc(fm.diffHeight) \
		-background $gc(fm.textBG) -fg $gc(fm.textFG) \
		-wrap none -font $gc(fm.fixedFont) \
		-insertwidth 0 -highlightthickness 0
	    ttk::scrollbar .diffs.xscroll -orient horizontal -command xscroll
	    ttk::scrollbar .diffs.yscroll -orient vertical -command yscroll
	    grid .diffs.status -row 0 -column 0 -columnspan 3 -stick ew
	    grid .diffs.left -row 1 -column 0 -sticky nsew
	    grid .diffs.yscroll -row 1 -column 1 -sticky ns
	    grid .diffs.right -row 1 -column 2 -sticky nsew
	    grid .diffs.xscroll -row 2 -column 0 -sticky ew
	    grid .diffs.xscroll -columnspan 3

	ttk::frame .merge
	    ttk::label .merge.l
	    text .merge.t -width $gc(fm.mergeWidth) \
		-height $gc(fm.mergeHeight) -highlightthickness 0 \
		-background $gc(fm.textBG) -fg $gc(fm.textFG) \
		-wrap none -font $gc(fm.fixedFont) \
		-xscrollcommand { .merge.xscroll set } \
		-yscrollcommand { .merge.yscroll set }
	    ttk::scrollbar .merge.xscroll -orient horizontal \
		-command { .merge.t xview }
	    ttk::scrollbar .merge.yscroll -orient vertical \
		-command { .merge.t yview }
	    ttk::frame .merge.menu
		ttk::button .merge.menu.open -text "Open" -command selectFiles
		ttk::button .merge.menu.restart -text "Restart" \
		    -state disabled -command startup
		ttk::button .merge.menu.undo -text "Undo" -state disabled \
		    -command undo
		ttk::button .merge.menu.redo -text "Redo" -state disabled \
		    -command redo
		ttk::button .merge.menu.skip -text "Skip" -state disabled \
		    -command skip
		ttk::button .merge.menu.left -text "Use Left" -state disabled \
		    -command useLeft
		ttk::button .merge.menu.right -text "Use Right" \
		    -state disabled -command useRight
		ttk::label .merge.menu.l
		ttk::button .merge.menu.save -text "Done" -state disabled \
		    -command save
		ttk::button .merge.menu.help -text "Help" \
		    -command { exec bk helptool fmtool & }
		ttk::button .merge.menu.quit -text "Quit" -command cmd_done
		grid .merge.menu.l -row 0 -column 0 -columnspan 2 -sticky ew \
		    -padx 1
		grid .merge.menu.open -row 1 -sticky ew -padx 1
		grid .merge.menu.restart -row 1 -column 1 -sticky ew -padx 1
		grid .merge.menu.undo -row 2 -column 0 -sticky ew -padx 1
		grid .merge.menu.redo -row 2 -column 1 -sticky ew -padx 1
		grid .merge.menu.skip -row 3 -column 0 -sticky ew -padx 1
		grid .merge.menu.save -row 3 -column 1 -sticky ew -padx 1
		grid .merge.menu.left -row 4 -column 0 -sticky ew -padx 1
		grid .merge.menu.right -row 4 -column 1 -sticky ew -padx 1
		grid .merge.menu.help -row 5 -column 0 -sticky ew -padx 1
		grid .merge.menu.quit -row 5 -column 1 -sticky ew -padx 1
	    grid .merge.l -row 0 -column 0 -columnspan 2 -sticky ew
	    grid .merge.t -row 1 -column 0 -sticky nsew
	    grid .merge.yscroll -row 1 -column 1 -sticky ns
	    grid .merge.menu -row 0 -rowspan 3 -column 2 -sticky n -padx 2
	    grid .merge.xscroll -row 2 -rowspan 2 -column 0 \
		-columnspan 2 -sticky ew

	ttk::label .status -anchor w

	grid .diffs -row 0 -column 0 -sticky nsew
	grid .merge -row 1 -column 0 -sticky nsew
	grid .status -row 2 -column 0 -sticky sew
	grid rowconfigure .diffs 1 -weight 1
	grid rowconfigure .merge 1 -weight 1
	grid rowconfigure . 0 -weight 1
	grid rowconfigure . 1 -weight 1
	grid columnconfigure .diffs.status 0 -weight 1
	grid columnconfigure .diffs.status 2 -weight 1
	grid columnconfigure .diffs 0 -weight 1
	grid columnconfigure .diffs 2 -weight 1
	grid columnconfigure .merge 0 -weight 1
	grid columnconfigure . 0 -weight 1

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

	.status configure \
	    -text "Welcome to filemerge!"

	bind .merge <Configure> { computeHeight "merge" }
	bind .diffs <Configure> { computeHeight "diffs" }
	bindhelp .merge.menu.restart "Discard all merges and restart"
	bindhelp .merge.menu.save "Save merges and exit"
	bindhelp .merge.menu.help "Run helptool to get detailed help"
	bindhelp .merge.menu.quit "Quit without saving any merges"
	bindhelp .merge.menu.redo "Redo last undo"
	bindhelp .merge.menu.open "Open Left and Right Files"
	bindhelp .merge.menu.undo "(Control-Up)  undo the last diff selection"
	bindhelp .merge.menu.skip \
	"(Control-Down)  Skip this diff, adding neither left nor right changes"
	bindhelp .merge.menu.left \
	    "(Control-Left)  Use the highlighted change from the left"
	bindhelp .merge.menu.right \
	    "(Control-Right)  Use the highlighted change from the right"
	.merge.menu.redo configure -state disabled
	foreach w {.diffs.left .diffs.right} {
		bindtags $w [list $w ReadonlyText . all]
	}
	computeHeight "diffs"
	computeHeight "merge"
	wm protocol . WM_DELETE_WINDOW { cmd_done }
}

proc bindhelp {w msg} \
{
	eval "bind $w <Enter> { .status configure -text \"$msg\" }"
	eval "bind $w <Leave> { .status configure -text {} }"
}

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

	bind all <Prior> { if {[Page "yview" -1 0] == 1} { break } }
	bind all <Next> { if {[Page "yview" 1 0] == 1} { break } }
	bind all <Up> { if {[Page "yview" -1 1] == 1} { break } }
	bind all <Down> { if {[Page "yview" 1 1] == 1} { break } }
	bind all <Left> { if {[Page "xview" -1 1] == 1} { break } }
	bind all <Right> { if {[Page "xview" 1 1] == 1} { break } }
	bind all <Alt-Up> "height .merge"
	bind all <Alt-Down> "height .diffs"
	bind all <Control-Left> {useLeft}
	bind all <Control-Right> {useRight}
	bind all <Control-Down> {skip}
	bind all <Control-Up> {undo}
	bind all <$gc(fm.quit)> cmd_done 
	if {$gc(aqua)} {
		bind all <Command-q> cmd_done
		bind all <Command-w> cmd_done
	}
}

proc confirm_done {msg l} \
{
	global exiting

	toplevel .c
	    frame .c.top
		label .c.top.icon -bitmap questhead
		label .c.top.msg -text $msg
		pack .c.top.icon -side left
		pack .c.top.msg -side right
	    frame .c.sep -height 2 -borderwidth 1 -relief sunken
	    frame .c.controls
		button .c.controls.discard -text "Discard merges" -command exit
		button .c.controls.cancel -text $l -command {
		    unset exiting
		    .merge.menu.quit configure -state normal
		    destroy .c
		}
		grid .c.controls.discard -row 0 -column 0 -padx 4
		grid .c.controls.cancel -row 0 -column 2 -padx 4
	    pack .c.top -padx 8 -pady 8
	    pack .c.sep -fill x -pady 4
	    pack .c.controls -pady 4
	set x [expr {[winfo rootx .merge.menu] - 150}]
	set y [expr {[winfo rooty .merge.menu] - 60}]
	wm geometry .c "+$x+$y"
	wm transient .c .
}

# --------------- main ------------------
proc startup {{buildwidgets {}}} \
{
	global argv0 argv argc dev_null done lfile rfile outputFile

	if {(($argc != 0) && ($argc != 3))} {
		puts "usage:\t$argv0 <left> <right> <output>\n\t$argv0"
		exit
	}
	set done 0
	if {$argc == 3} {
		set lfile ""; set rfile ""; set outputFile ""
		set a [split $argv " "]
		set lfile [lindex $argv 0]
		set rfile [lindex $argv 1]
		set outputFile [lindex $argv 2]
		if {![file exists $lfile] && ![file readable $lfile]} {
			displayMessage \
			    "File \"$lfile\" does not exist or is not readable"
			exit 1
		}
		if {![file exists $rfile] && ![file readable $rfile]} {
			displayMessage \
			    "File \"$rfile\" does not exist or is not readable"
			exit 1
		}
		if {$buildwidgets == 1} {widgets $lfile $rfile $outputFile}
		readFiles $lfile $rfile $outputFile
		resolved 0
		next
	} else {
		if {$buildwidgets == 1} {
			set lfile ""; set rfile ""; set outputFile ""
			widgets $lfile $rfile $outputFile
		} else {
			readFiles $lfile $rfile $outputFile
			resolved 0
			next
		}
	}
}

proc test_inputStringInMerge {string} \
{
	test_inputString $string .merge.t
}

proc test_getMergeText {} \
{
	return [.merge.t get 1.0 end]
}

proc fmtool {} \
{
	bk_init
	loadState fm
	startup 1
	restoreGeometry fm

	after idle [list wm deiconify .]
	after idle [list focus -force .]
	update idletasks

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

}

fmtool

