# 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"
}

# 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
}
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"
			}
		}
    	}
}
#
# setuptool - a tool for seting up a repository
# Copyright (c) 2000 by Aaron Kushner; All rights reserved.
#
# @(#)setuptool.tcl 1.30
#
# TODO: 
#
#	Add error checking for:
#		ensure repository name does not have spaces
#		validate all fields in entry widgets
#	Add dialog box to chose directory	
#
# Arguments:
# 	optional arg for the name of the repository
#

set debug 0

proc dialog_position { dlg width len } \
{
	set swidth [winfo screenwidth .]
	set sheight [winfo screenheight .]
	set x [expr {($swidth/2) - 100}]
	set y [expr {($sheight/2) - 100}]
	wm geometry $dlg ${width}x${len}+$x+$y
}

proc dialog { widgetname title trans  } \
{

	toplevel $widgetname -class Dialog
	wm title $widgetname $title
	#only mark as transient on demand
	if {$trans} {
		wm transient $widgetname
	}
	wm protocol $widgetname \
	    WM_DELETE_WINDOW "handle_close $widgetname "
}

proc handle_close {w} \
{
	exit
}

# Builds a set of buttons on the dialog.
proc dialog_button { widgetname msg count } \
{
	button $widgetname -text $msg \
	    -command "global st_dlg_button; set st_dlg_button $count"
	pack $widgetname -side left -expand 1 -padx 20 -pady 10
	return $widgetname
}

# Create frame for bottom area of dialog
proc dialog_bottom { widgetname args } \
{
	frame $widgetname.b -bd 2 -relief raised
	set i 0
	foreach msg $args {
		dialog_button $widgetname.b.$i $msg $i
		incr i
	}
	focus $widgetname.b.0
	pack $widgetname.b -side bottom -fill x
}

# Returns value of button pressed.
# Buttons start with val = 0
#
proc dialog_wait { dlg width len } \
{
	global st_dlg_button

	#position dialog
	dialog_position $dlg $width $len
	tkwait variable st_dlg_button
	destroy $dlg
	return $st_dlg_button
}

proc license_check {}  \
{
	global ret_value env tcl_platform st_g

	#
	# Make user accept license if environment var not set
	#
	#puts "bkdir=($st_g(bkdir))"
	if {[info exists env(BK_LICENSE)] && \
	    [string compare $env(BK_LICENSE) "ACCEPTED"] == 0} {
		return
        } elseif {$tcl_platform(platform) == "windows"} {
		set bkaccepted [file join $st_g(bkdir) _bkaccepted]
		if {[file exists $bkaccepted]} {return}
	} elseif {[info exists env(HOME)]} {
		set bkaccepted [file join $st_g(bkdir) .bkaccepted]
		if {[file exists $bkaccepted]} {return}
	} else {
		puts "Error: HOME not defined"
	}
	catch {wm iconify .} err
	# open modal dialogue box
	dialog .lic "License" 1
	frame .lic.t -bd 2 -relief raised
	    label .lic.t.lbl -text "License Agreement"
	    text .lic.t.text \
		-yscrollcommand { .lic.t.text.scrl set } \
		-xscrollcommand { .lic.t.text.scrl_h set } \
		-height 24 -width 80 -wrap none
	    scrollbar .lic.t.text.scrl -command ".lic.t.text yview"
	    scrollbar .lic.t.text.scrl_h -command ".lic.t.text xview" \
		-orient horizontal
	set fid [open "|bk help -p bkl" "r"]

	#while { [ gets $fid line ] != -1 } {
	#	.lic.t.text insert end $line
	#}
	.lic.t.text delete 1.0 end
	while { ! [ eof $fid ]} {
		.lic.t.text insert end [ read $fid 1000 ]
	}
	catch { close $fid }
	pack .lic.t.lbl -side top 
	pack .lic.t.text -side bottom -fill both -expand 1 
	    pack .lic.t.text.scrl -side right -fill y 
	    pack .lic.t.text.scrl_h -side bottom -fill x
	pack .lic.t -fill both -expand 1 
	dialog_bottom .lic Agree "Don't Agree"
	set rc [ dialog_wait .lic 600 480 ]
	if {$rc == 1} {
		displayMessage "License Not Accepted"
		exit 1
	}
	if {[info exist bkaccepted]} {
		#puts "exist bkaccepted"
		if {[catch {open $bkaccepted w} fid]} {
			puts "Cannot open $bkaccepted"
		} else {
			#puts "touching .bkaccepted"
			puts $fid "ACCEPTED"
			catch { close $fid }
	    	}
	}
	catch {wm deiconify .} err
	return 0
}

# update the entry widgets
proc update_info {field value} \
{
	global w
}

proc read_bkrc {config} \
{
	global env st_cinfo debug st_g w gc

	set fid [open $config "r"]
	while { [ gets $fid line ] != -1 } {
		if {[regexp -- {^ *#} $line d]} {continue}
		if {[regexp -- {^ *$} $line d]} {continue}
		set col [string first ":" $line ]
		set key [string range $line 0 [expr {$col - 1}]]
		set val [string range $line [expr {$col + 1}] \
		     [string length $line]]
	        set val [string trim $val]
		# Make sure we use argv[1] for the repo name if set
		if {$key == "repository"} {
			if {$st_cinfo(repository) == ""} {
				set st_cinfo(repository) "$val"
			}
		} else {
			set st_cinfo($key) $val
		}
		#puts "key=($key) val=($val)"
		if {($key == "category") && ($val != "")} {
			$gc(catmenu).menu invoke "$val"
		}
		update_info $key $val
	}
	if {$debug} {
		foreach el [lsort [array names st_cinfo]] {
			puts "$el = $st_cinfo($el)"
		}
    	}
	check_config
}

# Generate etc/config file and then create the repository
proc create_repo {} \
{
	global st_cinfo env st_repo_name tmp_dir debug st_g opts

	wm withdraw .
	# Create a temp config file from user-entered data 
	set pid [pid]
	set cfile [file join $tmp_dir "config.$pid"]
	set cfid [open "$cfile" w]
	foreach el $st_g(topics) {
		puts $cfid "${el}: $st_cinfo($el)"
		if {$debug} { puts "${el}: $st_cinfo($el)" }
	}
	catch { close $cfid }
	set repo $st_cinfo(repository)
	if {$opts(dir_override) == 1} {
		catch { exec bk setup -a -e -f -c$cfile $repo } msg
	} else {
		catch { exec bk setup -a -f -c$cfile $repo } msg
	}
	if {$msg != ""} {
		displayMessage "Repository creation failed: $msg"
		exit 1
	}
	catch {file delete $cfile}
	return 0
}

# Read previous values for config info from resource file
proc get_config_info {} \
{
	global env st_cinfo st_g

	if {[info exists st_g(bktemplate)] && ($st_g(bktemplate) != "")} {
		read_bkrc $st_g(bktemplate)
	} else {
		#puts "didn't find template file"
	}
	return 1
}

#
# Used to ensure that the mandatory fields have text. 
# TODO: Check validity of entries as much as possible
#       Get rid of sequence of if/then and make into loop so we can
#          easily handle many entry boxes
#
proc check_config {} \
{
        global st_cinfo w

	set repo 0; set log 0; set cat 0; set desc 0

        if {[info exists st_cinfo(repository)] && 
	    ($st_cinfo(repository) != "")} {
                #puts "repository: $st_cinfo(repository)"
                set repo 1
        } else {
                set repo 0
        }
        if {[info exists st_cinfo(logging)] && ($st_cinfo(logging) != "")} {
                #puts "logging: $st_cinfo(logging)"
                set log 1
        } else {
                set log 0
        }
        if {[info exists st_cinfo(email)] && ($st_cinfo(email) != "")} {
                #puts "email: $st_cinfo(email)"
                set email 1
        } else {
                set email 0
        }
        if {[info exists st_cinfo(description)] && 
	    ($st_cinfo(description) != "")} {
                #puts "descripton: $st_cinfo(description)"
                set desc 1
        } else {
                set desc 0
        }
        if {[info exists st_cinfo(category)]} {
	    if {($st_cinfo(category) != "") && 
	        ($st_cinfo(category) != "Please Select a Category")} {
			#puts "category: $st_cinfo(category)"
                	set cat 1
		}
        } else {
                set cat 0
        }
        if {($repo == 1) && ($log == 1) && ($desc == 1) && ($cat == 1) &&
	    ($email == 1)} {
                $w(create) configure -state normal
        } else {
                $w(create) configure -state disabled
        }
}

# Set the color and text for the pulldown when it is selected
#
proc setCat {cat} \
{
	global gc st_cinfo

	$gc(catmenu) configure \
	    -text $cat \
	    -bg $gc(setup.BG)
	set st_cinfo(category) "$cat"
	check_config
	return
	
}

# Create the hierarchical menus that are from the redhat rpm list
proc createCatMenu {w} \
{
	global gc

	set gc(catmenu) $w

	menubutton $gc(catmenu) \
	    -font $gc(setup.fixedFont) \
	    -relief raised \
	    -bg $gc(setup.BG) \
	    -text "Please Select a Category" \
	    -width 28 \
	    -state normal \
	    -menu $gc(catmenu).menu 
	set cmenu [menu $gc(catmenu).menu]

	set fid [open "|bk getmsg setup_categories" "r"]
	while {[gets $fid c] != -1} {
		$cmenu add command -label $c \
		    -command "setCat [list $c]"
	}
	catch { close $fid } err
}

proc create_config {widget} \
{
	global st_cinfo st_g rootDir st_dlg_button logo w
	global gc tcl_platform opts

	catch {exec bk bin} bin
	set logo [file join $bin "bklogo.gif"]
	if {[file exists $logo]} {
		#set bklogo [image create photo -file $logo]
		image create photo bklogo -file $logo
	}
	set swidth [winfo screenwidth .]
	set sheight [winfo screenheight .]
	set x [expr {($swidth/2) - 100}]
	set y [expr {($sheight/2) - 100}]
	#puts "y=($y) x=($x) sw=($swidth) sh=($sheight)"

        getConfig "setup"

	wm geometry . +10+10; # Fix and make a configurable option

	set st_cinfo(logging) "logging@openlogging.org"
	set st_cinfo(compression) "gzip"

	set w(main)      $widget
	set w(buttonbar) $w(main).t.bb
	set w(create)    $w(main).t.bb.b1
	set w(quit)      $w(main).t.bb.b2
	set w(logo)      $w(main).t.bb.l
	set w(label)     $w(main).t.l
	set w(help)      $w(main).t.t.t
	set w(info)      $w(main).t.info
	set w(msg)       $w(main).t.info.msg

	frame $w(main) -bg $gc(setup.BG)
	    frame $w(main).t -bd 2 -relief raised -bg $gc(setup.BG)
		label $w(main).t.label \
		    -text "Configuration Info" \
		    -bg $gc(setup.BG)
		frame $w(label) -bg $gc(setup.BG)
		frame $w(info) -bg $gc(setup.BG)
		    message $w(msg) \
			-width 200 \
			-bg $gc(setup.mandatoryColor) \
			-text "The items highlighted in blue on the right are \
			    required fields"
		    pack $w(msg) -side bottom  -pady 10
		# create button bar at the bottom of the app
		frame $w(buttonbar) -bg $gc(setup.BG)
		    button $w(create) \
			-text "Create Repository" \
			-bg $gc(setup.BG) \
			-state disabled \
			-command "global st_dlg_button; set st_dlg_button 0"
		    pack $w(create) -side left -expand 1 -padx 20 -pady 10
		    label $w(logo) -image bklogo
		    pack $w(logo) -side left -expand 1 -padx 20 -pady 10
		    button $w(quit) \
			-text "Quit" \
			-bg $gc(setup.BG) \
			-command "global st_dlg_button; set st_dlg_button 1"
		    pack $w(quit) -side left -expand 1 -padx 20 -pady 10
	# text widget to contain help about config options
	frame $w(main).t.t -bg $gc(setup.BG)
	    text $w(help) \
		-width 80 \
		-height 5 \
		-wrap word \
		-background $gc(setup.mandatoryColor) \
		-yscrollcommand " $w(main).t.t.scrl set " 
	    scrollbar $w(main).t.t.scrl \
		-bg $gc(setup.BG) \
		-command "$w(help) yview"
	pack $w(help) -fill both -side left -expand 1
        pack $w(main).t.t.scrl -side left -fill both
	pack $w(buttonbar) -side bottom  -fill x -expand 1
	pack $w(main).t.t -side bottom -fill both -expand 1
	pack $w(label) -side right -fill both -ipadx 5
	pack $w(info) -side right -fill both -expand yes -ipady 10 -ipadx 10

	foreach desc $st_g(topics) {
		    #puts "desc: ($desc) desc: ($desc)"
		    label $w(label).l_$desc \
			-text "$desc" \
			-justify right \
			-bg $gc(setup.BG) \
			-font $gc(setup.buttonFont)
		    if {$desc == "category"} {
			    createCatMenu $w(label).e_$desc
		    } else {
			    entry $w(label).e_$desc \
				-width 30 -relief sunken \
				-bd 2 -bg $gc(setup.BG) \
				-textvariable st_cinfo($desc) \
				-font $gc(fixedFont)
		    }
		    grid $w(label).l_$desc $w(label).e_$desc
		    grid $w(label).l_$desc -sticky e -padx 3
		    grid $w(label).e_$desc -sticky ns -pady 2
		    bind $w(label).e_$desc <FocusIn> "
			$w(help) configure -state normal;\
			$w(help) delete 1.0 end;\
			$w(help) insert insert \$st_g($desc);\
			$w(help) configure -state disabled"
	}

	if {$opts(force_repo) == 1} {
		$w(label).e_repository config -state disabled
	}
	# Highlight mandatory fields
	$w(label).e_repository config -bg $gc(setup.mandatoryColor)
	$w(label).e_description config -bg $gc(setup.mandatoryColor)
	$w(label).e_logging config -bg $gc(setup.mandatoryColor)
	$w(label).e_email config -bg $gc(setup.mandatoryColor)
	$w(label).e_category config -bg $gc(setup.mandatoryColor)

	bind $w(label).e_repository <KeyRelease> {
		check_config
	}
	bind $w(label).e_category <ButtonRelease> {
		check_config
	}
	bind $w(label).e_description <KeyRelease> {
		check_config
	}
	bind $w(label).e_email <KeyRelease> {
		check_config
	}
	bind $w(label).e_logging <KeyRelease> {
		check_config
	}
	bind $w(label).e_repository <FocusIn> {
		check_config
	}
	$w(main).t config -background black
	bind Text <Tab> { continue }
	bind Text <Shift-Tab> { continue }
	bind $w(label) <Tab> {tk_focusNext %W}
	bind $w(label) <Shift-Tab> {tk_focusPrev %W}
	bind $w(label) <Control-n> {tk_focusNext %W}
	bind $w(label) <Control-p> {tk_focusPrev %W}
	focus $w(label).e_repository
	pack $w(main).t
	pack $w(main)
	wm protocol . WM_DELETE_WINDOW "handle_close ."

	return 0
}

proc setbkdir {} \
{
	global st_g tcl_platform env errorCode

	set HKCU "HKEY_CURRENT_USER"
	set HKLM "HKEY_LOCAL_MACHINE"
	set l {Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders}
	set tfile "/etc/BitKeeper/etc/config.template"
	set errorCode [list]

        if {$tcl_platform(platform) == "windows"} {
		package require registry
		catch {set appdir [registry get "$HKLM\\$l" {Common AppData}]}
		if {$errorCode ==  {} } {
			set ct [file join $appdir BitKeeper etc config.template]
			if {[file exists $ct]} {
				set st_g(bktemplate) $ct
			}
		}
		set appdir [registry get "$HKCU\\$l" {AppData}]
		set st_g(bkdir) [file join $appdir BitKeeper]
		if {![file isdirectory $st_g(bkdir)]} {
			catch {file mkdir $st_g(bkdir)} err
		}
	} elseif {$tcl_platform(platform) == "unix"} {
		if {[file exists $tfile]} {
			set st_g(bktemplate) $tfile
		}
		if {[info exists env(HOME)]} {
			set st_g(bkdir) $env(HOME)
		}
	} else {
		displayMessage "HOME environment variable not set"
		exit 1
	}
}

#
# Reads the bkhelp.doc file to generate a list of entries to be used in
# the /etc/config file. Also, use bk gethelp on this list of entries to
# get the help text which will be shown in the bottom panel of setuptool
#
proc getMessages {} \
{
	global st_g

	set st_g(topics) "repository"
	set st_g(repository) "Repository name"

	set fid [open "|bk getmsg config_template" "r"]
	while {[gets $fid topic] != -1} {
		set found 0
		set cfg_topic ""
		set topic [string trim $topic]
		lappend st_g(topics) $topic 
		append cfg_topic "config_" $topic
		set hfid [open "|bk getmsg $cfg_topic" "r"]
		while {[gets $hfid help] != -1} {
			set found 1
			#puts "$topic: $help"
			append st_g($topic) $help " "
		}
		if {$found == 0} {
			#puts "topic not found: $topic"
			set st_g($topic) ""
		}	
	}
	catch { close $fid }
	catch { close $hfid }
}

proc main {} \
{
	global env argc argv st_repo_name st_dlg_button st_cinfo st_g w
	global gc opts

	setbkdir
	license_check
	getMessages

	set repo ""
	set opts(dir_override) 0
	set opts(force_repo) 0
	set argindex 0
	set fnum 0

	wm withdraw .

	# Override the repo name found in the template file if argc is set
	while {$argindex < $argc} {
	    set arg [lindex $argv $argindex]
	    switch -regexp -- $arg {
		"^-e" {
		    set opts(dir_override) 1
		}
		"^-F" {
		    set opts(force_repo) 1
		}
		default {
		    incr fnum
		    set repo $arg
		}
	    }
	    incr argindex
	}
	set arg [lindex $argv $argindex]
	if {$fnum > 1} {
		displayMessage "Wrong number of arguments. If the repository
name contains spaces, please put the name in quotes.\nFor example:\n\tbk setuptool \"test repo\""
		exit
	}
	if {($opts(force_repo) == 1) && ($repo == "")} {
		displayMessage \
		    "A repo name is required if you use the -F option"
		exit
	}

	if {$repo != ""} {
		set st_cinfo(repository) $repo
	} else {
		set st_cinfo(repository) ""
	}
	wm deiconify .

	create_config .c
	get_config_info

	tkwait variable st_dlg_button
	if {$st_dlg_button != 0} {
		puts "Cancelling creation of repository"
		exit
	}
	if {[create_repo] == 0} {
		destroy $w(main)
		tk_messageBox -title "Repository Created" \
		    -type ok -icon info \
		    -message "$st_cinfo(repository) repository created"
		exit
	} else {
		destroy $w(main)
		displayMessage "Failed to create repository"
	}
}

bk_init
main
