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

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

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

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

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

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

	set app $prog

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

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

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

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

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

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

	set _d(cset.listHeight) 12

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

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

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

	set _d(rename.listHeight) 8

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

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

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

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

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

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

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

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

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

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

	global gc app

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

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

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

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

	}
}

# From a Cameron Laird post on usenet
proc print_stacktrace {} {
	set depth [info level]
	puts "Current call stack shows"
	for {set i 1} {$i < $depth} {incr i} {
		puts "\t[info level $i]"
	}
}
proc _parray {a {pattern *}} {
	upvar 1 $a array
	if {![array exists array]} {
		error "\"$a\" isn't an array"
	}
	set maxl 0
	foreach name [lsort [array names array $pattern]] {
		if {[string length $name] > $maxl} {
			set maxl [string length $name]
		}
	}
	set maxl [expr {$maxl + [string length $a] + 2}]
	set answer ""
	foreach name [lsort [array names array $pattern]] {
		set nameString [format %s(%s) $a $name]
		append answer \
		    [format "%-*s = %s\n" $maxl $nameString $array($name)]
	}
	return $answer
}
#
# This search library code can be called from other bk tcl/tk applications
#
# To add the search feature to a new app, you need to add the following
# lines:
#
# search_widgets .enclosing_frame .widget_to_search
# search_keyboard_bindings
#
# The search_widgets procedure takes two arguments. The first argument
# is the enclosing widget that the search buttons and prompts will be
# packed into. The second argument is the widget that search will do
# its searching in.
# 

proc searchbuttons {button state} \
{
	global	search

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

proc searchdir {dir} \
{
	global	search

	set search(dir) $dir
}

proc search {dir} \
{
	global	search

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

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

proc searchreset {} \
{
	global	search

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

proc searchrecall {} \
{
	global	search

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

proc searchactive {} \
{
	global	search

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

proc searchstring {} \
{
	global	search lastDiff

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

proc searchnext {} \
{
	global	search

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

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

proc gotoLine {} \
{
	global search

	set location ""

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

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

	$search(widget) see $location
}

proc clearOrRecall {} \
{
	global search 

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

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

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

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

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

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

	search_init $w $s

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

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

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

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

proc example_main_widgets {} \
{
	#global	search 

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

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

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

# revtool - a tool for viewing SCCS files graphically.
# Copyright (c) 1998 by Larry McVoy; All rights reserved.
#
# @(#)revtool.tcl 1.164 lm@work.bitmover.com
#

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

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

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

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

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

#
# Set highlighting on the bounding box containing the revision number
#
# revision - (default style box) gc(rev.revOutline)
# merge -
# red - do a red rectangle
# arrow - do a $arrow outline
# old - do a rectangle in gc(rev.oldColor)
# new - do a rectangle in gc(rev.newColor)
# gca - do a black rectangle -- used for GCA
proc highlight {id type {rev ""}} \
{
	global gc w

	catch {set bb [$w(graph) bbox $id]} err
	#puts "In highlight: id=($id) err=($err)"
	# If node to highlight is not in view, err=""
	if {$err == ""} { return "$err" }
	# Added a pixel at the top and removed a pixel at the bottom to fix 
	# lm complaint that the bbox was touching the characters at top
	# -- lm doesn't mind that the bottoms of the letters touch, though
	#puts "id=($id)"
	set x1 [lindex $bb 0]
	set y1 [expr [lindex $bb 1] - 1]
	set x2 [lindex $bb 2]
	set y2 [expr [lindex $bb 3] - 1]

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

	$w(graph) raise revtext
	return $bg
}

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

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

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

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

# If in annotated diff output, find parent and diff between parent 
# and selected rev.
#
# If only a node in the graph is selected, then do the diff between it 
# and its parent
#
proc diffParent {} \
{
	global w file rev1 rev2

	set rev ""
	set b ""
	# See if node is selected and then try to get the revision number
	set id [$w(graph) find withtag old]
	if {$id != ""} {
		set tags [$w(graph) gettags $id]
		set bb [$w(graph) bbox $id]
		set x1 [expr {[lindex $bb 0] - 1}]
		set y1 [expr {[lindex $bb 1] - 1}]
		set x2 [expr {[lindex $bb 2] + 1}]
		set y2 [expr {[lindex $bb 3] + 1}]
		if {$bb != ""} {
			set b [$w(graph) find enclosed $x1 $y1 $x2 $y2]
			# Tags for the different indexes
			# t(0)=1.130-kush revsion
			# t(1)=old/new
			# t(2)=1.130-kush revtext current
			set tag [lindex $b 2]
			set tags [$w(graph) gettags $tag]
			if {[lsearch $tags revtext] >= 0} { 
				set rev_user [lindex $tags 0]
				set rev [lindex [split $rev_user "-"] 0]
				#puts "tags=($tags) rev=($rev)"
			}
		}
	}
	#puts "id=($id) rev=($rev)"
	set selectedLine [$w(aptext) tag ranges select]
	if {$selectedLine != ""} {
		set l [lindex $selectedLine 0]
		set line [$w(aptext) get $l "$l lineend - 1 char"]
		if {[regexp \
		    {^(.*)[ \t]+([0-9]+\.[0-9.]+).*\|} $line m user rev]} {
			set parent [exec bk prs -d:PARENT:  -hr${rev} $file]
			#puts "if: line=($line)"
			#puts "rev=($rev) parent=($parent) f=($file)"
			displayDiff $parent $rev
		}
	} elseif {$rev != ""} {
		set rev1 [exec bk prs -d:PARENT: -hr${rev} $file]
		set rev2 $rev
		set base [file tail $file]
		# not fully working -- need to reset nodes when clicking on
		# a new node
		#set hrev1 [lineOpts $rev1]
		#set hrev2 [lineOpts $rev2]
		#highlight $hrev1 "old"
		#highlight $hrev2 "new"

		if {$base == "ChangeSet"} {
			csetdiff2
			return
		}
		busy 1
		displayDiff $rev1 $rev2
	}
	return
}

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

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

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

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

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

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

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

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

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

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

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

	set bbox [$w(graph) bbox $revname]
	set b_x1 [lindex $bbox 0]
	set b_x2 [lindex $bbox 2]
	set b_y1 [lindex $bbox 1]
	set b_y2 [lindex $bbox 3]

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

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

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

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

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

	global serial2rev rev2date revX revY ht screen gc w
	global month

	set curday ""
	set prevday ""
	set lastx 0

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

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

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

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

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

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

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

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

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

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

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

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

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

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

proc balloon_setup {rev} \
{
	global gc app

	$w(graph) bind $rev <Enter> \
	    "after 500 \"balloon_aux_s %W [list $msg]\""
	$w(graph) bind $rev <Leave> \
	    "after cancel \"balloon_aux_s %W [list $msg]\"
	    after 100 {catch {destroy .balloon_help}}"
}

proc balloon_aux_s {w rev1} \
{
	global gc dspec dev_null file

	set t .balloon_help
	catch {destroy $t}
	toplevel $t
	wm overrideredirect $t 1
	set dspec \
"-d:DPN:@:I:, :Dy:-:Dm:-:Dd: :T::TZ:, :P:\$if(:HT:){@:HT:}\n\$each(:C:){  (:C:)\n}\$each(:SYMBOL:){  TAG: (:SYMBOL:)\n}\n" 

	catch { exec bk prs $dspec -r$rev1 "$file" 2>$dev_null } msg

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

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

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

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

	# Now figure out where we can put the list.
	set word [lindex $l 0]
	if {[regexp $line_rev $word dummy a] == 1} { set word $a }
	regexp {(.*)-([^-]*)} $word dummy rev last

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

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

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

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

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

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

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

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

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

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

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

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

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

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

	# Figure out the biggest node and its length.
	# XXX - this could be done on a per column basis.  Probably not
	# worth it until we do LOD names.
	if {$N != ""} { set n "-n$N" }
	set errorCode [list]
	set d [open "| bk prs -hr+ -nd:DS: \"$file\" 2>$dev_null" "r"]
	gets $d s
	close $d
	if {$s < 300} { set r "" }
	set d [open "| bk _lines $Opts(line) $n $r \"$file\" 2>$dev_null" "r"]

	#puts "bk _lines $Opts(line) $n $r \"$file\" 2>$dev_null"
	if  {[lindex $errorCode 2] == 1} {
		puts stderr "Error: Invalid revision number. rev=($r)"
		exit 1;
	}
	set len 0
	set big ""
	while {[gets $d s] >= 0} {
		lappend lines $s
		foreach word [split $s] {
			# Figure out if we have another parent.
			set node  [split $word '@']
			set word [lindex $node 0]

			# figure out whether name or revision is the longest
			# so we can find the largest text string in the list
			set revision [split $word '-']
			set rev [lindex $revision 0]
			set programmer [lindex $revision 1]

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

			if {$stacked} {
				if {$revlen > $namelen} { 
					set txt $rev
					set l $revlen
				} else {
					set txt $programmer
					set l $namelen
				}
			} else {
				set txt $word
				set l [string length $word]
			}
			if {($l > $len) && ([string first '-BAD' $rev] == -1)} {
				set len $l
				set big $txt
			}
		}
	}
	catch {close $d} err
	set len [font measure $gc(rev.fixedBoldFont) "$big"]
	set ht [font metrics $gc(rev.fixedBoldFont) -ascent]
	incr ht [font metrics $gc(rev.fixedBoldFont) -descent]

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

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

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

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

	# Highlight the kids
	catch {exec bk prs -hr$rev1 -d:KIDS: $fname} kids
	foreach r $kids {
		$w(graph) itemconfigure "l_$rev1-$r" -fill $gc(rev.hlineColor)
	}
	# Highlight the kid (XXX: There was a reason why I did this)
	catch {exec bk prs -hr$rev1 -d:KID: $fname} kid
	if {$kid != ""} {
		$w(graph) itemconfigure "l_$kid" -fill $gc(rev.hlineColor)
	}
	# NOTE: I am only interested in the first MPARENT
	set mpd [open "|bk prs -hr$rev1 {-d:MPARENT:} $fname"]
	if {[gets $mpd mp]} {
		$w(graph) itemconfigure "l_$mp-$rev1" -fill $gc(rev.hlineColor)
	}
	catch { close $mpd }
	$w(graph) itemconfigure "l_$rev1" -fill $gc(rev.hlineColor)
}

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

	# destroy comment window if user is using mouse to click on the canvas
	if {$id == ""} {
		catch {pack forget $w(cframe); set comments_mapped 0}
	}
	$w(graph) delete new
	$w(graph) delete old
	.menus.cset configure -state disabled -text "View Changeset "
	.menus.difftool configure -state disabled
	set rev1 [getRev "old" $id]

	highlightAncestry $rev1

	if {$rev1 != ""} {
		catch {exec bk prs -hr$rev1 -d:CSETKEY: $file} info
		#puts "info=($info)"
		if {$info == ""} {
			.menus.cset configure \
			    -state disabled \
			    -text "Not in a CSET"
		} else {
			.menus.cset configure \
			    -state normal \
			    -text "View Changeset "
		}
	}
	if {[info exists rev2]} { unset rev2 }
}

proc getRightRev { {id {}} } \
{
	global	rev2 file w

	$w(graph) delete new
	set rev2 [getRev "new" $id]
	if {$rev2 != ""} {
		.menus.difftool configure -state normal
		catch {exec bk prs -hr$rev2 -d:CSETKEY: $file} info
		if {$info == ""} {
			.menus.cset configure \
			    -state disabled \
			    -text "Not in a CSET"
		} else {
			.menus.cset configure \
			    -state normal \
			    -text "View Changesets"
		}
	}
}

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

	if {$id == ""} {
		set id [$w(graph) gettags current]
		# Don't want to create boxes around items that are not
		# graph nodes
		if {([lsearch $id date_*] >= 0) || ([lsearch $id l_*] >= 0)} {
			return 
		}
	}
	set id [lindex $id 0]
	if {("$id" == "current") || ("$id" == "")} { return "" }
	$w(graph) select clear
	highlight $id $type 
	regsub -- {-.*} $id "" id
	return $id
}

# msg -- optional argument -- use msg to pass in text to print
# if file handle f returns no data
#
proc filltext {win f clear {msg {}}} \
{
	global search w file
	#puts stderr "filltext win=($win) f=($f) clear=($clear) msg=($msg)"

	$win configure -state normal
	if {$clear == 1} { $win delete 1.0 end }
	while { [gets $f str] >= 0 } {
		$win insert end "$str\n"
	}
	catch {close $f} ignore
	$win configure -state disabled
	if {$clear == 1 } { busy 0 }
	searchreset
	set search(prompt) "Welcome"
}

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

	set lock "inprs"

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

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

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

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

	busy 1
	set sfile [exec bk sfiles $file]
	catch {exec bk prs -hn -d:COMPRESSION: -r+ $sfile} compression
	if {$compression == "gzip"} { 
		catch {exec bk admin -Znone $sfile} err
	}
	set f [open "$sfile" "r"]
	set ttype "sccs"
	filltext $w(aptext) $f 1 "No sfile data"
}

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

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



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

	if {[info exists lock] && ($lock == "inprs")} {
		set sem "show_sccslog"
		return
	}
	# XXX: Oy, this is yucky. Setting srev to "" since we just clicked
	# on a node and we no longer looking at a specific rev (used to 
	# determine what we are looking at in selectTag. This fixes a bug
	# where we were forced to click on a line twice to get the comments.
	# The right fix is to use tcl Marks to determine what we are looking
	# at.
	set srev ""

	if {$type == "id"} {
		#getLeftRev $val
	} elseif {$type == "rev"} {
		set rev1 $val
	}
	if {"$rev1" == ""} { return }
	busy 1
	set base [file tail $file]
	if {$base != "ChangeSet"} {
		set get \
		    [open "| bk get $Opts(get) -Pr$rev1 \"$file\" 2>$dev_null"]
		set ttype "annotated"
		filltext $w(aptext) $get 1 "No annotation"
		return
	}
	set rev2 $rev1
	switch $type {
	    id		{ csetdiff2 }
	    rev		{ csetdiff2 $rev1 }
	}
}

proc difftool {file r1 r2} \
{
	catch {exec bk difftool -r$r1 -r$r2 $file &} err
	busy 0
}

proc csettool {} \
{
	global rev1 rev2 file

	if {[info exists rev1] != 1} { return }
	if {[info exists rev2] != 1} { set rev2 $rev1 }
	catch {exec bk csettool -r$rev1..$rev2 &} err
}

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

	if {![info exists rev1] || ($rev1 == "")} { return }
	if {$difftool == 0} { getRightRev $id }
	if {"$rev2" == ""} { return }
	set base [file tail $file]
	if {$base == "ChangeSet"} {
		csetdiff2
		return
	}
	busy 1
	if {$difftool == 1} {
		difftool $file $rev1 $rev2
		return
	}
	displayDiff $rev1 $rev2
}

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

	set r1 [file join $tmp_dir $rev1-[pid]]
	catch { exec bk get $Opts(get) -kPr$rev1 $file >$r1}
	set r2 [file join $tmp_dir $rev2-[pid]]
	catch {exec bk get $Opts(get) -kPr$rev2 $file >$r2}
	set diffs [open "| diff $Opts(diff) $r1 $r2"]
	set l 3
	$w(aptext) configure -state normal; $w(aptext) delete 1.0 end
	$w(aptext) insert end "- $file version $rev1\n"
	$w(aptext) insert end "+ $file version $rev2\n\n"
	$w(aptext) tag add "oldTag" 1.0 "1.0 lineend + 1 char"
	$w(aptext) tag add "newTag" 2.0 "2.0 lineend + 1 char"
	diffs $diffs $l
	$w(aptext) configure -state disabled
	searchreset
	file delete -force $r1 $r2
	busy 0
	set ttype "annotated"
}

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

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

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

	if {$file != "ChangeSet"} {return}
	if {$rev1 == ""} {return}
	if {![info exists rev2] || ($rev2 == "")} { 
		set end $rev1 
	} else {
		# don't want to modify global rev2 in this procedure
		set end $rev2
	}
	busy 1
	cd2root
	$gc(current) delete 1 end
	set revs [open "| bk -R prs -hbMr$rev1..$end {-d:I:\n} ChangeSet"]
	while {[gets $revs r] >= 0} {
		set log [open "| bk cset -Hr$r" r]
		while {[gets $log file_rev] >= 0} {
			set f [lindex [split $file_rev $bk_fs] 0]
			set rev [lindex [split $file_rev $bk_fs] 1]
			$gc(current) add command -label "${f}@${rev}" \
			    -command "gotoRev $f $rev"
		}
		catch {close $log}
	}
	catch {close $revs}
	busy 0
	return
}

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

	busy 1
	if {$rev != ""} { set rev1 $rev; set rev2 $rev }
	$w(aptext) configure -state normal; $w(aptext) delete 1.0 end
	$w(aptext) insert end "ChangeSet history for $rev1..$rev2\n\n"

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

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

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

proc diffs {diffs l} \
{
	global	Opts w

	if {"$Opts(diff)" == "-u"} {
		set lexp {^\+}
		set rexp {^-}
		gets $diffs str
		gets $diffs str
	} else {
		set lexp {^>}
		set rexp {^<}
	}
	while { [gets $diffs str] >= 0 } {
		$w(aptext) insert end "$str\n"
		incr l
		if {[regexp $lexp $str]} {
			$w(aptext) tag \
			    add "newTag" $l.0 "$l.0 lineend + 1 char"
		}
		if {[regexp $rexp $str]} {
			$w(aptext) tag \
			    add "oldTag" $l.0 "$l.0 lineend + 1 char"
		}
	}
	catch { close $diffs; }
}

proc done {} \
{
	#saveHistory
	exit
}

# All of the pane code is from Brent Welch.  He rocks.
proc PaneCreate {} \
{
	global	percent gc paned

	# Figure out the sizes of the two windows and set the
	# master's size and calculate the percent.
	set x1 [winfo reqwidth .p.top]
	set x2 [winfo reqwidth .p.b]
	if {$x1 > $x2} {
		set xsize $x1
	} else {
		set xsize $x2
	}
	set ysize [expr {[winfo reqheight .p.top] + [winfo reqheight .p.b.p]}]
	set percent [expr {[winfo reqheight .p.b] / double($ysize)}]
	.p configure -height $ysize -width $xsize -background black
	frame .p.fakesb -height $gc(rev.scrollWidth) -background grey \
	    -borderwid 1.25 -relief sunken
	    label .p.fakesb.l -text "<-- scrollbar -->"
	    pack .p.fakesb.l -expand true -fill x
	place .p.fakesb -in .p -relx .5 -rely $percent -y -2 \
	    -relwidth 1 -anchor s
	frame .p.sash -height 2 -background black
	place .p.sash -in .p -relx .5 -rely $percent -relwidth 1 \
	    -anchor center
	frame .p.grip -background grey \
		-width 13 -height 13 -bd 2 -relief raised -cursor double_arrow
	place .p.grip -in .p -relx 1 -x -50 -rely $percent -anchor center
	place .p.top -in .p -x 0 -rely 0.0 -anchor nw -relwidth 1.0 -height -2
	place .p.b -in .p -x 0 -rely 1.0 -anchor sw -relwidth 1.0 -height -2

	# Set up bindings for resize, <Configure>, and
	# for dragging the grip.
	bind .p <Configure> PaneResize
	bind .p.grip <ButtonPress-1> "PaneDrag %Y"
	bind .p.grip <B1-Motion> "PaneDrag %Y"
	bind .p.grip <ButtonRelease-1> "PaneStop"

	PaneGeometry
	set paned 1
}

# When we get an resize event, don't resize the top canvas if it is
# currently fitting in the window.
proc PaneResize {} \
{
	global	percent

	set ht [expr {[ht all] + 30}]
	incr ht -1
	set y [winfo height .p]
	set y1 [winfo height .p.top]
	set y2 [winfo height .p.b]
	if {$y1 >= $ht} {
		set y1 $ht
		set percent [expr {$y1 / double($y)}]
	}
	if {$y > $ht && $y1 < $ht} {
		set y1 $ht
		set percent [expr {$y1 / double($y)}]
	}
	PaneGeometry
}

proc PaneGeometry {} \
{
	global	percent psize

	place .p.top -relheight $percent
	place .p.b -relheight [expr {1.0 - $percent}]
	place .p.grip -rely $percent
	place .p.fakesb -rely $percent -y -2
	place .p.sash -rely $percent
	raise .p.sash
	raise .p.grip
	lower .p.fakesb
	set psize [winfo height .p]
}

proc PaneDrag {D} \
{
	global	lastD percent psize

	if {[info exists lastD]} {
		set delta [expr {double($lastD - $D) / $psize}]
		set percent [expr {$percent - $delta}]
		if {$percent < 0.0} {
			set percent 0.0
		} elseif {$percent > 1.0} {
			set percent 1.0
		}
		place .p.fakesb -rely $percent -y -2
		place .p.sash -rely $percent
		place .p.grip -rely $percent
		raise .p.fakesb
		raise .p.sash
		raise .p.grip
	}
	set lastD $D
}

proc PaneStop {} \
{
	global	lastD

	PaneGeometry
	catch {unset lastD}
}


proc busy {busy} \
{
	global	paned w

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

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

	set sem "start"
	set ttype ""
	set dspec \
"-d:DPN:@:I:, :Dy:-:Dm:-:Dd: :T::TZ:, :P:\$if(:HT:){@:HT:}\n\$each(:C:){  (:C:)\n}\$each(:SYMBOL:){  TAG: (:SYMBOL:)\n}\n"
	set Opts(diff) "-u"
	set Opts(get) "-aum"
	set Opts(line) "-u -t"
	set yspace 20
	# cframe	- comment frame	
	# apframe	- annotation/prs frame
	# ctext		- comment text window
	# aptext	- annotation and prs text window
	# graph		- graph canvas window
	set w(cframe) .p.b.c
	set w(ctext) .p.b.c.t
	set w(apframe) .p.b.p
	set w(aptext) .p.b.p.t
	set w(graph) .p.top.c
	set stacked 1

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

	if {$tcl_platform(platform) == "windows"} {
		set gc(py) 0; set gc(px) 1; set gc(bw) 2
		set gc(histfile) [file join $gc(bkdir) "_bkhistory"]
	} else {
		set gc(py) 1; set gc(px) 4; set gc(bw) 2
		set gc(histfile) [file join $gc(bkdir) ".bkhistory"]
	}
	set Opts(line_time)  "-R-$gc(rev.showHistory)"
	if {"$gc(rev.geometry)" != ""} {
		wm geometry . $gc(rev.geometry)
	}
	wm title . "revtool"

	frame .menus
	    button .menus.quit -font $gc(rev.buttonFont) -relief raised \
		-bg $gc(rev.buttonColor) \
		-pady $gc(py) -padx $gc(px) -borderwid $gc(bw) \
		-text "Quit" -command done
	    button .menus.help -font $gc(rev.buttonFont) -relief raised \
		-bg $gc(rev.buttonColor) \
		-pady $gc(py) -padx $gc(px) -borderwid $gc(bw) \
		-text "Help" -command { exec bk helptool revtool & }
	    menubutton .menus.mb -font $gc(rev.buttonFont) -relief raised \
		-bg $gc(rev.buttonColor) \
		-pady $gc(py) -padx $gc(px) -borderwid $gc(bw) \
		-text "Select Range" -width 15 -state normal \
		-menu .menus.mb.menu
		set m [menu .menus.mb.menu]
		$m add command -label "Last Day" \
		    -command {set srev ""; revtool $fname -1D}
		$m add command -label "Last 2 Days" \
		    -command {set srev ""; revtool $fname -2D}
		$m add command -label "Last 3 Days" \
		    -command {set srev ""; revtool $fname -3D}
		$m add command -label "Last 4 Days" \
		    -command {set srev ""; revtool $fname -4D}
		$m add command -label "Last 5 Days" \
		    -command {set srev ""; revtool $fname -5D}
		$m add command -label "Last 6 Days" \
		    -command {set srev ""; revtool $fname -6D}
		$m add command -label "Last Week" \
		    -command {set srev ""; revtool $fname -W}
		$m add command -label "Last 2 Weeks" \
		    -command {set srev ""; revtool $fname -2W}
		$m add command -label "Last 3 Weeks" \
		    -command {set srev ""; revtool $fname -3W}
		$m add command -label "Last 4 Weeks" \
		    -command {set srev ""; revtool $fname -4W}
		$m add command -label "Last 5 Weeks" \
		    -command {set srev ""; revtool $fname -5W}
		$m add command -label "Last 6 Weeks" \
		    -command {set srev ""; revtool $fname -6W}
		$m add command -label "Last 2 Months" \
		    -command {set srev ""; revtool $fname -2M}
		$m add command -label "Last 3 Months" \
		    -command {set srev ""; revtool $fname -3M}
		$m add command -label "Last 6 Months" \
		    -command {set srev ""; revtool $fname -6M}
		$m add command -label "Last 9 Months" \
		    -command {set srev ""; revtool $fname -9M}
		$m add command -label "Last Year" \
		    -command {set srev ""; revtool $fname -1Y}
		$m add command -label "All Changes" \
		    -command {set srev ""; revtool $fname 1.1..}
	    button .menus.cset -font $gc(rev.buttonFont) -relief raised \
		-bg $gc(rev.buttonColor) \
		-pady $gc(py) -padx $gc(px) -borderwid $gc(bw) \
		-text "View Changeset " -width 15 -command r2c -state disabled
	    button .menus.difftool -font $gc(rev.buttonFont) -relief raised \
		-bg $gc(rev.buttonColor) \
		-pady $gc(py) -padx $gc(px) -borderwid $gc(bw) \
		-text "Diff tool" -command "diff2 1" -state disabled
	    menubutton .menus.fmb -font $gc(rev.buttonFont) -relief raised \
		-bg $gc(rev.buttonColor) \
		-pady $gc(py) -padx $gc(px) -borderwid $gc(bw) \
		-text "Select File" -width 12 -state normal \
		-menu .menus.fmb.menu
		set gc(fmenu) [menu .menus.fmb.menu]
		set gc(current) $gc(fmenu).current
		set gc(recent) $gc(fmenu).recent
		$gc(fmenu) add command -label "Open new file" \
		    -command { 
		    	set fname [selectFile]
			if {$fname != ""} {
				revtool $fname "-$gc(rev.showHistory)"
			}
		    }
		$gc(fmenu) add command -label "Project History" \
		    -command {
			cd2root
			set fname ChangeSet
		    	revtool ChangeSet -$gc(rev.showHistory)
		    }
		$gc(fmenu) add separator
		$gc(fmenu) add cascade -label "Current ChangeSet" \
		    -menu $gc(current)
		$gc(fmenu) add cascade -label "Recently Viewed Files" \
		    -menu $gc(recent)
		menu $gc(recent) 
		menu $gc(current) 
		$gc(recent) add command -label "$fname" \
		    -command "revtool $fname -$gc(rev.showHistory)"
		getHistory
	    if {"$fname" == "ChangeSet"} {
		    #.menus.cset configure -command csettool
		    pack .menus.quit .menus.help .menus.mb .menus.cset \
			.menus.fmb -side left -fill y
	    } else {
		    pack .menus.quit .menus.help .menus.difftool \
			.menus.mb .menus.cset .menus.fmb -side left -fill y
	    }
	frame .p
	    frame .p.top -borderwidth 2 -relief sunken
		scrollbar .p.top.xscroll -wid $gc(rev.scrollWidth) \
		    -orient horiz \
		    -command "$w(graph) xview" \
		    -background $gc(rev.scrollColor) \
		    -troughcolor $gc(rev.troughColor)
		scrollbar .p.top.yscroll -wid $gc(rev.scrollWidth)  \
		    -command "$w(graph) yview" \
		    -background $gc(rev.scrollColor) \
		    -troughcolor $gc(rev.troughColor)
		canvas $w(graph) -width 500 \
		    -background $gc(rev.canvasBG) \
		    -xscrollcommand ".p.top.xscroll set" \
		    -yscrollcommand ".p.top.yscroll set"
		pack .p.top.yscroll -side right -fill y
		pack .p.top.xscroll -side bottom -fill x
		pack $w(graph) -expand true -fill both

	    frame .p.b -borderwidth 2 -relief sunken
	    	# prs and annotation window
		frame .p.b.p
		    text .p.b.p.t -width $gc(rev.textWidth) \
			-height $gc(rev.textHeight) \
			-font $gc(rev.fixedFont) \
			-xscrollcommand { .p.b.p.xscroll set } \
			-yscrollcommand { .p.b.p.yscroll set } \
			-bg $gc(rev.textBG) -fg $gc(rev.textFG) -wrap none 
		    scrollbar .p.b.p.xscroll -orient horizontal \
			-wid $gc(rev.scrollWidth) -command { .p.b.p.t xview } \
			-background $gc(rev.scrollColor) \
			-troughcolor $gc(rev.troughColor)
		    scrollbar .p.b.p.yscroll -orient vertical \
			-wid $gc(rev.scrollWidth) \
			-command { .p.b.p.t yview } \
			-background $gc(rev.scrollColor) \
			-troughcolor $gc(rev.troughColor)
		# change comment window
		frame .p.b.c
		    text .p.b.c.t -width $gc(rev.textWidth) \
			-height $gc(rev.commentHeight) \
			-font $gc(rev.fixedFont) \
			-xscrollcommand { .p.b.c.xscroll set } \
			-yscrollcommand { .p.b.c.yscroll set } \
			-bg $gc(rev.commentBG) -fg $gc(rev.textFG) -wrap none 
		    scrollbar .p.b.c.xscroll -orient horizontal \
			-wid $gc(rev.scrollWidth) -command { .p.b.c.t xview } \
			-background $gc(rev.scrollColor) \
			-troughcolor $gc(rev.troughColor)
		    scrollbar .p.b.c.yscroll -orient vertical \
			-wid $gc(rev.scrollWidth) \
			-command { .p.b.c.t yview } \
			-background $gc(rev.scrollColor) \
			-troughcolor $gc(rev.troughColor)

		pack .p.b.c.yscroll -side right -fill y
		pack .p.b.c.xscroll -side bottom -fill x
		pack .p.b.c.t -expand true -fill both

		pack .p.b.p.yscroll -side right -fill y
		pack .p.b.p.xscroll -side bottom -fill x
		pack .p.b.p.t -expand true -fill both

		#pack .p.b.c -expand true -fill both
		#pack forget .p.b.c

		pack .p.b.p -expand true -fill both -anchor s
		pack .p.b -expand true -fill both -anchor s

	set paned 0
	after idle {
	    PaneCreate
	}
	frame .cmd 
	search_widgets .cmd $w(aptext)
	# Make graph the default window to have the focus
	set search(focus) $w(graph)

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

	bind $w(graph) <Button-1>	{ prs; currentMenu; break }
	bind $w(graph) <Double-1>	{ selectNode "id"; break }
	bind $w(graph) <3>		{ diff2 0; currentMenu; break }
	bind $w(graph) <h>		"history"
	bind $w(graph) <t>		"history tags"
	bind $w(graph) <d>		"diffParent"
	bind $w(graph) <Button-2>	{ history; break }
	bind $w(graph) <Double-2>	{ history tags; break }
	bind $w(graph) <$gc(rev.quit)>	"done"
	bind $w(graph) <s>		"sfile"
	bind $w(graph) <c>		"sccscat"
	bind $w(graph) <Prior>		"$w(aptext) yview scroll -1 pages"
	bind $w(graph) <Next>		"$w(aptext) yview scroll  1 pages"
	bind $w(graph) <space>		"$w(aptext) yview scroll  1 pages"
	bind $w(graph) <Up>		"$w(aptext) yview scroll -1 units"
	bind $w(graph) <Down>		"$w(aptext) yview scroll  1 units"
	bind $w(graph) <Home>		"$w(aptext) yview -pickplace 1.0"
	bind $w(graph) <End>		"$w(aptext) yview -pickplace end"
	bind $w(graph) <Control-b>	"$w(aptext) yview scroll -1 pages"
	bind $w(graph) <Control-f>	"$w(aptext) yview scroll  1 pages"
	bind $w(graph) <Control-e>	"$w(aptext) yview scroll  1 units"
	bind $w(graph) <Control-y>	"$w(aptext) yview scroll -1 units"

	bind $w(graph) <Shift-Prior>	"$w(graph) yview scroll -1 pages"
	bind $w(graph) <Shift-Next>	"$w(graph) yview scroll  1 pages"
	bind $w(graph) <Shift-Up>	"$w(graph) yview scroll -1 units"
	bind $w(graph) <Shift-Down>	"$w(graph) yview scroll  1 units"
	bind $w(graph) <Shift-Left>	"$w(graph) xview scroll -1 pages"
	bind $w(graph) <Shift-Right>	"$w(graph) xview scroll  1 pages"
	bind $w(graph) <Left>		"$w(graph) xview scroll -1 units"
	bind $w(graph) <Right>		"$w(graph) xview scroll  1 units"
	bind $w(graph) <Shift-Home>	"$w(graph) xview moveto 0"
	bind $w(graph) <Shift-End>	"$w(graph) xview moveto 1.0"
	if {$tcl_platform(platform) == "windows"} {
		bind . <Shift-MouseWheel>   { 
		    if {%D < 0} {
		    	$w(graph) xview scroll -1 pages
		    } else {
		    	$w(graph) xview scroll 1 pages
		    }
		}
		bind . <Control-MouseWheel> {
		    if {%D < 0} {
			$w(graph) yview scroll 1 units
		    } else {
			$w(graph) yview scroll -1 units
		    }
		}
		bind . <MouseWheel> {
		    if {%D < 0} {
			$w(aptext) yview scroll 5 units
		    } else {
			$w(aptext) yview scroll -5 units
		    }
		}
	} else {
		bind . <Shift-Button-4>   "$w(graph) xview scroll -1 pages"
		bind . <Shift-Button-5>   "$w(graph) xview scroll 1 pages"
		bind . <Control-Button-4> "$w(graph) yview scroll -1 units"
		bind . <Control-Button-5> "$w(graph) yview scroll 1 units"
		bind . <Button-4>	  "$w(aptext) yview scroll -5 units"
		bind . <Button-5>	  "$w(aptext) yview scroll 5 units"
	}
	$search(widget) tag configure search \
	    -background $gc(rev.searchColor) -font $gc(rev.fixedBoldFont)
	search_keyboard_bindings
	bind . <n>	{
	    set search(dir) "/"
	    searchnext
	}
	bind . <p>	{
	    set search(dir) "?"
	    searchnext
	}
	searchreset

	bind $w(aptext) <Button-1> { selectTag %W %x %y "B1"; break}
	bind $w(aptext) <Button-3> { selectTag %W %x %y "B3"; break}
	bind $w(aptext) <Double-1> { selectTag %W %x %y "D1"; break }

	# highlighting.
	$w(aptext) tag configure "newTag" -background $gc(rev.newColor)
	$w(aptext) tag configure "oldTag" -background $gc(rev.oldColor)
	$w(aptext) tag configure "select" -background $gc(rev.selectColor)

	bindtags $w(aptext) {Bk .p.b.p.t . all}
	bindtags $w(ctext) {.p.b.c.t . all}

	bind Bk <Shift-Button-1> { 
		#puts "in %W %x %y"
		tkTextButton1 %W %x %y
		%W tag remove sel 0.0 end
		break 
	}

	bind Bk <Shift-B1-Motion> {
		set tkPriv(x) %x
		set tkPriv(y) %y
		tkTextSelectTo %W %x %y
	}

	bind Bk <ButtonRelease-1> {
		tkCancelRepeat
	}

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

	wm deiconify .
	focus $w(graph)
	. configure -background $gc(BG)
} ;# proc widgets

#
#
#
#
proc selectFile {} \
{
	global gc fname

	set file [tk_getOpenFile]
	if {$file == ""} {return}
	catch {set f [open "| bk sfiles -g \"$file\"" r]} err
	if { ([gets $f fname] <= 0)} {
		set rc [tk_dialog .new "Error" "$file is not under revision control.\nPlease select a revision controled file" "" 0 "Cancel" "Select Another File" "Exit BitKeeper"]
		if {$rc == 2} {exit} elseif {$rc == 1} { selectFile }
	} else {
		#displayMessage "file=($file) err=($err)"
		# XXX: Need to add in a function so that we can check for
		# duplicates
		if {$fname == "ChangeSet"} {
			#pack forget .menus.difftool
		} else {
			$gc(recent) add command -label "$fname" \
			    -command "revtool $fname -$gc(rev.showHistory)" 
		}
	}
	catch {close $f}
	return $fname
}

# XXX: Should only save the most recent (10?) files that were looked at
# should be a config option
proc saveHistory {} \
{
	global gc

	set num [$gc(recent) index end]
	set h [open "$gc(histfile)" w]
	if {[catch {open $gc(histfile) w} fid]} {
		puts stderr "Cannot open $bkrc"
	} else {
		# Start at 3 so we skip over the "Add new" and sep entries
		set start 3
		set saved [expr $gc(rev.savehistory) + 2]
		if {$num > $saved} {
			set start [expr $num - $gc(rev.savehistory)]
		}
		for {set i $start} {$i <= $num} {incr i 1} {
			set index $i
			set fname [$gc(recent) entrycget $index -label]
			#puts [$gc(recent) entryconfigure $index]
			#puts "i=($i) label=($fname)"
			puts $fid "$fname"
		}
		catch {close $h}
	}
	return
}

proc getHistory {} \
{
	global gc

	if {![file exists $gc(histfile)]} {
		#puts stderr "no history file exists"
		return
	}
	set h [open "$gc(histfile)"]
	while {[gets $h file] >= 0} {
		if {$file == "ChangeSet"} {continue}
		$gc(recent) add command -label "$file" \
		    -command "revtool $file -$gc(rev.showHistory)" 
	}
	catch {close $h}
}

# Arguments:
#  lfname	filename that we want to view history
#  R		Revision or time period that we want to view
#  N		Number of revs to show
#
proc revtool {lfname R {N {}}} \
{
	global	bad revX revY search dev_null rev2date serial2rev w
	global  srev Opts gc file rev2rev_name cdim firstnode fname
	global  merge diffpair

	# Set global so that other procs know what file we should be
	# working on. Need this when menubutton is selected
	set fname $lfname

	busy 1
	$w(graph) delete all
	if {[info exists revX]} { unset revX }
	if {[info exists revY]} { unset revY }
	if {[info exists rev1]} { unset rev1 }
	if {[info exists rev2]} { unset rev2 }
	if {[info exists rev2date]} { unset rev2date }
	if {[info exists serial2rev]} { unset serial2rev }
	if {[info exists rev2rev_name]} { unset rev2rev_name }
	if {[info exists firstnode]} { unset firstnode }

	set bad 0
	set file [exec bk sfiles -g $lfname 2>$dev_null]
	if {$lfname == "ChangeSet"} {
		pack forget .menus.difftool
	} else {
		pack configure .menus.difftool -before .menus.mb \
		    -side left
	}
	if {"$file" == ""} {
		displayMessage "No such file \"$lfname\" rev=($R) \nPlease \
select a new file to view"
		set lfname [selectFile]
		if {$lfname == ""} { exit }
		set file [exec bk sfiles -g $lfname 2>$dev_null]
	}
	if {[catch {exec bk root $file} proot]} {
		wm title . "revtool: $file $R"
	} else {
		wm title . "revtool: $proot: $file $R"
	}
	if {$srev != ""} {
		set Opts(line_time) "-R$srev.."
	} else {
		set Opts(line_time) "-R$R"
	}
	# If valid time range given, do the graph
	if {[listRevs $Opts(line_time) "$file" $N] == 0} {
		revMap "$file"
		dateSeparate
		setScrollRegion
		set first [$w(graph) gettags $firstnode]
		if {$srev == ""} {
			history "-r$R"
		} else {
			history "-r$srev"
		}
	} else {
		set ago ""
		catch {set ago [exec bk prs -hr+ -d:AGE: $lfname]}
		# XXX: Highlight this in a different color? Yellow?
		$w(aptext) configure -state normal; $w(aptext) delete 1.0 end
		$w(aptext) insert end  "Error: No data within the given time\
period; please choose a longer amount of time.\n
The file $lfname was last modified ($ago) ago."
		revtool $lfname +
	}
	# Now make sure that the last node is visible in the canvas
	if {$srev == ""} {
		catch {exec bk prs -hr+ -d:I:-:P: $lfname 2>$dev_null} out
	} else {
		catch {exec bk prs -hr$srev -d:I:-:P: $lfname 2>$dev_null} out
	}
	if {$out != ""} {
		centerRev $out
	}
	# Make sure we don't lose the highlighting when we do a select Range
	if {[info exists merge(G)] && ($merge(G) != "")} {
		set gca [lineOpts $merge(G)]
		highlight $gca "gca"
		set rev2 [lineOpts $merge(r)]
		highlight $rev2 "remote"
		set rev1 [lineOpts $merge(l)]
		highlight $rev1 "local"
	} else {
		if {[info exists diffpair(left)] && ($diffpair(left) != "")} {
			set rev1 [lineOpts $diffpair(left)]
			highlight $rev1 "old"
		}
		if {[info exists diffpair(right)] && ($diffpair(right) != "")} {
			set rev2 [lineOpts $diffpair(right)]
			highlight $rev2 "new"
		}
	}
	set search(prompt) "Welcome"
	focus $w(graph)
	busy 0
	return
} ;#revtool

proc init {} \
{
	global env

	bk_init
	set env(BK_YEAR4) 1
}

#
# srev	- specified revision to warp to on startup
# rev1	- left-side revision
# rev2	- right-side revision
# gca	- greatest common ancestor
#
proc arguments {} \
{
	global rev1 rev2 dfile argv argc fname gca srev errorCode

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

	while {$argindex < $argc} {
		set arg [lindex $argv $argindex]
		switch -regexp -- $arg {
		    "^-G.*" {
			set gca [string range $arg 2 end]
		    }
		    "^-r.*" {
			#set rev2_tmp [lindex $argv $argindex]
		   	#regexp {^[ \t]*-r(.*)} $rev2_tmp dummy revs
			set rev2 [string range $arg 2 end]
		    }
		    "^-l.*" {
			set rev1 [string range $arg 2 end]
		    }
		    "^-d.*" {
			set dfile [string range $arg 2 end]
		    }
		    default {
		    	incr fnum
			set opts(file,$fnum) $arg
		    }
		}
		incr argindex
	}
	set arg [lindex $argv $argindex]

	if {($gca != "") && (($rev2 == "") || ($rev1 == ""))} {
		puts stderr "error: GCA options requires -l and -r"
		exit
	}
	if {($rev1 != "") && (($rev2 == "") && ($gca == ""))} {
		set srev $rev1
	}

	# regexes for valid revision numbers. This probably should be
	# a function that uses a bk command to check whether the revision
	# exists.
	set r2 {^([1-9][0-9]*)\.([1-9][0-9]*)$}
	set r4 {^([1-9][0-9]*)\.([1-9][0-9]*)\.([1-9][0-9]*)\.([1-9][0-9]*)$}
	set d1 ""; set d2 ""
	if {[info exists rev1] && $rev1 != ""} {
		if {![regexp -- $r2 $rev1 d1] &&
		    ![regexp -- $r4 $rev1 d2]} {
			puts stderr "\"$rev1\" is not a valid revision number."
			exit 1
		}
	}
	if {[info exists rev2] && $rev2 != ""} {
		if {![regexp -- $r2 $rev2 d1] &&
		    ![regexp -- $r4 $rev2 d2]} {
			puts stderr "\"$rev2\" is not a valid revision number."
			exit 1
		}
	}
	if {$fnum > 1} {
		puts stderr "Error: Incorrect argument or too many arguments."
		exit 1
	} elseif {$fnum == 0} {
		cd2root
		# This should match the CHANGESET path defined in sccs.h
		set fname ChangeSet
		catch {exec bk sane -r} err
		if {[lindex $errorCode 2] == 1} {
			displayMessage "$err" 0
			exit 1
		}
	} elseif {$fnum == 1} {
		set fname $opts(file,1)
		if {[file isdirectory $fname]} {
			catch {cd $fname} err
			if {$err != ""} {
				displayMessage "Unable to cd to $fname"
				exit 1
			}
			cd2root
			# This should match the CHANGESET path defined in sccs.h
			set fname ChangeSet
			catch {exec bk sane} err
			if {[lindex $errorCode 2] == 1} {
				displayMessage "$err" 0
				exit 1
			}
		} elseif {[exec bk sfiles -g "$fname"] == ""} {
			puts stderr \
			    "\"$fname\" is not a revision controlled file"
			displayMessage "\"$fname\" not a bk controlled file"
			exit
		}
	}
} ;# proc arguments

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

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


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

	if {$gca != ""} {
		set merge(G) $gca
		set merge(l) $rev1
		set merge(r) $rev2
	} elseif {$rev2 != ""} { 
		set diffpair(right) $rev2 
	}
	if {$srev != ""} {  ;# If -l option without the -r -G
		revtool $fname "-$srev" $gc(rev.showRevs)
		set rev1 [lineOpts $srev]
		highlight $rev1 "old"
		set file [exec bk sfiles -g $fname 2>$dev_null]
		highlightTextRev $rev1 $fname
		.menus.cset configure -state normal 
	} elseif {$rev1 == ""} { ;# if no arguments
		# If called with no args, show the last 200 revs
		revtool $fname "-$gc(rev.showHistory)" $gc(rev.showRevs)
	} else { ;# if -l argument
		set diffpair(left) $rev1
		set srev $rev1
		revtool $fname "-$rev1"
	}
	if {[info exists rev2] && ($rev2 != "")} {
		set diffpair(right) $rev2
		diff2 2
	} 
	if {[info exists dfile] && ($dfile != "")} {
		printCanvas
	}
}

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

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

init
arguments
widgets
startup
