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

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

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

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

	set sdiffw [list "bk" "ndiff" "--sdiff=1" "--ignore-trailing-cr"]
	set dev_null "/dev/null"
	set wish "wish"
	set tmp_dir  "/tmp"
	if {[info exists env(TMPDIR)] && [file writable $env(TMPDIR)]} {
		set tmp_dir $env(TMPDIR)
	}
	set keytmp "/var/bitkeeper"

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

	set file_start_stop {(.*)@(.*)\.\.(.*)}
	set file_stop {(.*)@([0-9.]+$)}
	set file_rev {(.*)@([0-9].*)}
	set env(BK_GUI) "YES"
	catch { unset env(BK_NO_GUI_PROMPT) }

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


# This script expects a complete installation in pwd.
#

catch {wm withdraw .}

proc main {} \
{
	global	argv runtime fixedFont

	bk_init
	initGlobals

	set runtime(installed) 0
	if {[set x [lsearch -exact $argv "--installed"]] > -1} {
	    set runtime(installed) 1
	    set argv [lreplace $argv $x $x]
	}

	if {[llength $argv] == 1} {
		set runtime(destination) [lindex $argv 0]
	} elseif {[llength $argv] > 1} {
		usage
		exit 1
	}

	widgets
	if {[file exists bitkeeper/gui/images/bk.ico]} {
		catch {wm iconbitmap . bitkeeper/gui/images/bk.ico}
	}

	set fixedFont TkFixedFont
	option add *font TkDefaultFont
	if {[tk windowingsystem] eq "x11"} {
	    font configure TkDefaultFont -size -14
	}

	set w 600
	set h 400
	centerWindow . $w $h
	wm geometry  . ${w}x${h}

	. configure -step Welcome
	. show
	wm deiconify .

	# ::done is set by the wizard code when the user presses
	# done or cancel...
	vwait ::done
	exit $::done
}

proc initGlobals {} \
{
	global runtime wizData tcl_platform

	set runtime(tmpdir) [pwd]
	set runtime(destination) ""
        set runtime(register_email) ""
	set runtime(upgradeCheckbutton) 0
	if {$tcl_platform(platform) == "windows"} {
#		set runtime(enableSccDLL) 1
		if {$::tcl_platform(osVersion) < 5.1} {
			set runtime(shellxCheckbutton) 0
			set runtime(enableShellxLocal) 0
		} else {
			set runtime(shellxCheckbutton) 1
			set runtime(enableShellxLocal) 1
		}
		set key {HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft}
		append key {\Windows\CurrentVersion}
		if {[catch {package require registry}]} {
			puts "ERROR: Could not find registry package"
		}
		if {[catch {set pf [registry get $key ProgramFilesDir]}]} {
			puts "Can't read $key"
			set pf {C:\Program Files}
		}
		set runtime(places) \
		    [list [normalize [file join $pf BitKeeper]]]
		set runtime(symlinkDir) ""
		set id "./gnu/id"
	} else {
#		set runtime(enableSccDLL) 0
		set runtime(enableShellxLocal) 0
		set runtime(symlinkDir) "/usr/bin"
		set runtime(places) {
			/usr/local/bitkeeper 
			/opt/bitkeeper 
			/usr/libexec/bitkeeper
		}
		set id "id"
	}
	if {[catch {exec $id -un} ::runtime(user)]} {
		set ::runtime(user) ""
	}

	if {$::runtime(user) ne "root"} {
		set home [homedir]
		if {[file exists $home]} {
			lappend ::runtime(places) \
			    [normalize [file join $home bitkeeper]]
		}
	}

	set oldinstall [findOldInstall]
	if {$oldinstall ne ""} {
		set i [lsearch -exact $runtime(places) $oldinstall]
		if {$i == -1} {
			set runtime(places) \
			    [linsert $runtime(places) 0 $oldinstall]
			set i 0
		}
	} else {
		set i 0
	}
	set ::runtime(destination) [lindex $runtime(places) $i]
	if {$tcl_platform(platform) eq "windows"} {
		set ::runtime(hasWinAdminPrivs) [hasWinAdminPrivs]
	} else {
		set ::runtime(hasWinAdminPrivs) 0
	}
}

proc hasWinAdminPrivs {} \
{
	global	tcl_platform

	set key "HKEY_LOCAL_MACHINE\\System\\CurrentControlSet"
	append key "\\Control\\Session Manager\\Environment"

	if {[catch {set type [registry type $key Path]}]} {
		return 0
	}

	if {[catch {set path [registry get $key Path]}]} {
		return 0
	}

	# if this fails, it's almost certainly because the
	# user doesn't have admin privs.
	if {[catch {registry set $key Path $path $type}]} {
		return 0
	} else {
		return 1
	}
}

# this is where the actual install takes place
proc install {} \
{
	global tcl_platform runtime

	set installfrom [pwd]

	set command [list doCommand bk _install -vf]
	if {$runtime(hasWinAdminPrivs)} {
#		if {$runtime(enableSccDLL)}	   {lappend command -s}
		if {$runtime(enableShellxLocal)}   {lappend command -l}
	}
	if {$runtime(doSymlinks)} {lappend command -S}

	# destination must be normalized, otherwise we run into a 
	# bug in the msys shell where mkdir -p won't work with 
	# DOS-style (backward-slash) filenames.
	lappend command [file normalize $runtime(destination)]
	set err [catch $command result]

	if {$err == 0} {
		set newbk [file join $runtime(destination) bk]
		set version [string trim [doCommand -nolog $newbk version]]
		set m [string trim $::strings(InstallComplete)]
		set m [string map [list %v $version] $m]
		log "\n$m\n"
	} else {
		log $result error
	}
}

proc finish {} {
        if {$::runtime(register_email) ne ""} {
                set fp [file tempfile temp_file]
                puts $fp [exec bk version]
                close $fp

                set to install@bitkeeper.com
                set email $::runtime(register_email)
                set subject "$email wants to make BitKeeper awesome"
                set url http://bitmover.com/cgi-bin/bkdmail

                catch {
                    exec bk mail -u $url -s $subject $to < $temp_file
                }
        }
        set ::done 0
}

proc findOldInstall {} \
{

	global env
	set oldinstall ""
	set PATH $env(PATH)
	if {[info exists env(_BK_ITOOL_OPATH)]} {
		set env(PATH) $env(_BK_ITOOL_OPATH)
	}
	set pwd [pwd] ;# too bad tcl's cd doesn't have a "cd -" equivalent
	cd /
	if {![catch {exec bk bin} result]} {
		set oldinstall [normalize $result]
	}
	cd $pwd
	set env(PATH) $PATH
	return $oldinstall
}

# normalize is required to convert relative paths to absolute and
# to convert short names (eg: c:/progra~1) into long names (eg:
# c:/Program Files). nativename is required to give the actual,
# honest-to-goodness filename (read: backslashes instead of forward
# slashes on windows)
proc normalize {dir} \
{
	return [file nativename [file normalize $dir]]
}

proc homedir {} \
{
	if {[info exists ::env(HOME)]} {
		return $::env(HOME)
	} else {
		return [normalize ~]
	}
}


# This not only sets the focus, but attempts to put the cursor in
# the right place
proc focusEntry {w} \
{
	catch {
		$w selection range 0 end
		$w icursor end
		focus $w
	}
}

# Insert a step right after the current step
# Side Effect: The global variable paths is modified with the 
# new path
proc wizInsertStep {step} \
{
	global paths

	set curPath [. configure -path]
	set curStep [. configure -step]
	if {![info exists paths($curPath)]} {
		return -code error "paths($curPath) doesn't exist"
	}
	set i [lsearch -exact $paths($curPath) $curStep]
	incr i

	# Bail if the step was already in the path as the next step
	if {[lindex $paths($curPath) $i] eq $step} {return}

	# I don't know how to modify a path, so I just add a new one
	set newpath "${curPath}_${step}"
	set paths($newpath) [linsert $paths($curPath) $i $step]
	. add path $newpath -steps $paths($newpath)
	. configure -path $newpath
}

proc widgets {} \
{
	global tcl_platform
	global	paths runtime

	option add *Entry*BorderWidth            1 startupFile
	option add *WizSeparator*stripe          #00008b startupFile

	::tkwizard::tkwizard . \
	    -title "BK Installation Assistant" \
	    -sequential 1 \
	    -icon bklogo

	. buttonconfigure finish -text "Done"

	if {$runtime(installed)} {
		set paths(new) {SummaryInstalled}
		. add path new -steps $paths(new)
	} elseif {$tcl_platform(platform) eq "windows"} {
		set paths(new) {Welcome PickPlace InstallDLLs Install Summary
                    SummaryInstalled}
		. add path new -steps $paths(new)
		set paths(existing) {Welcome PickPlace OverWrite InstallDLLs
                    Install Summary SummaryInstalled}
		. add path existing -steps $paths(existing)
		set paths(createDir) {Welcome PickPlace CreateDir InstallDLLs
                    Install Summary SummaryInstalled}
		. add path createDir -steps $paths(createDir)
	} else {
		set paths(new) {Welcome PickPlace Install Summary
                    SummaryInstalled}
		. add path new -steps $paths(new)
		set paths(existing) {Welcome PickPlace OverWrite Install
                    Summary SummaryInstalled}
		. add path existing -steps $paths(existing)
		set paths(createDir) {Welcome PickPlace CreateDir Install
                    Summary SummaryInstalled}
		. add path createDir -steps $paths(createDir)
	}
	. configure -path new

	#-----------------------------------------------------------------------
	. add step Welcome \
	    -title "Welcome" \
	    -body {
		    global tcl_platform

		    # this needs to be dynamic since part of the string
		    # depends on a variable
		    set map [list \
				 %D $::runtime(destination) \
				 %B $::runtime(symlinkDir)\
				]

		    set p $tcl_platform(platform)
		    if {$::runtime(installed)} { set p "installed" }
		    set d [string map $map $::strings(Welcome.$p)]
		    $this stepconfigure Welcome -description [unwrap $d]
	    }

	#-----------------------------------------------------------------------
	. add step PickPlace -title "Install Directory" 

	. stepconfigure PickPlace -body {
		global widgets tcl_platform

		set w [$this info workarea]

		set p $tcl_platform(platform)
		$this stepconfigure PickPlace \
		    -description [unwrap $::strings(PickPlace.$p)]
		if {![info exists ::runtime(destinationRB)]} {
			set ::runtime(destinationRB) $::runtime(destination)
		}

		ttk::label $w.label -text "Installation Directory:"
		grid $w.label -row 0 -column 0 -columnspan 2 -sticky w

		# determine how much space the radiobutton takes up so 
		# we can indent the entry widget appropriately. This 
		# widget needs to use all the same options as the 
		# ones that show up in the GUI or things won't quite line
		# up right...
		ttk::radiobutton $w.bogus -text ""
		set rbwidth [winfo reqwidth $w.bogus]
		destroy $w.bogus

		# this is a pain in the butt, but to get the proper 
		# alignment we need separate radiobuttons and labels
		set row 1
		foreach dir [linsert $::runtime(places) end ""] {
			if {$dir == ""} {
				set label "Other..."
			} else {
				set dir [normalize $dir]
				set label $dir
			}

			ttk::radiobutton $w.rb-$row \
			    -text $label \
			    -variable ::runtime(destinationRB) \
			    -value $dir \
			    -command [list setDestination $dir]

			grid $w.rb-$row -row $row -column 0 \
			    -sticky ew -padx 0 -ipadx 0 -columnspan 2

			grid rowconfigure $w $row -weight 0

			incr row
		}

                if {[llength $::runtime(places)] > 0} {
                        after idle [list focus $w.rb-1]
                }

		set ::widgets(destinationEntry) $w.destinationEntry
		set ::widgets(destinationButton) $w.destinationButton

		ttk::button $::widgets(destinationButton) \
		    -text "Browse..." \
		    -state disabled \
		    -command {
			    set f $::runtime(destination)
			    if {$f eq ""} {
				    catch {exec id -un} id
				    if {$id eq "root"} {
					    set f "/"
				    } else {
					    set f ~
				    }
			    }
				    
			    set tmp [tk_chooseDirectory -initialdir $f]
			    if {$tmp ne ""} {
				    set ::runtime(destination) $tmp
				    set ::runtime(destinationRB) ""
				    setDestination $tmp
			    }
		    }
		ttk::entry $widgets(destinationEntry) \
		    -state normal \
		    -textvariable ::runtime(destination)

		bind $widgets(destinationEntry) <Any-KeyPress> {
			set ::runtime(destinationRB) ""
			$widgets(dirStatus) configure -text ""
			. configure -state normal
		}

		grid $::widgets(destinationEntry) -row $row -column 1 \
		    -sticky ew 
		grid $::widgets(destinationButton) -row $row -column 2 -padx 2

		incr row
		set ::widgets(dirStatus) $w.dirStatus
		label $::widgets(dirStatus) -anchor w -foreground red
		grid $::widgets(dirStatus) -pady 10 -row $row -column 0 \
		    -columnspan 3 -sticky ew

		grid columnconfigure $w 0 -weight 0 -minsize $rbwidth
		grid columnconfigure $w 1 -weight 1
		grid columnconfigure $w 2 -weight 0
		
		# this invisible row takes up the vertical slack if the
		# user resizes..
		incr row
		grid rowconfigure $w $row -weight 1

		setDestination $::runtime(destinationRB)
	}
	
	#-----------------------------------------------------------------------
	. add step InstallDLLs \
	    -title "Install BitKeeper DLLs" \
	    -body {
		    set w [$this info workarea]
		    set bk [file join $::runtime(destination)/bk]

		    if {$runtime(hasWinAdminPrivs)} {
			    $this stepconfigure InstallDLLs \
				-description [unwrap $::strings(InstallDLLs)]
			    if {$runtime(shellxCheckbutton)} {
				    ttk::checkbutton $w.shellx-local \
					-text "Enable Windows Explorer\
					    integration (local drives only)" \
					-variable ::runtime(enableShellxLocal) \
					-onvalue 1 \
					-offvalue 0 
			    }
#			    ttk::checkbutton $w.bkscc \
#				-text "Enable Visual Studio integration" \
#				-variable ::runtime(enableSccDLL) \
#				-onvalue 1 \
#				-offvalue 0 

			    ttk::frame $w.spacer1 -height 8
			    pack $w.spacer1 -side top -fill x
#			    pack $w.bkscc -side top -fill x -anchor w
			    if {$runtime(shellxCheckbutton)} {
				    pack $w.shellx-local -side top -fill x \
					-anchor w
				    after idle [list focus $w.shellx-local]
			    }	
		    } else {
			    $this stepconfigure InstallDLLs -description \
				[unwrap $::strings(InstallDLLsNoAdmin)]
		    }
	    }

	#-----------------------------------------------------------------------
	. add step OverWrite \
	    -title "Existing Installation" \
	    -body {
		    set w [$this info workarea]
		    set bk [file join $::runtime(destination)/bk]
		    set map [list \
				 %D $::runtime(destination) \
				 %B $::runtime(symlinkDir)\
				]
		    lappend map %bk $bk

		    set d [string map $map $::strings(Overwrite)]
		    $this stepconfigure OverWrite -description [unwrap $d]

		    catch {exec $bk version} versionInfo
		    ttk::label $w.versionInfo -text $versionInfo
		    pack $w.versionInfo -side top -fill x -padx 32

		    set ::runtime(upgradeCheckbutton) 0
		    $this configure -state pending

		    ttk::checkbutton $w.overwrite \
			-text "Yes, remove the existing installation" \
			-variable ::runtime(upgradeCheckbutton) \
			-onvalue 1 \
			-offvalue 0 \
			-command {
				if {$::runtime(upgradeCheckbutton)} {
					. configure -state normal
				} else {
					. configure -state pending
				}
			}
                    after idle  [list focus $w.overwrite]

		    pack $w.overwrite -side top -fill x -anchor w -pady 16
	    }

	#-----------------------------------------------------------------------
	. add step Install \
	    -title "Install" \
	    -body {
		    $this configure -defaultbutton next
		    $this buttonconfigure next -text Install

		    grid columnconfigure $w 0 -weight 0
		    grid columnconfigure $w 1 -weight 1

		    # for substitutions...
		    set map [list \
				 %D $::runtime(destination) \
				 %B $::runtime(symlinkDir)\
				]
		    set d [string map $map $::strings(Install)]
		    $this stepconfigure Install -description [unwrap $d]

		    set row 0
		    if {![file exists $::runtime(destination)]} {
			    set d [string map $map $::strings(DirDoesntExist)]
			    label $w.icon1 \
				-bitmap warning \
				-width 32 \
				-height 32 \
				-background white \
				-borderwidth 2 \
				-relief groove \
				-anchor c
			    label $w.text1 \
				-text [unwrap $d] \
				-anchor nw \
				-justify l

			    grid $w.icon1 -row $row -column 0 -sticky n
			    grid $w.text1 -row $row -column 1 -sticky new
			    incr row
			    grid rowconfigure $w $row -minsize 8
			    incr row

			    bind $w.text1 <Configure> {
				    # N.B. the -10 is somewhat arbitrary 
				    # but gives a nice bit of padding
				    after idle {after 1 {
					    %W configure -wraplength \
						[expr {%w -10}]}}

			    }
		    }

		    # symlinkDir == "" on Windows so this is always false
		    if {[file writable $::runtime(symlinkDir)]} {
			    set runtime(doSymlinks) 1
		    } else {
			    set runtime(doSymlinks) 0
			    if {$::tcl_platform(platform) ne "windows"} {
				    set w [$this info workarea]
				    set d [string map $map $::strings(NoSymlinks)]

				    label $w.icon2 \
					-bitmap warning \
					-width 32 \
					-height 32 \
					-background white \
					-borderwidth 2 \
					-relief groove \
					-anchor c
				    label $w.text2 \
					-text [unwrap $d] \
					-anchor nw \
					-justify l

				    grid $w.icon2 -row $row -column 0 -sticky n
				    grid $w.text2 -row $row -column 1 \
					-sticky new

				    incr row
				    ttk::button $w.moreInfo \
					-text "More info..." \
					-command [list moreInfo symlinks]

				    grid $w.moreInfo -row $row -column 1 \
					-pady 12 -sticky w

				    # this causes the text label to
				    # wrap when the gui is resized
				    bind $w.text2 <Configure> {
					    # N.B. the -10 is somewhat
					    # arbitrary but gives a
					    # nice bit of padding
					    after idle {after 1 {
						    %W configure -wraplength \
							[expr {%w -10}]}}

				    }
			    }
		    }
		    
	    }

	#-----------------------------------------------------------------------
	. add step Summary \
	    -title "Installing..." \
	    -body {
		    $this buttonconfigure cancel -state disabled
	    }

	. stepconfigure Summary -body {
		global	fixedFont

		set w [$this info workarea]

		set ::widgets(log) $w.log
		text $w.log \
		    -font $fixedFont \
		    -wrap none \
		    -yscrollcommand [list $w.vsb set] \
		    -xscrollcommand [list $w.hsb set] \
		    -borderwidth 1 \
		    -background #ffffff \
		    -relief sunken
		ttk::scrollbar $w.vsb \
		    -orient vertical \
		    -command [list $w.log yview]
		ttk::scrollbar $w.hsb \
		    -orient horizontal \
		    -command [list $w.log xview]

		bind all <Next> "scroll $w.log 1 pages"
		bind all <Prior> "scroll $w.log -1 pages"
		bind all <Down> "scroll $w.log 1 units"
		bind all <Up> "scroll $w.log -1 units"
		bind all <MouseWheel> "
			if {%D < 0} {
				scroll $w.log +1 units
			} else {
				scroll $w.log -1 units
			}
		"

		$w.log tag configure error -foreground red
		$w.log tag configure skipped -foreground blue
		$w.log configure -state disabled

		pack $w.vsb -side right -fill y
		pack $w.log -side left -fill both -expand y

		. stepconfigure Summary -title "Installing.."
                $this configure -defaultbutton none

		doInstall

		if {$::runtime(installStatus) == 0} {
			. stepconfigure Summary -title "Installation Complete"
		} else {
			. stepconfigure Summary -title "Installation Error"
		}

		$this buttonconfigure cancel -state disabled
                $this configure -defaultbutton next
	}
	#-----------------------------------------------------------------------
	. add step SummaryInstalled \
	    -title "Setup Complete" \
	    -body {
		    set desc [unwrap $::strings(SummaryInstalled)]
		    $this stepconfigure SummaryInstalled -description $desc
		    $this buttonconfigure cancel -state disabled
		    $this configure -defaultbutton finish

                    set w [$this info workarea]
                    grid columnconfigure $w 0 -weight 1

                    ttk::label $w.label -text "Your Email Address"
                    grid $w.label -row 0 -column 0 -sticky w

                    set ::runtime(register_email) ""
                    ttk::entry $w.email -textvariable ::runtime(register_email)
                    grid $w.email -row 1 -column 0 -sticky ew
                    focus $w.email
	    }

	bind . <<WizCancel>> {set ::done 1}
	bind . <<WizFinish>> {finish}

	bind . <<WizBackStep>> {
		# this button may have been reconfigured to say "Install"..
		%W buttonconfigure next -text "Next >"

		# this one may have been disabled (Summary step does this...)
		%W buttonconfigure cancel -state normal
	}

	bind . <<WizNextStep>> {
		# this button may have been reconfigured to say "Install"..
		%W buttonconfigure next -text "Next >"

		switch -exact -- [. cget -step] {
			PickPlace {
				set ::runtime(destination) \
				    [string trim $::runtime(destination)]

				if {$::runtime(destination) eq ""} {
					bell
					break
				}

				if {[file exists $::runtime(destination)]} {
					set result [validateDestination]
					$widgets(dirStatus) configure \
					    -text $result \
					    -foreground red
					if {$result ne ""} {
						bell
						break
					}
				}
	
				if {[file exists $::runtime(destination)] && \
				    ![isempty $::runtime(destination)]} {
					. configure -path existing
				} else {
					. configure -path new
				}
			}
			Welcome {
			}
		}
	}
}

proc doInstall {} \
{
	global runtime widgets

	busy 1
	if {[catch {install} error]} {
		set ::runtime(installStatus) 1
		log $error
	} else {
		set ::runtime(installStatus) 0
	}

	busy 0
	return $::runtime(installStatus)
}

proc log {string {tag {}}} \
{
	set yview [$::widgets(log) yview]
	$::widgets(log) configure -state normal
	$::widgets(log) insert end $string $tag
	$::widgets(log) configure -state disabled
	# only scroll if the user hasn't manually scrolled
	if {[lindex $yview 1] >= 1} {
		$::widgets(log) see end-1c
	}
}

proc scroll {w args} \
{
        if {![winfo exists $w]} { return }
        $w yview scroll {*}$args
}

proc busy {on} \
{
	global widgets

	if {$on} {
		# the log widget has to be set separately because it
		# doesn't share the same cursor as "." since it's a 
		# text widget
		. configure -state busy
		$widgets(log) configure -cursor watch
	} else {
		. configure -state normal
		if {[tk windowingsystem] eq "x11"} {
			$widgets(log) configure -cursor {}
		} else {
			$widgets(log) configure -cursor arrow
		}

	}
	update
}

# this is a cross between exec and our own bgexec; it runs a command
# in a pipe with a fileevent so the GUI doesn't hang while the 
# external process is running. Plus, if the command spews out data
# we can see it as it gets generated (try setting the environment
# variable BK_DEBUG to get a bunch of output from the installer)
proc doCommand {args} \
{
	global pipeOutput errorCode strings

	if {[lindex $args 0] eq "-nolog"} {
		set args [lrange $args 1 end]
		set log 0
	} else {
		set log 1
	}
	
	lappend args |& cat
	set pipeOutput ""
	set ::DONE 0
	set p [open "|$args"]
	fconfigure $p -blocking false
	fileevent $p readable [list readPipe $p $log]

	# This variable is set by readPipe when we get EOF on the pipe
	vwait ::DONE

	# uninstall failed. Sucks to be the user.
        if {$::DONE == 3} {
		tk_messageBox \
		    -icon error \
		    -message $strings(uninstall.failed)
		return -code error \
		    "uninstallation of previous version failed"
        }

	if {$::DONE == 2} {
		# exit immediately; system must reboot. If we don't
		# exit it can cause the reboot process to hang on 
		# Windows/Me
		exit 2
	}

	if {$::DONE != 0} {
		set error "unexpected error"
		if {[string length $pipeOutput] > 0} {
			append error ": $pipeOutput"
		}
		return -code error $error
	}

	return $pipeOutput
}

proc readPipe {pipe log} {
	global pipeOutput errorCode

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

	if {$status == 0 && $result >= 0} {
		# successfully read the channel
		if {$log} {
			log "$line\n"
		} else {
			append pipeOutput "$line\n"
		}
	} elseif {$status == 0 && [fblocked $pipe]} {
		# read blocked; do nothing
	} else {
		# either EOF or an error on the channel. Shut 'er down, boys!
		fconfigure $pipe -blocking true
		set errorCode [list NONE]
		catch {close $pipe} result
		if {[info exists errorCode] && 
		    [lindex $errorCode 0] == "CHILDSTATUS"} {
			set ::DONE [lindex $::errorCode 2]
		} else {
			set ::DONE 0
		}
	}
}

proc setDestination {dir} \
{
	global widgets

	if {$dir eq ""} {
		$widgets(destinationButton) configure -state normal
		$::widgets(dirStatus) configure -text ""
		. configure -state pending

	} else {
		$widgets(destinationButton) configure -state disabled
		set ::runtime(destination) $dir

		if {[file exists $dir]} {
			set message [validateDestination]
			$::widgets(dirStatus) configure \
			    -text $message \
			    -foreground red
			if {[string length $message] == 0} {
				. configure -state normal
			} else {
				. configure -state pending
			}
		} else {
			. configure -state normal
			$::widgets(dirStatus) configure \
			    -text "Directory $dir doesn't exist" \
			    -foreground black
		}
		$widgets(destinationButton) configure -state normal
	}
}

proc isempty {dir} \
{
	if {[catch {set files [exec bk _find -type f $dir]} error]} {
		# bk _find will fail if we don't have access to the
		# directory, so assume the directory is non empty
		# and bail
		return 0
	}
	if {[string length $files] > 0} { return 0 }
	return 1
}

proc validateDestination {} \
{
	set dest $::runtime(destination)

	if {![file isdirectory $dest]} {
		return "\"$dest\" is not a directory"
	}

	# tcl's [file readable] can return 1 for a directory even
	# if it belongs to another user and we don't have permission to
	# see the contents. However, glob will fail with a specific message
	# in this case.
	if {[catch {glob [file join $dest *]} message] &&
	    [regexp -nocase {.*permission denied} $message]} {
		# must belong to another user if we can't peek
		return "Access to \"$dest\" is denied"
	}

	set bkhelp [file join $dest bkhelp.txt]
	if {[file exists $bkhelp]} { return "" }

	if {![isempty $dest]} {
		return "Will not overwrite non-empty directory \"$dest\""
	}

	if {![file writable $dest]} {
		return "Write permission for \"$dest\" is denied"
	}

	return ""
}

proc moreInfo {what} \
{
	if {![winfo exists .moreInfo]} {
		toplevel .moreInfo
		wm title .moreInfo "BK Install Assistant Help"
		label .moreInfo.label \
		    -wraplength 300 \
		    -justify l \
		    -background #ffffff \
		    -foreground #000000 \
		    -borderwidth 1 \
		    -relief sunken

		frame .moreInfo.separator \
		    -borderwidth 2 \
		    -height 2 \
		    -relief groove

		ttk::button .moreInfo.ok \
		    -text Ok \
		    -command "wm withdraw .moreInfo"

		pack .moreInfo.label -side top \
		    -fill both -expand y -padx 8 -pady 8 -ipadx 2 -ipady 2
		pack .moreInfo.separator -side top -fill x
		pack .moreInfo.ok -side bottom -expand y

	}

	.moreInfo.label configure \
	    -text [unwrap $::strings(MoreInfo,$what)]

	set x [expr {[winfo rootx .] + 50}]
	set y [expr {[winfo rooty .] + 50}]

	wm geometry .moreInfo +$x+$y
	wm deiconify .moreInfo
}

# this removes hardcoded newlines from paragraphs so that the paragraphs
# will wrap when placed in a widget that wraps (such as the description
# of a step). It also removes leading whitespace in front of each line.
proc unwrap {text} \
{
	set text [string map [list \n\n \001] [string trim $text]]

	set text [string trim $text]
	regsub -all {([\n\001])\s+} $text {\1} text

	# split on paragraph boundaries
	set newtext ""
	foreach p [split $text \001] {
		if {[string match ">*" $p]} {
			# if a paragraph begins with ">", it is a preformatted,
			# indented paragraph with no wrapping; we'll remove 
			# leading >'s and add indentation
			set indent [string repeat " " 4]
			set p [string map [list "\n" "\n$indent"] $p]
			set p "$indent[string range $p 1 end]"

		} else {
			set p [string map [list \n " "] $p]
		}
		lappend newtext $p
	}
	set text [join $newtext \n\n]

	return $text
}

proc usage {} \
{
	set image "\[installer\]"
	puts stderr "usage: $image ?directory?"
}

# these strings will be reformatted; the newlines and leading spaces
# will be collapsed to paraphaphs so they will wrap when the GUI is
# resized. The formatting here is just to make the code easier to
# read.
set strings(Welcome.windows) {
	Thank you for installing BitKeeper.  

	This installer will install BitKeeper in the location of your
	choosing.  We recommend that you choose to install the BitKeeper 
	binaries in a subdirectory named "bitkeeper" so that it is easy 
	to do a manual uninstall if you wish. 

	When you are ready to continue, press Next.
}

set strings(Welcome.unix) {
	Thank you for installing BitKeeper.  

	This installer will install BitKeeper in the location of your
	choosing.  We recommend that you choose to install the BitKeeper
	binaries in a subdirectory named "bitkeeper" so that it is easy to
	do a manual uninstall if you wish. The installer will also create
	some symlinks, if you are running with sufficient privileges,
	from %B to that directory to provide SCCS compatible
	interfaces for make, patch, emacs, etc.

	When you are ready to continue, press Next.
}

set strings(Welcome.installed) {
	Thank you for installing BitKeeper.

	When you are ready to continue, press Next.
}

set strings(PickPlace.unix) {
	The installation directory can be anywhere, 
	/usr/local/bitkeeper is recommended.  
}

set strings(PickPlace.windows) {
	The installation directory can be anywhere, 
	C:/Program Files/bitkeeper is recommended.  
}

set strings(Overwrite) {
	BitKeeper appears to already be installed in %D. 
	Please confirm the removal of the existing version before continuing.
}

set strings(InstallDLLsNoAdmin) {
	BitKeeper includes optional integration with Windows Explorer.

	You do not have sufficient privileges on this machine to install 
	these features. These features must be must be installed from a user 
	account that has Administrator privileges. 
}

set strings(InstallDLLs) {
	BitKeeper includes optional integration with Windows Explorer.
}

set strings(Install) {
	BitKeeper is ready to be installed.

        Installation Directory: %D
}

set strings(UnexpectedError) {
	An unexpected error has occured. Read the log for more information.
}

set strings(DirDoesntExist) {
	The directory %D doesn't exist. It will be created during install.
}

set strings(NoSymlinks) {
	You do not have write permission on %B so no links will be
	created there.  This will somewhat reduce the functionality
	of BitKeeper but can be corrected later if you wish.
}

set strings(MoreInfo,symlinks) {
	The  purpose  of the symbolic links is to provide compatible
	interfaces for those tools which understand the ATT SCCS
	system.  BitKeeper deliberately  chooses to  look  like
	SCCS so that programs such as make(1), patch(1), emacs(1),
	and others will automatically work with BitKeeper the
	same  way  they  worked with SCCS.  BitKeeper is not an
	SCCS based system, it just appears as such on the command
	line  for compatibility with existing applications.

	More info may be found by running "bk help links".
}

# these are not re-wrapped, so they need to be manually formatted
set strings(uninstall.failed) {
The uninstallation of the previous version of BitKeeper 
could not be completed. 

You may choose to install this version in another location
rather than in the same location as the previous install 
by using the back button.
}

set strings(InstallComplete) {
Installation is complete.

%v
}

set strings(SummaryInstalled) {
    BitKeeper setup is complete.

    Enjoy BitKeeper and send support@bitkeeper.com
    any questions. Don't forget to try the quick and informative
    demo at http://www.bitkeeper.com/Test.html

    Would you like to participate in helping make BitKeeper better?
    Register your email address with us to receive important updates.

    The BitKeeper Team
}
# Copyright (c) 2001, Bryan Oakley
# All Rights Reservered
#
# Bryan Oakley
# oakley@bardo.clearlight.com
#
# tkwizard 1.01
#
# this code is freely distributable without restriction, and is 
# provided as-is with no warranty expressed or implied. 
#
# Notes: 
#
# styles are used to define the overall organization. Most notably,
# the button placement. But styles could also add other areas to the
# wizard, too. 
#
# layouts are used to define the look of a particular step -- all the 
# stuff that is different for each step.
#
# this file is slightly modified from the version Bryan keeps on his
# external website. Primarily, it has been reformatted slightly (proc
# opening curly braces have been moved down a line. )

interp alias {} debug {} tk_messageBox -message

package require Tk 8.0
package provide tkwizard 1.00

# create the package namespace, and do some basic initialization
namespace eval ::tkwizard {

    variable initialized 0
    variable updateID    {}
    variable layoutData
    variable styleData 

    namespace export tkwizard
    
    set ns ::tkwizard

    # define class bindings
    bind Wizard <<WizNextStep>> [list ${ns}::handleEvent %W <<WizNextStep>>]
    bind Wizard <<WizBackStep>> [list ${ns}::handleEvent %W <<WizBackStep>>]
    bind Wizard <<WizCancel>>   [list ${ns}::handleEvent %W <<WizCancel>>]
    bind Wizard <<WizFinish>>   [list ${ns}::handleEvent %W <<WizFinish>>]
    bind Wizard <<WizSelectStep>> \
        [list ${ns}::handleEvent %W <<WizSelectStep>> %\#]
    
    # create a default image
    image create photo ::tkwizard::logo -data {
       R0lGODlhIAAgALMAANnZ2QAAwAAA/wBAwAAAAICAgAAAgGBggKCgpMDAwP//
       /////////////////////yH5BAEAAAAALAAAAAAgACAAAAT/EMhJq60hhHDv
       pVCQYohAIJBzFgpKoSAEAYcUIRAI5JSFlkJBCGLAMYYIIRAI5ASFFiqDgENK
       EUIwBAI5ywRlyhAEHFKKEEIgEMgJyiwUBAGHnCKEEAyBQM4yy5RhCDikFDBI
       SSCQExRKwxBDjAGHgEFKQyCQk9YgxBBjDAGDnAQCOWkNQgwxxDgwyGkIBHJS
       GoQQYohRYJDTEAjkpDWIIYQQBQY5A4FATlqDEEIMgWCQMxgCgZy0BiikRDDI
       GQyBQE5aAxRSIhjkNIRAICetAQop04BBTgOBnLTKIIQQacAgZzAQyEkrCEII
       kQYMckoDgZy0giCESAMGOaWBQMoydeeUQYhUYJBTGgikLHNOGYRACQY5pYFA
       yjLnnEGgNGCQMxgAACgFAjnpFEUNGOQ0BgI5Z6FUFlVgkJNAICctlMqiyggB
       BkMIBHLOUiidSUEiJwRyzlIopbJQSilFURJUIJCTVntlKhhjCwsEctJqr0wF
       Y0xhBAA7
    }

    # Make a class binding to do some housekeeping
    bind Wizard <Destroy> [list ${ns}::wizard-destroy %W]

    # add a few handy option db entries for some decorative frames
    option add *WizSeparator*BorderWidth        2 startupFile
    option add *WizSeparator*Relief        groove startupFile
    option add *WizSeparator*Height             2 startupFile

    option add *WizSpacer*Height                2 startupFile
    option add *WizSpacer*BorderWidth           0 startupFile
    option add *WizSpacer*Relief           groove startupFile
}

## 
# tkwizard
#
# usage: tkwizard pathName ?options?
#
# creates a tkwizard
#
proc ::tkwizard::tkwizard {name args} \
{

    set body {}

    # the argument -style is a create-time-only option. Thus, if it
    # appears in args we need to handle it specially.
    set i [lsearch -exact $args "-style"]
    if {$i >= 0} {

        set j [expr {$i + 1}]
        set style [lindex $args $j]
        set args [lreplace $args $i $j]
        init $name $style

    } else {
        init $name default
    }

    if {[catch "\$name configure $args" message]} {
        destroy $name
        return -code error $message
    }

    return $name
}

##
# info
#
# usage: tkwizard::info option
#
# option: 
#   layouts               returns the list of known layouts
#   layout <type> <name>  eg: info layout description Basic-1
#   styles                returns the list of known layouts
#   style <type> <name>   eg: info style description Basic-1

proc ::tkwizard::info {option args} \
{
    variable layoutData
    variable styleData

    switch -exact -- $option {

        layouts {
            set layouts {}
            foreach key [array names layoutData *,-description] {
                set name [lindex [split $key ,] 0]
                lappend layouts $name
            }
            return $layouts
        }

        layout {
            switch -exact -- [lindex $args 0] {
                "description" {
                    return $layoutData([lindex $args 1],-description)
                }
            }
        }

        styles {
            set styles {}
            foreach key [array names styleData *,-description] {
                set name [lindex [split $key ,] 0]
                lappend styles $name
            }
            return $styles
        }

        style {
            switch -exact -- [lindex $args 0] {
                "description" {
                    return $styleData([lindex $args 1],-description)
                }
            }
        }
    }
}

##
# wizard-destroy
#
# does cleanup of the wizard when it is destroyed. Specifically,
# it destroys the associated namespace and command alias
# 
proc ::tkwizard::wizard-destroy {name} \
{

    upvar #0 ::tkwizard::@$name-state wizState

    if {[::info exists wizState]} {

        set w $wizState(window)
        interp alias {} $wizState(alias) {}
        catch {namespace delete $wizState(namespace)} message
    }

    return ""
}


##
# wizProxy
#
# this is the procedure that represents the wizard object; each
# wizard will be aliased to this proc; the wizard name will be
# provided as the first argument (this is transparent to the caller)

proc ::tkwizard::wizProxy {name args} \
{

    # No args? Throw an error.
    if {[llength $args] == 0} {
        return -code error "wrong \# args: should be $name \"$option\" ?args?"
    }

    # The first argument is the widget subcommand. Make sure it's valid.
    set command [lindex $args 0]
    set commands [::info commands ::tkwizard::wizProxy-*]

    if {[lsearch -glob $commands *wizProxy-$command] == -1} {
        set allowable [list]
        foreach c [lsort $commands] {
            regexp {[^-]+-(.*)$} $c -> tmp
            lappend allowable $tmp
        }
        return -code error "bad option \"$command\":\
                            must be [join $allowable {, }]"
    }

    # Call the worker proc
    eval wizProxy-$command $name [lrange $args 1 end]
}

##
# wizProxy-cget 
#
# usage: pathName cget option
#
proc ::tkwizard::wizProxy-cget {name args} \
{
    upvar #0 ::tkwizard::@$name-config wizConfig

    # Check for valid number of arguments
    if {[llength $args] != 1} {
        return -code error "wrong \# args: should be \"$name cget option\""
    }

    # Fetch requested value
    set option [lindex $args 0]
    if {[::info exists wizConfig($option)]} {
        return $wizConfig($option)
    } 

    # Apparently the caller gave us an unknown option. So, we'll throw 
    # a pie in their face...
    return -code error "unknown option \"$option\""
}

##
# wizProxy-configure
#
# usage: pathName configure ?option? ?value option value ...?
#
proc ::tkwizard::wizProxy-configure {name args} \
{
    upvar #0 ::tkwizard::@$name-config wizConfig
    upvar #0 ::tkwizard::@$name-state  wizState

    # If we were given no arguments we must return all options. This
    # isn't fully functioning yet; but is good enough for the alpha
    # versions of the code
    if {[llength $args] == 0} {
        set result [list]
        foreach item [lsort [array names wizConfig]] {
            lappend result [list $item $wizConfig($item) [string trimleft $item -]]
        }
        return $result

    }

    # One argument is synonymous with the cget method
    if {[llength $args] == 1} {
        return [uplevel $name cget [lindex $args 0]]

    }
    
    # More than one argument means we have to set some values. 
    foreach {option value} $args {

        # First we'll do some validation
        if {![::info exists wizConfig($option)]} {
            return -code error "unknown option \"$option\""
        }

        # and one sanity check
        if {[string match $option* "-style"]} {
            return -code error "can't modify -style after widget is created"
        }

        # set the value; only do this if it has changed in case there
        # are triggers set on the variable
        if {"$wizConfig($option)" == "$value"} {
            continue
        }
        set wizConfig($option) $value

        # Some attributes require additional processing
        switch -exact -- $option {
	    -height -
	    -width {
		$wizConfig(toplevel) configure $option $value
	    }
            -background {
                $wizConfig(toplevel) configure -background $value
            }
            -title {
                # Set the wizard title
                wm title $name $value
            }
            -step {
                showStep $name $wizConfig(-path) $wizConfig(-step)
            }
            -defaultbutton -
            -icon -
            -sequential -
            -path {
                updateDisplay $name
            }
            -state {
                # The trailing "0" means "do this right now; don't wait
                # for an idle handler". We do this because the state 
                # change might require the setting of a cursor or
                # statusbar...
                updateDisplay $name 0
            }
        }
    }

    # generate an event so other interested parties
    # (eg: the layout and style code) can adjust their
    # colors accordingly
    event generate $name <<WizConfig>>

}

##
# wizProxy-default
#
# sets the default button and binds <Return> to invoke that button

proc ::tkwizard:wizProxy-default {name button} \
{

    if {[lsearch -exact {none next back cancel finish} $button] == -1} {
        return -code error "unknown button \"$button\": must be\
           one of back, cancel, finish, next or none"
    }

    eval ${name}::~style default $button

}

##
# wizProxy-hide
#
# usage: pathName hide
#
# Hides the wizard without destroying it. We do nothing with the
# state, but note that a subsequent 'show' will reset the state

proc ::tkwizard::wizProxy-hide {name args} \
{
    upvar #0 ::tkwizard::@$name-state wizState

    wm withdraw $wizState(window)
}

##
# wizProxy-add
# 
# usage: pathName add path name ?option value option value ...?
#        pathName add step name ?option value option value ...?
#
proc ::tkwizard::wizProxy-add {name type itemname args} \
{
   upvar #0 ::tkwizard::@$name-state wizState

   switch -- $type {
      "path" {
         if {[::info exists wizState(steps,$itemname)]} {
            return -code error "path \"$itemname\" already exists"
         }
         set wizState(steps,$itemname) [list]
         lappend wizState(paths) $itemname

          # If the caller provided additional arguments, pass them
          # to the pathconfigure method
         if {[llength $args] > 0} {
            eval wizProxy-pathconfigure \$name \$itemname $args
         }
      }

      "step" {
          eval newStep \$name \$itemname $args
      }
   }

   return $itemname
}

proc ::tkwizard::wizProxy-pathconfigure {name pathname args} \
{
   upvar #0 ::tkwizard::@$name-state wizState

   if {![::info exists wizState(steps,$pathname)]} {
      return -code error "path \"$pathname\" doesn't exist"
   }

   if {[llength $args] == 0} {
       return [list [list -steps $wizState(steps,$pathname)]]
   }

   if {[llength $args] == 1} {
       if {[equal [lindex $args 0] "-steps"]} {
         return $wizState(steps,$pathname)
      } else {
         return -code error "unknown option \"[lindex $args 0]\""
      }
   }

   foreach {name value} $args {
      switch -- $name {
         "-steps" {
            set wizState(steps,$pathname) $value
            updateDisplay $name
         }
         default {
            return -code error "unknown option \"$name\""
         }
      }
   }
}

proc ::tkwizard::wizProxy-delete {name type itemname} \
{
    upvar #0 ::tkwizard::@$name-state wizState

    switch -- $type {
	"path" {
	    if {![::info exists wizState(steps,$itemname)]} {
		return -code error "path \"$itemname\" doesn't exist"
	    }
	    unset wizState(steps,$itemname) 
	    set i [lsearch -exact $wizState(paths) $itemname]
	    if {$i >= 0} {
		# the above condition should always be true unless
		# our internal state gets corrupted.
		set wizState(paths) [lreplace $wizState(paths) $i $i]
	    }
	}
	"step" {
	    return -code error "not implemented yet"
	}
    }
    
}

##
# newStep
#
# implements the "step" method of the wizard object. The body
# argument is code that will be run when the step identified by
# 'stepName' is to be displayed in the wizard
#
# usage: wizHandle step stepName ?option value ...? 
# options: -description, -layout, -title, -icon, -body
#

proc ::tkwizard::newStep {name stepName args} \
{

    upvar #0 ::tkwizard::@$name-config     wizConfig
    upvar #0 ::tkwizard::@$name-state      wizState
    upvar #0 ::tkwizard::@$name-stepConfig stepConfig

    set stepConfig($stepName,-icon)         $wizConfig(-icon)
    set stepConfig($stepName,-description) ""
    set stepConfig($stepName,-layout)      default
    set stepConfig($stepName,-title)       $stepName
    set stepConfig($stepName,-body)        ""
        
    # Store the step options
    eval wizProxy-stepconfigure \$name \$stepName $args

    # wizState(steps) is the master list of steps
    lappend wizState(steps) $stepName

    # wizState(steps,Default) is the default path, and contains all
    # of the steps. It seems redundant to keep all steps in two places,
    # but it is possible for someone to redefine the steps in the Default
    # step, and we don't want that to affect the master list of steps
    lappend wizState(steps,Default) $stepName
}

# this code executes the body of a step in the appropriate context
proc ::tkwizard::initializeStep  {name stepName} \
{
    upvar #0 ::tkwizard::@$name-stepConfig stepConfig

    namespace eval ::tkwizard::${name} [list set this $name]
    namespace eval ::tkwizard::${name} $stepConfig($stepName,-body)
}

##
# wizProxy-widget
#
# Returns the path to an internal widget, or executes the
# an internal widget command
#
# usage: wizHandle widget widgetName ?args?
#
# if [llength $args] > 0 it will run the widget command with
# the args. Otherwise it will return the widget path

proc ::tkwizard::old-wizProxy-widget {name args} \
{
    upvar #0 ::tkwizard::@$name-state wizState

    if {[llength $args] == 0} {
        # return a list of all widget names
        set result [list]
        foreach item [array names wizState widget,*] {
            regsub {widget,} $item {} item
            lappend result $item
        }
        return $result
    }

    set widgetname [lindex $args 0]
    set args [lrange $args 1 end]

    if {![::info exists wizState(widget,$widgetname)]} {
        return -code error "unknown widget: \"$widgetname\""
    }

    if {[llength $args] == 0} {
        return $wizState(widget,$widgetname)
    }

    # execute the widget command
    eval [list $wizState(widget,$widgetname)] $args
}

##
# wizProxy-info
#
# Returns the information in the state array
# 
# usage: pathName info steps ?pattern?
#        pathName info paths ?pattern?
#        pathName info workarea
#        pathName info namespace
#
# pattern is a glob-style pattern; if not supplied, "*" is used

proc ::tkwizard::wizProxy-info {name args} \
{

    upvar #0 ::tkwizard::@$name-state  wizState
    upvar #0 ::tkwizard::@$name-widget wizWidget

    if {[llength $args] == 0} {
        return -code error "wrong \# args: should be \"$name info option\""
    }

    switch -exact -- [lindex $args 0] {
        paths {
            set result [list]
            set pattern "*"
            if {[llength $args] > 1} {set pattern [lindex $args 1]}
            foreach path $wizState(paths) {
                if {[string match $pattern $path]} {
                    lappend result $path
                }
            }
            return $result
        }

        steps {
            set result [list]
            set pattern "*"
            if {[llength $args] > 1} {set pattern [lindex $args 1]}
            foreach step $wizState(steps) {
                if {[string match $pattern $step]} {
                    lappend result $step
                }
            }
            return $result
        }

        workarea {
            return [${name}::~layout workarea]
        }

        namespace {
            set ns ::tkwizard::${name}
            return $ns
        }

        default {
            return -code error "bad option \"[lindex $args 0]\":\
                                should be workarea, paths or steps"
        }
    }
}

##
# wizProxy-eval 
#
# usage: pathName eval arg ?arg ...?
#
proc ::tkwizard::wizProxy-eval {name code} \
{
    set ns ::tkwizard::${name}
    namespace eval $ns $code
}
    
##
# wizProxy-show
# 
# Causes the wizard to be displayed in it's initial state
#
# usage: wizHandle show
#
# This is where all of the widgets are created, though eventually
# I'll probably move the widget drawing to a utility proc...
proc ::tkwizard::wizProxy-show {name args} \
{
    variable initialized

    upvar #0 ::tkwizard::@$name-state  wizState
    upvar #0 ::tkwizard::@$name-config wizConfig
    upvar #0 ::tkwizard::@$name-widget wizWidget

    # reset the wizard state
    set wizState(history)         [list]

    set currentPath $wizConfig(-path)
    set steps $wizState(steps,$currentPath)
    set firstStep [lindex $steps 0]
    if {[llength $steps] == 0} {
        # no steps? Just show it as-is.
        wm deiconify $name
        return
    }

    set initialized 1

    # show the first step
    showStep $name $currentPath $firstStep

    # make it so, Number One
    wm deiconify $wizState(window)

    # This makes sure closing the window with the window manager control
    # Does The Right Thing (I *think* this is what The Right Thing is...)
    wm protocol $name WM_DELETE_WINDOW \
        [list event generate $name <<WizCancel>>]

    return ""
}

# Called with no second argument, just register an after idle handler. 
# Called with a second arg of zero (which is what the after idle event
# does) causes the display to be updated
proc ::tkwizard::updateDisplay {name {schedule 1}} \
{
    variable initialized
    variable updateID

    if {$schedule} {
        catch {after cancel $updateID} message
        set command "[list updateDisplay $name 0]; [list set updateID {}]"
        set updateID [after idle [namespace code $command]]
        return
    }


    if {!$initialized} return

    upvar #0 ::tkwizard::@$name-config     wizConfig
    upvar #0 ::tkwizard::@$name-stepConfig stepConfig

    set step   $wizConfig(-step)
    set layout $stepConfig($step,-layout)
    set path   $wizConfig(-path)

    # update the map
    ${name}::~layout updatemap

    # update the step data
    ${name}::~layout updatestep $step

    # update the wizard buttons
    updateButtons $name
}

# Causes a step to be built by clearing out the current contents of
# the client window and then executing the initialization code for
# the given step

proc ::tkwizard::buildStep {name step}  \
{
    upvar #0 ::tkwizard::@$name-state      wizState
    upvar #0 ::tkwizard::@$name-config     wizConfig
    upvar #0 ::tkwizard::@$name-stepConfig stepConfig
    upvar #0 ::tkwizard::@$name-widget     wizWidget

    set step $wizConfig(-step)
    set layout $stepConfig($step,-layout)

    # reset the state of the windows in the wizard
    ${name}::~layout clearstep

    # update the visual parts of the wizard
    updateDisplay $name

    # initialize the step
    initializeStep $name $step

}

# This block of code is common to all wizard actions. 
# (ie: it is the target of the -command option for wizard buttons)
proc ::tkwizard::xcmd {command name {arg {}}} \
{

    upvar #0 ::tkwizard::@$name-state  wizState
    upvar #0 ::tkwizard::@$name-config wizConfig

    switch $command {
        Next       {event generate $name <<WizNextStep>>}
        Previous   {event generate $name <<WizBackStep>>}
        Finish     {event generate $name <<WizFinish>>}
        Cancel     {event generate $name <<WizCancel>>}
        SelectStep {
            event generate $name <<WizSelectStep>> -serial $arg
        }

        default {
            # This should never happen since we have control over how
            # this proc is called. It doesn't hurt to put in the default
            # case, if for no other reason to document this fact.
            puts "'$command' not implemented yet"
        }
    }
}

# Since I'm striving for compatibility with tcl/tk 8.0 I can't make
# use of [string equal], so this makes the code more readable and 
# more portable
proc ::tkwizard::equal {string1 string2} \
{
    if {[string compare $string1 $string2] == 0} {
        return 1
    } else {
        return 0
    }
}

proc ::tkwizard::handleEvent {name event args} \
{

    upvar #0 ::tkwizard::@$name-state      wizState
    upvar #0 ::tkwizard::@$name-config     wizConfig
    upvar #0 ::tkwizard::@$name-stepConfig stepConfig

    # define some shorthand
    set path      $wizConfig(-path)
    set steps     $wizState(steps,$path)
    set stepIndex [lsearch -exact $steps $wizConfig(-step)]

    switch $event {

        <<WizNextStep>> {
            if {![equal $wizConfig(-step) [lindex $steps end]]} {
                set i [expr {$stepIndex + 1}]
                set step [lindex $wizState(steps,$path) $i]
                showStep $name $path $step
            }
        }

        <<WizBackStep>> {

            incr stepIndex -1
            set step [lindex $steps $stepIndex]
            set wizConfig(-step) $step
            showStep $name $path $step
        }

        <<WizFinish>> {

            wizProxy-hide $name
        }

        <<WizCancel>> {

            wizProxy-hide $name
        }

        <<WizSelectStep>> {
            if {!$wizConfig(-sequential) && \
                    [equal $wizConfig(-state) "normal"]} {
                set n [lindex $args 0]
                set path $wizConfig(-path)
                set steps $wizState(steps,$path)
                set wizConfig(-step) [lindex $steps $n]
                showStep $name
            }
        }

        default {
            puts "'$event' not implemented yet"
        }
    }
}

proc ::tkwizard::showStep {name args} \
{

    upvar #0 ::tkwizard::@$name-state      wizState
    upvar #0 ::tkwizard::@$name-config     wizConfig
    upvar #0 ::tkwizard::@$name-stepConfig stepConfig

    if {[llength $args] > 0} {
        set path [lindex $args 0]
        set step [lindex $args 1]
    } else {
        set path $wizConfig(-path)
        set step $wizConfig(-step)
    }

    set wizConfig(-step) $step

    if {![::info exists stepConfig($step,-layout)]} {
	    set stepConfig($step,-layout) "default"
    }
    set layout $stepConfig($step,-layout)

    # Build the appropriate layout
    buildLayout $name $layout

    # Set the state to "normal". The step can override this if necessary,
    # but this is a reasonable behavior for most simple wizards
    set wizConfig(-state) "normal"

    # Build the step
    buildStep $name $step

    # focus on the default button; the step may override
    ${name}::~style focus $wizConfig(-defaultbutton)
}

proc ::tkwizard::init {name {style {default}}} \
{

    # name should be a widget path
    set w $name

    # create variables in this namespace to keep track
    # of the state of this wizard. We do this here to 
    # avoid polluting the namespace of the widget. We'll
    # create local aliases for the variables to make the
    # code easier to read and write

    # this variable contains state information about the 
    # wizard, such as the wizard title, the name of the 
    # window and namespace associated with the wizard, the
    # list of steps, and so on.
    variable "@$name-state"
    upvar \#0 ::tkwizard::@$name-state wizState

    # this variable contains all of the parameters associated
    # with the wizard and settable with the "configure" method
    variable "@$name-config"
    upvar \#0 ::tkwizard::@$name-config wizConfig

    # this variable contains information on the wizard buttons
    variable "@$name-buttonConfig"
    upvar \#0 ::tkwizard::@$name-config buttonConfig

    # this contains step-specific data, such as the step title,
    # icon, etc. All elements are unset prior to rendering a given 
    # step. It is each step's responsibility to set it appropriately, 
    # and it is each step type's responsibility to use the data.
    variable "@$name-stepConfig"
    upvar \#0 ::tkwizard::@$name-stepConfig  stepConfig

    #---
    # do some state initialization; more will come later when
    # the wizard is actually built
    #---

    # These are internal values managed by the widget code and are
    # not directly settable by the user
    # window:    widget path of wizard toplevel window
    # namespace: name of namespace associated with wizard
    # toplevel:  name of actual toplevel widget proc, which will have
    #            been renamed into the wizard namespace
    set wizState(paths)        [list Basic]
    set wizState(steps,Basic)  [list]

    set wizState(title)        ""
    set wizState(window)       $w
    set wizState(namespace)    ::tkwizard::$name
    set wizState(name)         $name
    set wizState(toplevel)     {}

    # These relate to options settable via the "configure" subcommand
    # -sequential if true, wizard steps must be accessed sequentially
    # -path:      the current path
    # -step:      the current step
    # -title:     string to show in titlebar 
    # -state:     state of wizard; "normal" or "busy"
    set wizConfig(-defaultbutton) "next"
    set wizConfig(-sequential)     1
    set wizConfig(-cursor)         {}
    set wizConfig(-path)           Default
    set wizConfig(-step)           ""
    set wizConfig(-state)          normal
    set wizConfig(-title)          ""
    set wizConfig(-icon) 	      ::tkwizard::logo

    if {[string length $style] > 0} {
        # use the style given to us
        set wizConfig(-style) $style
    } else {
        # use the default style
        set wizConfig(-style) "default"
    }

    # create the wizard shell (ie: everything except for the step pages)
    buildDialog $name

    # this establishes a namespace for this wizard; this namespace
    # will contain wizard-specific data managed by the creator of
    # the wizard
    namespace eval $name {}

    # this creates the instance command by first renaming the widget
    # command associated with our toplevel, then making an alias 
    # to our own command
    set wizState(toplevel) $wizState(namespace)::originalWidgetCommand
    rename $w $wizState(toplevel)
    interp alias {} ::$w {} ::tkwizard::wizProxy $name
    set wizState(alias) ::$w

    # set some useful configuration values
    set wizConfig(-background) \
        [$wizState(namespace)::originalWidgetCommand cget -background]
}

# my long term plan is to perhaps some day ship a bevy of styles,
# and create a wizard wizard that will show available styles to
# let you pick from them. The register command is to facilitate that.
proc ::tkwizard::registerStyle {styleName args} \
{
    variable styleData
    
    set styleData($styleName,-description) ""
    set styleData($styleName,-command)     ""

    foreach {arg value} $args {
        switch -- $arg {
            -description {
                set styleData($styleName,$arg) $value
            }
            -command {
                set styleData($styleName,-command) \
                    "[uplevel [list namespace current]]::$value"
            }
            default {
                return -code error "invalid style attribute \"$arg\":\
                                    must be <whatever>"
            }
        }
    }
}

# my long term plan is to perhaps some day ship a bevy of layouts,
# and create a wizard wizard that will show available layouts to
# let you pick from them. The register command is to facilitate that.
proc ::tkwizard::registerLayout {layoutName args} \
{
    variable layoutData

    # set some defaults
    set layoutData($layoutName,-description) ""
    set layoutData($layoutName,-command)     ""
    
    # overwrite defaults with values passed in
    foreach {arg value} $args {
        switch -exact -- $arg {
            -description {
                set layoutData($layoutName,$arg) $value
            }
            -command {
                set layoutData($layoutName,-command) \
                    "[uplevel [list namespace current]]::$value"
            }
            default {
                return -code error "invalid layout attribute \"$arg\":\
                                    must be -command or -description"
            }
       }
    }
}

proc ::tkwizard::buildDialog {name} \
{

    variable styleData

    upvar #0 ::tkwizard::@$name-state wizState
    upvar #0 ::tkwizard::@$name-config wizConfig
    upvar #0 ::tkwizard::@$name-widget wizWidget

    set wizState(visible,nextButton)    1
    set wizState(visible,backButton)    1
    set wizState(visible,cancelButton)  1
    set wizState(visible,finishButton)  1

    # create the toplevel window. "." is treated specially. Any other
    # value must not exist as a window, but we want the ability to 
    # make "." a wizard so folks can write standalone wizard apps
    set w $wizState(window)
    if {$w == "."} {
        . configure -bd 2 -relief groove -cursor $wizConfig(-cursor)
        bindtags . [list . Wizard all]
    } else {
        toplevel $w -class Wizard \
            -bd 2 -relief groove -cursor $wizConfig(-cursor)
    }
    wm title $w $wizConfig(-title)

    # create an alias to the public interface of the current
    # style, then initialize the dialog using the style public interface.
    # We can create this alias here because, unlike layouts, styles can
    # only be set when the widget is first created. It's not possible to
    # change styles at runtime.
    interp alias {} ::tkwizard::${name}::~style \
                 {} $styleData($wizConfig(-style),-command) $name

    set wizWidget(path,layoutFrame) [${name}::~style init]

    # return the name of the toplevel, for lack of a better idea...
    return $wizState(window)
}

proc ::tkwizard::buildLayout {name layoutName} \
{
    variable layoutData

    upvar #0 ::tkwizard::@$name-state wizState
    upvar #0 ::tkwizard::@$name-config wizConfig
    upvar #0 ::tkwizard::@$name-widget wizWidget

    set w $wizState(window)
    set lf $wizWidget(path,layoutFrame)

    # reset the layout alias to point to this layout
    # (with the assumption being, we are in this proc because
    # we are setting this particular layout to the current layout...)

    interp alias {} ::tkwizard::${name}::~layout \
                 {} $layoutData($layoutName,-command) $name

    ${name}::~layout init $lf

    # remove any previously displayed layout
    eval pack forget [winfo children $lf]

    # ... and display this one.
    pack $lf.frame-$layoutName -side top -fill both -expand y

}

##
# wizProxy-stepconfigure
#
# usage: pathName stepconfigure stepName ?options?
#
# options:
#   -icon         name of an image to associate with this step
#   -description  string to describe the step
#   -layout       name of layout to use for displaying the wizard step
#   -title        string 
#   -body         code to execute when the step is displayed

proc ::tkwizard::wizProxy-stepconfigure {name step args} \
{

    upvar #0 ::tkwizard::@$name-state      wizState
    upvar #0 ::tkwizard::@$name-config     wizConfig
    upvar #0 ::tkwizard::@$name-stepConfig stepConfig
    upvar #0 ::tkwizard::@$name-widget     wizWidget

    # no arguments: return all known values
    if {[llength $args] == 0} {
        set result [list]
        foreach element [lsort [array names stepConfig $step,*]] {
            set option [lindex [split $element ,] 1]
            lappend result [list $option $stepConfig($element)]
        }
        return $result
    }

    # one argument: return the value
    if {[llength $args] == 1} {
        set option [lindex $args 0]
        if {[::info exists stepConfig($step,$option)]} {
            return $stepConfig($step,$option)
        } else {
            return -code error "unknown step option \"$option\""
        }
    }

    # More than one argument? 
    foreach {option value} $args {

        if {![::info exists stepConfig($step,$option)]} {
            return -code error "unknown step option \"$option\""
        }

        set stepConfig($step,$option) $value
    }

    # Update the layout with the new data if this is the current step.
    if {[equal $step $wizConfig(-step)]} {
        set layout $stepConfig($step,-layout)
        ${name}::~layout updatestep $step
#        layout-${layout}::updateStep $name $step
    }

}

##
# updateButtons
#
# updates the visual state of the buttons based on the current state
# of the wizard (wizard state, current step, current path, etc.)
#
proc ::tkwizard::updateButtons {name args} \
{

    upvar #0 ::tkwizard::@$name-state      wizState
    upvar #0 ::tkwizard::@$name-config     wizConfig
    upvar #0 ::tkwizard::@$name-stepConfig stepConfig
    upvar #0 ::tkwizard::@$name-widget     wizWidget

    set path      $wizConfig(-path)
    set steps     $wizState(steps,$path)
    set stepIndex [lsearch -exact $steps $wizConfig(-step)]

    if {$wizConfig(-defaultbutton) == "none"} {
        ${name}::~style buttonconfigure finish -default normal
        ${name}::~style buttonconfigure next   -default normal
        ${name}::~style buttonconfigure back   -default normal
        ${name}::~style buttonconfigure cancel -default normal
        bind $name <Return> {}
    } else {
        foreach b {next back cancel finish} {
            if {[string match $b $wizConfig(-defaultbutton) ]} {
                bind $name <Return> \
                    [namespace code [list ${name}::~style invokebutton $b]]
                ${name}::~style buttonconfigure $b -default active
            } else { 
                ${name}::~style buttonconfigure $b -default normal
            }
        }
    }

    switch -exact -- $wizConfig(-state) {

        "disabled" {

            $name configure -cursor $wizConfig(-cursor)
            ${name}::~style buttonconfigure cancel config -cursor {}

            # Disable all buttons. I doubt anyone will ever use this 
            # feature, but you never know...
            ${name}::~style buttonconfigure finish -state disabled
            ${name}::~style buttonconfigure next   -state disabled
            ${name}::~style buttonconfigure back   -state disabled
            ${name}::~style buttonconfigure cancel -state disabled
        }            

        "normal" {

            $name configure -cursor $wizConfig(-cursor)
            ${name}::~style buttonconfigure cancel -cursor {}

            # Configure next and finish buttons depending on whether
            # there is a next step or not
            if {[equal [lindex $steps end] $wizConfig(-step)]} {
                ${name}::~style buttonconfigure finish -state normal
                ${name}::~style buttonconfigure next   -state disabled
            } else {
                ${name}::~style buttonconfigure finish -state disabled
                ${name}::~style buttonconfigure next   -state normal
            }

            # enable the previous button if we are not on the first step
            if {$stepIndex > 0} {
                ${name}::~style buttonconfigure back -state normal
            } else {
                ${name}::~style buttonconfigure back -state disabled
            }
        }
        "pending" {
            $name configure -cursor $wizConfig(-cursor)
            ${name}::~style buttonconfigure cancel -cursor {}

            # Forward progress is disabled
            ${name}::~style buttonconfigure finish -state disabled
            ${name}::~style buttonconfigure next   -state disabled

            # cancelling is allowed
            ${name}::~style buttonconfigure cancel -state normal

            # enable the previous button if we are not on the first step
            if {$stepIndex > 0} {
                ${name}::~style buttonconfigure back -state normal
            } else {
                ${name}::~style buttonconfigure back -state disabled
            }
        }

        "busy" {
            $name configure -cursor watch
            ${name}::~style buttonconfigure cancel -cursor left_ptr

            # Disable everything but the rather important "Cancel" 
            # button.
            ${name}::~style buttonconfigure finish -state disabled
            ${name}::~style buttonconfigure next   -state disabled
            ${name}::~style buttonconfigure back   -state disabled
            ${name}::~style buttonconfigure cancel -state normal
            update
        }

    }
}

##
# wizProxy-buttonconfigure
#
# usage: pathName buttonconfigure buttonName args
#
# args is any valid argument to the configure method of a button
# (eg: -text, -borderwidth, etc)

proc ::tkwizard::wizProxy-buttonconfigure {name button args} \
{

    upvar #0 ::tkwizard::@$name-state      wizState
    upvar #0 ::tkwizard::@$name-config     wizConfig
    upvar #0 ::tkwizard::@$name-stepConfig stepConfig
    upvar #0 ::tkwizard::@$name-widget     wizWidget

    if {[lsearch -exact {next back cancel finish} $button] == -1} {
        return -code error "unknown button \"$button\": must be\
           one of back, cancel, finish or next"
    }
    
    if {[llength $args] == 1} {
	    if {[equal [lindex $args 0] -state]} {
		    return $wizState(buttonState,$button)
	    } else {
		    set option [lindex $args 0]
		    return [${name}::~style buttonconfigure $button $option]
	    }
    } 

    set newArgs [list]
    foreach {arg value} $args {
        if {[string match "${arg}*" "-state"]} {
            if {[string match "${value}*" "hidden"]} {
                # we'll set the internal state to hidden, and the
                # actual button state to disabled
                set wizState(buttonState,$button) "hidden"
                lappend newArgs -state disabled
            } else {
                set wizState(buttonState,$button) "visible"
                lappend newArgs $arg $value
            }
        } else {
            # set the arg to the 
            lappend newArgs $arg $value
        }
    }

    eval ${name}::~style buttonconfigure $button $newArgs
#    eval ~\${button}Button configure $newArgs
}

proc ::tkwizard::wizProxy-dump {name} \
{

    upvar #0 ::tkwizard::@$name-state      wizState
    upvar #0 ::tkwizard::@$name-config     wizConfig
    upvar #0 ::tkwizard::@$name-stepConfig stepConfig

    puts "wizState:"
    parray wizState

    puts "wizConfig:"
    parray wizConfig

    puts "stepConfig:"
    parray stepConfig
}

### This is the default step layout
tkwizard::registerLayout "default" \
    -description {The default layout} \
    -command tkwizard::layout-default::layoutCommand

namespace eval ::tkwizard::layout-default {

    # This is an array containing the significant widget paths
    # used by this layout. It saves us from having to hard-code
    # widget pathnames everywhere
    variable widget
    array set widget {}
}

# this is the public interface to this layout, and is accessible via
# an interpreter alias created by the init command. Note that in all
# procs, the wizard name is the first argument. This is done by 
# the wizard code, and is a required argument. All other arguments
# are (or can be) unique to the step

proc ::tkwizard::layout-default::layoutCommand {name command args} \
{
    variable widget

    switch -- $command {
        init       {eval init $name $args}
        updatestep {eval updateStep \$name $args}
        updatemap  {eval updateMap \$name $args}
        clearstep  {eval clearStep \$name $args}
	workarea   {return $widget(workArea)}
        update    {
            eval updateStep \$name $args
            eval updateMap  \$name $args
        }
        default    {
            return -code error "unknown layout command \"$command\"\
                                for layout \"default\""
        }
    }
}

proc ::tkwizard::layout-default::init {name layoutFrame} \
{
    variable widget

    upvar #0 ::tkwizard::@$name-state  wizState
    upvar #0 ::tkwizard::@$name-config wizConfig
    upvar #0 ::tkwizard::@$name-widget wizWidget

    # The first time this layout is initialized we need to define
    # the widget paths
    if {![::info exists widget(frame)]} {
        
	set layout $layoutFrame.frame-default

        set widget(frame)        $layout
        set widget(workArea)     $layout.workArea
        set widget(icon)         $layout.icon
        set widget(title)        $layout.title
        set widget(description)  $layout.description

        set widget(buttonFrame)  $layout.buttonFrame
        set widget(nextButton)   $widget(buttonFrame).nextButton
        set widget(backButton)   $widget(buttonFrame).backButton
        set widget(cancelButton) $widget(buttonFrame).cancelButton
        set widget(finishButton) $widget(buttonFrame).finishButton
    }

    # Likewise, if this is the first time this proc is called we need
    # to create the widgets
    if {![winfo exists $widget(frame)]} {
        build $name
    }

}

proc ::tkwizard::layout-default::clearStep {name} \
{
    variable widget

    if {[::info exists widget(workArea)] && [winfo exists $widget(workArea)]} {
        eval destroy [winfo children $widget(workArea)]
    }
}

proc ::tkwizard::layout-default::build {name} \
{
    variable widget

    upvar #0 ::tkwizard::@$name-state wizState
    upvar #0 ::tkwizard::@$name-config wizConfig

    # using the option database saves me from hard-coding it for
    # every widget. I guess I'm just lazy.
    # FIXME: shouldn't those priorities be startupFile? I don't
    # recall why I set them to interactive originally...
    option add *WizLayoutDefault*Label.justify           left interactive
    option add *WizLayoutDefault*Label.anchor              nw interactive
    option add *WizLayoutDefault*Label.highlightThickness   0 interactive
    option add *WizLayoutDefault*Label.borderWidth          0 interactive
    option add *WizLayoutDefault*Label.padX                 5 interactive
    option add *WizLayoutDefault.titleBackground      #ffffff startupFile

    frame $widget(frame) -class WizLayoutDefault
    frame $widget(frame).sep1 -class WizSeparator 
    $widget(frame).sep1 configure \
        -background [option get $widget(frame).sep1 stripe Background]

    # Client area. This is where the caller places its widgets.
    frame $widget(workArea) -bd 2 -relief flat
    frame $widget(frame).sep2 -class WizSeparator

    # title and icon
    set background [option get $widget(frame) titleBackground Background]
    frame $widget(frame).titleframe \
	-bd 4 -relief flat -background $background

    label $widget(title) \
	-background $background \
	-anchor w \
	-width 40

    # we'll use a default icon, but the user can always override it
    label $widget(icon) \
	-borderwidth 0 \
	-image ::tkwizard::logo \
	-background $background \
	-anchor c

    set font [font configure TkDefaultFont]
    switch -- [tk windowingsystem] {
	"win32" { set size  18 }
	"aqua"  { set size  24 }
	"x11"   { set size -24 }
    }
    dict set font -size $size
    dict set font -weight bold
    $widget(title) configure -font $font

    set tf $widget(frame).titleframe
    grid $widget(title)    -in $tf -row 0 -column 0 -sticky nsew
    grid $widget(icon)     -in $tf -row 0 -column 1 -padx 8

    grid columnconfigure $tf 0 -weight 1
    grid columnconfigure $tf 1 -weight 0

    # Step description. We'll pick rough estimates on the size of this
    # area. I noticed that if I didn't give it a width and height, and a
    # step defined a really, really long string, the label would try to
    # accomodate the longest string possible, making the widget unnaturally
    # wide.

    label $widget(description)  -width 40  -bd 0

    # when our label widgets change size we want to reset the
    # wraplength to that same size.
    foreach w {title description} {
	bind $widget($w) <Configure> {
	    # yeah, I know this looks weird having two after idle's, but
	    # it helps prevent the geometry manager getting into a tight
	    # loop under certain circumstances
	    #
	    # note that subtracting 10 is just a somewhat arbitrary number
	    # to provide a little padding...
	    after idle {after 1 {%W configure -wraplength [expr {%w -10}]}}
	}
    }
    
    grid $widget(frame).titleframe   -row 0 -column 0 -sticky nsew -padx 0
    
    grid $widget(frame).sep1  -row 1 -sticky ew 
    grid $widget(description) -row 2 -sticky nsew -pady 8 -padx 8
    grid $widget(workArea)    -row 3 -sticky nsew -padx 8 -pady 8

    grid columnconfigure $widget(frame) 0 -weight 1

    grid rowconfigure $widget(frame) 0 -weight 0
    grid rowconfigure $widget(frame) 1 -weight 0
    grid rowconfigure $widget(frame) 2 -weight 0
    grid rowconfigure $widget(frame) 3 -weight 1

    # the description text will initially not be visible. It will pop 
    # into existence if it is configured to have a value
    grid remove $widget(description)

}

proc ::tkwizard::layout-default::updateStep {name step} \
{

    variable widget

    # if the layout widget doesn't exist; do nothing. This will be
    # the case when the wizard is first defined but before the first
    # step has actually been shown.
    if {![::info exists widget(frame)] || 
	![::winfo exists $widget(frame)]} {
        return
    }

    upvar #0 ::tkwizard::@$name-state wizState
    upvar #0 ::tkwizard::@$name-config wizConfig
    upvar #0 ::tkwizard::@$name-stepConfig stepConfig

    $widget(title)       configure -text  $stepConfig($step,-title)
    $widget(icon)        configure -image $stepConfig($step,-icon)
    $widget(description) configure -text  $stepConfig($step,-description)

    # Hide description if it isn't being used
    if {[string length $stepConfig($step,-description)] > 0} {
        grid $widget(description)
    } else {
        grid remove $widget(description)
    }
}

proc ::tkwizard::layout-default::updateMap {name {option ""}} \
{
    # do nothing; this layout doesn't have a map
}

### Default style
tkwizard::registerStyle "default" \
    -description {This is the default style} \
    -command tkwizard::style-default::styleCommand



namespace eval tkwizard::style-default {

    # this will contain style-specific widget paths
    variable widget

}

proc ::tkwizard::style-default::styleCommand {name command args} \
{

    variable widget

    switch -- $command {

        init {
            eval init \$name $args
        }

        invokebutton {
            set w $widget([lindex $args 0]Button)
            if {[$w cget -state] == "disabled"} {
                bell
            } else {
                $w invoke
            }
        }

        focus {
            set name "[lindex $args 0]Button"
            focus $widget($name)
        }

        buttonconfigure {
            set w "[lindex $args 0]Button"
            if {[winfo exists $widget($w)]} {
                eval \$widget(\$w) configure [lrange $args 1 end]
            }
        }

        showbutton {
            foreach button $args {
                set w ${button}Button
                pack $widget($w)
            }
        }
        hidebutton {
            foreach button $args {
                set w ${button}Button
                pack forget $widget($w)
            }
        }

        default {
            return -code error "unknown style command \"$command\"\
                                for style \"default\""
        }
    }
}

proc ::tkwizard::style-default::init {name} \
{

    variable widget

    upvar #0 ::tkwizard::@$name-config wizConfig

    # the present design precludes prefix from ever being ".",
    # but we'll add this code just in case that changes some day...
    if {$name == "."} {
        set prefix ""
    } else {
        set prefix $name
    }

    frame $prefix.layoutFrame -bd 0
    frame $prefix.buttonFrame -bd 0
    frame $prefix.separator -class WizSeparator

    pack $prefix.buttonFrame -side bottom -fill x -expand n
    pack $prefix.separator -side bottom -fill x -expand n
    pack $prefix.layoutFrame -side top -fill both -expand y

    option add $prefix.buttonFrame*BorderWidth  2      widgetDefault
    option add $prefix.buttonFrame*Relief       groove widgetDefault

    # add control buttons
    set widget(nextButton)   $prefix.buttonFrame.nextButton
    set widget(backButton)   $prefix.buttonFrame.backButton
    set widget(cancelButton) $prefix.buttonFrame.cancelButton
    set widget(finishButton) $prefix.buttonFrame.finishButton

    ttk::button $widget(backButton) \
        -text "< Back" \
        -default normal \
        -command [list event generate $name <<WizBackStep>>]

    ttk::button $widget(nextButton) \
        -text "Next >" \
        -default normal \
        -command [list event generate $name <<WizNextStep>>]

    ttk::button $widget(finishButton) \
        -text "Finish" \
        -default normal \
        -command [list event generate $name <<WizFinish>>]

    ttk::button $widget(cancelButton) \
        -text "Cancel"   \
        -default normal \
        -command [list event generate $name <<WizCancel>>]

    pack $widget(cancelButton) -side right -pady 4 -padx 5 
    pack $widget(finishButton) -side right -pady 4 -padx 1
    pack $widget(nextButton)   -side right -pady 4 -padx 1
    pack $widget(backButton)   -side right -pady 4 -padx 1

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

    package provide ttk::theme::bk 0.1

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

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

        -activebutton   "#E5E8ED"
    }

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

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

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

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

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

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

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

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

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

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

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

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

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

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

	rename proc realproc
	rename newproc proc
}

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

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

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

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

		"x11" {
			ttk::setTheme bk
		}
	}

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

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

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

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

proc bk_init {} {
	set tool [bk_toolname]

	bk_initPlatform

	bk_initTheme

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

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

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

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

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

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

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

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

proc cd2product {{path ""}} {
	set cmd [list exec bk root]
	if {$path ne ""} { lappend cmd $path }
	if {[catch { cd [{*}$cmd] } err]} {
		puts "Could not change directory to product root."
		exit 1
	}
}

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

proc displayMessage {msg {exit {}}} \
{
	if {$exit != ""} {
		set title "Error"
		set icon "error"
	} else {
		set title "Info"
		set icon "info"
	}
	tk_messageBox -title $title -type ok -icon $icon -message $msg \
	    -parent [bk_toplevel]
	if {$exit == 1} {
		exit 1
	} else {
		return
	}
}

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

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

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

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

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

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

	set w [winfo toplevel $w]

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

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

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

# From a Cameron Laird post on usenet
proc print_stacktrace {} \
{
	set depth [info level]
	puts "Current call stack shows"
	for {set i 1} {$i < $depth} {incr i} {
		puts "\t[info level $i]"
	}
}

proc tmpfile {name} \
{
	global	tmp_dir tmp_files tmp_filecount

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

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

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

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

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

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

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

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

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

proc debugGeom {args} \
{
	global env

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

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

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

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

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

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

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

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

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

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


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

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

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

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

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

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

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

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

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

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

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

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

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

	catch {destroy $grabWin}

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

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

	unset bgExec(handler)
	unset bgExec(status)

	return $exitCode
}

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

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

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

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

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

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

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

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

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

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

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

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

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

# License Functions

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

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

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

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

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

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

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

# Aqua stuff

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

proc isBinary { filename } \
{
    global	gc

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

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

set ::display_text_sizes on

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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


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

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

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

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

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

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

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

}

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

	unless (cmd) return;

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

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

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

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

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

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

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

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

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

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

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

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

	system("bk help -s ${tool}", undef, &usage, undef);
	puts(usage);
	exit(1);
}
#lang tcl
image create photo bklogo -data {R0lGODdhnwAhAPcAAAAAAAICAg4ODg8PDxAQEBERERISEhMTExQUFBUVFRYWFhcX
FxkZGRoaGhwcHB0dHR4eHiEhISIiIiMjIyQkJCUlJSYmJicnJygoKCoqKisrKyws
LC4uLi8vLzAwMDExMTIyMjMzMzQ0NDU1NTY2Njc3Nzg4ODk5OTo6Ojs7Ozw8PD09
PT4+Pj8/P0BAQEFBQUJCQkNDQ0REREVFRUZGRkdHR0hISElJSUpKSktLS0xMTE1N
TU5OTk9PT1BQUFFRUVJSUlNTU1RUVFVVVVZWVldXV1hYWFlZWVpaWltbW1xcXF1d
XV5eXl9fX2BgYGFhYWJiYmRkZGZmZmdnZ2hoaGlpaWpqamtra2xsbG1tbW5ubnBw
cHFxcXJycnNzc3R0dHV1dXZ2dnd3d3h4eHl5eXp6ent7e3x8fH19fX5+fn9/f4CA
gIGBgYKCgoODg4SEhIWFhYaGhoeHh4iIiImJiYqKiouLi4yMjI2NjY6Ojo+Pj5CQ
kJGRkZKSkpOTk5SUlJWVlZaWlpeXl5iYmJmZmZqampubm5ycnJ2dnZ6enp+fn6Cg
oKGhoaKioqOjo6SkpKWlpaampqenp6ioqKmpqaqqqqurq6ysrK2tra6urq+vr7Cw
sLGxsbKysrOzs7S0tLW1tba2tre3t7i4uLm5ubq6uru7u7y8vL29vb6+vr+/v8DA
wMHBwcLCwsPDw8TExMXFxcbGxsfHx8jIyMnJycrKysvLy8zMzM3Nzc7Ozs/Pz9DQ
0NHR0dLS0tPT09TU1NXV1dbW1tfX19jY2NnZ2dra2tvb29zc3N3d3d7e3t/f3+Dg
4OHh4eLi4uPj4+Tk5OXl5ebm5ufn5+jo6Onp6erq6uvr6+zs7O3t7e7u7u/v7/Dw
8PHx8fLy8vPz8/T09PX19fb29vf39/j4+Pn5+fr6+vv7+/z8/P39/f7+/v///wAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAACwAAAAAnwAhAAAI/gDVCRxIsKDBgwgTKlzIsKHDhxAjSpxI
saLFixgzatzIsaPHjyBDihxJ0mC6kyhTnsyoEuXAliVjbkyHDt25cuRy6iRXzty5
muko0ryps+dPm+bKKfWJLqjMpxOHkgPnjdu2q9yydvMGbly5phLTnSMXruo2bt2+
hcspjmq3tOLInXMKNSS3Z8FomcrEyE+cMVeW+IgxAoOBAAA6jFKHzhUQHzx05MBB
OUcONJugUcPmbdxPiDSD/OghmXKazad89NihozW1bN/Iga0L8m7evX3/Bh5cGDEA
AA1otvIh4jeADTBiGAfAARWyaNvEzX2IrtyP4sZjeCHWDNQOBr9n/tAo9gwbOHPo
aNfGq5evX8CCCWPwDVysuGzMjH/J9IkUC+MZxAKMM9t4VtOBCCaIjjnibPOMfpyY
QoswySTTAQBEpNIKLsZM041cCjaVUogqJdgSTQqWiKBLEtnWXm7w8WYYYoqJFQ42
yBgnhSGOYMLJAcbJscov0HAT105I7jSOON5ck4yOiFySii7D1ABAC59wQooswkCz
zVpJ8tRTUmEqZWaSRp1DJprmrIlkOUfRJZJ9OBrHxB6IVMLJCTpiAosx1GS1jTaE
XjWoNtlgg002jGITDTF29uEIKbaAAYACoWSySSm1FCONNm8Nmo02Z6HlzTffdCMq
qVqdahaj/qxyBQ4431gFa6lpfVMVoqOexdU46MkZEjrkcJPfb0nggUgmoaRgnBKJ
kGLHcgBQRi21OTCjDDDGJcvIKHFcOkmWobzySzOHXGucDtAUou5v7E6hbg6caMbD
uwAMEs0O8waimTbgfCXsR+mY4w00xiFxRyKdnILAbwLAIUgntxTzAXO21CIDAKXw
sstvcMxCywIzABMMLwnfoQgjvwVCCiijuNILM9Zog00IAMxwiy25lAJADcIUc4wH
OdvCs89AE2MM0TLQQgsXv+UxzDGv/DZHLbfo8gUAeRBDtdW0eLIxAGBwZ95XJIkF
jjQJ24EIJ2gYR8QbE9cSjJUtjDIK/gsJtOJKK7+N8ckoLbxQSy63GHdEHXQAeYYo
n4jCCi/LWJOVNTgA4AIppKQCiwIxZM3Lxnl3/nkMPO+yMQuiiGJKBgBoAEstuPz2
eCmrEAJAHLjwgjIAZ4TiegIAJBDLzNmIM9tCLuL23m7yHZbYYjSFQ41xKSQhBZ8A
TJBFG3McEgouwcwAgAqWWFLHHqiogspvW0iCSR6AyLKzcUbEQQAABxBiiSalsMUx
quGNcHyjGjY43yUwAQpUtOIVscAaDACQgkowEBWsgCAtbDHBFFDCEpwYw29CYQpV
/KYLlMiEKFTRCljM4haJA4AXPrgJZwEAFK4IhjS+YY6BHaR5/u7RTXx6Y5wGCAQd
1sNXBFYgBTswwhS7EIb5UAAJSXDiFC0EHAC04IhKiMIVtthF7X7zAAcYJwSJoMQp
eOEMboxjKtZIIBUjEQYAZPCFuJjgCR4RCUtlUBa2yCMA9ggJTNQRAJfgRCh+owVG
UCIFLWghLXAxxi00AhKXsAAAKlAJUuCiGdxAG0OACCPoEfE3RmRMEn9TgzXcwRBY
MICdGmEKXUgRAFSkBChe0bsxauERmECFLYBBjF8YxwEYEIBxnPAtXkDjQwy6RgJP
wAhHOAEAq4CFLXjhi42ZgBGNuGY2t9kL5ZzgkpjowSYlcYlO/OYKiYDEBVjAClng
whe9/mCkIhyxhd9gARKfqAUzuCGbhpDyeUOc0fSOuEoMqaEOhXCEHgpgnDKAgha+
mKL8UIELYiBjGPCLBCdcAQxlNMMYxgmCGJpgnAEMghO2GCg5GISNG1zrFLwExjDM
Ry2c4kKn5jvnI7oAv0lg4hPXUoEqZBFFYfyGAiKYgAFywAdGQAIUt5BpekaCxOv9
hghs0AMjLnGJIxgHBpRIhS2Ug4JJbIIVwGhGNI6FwosaQxrUOBYAhDAGM3DvSpBY
BTGqAQ5yiKOmg0SEIZAAAMnhYhjFoAEATKBYxjoWspI9wAgmwL8vLNATpPiNFQhx
iAqkoBSw4AUxIAWAG0hBAgAw/oAVFCEJUuwCGt4ohw870lX8xUEQlyjFKQ7JnENw
ohUvwCUlOPEKYkzjGgiTYSVCYQtlXCMb0cXQGdpAhwEYRwwwZYY2wnEjm54AEYVA
wwlAwYrHGkOyJjhEetfb3mG8FwAWsEIV1uCjToTCge8khCGS8ARSpLYYrM3CIAJB
0QIgghKo+IU0zrPbmfT2N0iwQyJCMQtbrME4GuDDJErhgkEuFxbFeE00fuOF6WYV
G9tY8W+M0AY8CEIMxiFAI04hYW40ybyIQMQjNEGKNohCGMQwH2UPMeQiHznJk0XE
ISCxiVF4LpD+LAQiJuGJSbxBtSAFABYEEYgh/IYKEP7F/jQoPBK1sQ3DeHgiLnox
wd8M4Q6NCEULBjkJTqBYxSymRChevI3sGkEOgHgEJUhgHCBY4k/U0AY1prkIRkwX
EACgwy9+4c1ELOLSmd60cij74C/i4hfECAYjEdGITJSiCADYBTB84U9CEAIRvxFB
bZ3ZDVEyjz3OE6KMpKcYdRTsG9lFQpxLgYtpkZENeXiEKPZ8AklswhXOxUZ062qL
ZSzqQb85Ah0KgYlQIEKWv7EDKHChjGlAw0rnpDIq3ACAOeQCF8n95iM2Me963zu5
JUgEI97Ki2M04xlPAsAWGCEJ9k4QF4j7TRYQoQhIZA4AfgBFLZSRDc9UeCAHFbZ8
/uhjRHQgYxFx+w0ElFCFKGzAOBEgAx0EEYf//MYEUGhFl3YAgt8cwAQXTUY1EBGF
luqgDJxQRSqISwAt/KEXmLj4AUpgghS4QAEAgIMhkss/EpTA6ljXOtcBMAI3jEKA
08CGG3q+SRKYYAUlBkAstPDy2I4gEplABJAoSAhiUOMbvk5IyGM08iLSBBL4Kp4K
3EAIPwwiEo9wwxvSEIYu2CGHzyhEIOyQhi944ezI8Cq1RPAJWNBiFdRKgSxQsQc7
rCEMXPACGdbwhjdoAhNsSMMYurCFLsy+9rfP/e63YIhV+OIZ2ehGKQZxBzV8YQtf
MEMb3uAGVwhiDWkQAxe2/kBkVJhiDGAYAyaAUSTZfFwdgzelQmt0jhshYxacQEQf
/qCIco/CE5V4xCMuISGPxcIUoXAKtEAM0DANzPALr0AKkkM51DANyEAL8ecHgQAJ
pFALvYALqoAJiVAIjDBSvBAMvSALpgAK/2V6sxALsAALroAKoNAJDWSCKKiCqBAK
oCAhgMIV3CANwxALpDA4qhALsyALKQgLrTCCNahNtfAKqaAKtBAM5bc8HUEny5AL
qIAJkBAJDHQKqFAKohAKpfAKvGAMynAMv2ALgAQMy0AN1hANyMALtDALuVAM0HAN
1cAMu1CFkUAJn/AKvnAMxsALrfAJmLAps/ALCNYL/rSQgrSQC76zC7vAC7pgC7Hg
CqbHiB7ziJEoC7FgC8HwDOM1DuBwDcvgC4m4ibrgMbqAibUQC7FwC4ZYDMAAib8Q
eh8ChRxBE8UiDcWQC6+gCiwkC1hjNHNWDM5ADddADc6ADMWADM0QadyQDdKwDMZQ
DMoQDdjADdowDcegC7CgCqxAC79QjQYoDLiAgrcADMngDM8gjau1jBWSDMqwDMqA
DMQwDJCFDO8Yj/OIYMhQHrFRDuPQDXVoDMOgNPhYIfGYDMewWsjgDNNADdDQDMzQ
DNMwXoHnEQsSDttggAtZkMdwkMsgV9fADbPiDdtwDdZwDdpQQG3BDdhgDdZw/o3g
0JJ5tZDFkAzQYDnYSA3NgAzIsAzQUA3YYDPWQA3UUA0peQ3XoCjYQIdGiZRKuZSK
QofVcA3bUFg/YQ7j4A3aUJRHGZVS2ZTVIJTbcCqqQijdsBa2GIXVIQ7fsA1NqZSK
0ivc8A1x0SYAGQ7gEA5vhJeGRV5x0RMAWStNuSgk+UagiI2jQpLhIA7ioJezspeA
6ZiQGZnk1ZiUqZdr8RVNYRPkMA6VKZmY+Zh7eSQ48Zl9uZYeMRTmkBPj8JqvWRTo
ISI1cQ62CRQoYhNHgSCtiZo8MZs2cZq/eRS2WZzFeSDGmZzIeZzLgyLJyZy1uZsp
cn63mJskQp0LcRLTCykQ2nkgK6EeFhEQADs=}
main
