#!/bin/sh
# the exec restarts using tclsh which in turn ignores
# the command because of this backslash: \
exec mash-VERSION "$0" -name bin/script-loader -- "$@"

#
# Copyright (c) 1993-1996 The Regents of the University of California.
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. All advertising materials mentioning features or use of this software
#    must display the following acknowledgement:
#	This product includes software developed by the University of
#	California, Berkeley and the Network Research Group at
#	Lawrence Berkeley Laboratory.
# 4. Neither the name of the University nor of the Laboratory may be used
#    to endorse or promote products derived from this software without
#    specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#
# @(#) $Header: /usr/src/mash/repository/mash/mash-1/head.tcl,v 1.3 1997/08/15 07:23:36 mccanne Exp $ (LBL)
#
proc isWidgetObject { cl } {
	if { [$cl info heritage WidgetObject] != {} || $cl=="WidgetObject" } {
		return 1
	} else {
		return 0
	}
}
Class WidgetClass -superclass Class
WidgetClass proc unknown { cl args } {
	set private_options(-configspec) ""
	set private_options(-default) ""
	set private_options(-alias) ""
	set len [llength $args]
	for { set idx 0 } { $idx < $len } { incr idx 2 } {
		if { [info exists private_options([lindex $args $idx])] } {
			set private_options([lindex $args $idx]) \
					[lindex $args [expr $idx+1]]
			set args [lreplace $args $idx [expr $idx+1]]
			incr idx -2
		}
	}
	set idx [lsearch $args "-superclass"]
	if { $idx!=-1 } {
		incr idx
		if { [llength $args] <= $idx } {
			error "missing argument for option '-superclass'"
		}
		set superclasses [lindex $args $idx]
		set need_WidgetObject 1
		foreach superclass $superclasses {
			if { [$superclass info heritage WidgetObject]!="" } {
				set need_WidgetObject 0
				break
			}
		}
		if { $need_WidgetObject && $cl!="WidgetObject"} {
			lappend superclasses WidgetObject
			set args [lreplace $args $idx $idx $superclasses]
		}
	} else {
		if { $cl!="WidgetObject" } {
			lappend args -superclass WidgetObject
		}
	}
	eval [list $self] next [list $cl] $args
	$cl heritage_defaults
	foreach option [array names private_options] {
		set arg $private_options($option)
		$cl set_[string range $option 1 end] $arg
	}
}
WidgetClass proc set_widget_default { } {
	set count 0
	while [winfo exists .dummy_${count}__] { incr count }
	set dummy .dummy_${count}__
	button $dummy
	$self set_widget_default_ $dummy { -background -foreground \
			-activebackground -activeforeground -borderwidth \
			-cursor -disabledforeground -highlightbackground\
			-highlightcolor -highlightthickness -takefocus \
			{-boldfont -font} }
	destroy $dummy
	entry $dummy
	$self set_widget_default_ $dummy { -font -selectbackground \
			-selectforeground -selectborderwidth }
	destroy $dummy
}
WidgetClass proc set_widget_default_ { path options } {
	$self instvar widget_defaults_
	foreach option $options {
		if { [llength $option]==1 } {
			set option [lindex $option 0]
			set widget_defaults_($option) [$path cget $option]
		} else {
			set widget_defaults_([lindex $option 0]) \
					[$path cget [lindex $option 1]]
		}
	}
}
WidgetClass proc widget_default { option } {
	$self instvar widget_defaults_
	if { [info exists widget_defaults_($option) ] } {
		return $widget_defaults_($option)
	} else {
		error "no such default option \"$option\""
	}
}
WidgetClass proc translate_default { option value } {
	if { ![string compare $value "WidgetDefault"] } {
		return [WidgetClass widget_default $option]
	} elseif { [regexp {WidgetDefault\((.*)\)} $value dummy \
			defaultOption] } {
		return [WidgetClass widget_default $defaultOption]
	}
	return $value
}
WidgetClass set_widget_default
WidgetClass instproc heritage_defaults { } {
	set heritage [$self info heritage]
	set len [expr [llength $heritage]-1]
	while { $len >= 0 } {
		set cl [lindex $heritage $len]
		incr len -1
		if { [isWidgetObject $cl] } {
			$self configspec_ [$cl info configspec] 1
			$self default_ [$cl info default]
		}
	}
}
WidgetClass instproc set_configspec { specs } {
	$self configspec_ $specs 0
}
WidgetClass instproc configspec_ { specs {isAncestor} } {
	$self instvar configspec_
	foreach spec $specs {
		if { ! $isAncestor } {
			set option  [lindex $spec 0]
			set default [lindex $spec 3]
			set spec [lreplace $spec 3 3 [WidgetClass \
					translate_default $option $default]]
			set configspec_($option) $spec
		}
		option add *$self.[lindex $spec 1] \
				[lindex $spec 3] widgetDefault
	}
}
WidgetClass instproc set_alias { aliases } {
	$self instvar configspec_
	foreach alias $aliases {
		set al   [lindex $alias 0]
		set orig [lindex $alias 1]
		if { ![info exists configspec_($orig)] } {
			error "no configspec $orig (specified in alias list)"
		}
		set configspec_($al) $configspec_($orig)
	}
}
WidgetClass instproc set_default { defaults } {
	$self default_ $defaults
	$self set defaults_ $defaults
}
WidgetClass instproc default_ { defaults } {
	foreach default $defaults {
		set option [lindex $default 0]
		set star [string last "*" $option]
		set dot  [string last "." $option]
		if { $star < $dot } {
			set idx [expr $dot+1]
		} else {
			set idx [expr $star+1]
		}
		option add *${self}$option [WidgetClass translate_default \
				-[string tolower [string range $option $idx \
				end]] [lindex $default 1]] widgetDefault
	}
}
WidgetClass instproc create { widget args } {
	eval [list $self] next [list _o$widget] [list $widget] $args
	return $widget
}
WidgetClass instproc info { option args } {
	if { $option == "default" } {
		if { $args != "" } {
			error "extra arguments in call to 'info $option'"
		}
		return [$self set defaults_]
	} elseif { $option == "configspec" } {
		$self instvar configspec_
		set len [llength $args]
		if { $len == 0 } {
			set list {}
			foreach el [array names configspec_] {
				lappend list $configspec_($el)
			}
			return $list
		}
		if { [llength $args] != 1 } {
			error "extra arguments in call to 'info $option'"
		}
		if { [info exists configspec_($args)] } {
			return $configspec_($args)
		} else {
			return ""
		}
		return [eval [list $self] next [list $option] $args]
	} else {
		return [eval [list $self] next [list $option] $args]
	}
}
WidgetClass WidgetObject -configspec {
	{-options options Options {} widget_options widget_options}
}
WidgetObject instproc init { widget args } {
	$self next
	$self instvar path_ widget_proc_
	set path_ $widget
	$self create_root_widget $widget
	if { ![winfo exists $widget] } {
		error "must create a widget $widget inside\
				[$self info class]::create_root_widget"
	}
	$self instvar widget_proc_
	set widget_proc_ "proc_$self"
	rename $widget $widget_proc_
	proc ::$widget { args } "return \[uplevel [list $self] \$args\]"
	$self build_widget $widget
	set heritage [[$self info class] info heritage]
	set idx 0
	for { set idx [expr [llength $heritage]-1] } {$idx>=0} {incr idx -1} {
		set cl [lindex $heritage $idx]
		if { [isWidgetObject $cl] } {
			$self configure_default $cl
		}
	}
	$self configure_default [$self info class]
	if { $args!="" } {
		eval [list $self] configure $args
	}
	if { [winfo toplevel $path_]==$path_ } {
		bind $widget <Destroy> "if \{\"%W\"==\"$path_\"\} \
				\{delete $self\}"
	} else {
		bind $widget <Destroy> "delete $self"
	}
}
WidgetObject instproc create_root_widget { path } {
	frame $path -class [$self info class]
}
WidgetObject instproc build_widget { path } {
}
WidgetObject instproc info { option args } {
	switch $option {
		"path" {
			if { $args != "" } {
				error "extra arguments in call to 'info $option'"
			}
			return [$self set path_]
		}
		"self" { return $self }
		default {
			return [eval [list $self] next [list $option] $args]
		}
	}
}
WidgetObject instproc unknown { method args } {
	return [eval [list $self] widget_proc [list $method] $args]
}
WidgetObject instproc widget_proc { args } {
	$self instvar widget_proc_
	return [eval [list $widget_proc_] $args]
}
WidgetObject instproc config { args } {
	return [eval [list $self] configure $args]
}
WidgetObject instproc configure_default { cl } {
	set path [$self info path]
	set widget_class [winfo class $path]
	if { $widget_class == [$self info class] } {
		foreach spec [$cl info configspec] {
			set optVal [option get $path [lindex $spec 1] $cl]
			$self configure [lindex $spec 0] $optVal
		}
	} else {
		foreach spec [$cl info configspec] {
			$self configure [lindex $spec 0] [lindex $spec 3]
		}
	}
}
WidgetObject instproc configure { args } {
	set len [llength $args]
	switch $len {
		0 { return [$self configure_all] }
		1 { return [$self configure_one $args] }
		default {
			if { $len % 2 != 0 } {
				error "odd number of arguments for configure"
			}
			for { set i 0 } { $i < $len } { incr i 2 } {
				$self configure_one [lindex $args $i] \
						[lindex $args [expr $i+1]]
			}
		}
	}
}
WidgetObject instproc configure_one { args } {
	set option [lindex $args 0]
	if { [string index $option 0] != "-" } {
		error "invalid option $option: must start with -"
	}
	set option [string range $option 1 end]
	set spec [[$self info class] info configspec -$option]
	if { $spec!="" } {
		set config_proc [lindex $spec 4]
		set cget_proc   [lindex $spec 5]
		if { $cget_proc=={} } { set cget_proc $config_proc }
		if { [llength $args] < 2 } {
			return [lreplace $spec 4 end [$self $cget_proc \
					"-$option"]]
		} else {
			return [$self $config_proc "-$option" [lindex $args 1]]
		}
	}
	foreach cl [[$self info class] info heritage] {
		if { [isWidgetObject $cl] } {
			set spec [$cl info configspec -$option]
			if { $spec!="" } {
				set config_proc [lindex $spec 4]
				set cget_proc   [lindex $spec 5]
				if { $cget_proc=={} } {
					set cget_proc $config_proc
				}
				if { [llength $args] < 2 } {
					return [lreplace $spec 4 end \
							[$self $cget_proc \
							"-$option"]]
				} else {
					return [$self $config_proc "-$option" \
							[lindex $args 1]]
				}
			}
		}
	}
	return [eval [list $self] widget_proc configure $args]
}
WidgetObject instproc configure_all { } {
	set result [$self configure_all_ [$self info class]]
	foreach cl [[$self info class] info heritage] {
		if { [isWidgetObject $cl] } {
			set result [concat $result [$self configure_all_ $cl]]
		}
	}
	set result [concat $result [$self widget_proc configure]]
	return $result
}
WidgetObject instproc configure_all_ { cl } {
	set result ""
	foreach spec [$cl info configspec] {
		set option [lindex $spec 0]
		if { $option != "-options" } {
			lappend result [$self configure $option]
		}
	}
	return $result
}
WidgetObject instproc cget { option } {
	return [lindex [$self configure_one $option] 4]
}
WidgetObject instproc widget_options { option args } {
	if { [llength $args]==0 } {
		error "options has no value; cannot read it"
	}
	set root [$self info path]
	foreach option [lindex $args 0] {
		set opt [string trim [lindex $option 0]]
		set arg [lindex $option 1]
		set lastdot [string last . $opt]
		if { $lastdot <= 0 } {
			set path $root
		} else {
			set firstdot  [string first . $opt]
			set path [string range $opt 0 [expr $firstdot-1]]
			set path [$self subwidget $path]
			if { $firstdot < $lastdot } {
				set path $path.[string range $opt \
						[expr $firstdot+1] \
						[expr $lastdot -1]]
			}
		}
		set opt [string range $opt [expr $lastdot+1] end]
		$path configure -$opt $arg
	}
}
WidgetObject instproc subwidget { widget args } {
	set path "[$self info path].$widget"
	if { ![winfo exists $path] } {
		$self instvar subwidgets_
		if { ![info exists subwidgets_($widget)] } {
			error "no subwidget $widget inside [$self info path]"
		}
		set path $subwidgets_($widget)
	}
	if { [llength $args]==0 } {
		return $path
	}
	return [eval [list $path] $args]
}
WidgetObject instproc set_subwidget { name path } {
	$self instvar subwidgets_
	$self set subwidgets_($name) $path
}
WidgetObject instproc ignore_args { args } {
}
WidgetObject instproc do_when_idle { command } {
	$self instvar do_idle_ids_
	set command [string trim $command]
	if ![info exists do_idle_ids_($command)] {
		set do_idle_ids_($command) \
				[after idle "WidgetObject do_idle_ \
				[list $self] [list $command]"]
	}
}
WidgetObject proc do_idle_ { o command } {
	$o instvar do_idle_ids_
	catch {unset do_idle_ids_($command)}
	if { [info command $o]!=$o } {
		return
	}
	set w [$o info path]
	if {![winfo exists $w] || [string compare [winfo class $w] \
			[$o info class]] != 0} {
		return
	} else {
		uplevel #0 $command
	}
}
WidgetClass proc transparent_gif { {color {}} } {
	global TRANSPARENT_GIF_COLOR
	if { $color!={} } {
		set TRANSPARENT_GIF_COLOR $color
	} else {
		set TRANSPARENT_GIF_COLOR [$self widget_default -background]
	}
}
WidgetClass proc EntryBindings { tag } {
	bind $tag <FocusIn>  "$self EntryBindings_FocusIn %W"
	bind $tag <FocusOut> "$self EntryBindings_FocusOut %W"
}
WidgetClass proc EntryBindings_FocusIn { entry } {
	if [string compare [$entry get] ""] {
		$entry selection from 0
		$entry selection to   end
		$entry icursor end
	} else {
		$entry selection clear
	}
}
WidgetClass proc EntryBindings_FocusOut { entry } {
    $entry selection clear
}
WidgetClass EntryBindings Entry
WidgetClass transparent_gif
WidgetClass Dialog -configspec {
	{ -defaultfocus defaultFocus DefaultFocus {} config_defaultfocus } 
	{ -title title Title {} config_wm_option }
	{ -transient transient Transient {} config_transient }
	{ -result result Result {} config_result cget_result }
	{ -modal modal Modal 1 config_option }
	{ -closecmd closeCmd CloseCmd {} config_option }
}
Dialog instproc create_root_widget { path } {
	toplevel $path -class [$self info class]
	wm withdraw $path
	wm protocol $path WM_DELETE_WINDOW "$self cancel"
}
Dialog instproc config_defaultfocus { option args } {
	if { [llength $args]==0 } {
		return [$self set default_focus_]
	} else {
		$self set default_focus_ [string trim [lindex $args 0]]
	}
}
Dialog instproc config_wm_option { option args } {
	if { [llength $args]==0 } {
		return [wm [string range [string trim $option] 1 end] \
				[$self info path]]
	} else {
		wm [string range [string trim $option] 1 end] \
				[$self info path] [lindex $args 0]
	}
}
Dialog instproc config_transient { option args } {
	set path [$self info path]
	if { [llength $args]==0 } {
		return [wm transient $path]
	} else {
		set is_mapped [winfo ismapped $path]
		wm transient $path [lindex $args 0]
		if { !$is_mapped } {
			wm withdraw $path
		}
	}
}
Dialog instproc center { } {
	set path [$self info path]
	wm withdraw $path
	update idletasks
	update
	set x [expr [winfo screenwidth $path]/2 - [winfo reqwidth $path]/2 \
			- [winfo vrootx [winfo parent $path]]]
	set y [expr [winfo screenheight $path]/2 - [winfo reqheight $path]/2 \
			- [winfo vrooty [winfo parent $path]]]
	wm geom $path +$x+$y
	wm deiconify $path
	raise $path
}
Dialog instproc grab { {start_focus {}} } {
	$self instvar old_focus_ old_grab_ grab_status_	
	set path [$self info path]
	set old_focus_ [focus]
	set old_grab_ [grab current $path]
	if {$old_grab_ != ""} {
		set grab_status_ [grab status $old_grab_]
	}
	grab $path
	if { [string trim $start_focus]=={} } {
		set start_focus [$self cget -defaultfocus]
	}
	if { $start_focus != {} } {
		focus [eval [list $self] subwidget $start_focus]
	}
}
Dialog instproc release { } {
	$self instvar old_focus_ old_grab_ grab_status_
	catch {focus $old_focus_}
	grab release [$self info path]
	if {$old_grab_ != ""} {
		if {$grab_status_ == "global"} {
			grab -global $old_grab_
		} else {
			grab $old_grab_
		}
	}
}
Dialog instproc wait { } {
	$self tkvar result_
	catch { unset result_ }
	tkwait variable [$self tkvarname result_]
	return $result_
}
Dialog instproc invoke { {start_focus {}} } {
	$self instvar old_focus_ old_grab_ grab_status_
	set path [$self info path]
	$self center
	if { [$self cget -modal] } {
		$self grab $start_focus
		set result [$self wait]
		$self release
		wm withdraw $path
		$self invoke_closecmd
		return $result
	} else {
		if { [string trim $start_focus]=={} } {
			set start_focus [$self cget -defaultfocus]
		}
		if { $start_focus != {} } {
			focus [eval [list $self] subwidget $start_focus]
		}
		$self tkvar result_
		catch { unset result_ }
		trace variable result_ w "Dialog nonmodal_result_ [list $self]\
				; $self ignore_args"
		return ""
	}
}
Dialog instproc cancel { } {
	$self configure -result {}
}
Dialog instproc config_result { option value } {
	$self tkvar result_
	set result_ $value
}
Dialog instproc cget_result { option } {
	$self tkvar result_
	if { [info exists result_] } {
		return $result_
	} else {
		return ""
	}
}
Dialog instproc config_option { option args } {
	$self instvar config_
	if { [llength $args]==0 } {
		return $config_($option)
	} else {
		set config_($option) [lindex $args 0]
	}
}
Dialog instproc invoke_closecmd { } {
	set closecmd [$self cget -closecmd]
	if { [string trim $closecmd]!={} } {
		uplevel #0 $closecmd
	}
}
Dialog proc nonmodal_result_ { dlg } {
	if { [info command $dlg]==$dlg } {
		set path [$dlg info path]
		if { ![winfo exists $path] } return
		wm deiconify [$dlg info path]
		$dlg tkvar result_
		trace vdelete result_ w "Dialog nonmodal_result_ $dlg"
		$dlg invoke_closecmd
	}
}
Dialog proc transient { cl args } {
	set count 0
	set path .dialog__$count
	while { [winfo exists $path] } {
		set path .dialog__$count
		incr count
	}
	eval $cl [list $path] $args
	set modal [$path cget -modal]
	if { ! $modal } {
		set command [$path cget -closecmd]
		append command "; destroy $path"
		$path configure -closecmd $command
		return [$path invoke]
	} else {
		set result [$path invoke]
		destroy $path
		return $result
	}
}
WidgetClass CompoundButton -configspec {
	{ -relief relief Relief raised config_all }
	{ -background background Background WidgetDefault config_all }
	{ -foreground foreground Foreground WidgetDefault config_all }
	{ -state state State normal config_all }
	{ -font font Font WidgetDefault config_all }
	{ -command command Command "" config_command }
} -alias {
	{ -bg -background }
	{ -fg -foreground }
} -default {
	{ .highlightThickness WidgetDefault }
	{ .takeFocus 1 }
	{ .borderWidth WidgetDefault }
	{ .relief raised }
}
CompoundButton proc root { className path } {
	while { $path!="" && [winfo class $path]!=$className } {
		set path [winfo parent $path]
	}
	return $path
}
CompoundButton proc init_ { cl } {
	$self instvar init_done_
	if [info exists init_done_($cl)] return
	set init_done_($cl) 1
	bind $cl <B1-Motion> "\[$self root $cl %W\] b1_motion %W %x %y"
	bind $cl <Button-1>  "\[$self root $cl %W\] button_down"
	bind $cl <ButtonRelease-1> "\[$self root $cl %W\] button_up"
}
CompoundButton instproc init { args } {
	CompoundButton init_ [$self info class]
	eval [list $self] next $args
	$self set button_down_ 0
	$self set entered_ 0
}
CompoundButton instproc build_widget { path } {
	bind $path <Enter> "$self enter"
	bind $path <Leave> "$self leave"
	bind $path <Key-space> "$self invoke_with_ui"
}
CompoundButton instproc add { args } {
	set widget_type [lindex $args 0]
	set subwidget   [lindex $args 1]
	set path        [$self info path].$subwidget
	eval [list $widget_type] [list $path] [lrange $args 2 end]
	$self instvar config_
	foreach name [array names config_] {
		$path configure $name $config_($name)
	}
	if { ![catch {$path configure -takefocus}] } {
		$path configure -takefocus 0
	}
	if { ![catch {$path configure -highlightthickness}] } {
		$path configure -highlightthickness 0
	}
	set tags [bindtags $path]
	set idx [lsearch $tags [winfo class $path]]
	if { $idx!=-1 } {
		set tags [lreplace $tags $idx $idx]
	}
	set cl [$self info class]
	if { [lsearch $tags $cl] == -1 } {
		set tags [concat $cl $tags]
	}
	bindtags $path $tags
	return $subwidget
}
CompoundButton instproc remove { subwidget } {
	destroy [$self info path].$subwidget
}
CompoundButton instproc invoke { } {
	set command [$self cget -command]
	if { [string trim $command]!={} } {
		uplevel #0 $command
	}
}
CompoundButton instproc config_command { option args } {
	$self instvar config_
	if { [llength $args] == 0 } {
		return $config_(-command)
	} else {
		set config_(-command) [lindex $args 0]
	}
}
CompoundButton instproc config_all { option args } {
	$self instvar config_
	if { [llength $args]==0 } {
		return $config_($option)
	} else {
		set value [lindex $args 0]
		set config_($option) $value
		if { ![catch {$self widget_proc configure $option}] } {
			$self widget_proc configure $option $value
		}
		foreach child [winfo children [$self info path]] {
			if { ![catch {$child configure $option}] } {
				$child configure $option $value
			}
		}
	}
}
CompoundButton instproc button_down { } {
	$self instvar button_down_ saved_relief_
	set saved_relief_ [$self cget -relief]
	if { [$self cget -state] != "disabled" } {
		set button_down_ 1
		$self configure -relief sunken
	}
}
CompoundButton instproc button_up { } {
	$self instvar entered_ button_down_ saved_relief_
	if { $button_down_ } {
		set button_down_ 0
		$self configure -relief $saved_relief_
		if { $entered_ && [$self cget -state] != "disabled" } {
			$self invoke
		}
	}
}
CompoundButton instproc b1_motion { widget x y } {
	$self instvar button_down_ entered_
	if { !$button_down_ } return
	set root [$self info path]
	if { $widget!=$root } {
		incr x [winfo x $widget]
		incr y [winfo y $widget]
	}
	if { $x >= 0 && $y >= 0 && $x < [winfo width $root] && \
			$y < [winfo height $root] } {
		if { ! $entered_ } {
			$self enter
		}
	} else {
		if { $entered_ } {
			$self leave
		}
	}
}
CompoundButton instproc enter { } {
	$self instvar entered_ button_down_
	if { [$self cget -state] != "disabled" } {
		if { $button_down_ } {
			$self configure -relief sunken
		}
		set entered_ 1
	}
}
CompoundButton instproc leave { } {
	$self instvar entered_ button_down_ saved_relief_
	if { $button_down_ } {
		$self configure -relief $saved_relief_
	}
	set entered_ 0
}
CompoundButton instproc invoke_with_ui { } {
	if {[$self cget -state] != "disabled"} {
		set oldRelief [$self cget -relief]
		$self configure -relief sunken
		update idletasks
		after 100
		$self configure -relief $oldRelief
		$self invoke
	}
}
WidgetClass ImageTextButton -superclass CompoundButton -configspec {
	{ -orient orient Orient horizontal config_orient }
	{ -style style Style imagetext config_style }
	{ -image image Image {} config_imageoption }
	{ -text text Text {} config_textoption }
	{ -underline underline Underline -1 config_textoption }
	{ -command command Command {} config_textoption }
} -alias {
	{ -under -underline }
} -default {
	{ *Button.borderWidth 0 }
	{ *Button.highlightThickness 0 }
	{ *Button.padX 1 }
	{ *Button.padY 1 }
}
ImageTextButton instproc build_widget { path } {
	$self next $path
	$self add button image
	$self add button text
}
ImageTextButton instproc repack { } {
	set path   [$self info path]
	catch { pack forget $path.image }
	catch { pack forget $path.text  }
	switch [$self cget -orient] {
		horizontal {
			set side left
		}
		vertical -
		default {
			set side top
		}
	}
	switch [$self cget -style] {
		imagetext {
			set list "[list $path.image] [list $path.text]"
		}
		image {
			set list $path.image
		}
		text {
			set list $path.text
		}
	}
	eval pack $list -side [list $side] -expand 1 -fill both -padx 2
}
ImageTextButton instproc config_orient { option {orient {}} } {
	$self instvar orient_
	switch -exact -- $orient {
		{} {
			if { [info exists orient_] } {
				return $orient_
			} else {
				return vertical
			}
		}
		vertical -
		horizontal {
			set orient_ $orient
			$self repack
		}
		default {
			error "invalid orientation $orient"
		}
	}
}
ImageTextButton instproc config_style { option {style {}} } {
	$self instvar style_
	switch -exact -- $style {
		{} {
			if { [info exists style_] } {
				return $style_
			} else {
				return imagetext
			}
		}
		imagetext -
		image -
		text {
			set style_ $style
			$self repack
		}
		default {
			error "invalid style $style"
		}
	}
}
ImageTextButton instproc config_imageoption { option args } {
	if { [llength $args]==0 } {
		return [$self subwidget image cget $option]
	} else {
		$self subwidget image configure $option [lindex $args 0]
	}
}
ImageTextButton instproc config_textoption { option args } {
	if { [llength $args]==0 } {
		return [$self subwidget text cget $option]
	} else {
		$self subwidget text configure $option [lindex $args 0]
	}
}
WidgetClass LabeledWidget -configspec {
	{ -label  label Label {} config_label }
	{ -underline underline Underline -1 config_underline }
	{ -widget widget Widget {} config_widget }
	{ -orient orient Orient horizontal config_orient }
} -alias {
	{ -under -underline }
}
LabeledWidget instproc build_widget { path } {
	label $path.label -anchor w
	$self set widget_ ""
}
LabeledWidget instproc config_label { option args } {
	if { [llength $args]==0 } {
		return [$self subwidget label cget -text]
	} else {
		$self subwidget label configure -text [lindex $args 0]
	}
}
LabeledWidget instproc config_underline { option args } {
	if { [llength $args]==0 } {
		return [$self subwidget label cget -underline]
	} else {
		$self subwidget label configure -underline [lindex $args 0]
	}
}
LabeledWidget instproc config_widget { option args } {
	$self instvar widget_
	if { [llength $args]==0 } {
		return $widget_
	} else {
		set widget [lindex $args 0]
		if { $widget != "" && [winfo parent $widget]!=[winfo parent \
				[$self info path]] } {
			error "\"$widget\" must have the same parent as\
					\"[$self info path]\""
		}
		catch { pack forget $widget_ }
		set widget_ $widget
		$self repack
	}
}
LabeledWidget instproc config_orient { option args } {
	$self instvar orient_
	if { [llength $args]==0 } {
		if { [info exists orient_] } {
			return $orient_
		} else {
			return horizontal
		}
	} else {
		$self set orient_ [lindex $args 0]
		$self repack
	}
}
LabeledWidget instproc repack { } {
	$self instvar widget_
	set label [$self subwidget label]
	catch { pack forget $label $widget_ }
	set orient [$self cget -orient]
	switch -exact -- $orient {
		horizontal {
			set side left
			set label_fill x
		}
		vertical {
			set side top
			set label_fill y
		}
		default {
			error "invalid orientation \"$orient\""
		}
	}
	pack $label -side $side -fill $label_fill -anchor w
	if { $widget_!="" } {
		set path [$self info path]
		pack $widget_ -side $side -fill both -expand 1 -in $path
		raise $widget_ $path
	}
}
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\26\134\43\24\134\43\302\134\43\134\43\330\330\330\370\374\370\134\43\134\43\134\43\70\370\60\200\200\200\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\26\134\43\24\134\43\134\43\3\123\10\272\334\376\120\205\40\142\234\103\20\142\33\316\133\267\174\202\306\111\323\103\232\47\20\14\231\367\146\354\70\233\50\134\134\156\255\13\203\234\17\260\347\323\155\204\73\142\21\106\100\326\74\277\201\223\247\212\106\223\112\211\125\367\204\314\176\130\221\134\43\334\355\224\302\242\5\57\224\146\120\333\360\106\2\134\43\73"]
image create photo Icons(check) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\24\134\43\24\134\43\302\134\43\134\43\330\330\330\370\374\370\134\43\134\43\134\43\370\24\100\200\200\200\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\24\134\43\24\134\43\134\43\3\126\10\272\274\21\55\212\366\306\210\312\116\27\354\330\214\47\154\225\46\20\215\367\1\345\167\22\250\43\12\235\11\303\114\255\332\67\266\153\267\230\157\367\22\16\211\306\43\21\263\370\251\100\251\31\21\232\231\265\134\134\306\347\253\64\352\125\261\267\116\327\13\340\305\36\305\344\70\31\214\264\335\311\5\216\331\110\134\43\134\43\73"]
image create photo Icons(cross) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\22\134\43\22\134\43\302\134\43\134\43\330\330\330\134\43\134\43\134\43\370\374\370\270\274\270\70\370\60\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\22\134\43\22\134\43\134\43\3\112\10\272\334\376\360\205\71\243\232\42\347\52\363\40\104\60\154\116\40\14\50\50\242\103\320\230\254\312\266\14\34\207\63\175\11\140\357\343\256\335\357\47\12\2\114\224\200\52\251\73\236\156\53\226\321\11\235\115\251\51\234\264\44\235\154\45\121\24\47\222\274\132\42\11\134\43\73"]
image create photo Icons(plus) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\22\134\43\22\134\43\302\134\43\134\43\330\330\330\134\43\134\43\134\43\370\374\370\270\274\270\70\370\60\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\22\134\43\22\134\43\134\43\3\101\10\272\334\376\360\205\71\243\232\42\347\52\363\370\337\346\4\2\150\202\101\103\236\147\272\254\154\373\12\104\155\337\301\340\2\344\355\23\271\35\211\102\44\352\146\61\31\62\171\144\300\222\273\27\63\352\314\231\70\221\242\145\273\110\134\43\134\43\73"]
image create photo Icons(minus) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\24\134\43\24\134\43\302\134\43\134\43\330\330\330\120\124\120\134\43\134\43\134\43\270\274\270\370\374\370\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\24\134\43\24\134\43\134\43\3\134\134\10\272\334\356\41\312\327\242\270\170\104\32\260\317\301\43\175\327\4\21\232\44\15\32\24\14\4\312\6\162\272\274\132\254\301\173\72\53\253\330\13\365\122\205\30\64\42\257\270\71\11\227\273\143\5\106\30\106\233\225\130\25\152\312\52\225\105\21\325\212\303\42\265\270\136\13\302\222\105\164\153\27\153\116\224\162\214\166\212\276\221\134\43\134\43\73"]
image create photo Icons(trashcan) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\50\134\43\50\134\43\302\134\43\134\43\330\330\330\170\174\134\43\370\374\134\43\270\274\270\134\43\134\43\134\43\170\174\170\134\43\134\43\134\43\134\43\134\43\134\43\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\50\134\43\50\134\43\134\43\3\270\10\272\334\376\60\312\111\253\275\70\353\27\372\316\201\40\14\304\147\205\342\110\24\346\204\246\53\333\162\151\112\26\362\314\274\165\254\357\265\332\55\247\343\5\175\77\143\160\230\264\21\236\3\30\256\330\173\76\235\323\26\317\172\225\22\65\106\56\101\210\334\204\271\307\54\70\50\20\57\313\30\145\300\252\204\237\330\52\50\233\31\307\267\273\154\166\56\176\2\163\112\42\174\25\207\210\4\121\176\202\20\213\60\204\52\152\22\222\224\75\226\221\231\44\215\204\211\234\224\150\204\220\13\230\42\244\176\241\15\250\171\216\245\233\100\231\264\136\137\247\265\265\103\267\270\271\240\61\262\73\142\303\304\303\70\307\24\307\312\313\314\315\301\17\316\321\316\77\324\325\326\327\330\11\134\43\73"]
image create photo Icons(warning) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\20\134\43\12\134\43\241\134\43\134\43\330\330\330\370\374\370\134\43\134\43\134\43\200\200\200\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\20\134\43\12\134\43\134\43\2\35\204\217\171\301\355\201\202\230\264\212\21\155\35\70\153\256\134\43\322\326\205\343\125\206\42\252\266\356\133\134\43\134\43\73"]
image create photo Icons(minimize) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\20\134\43\12\134\43\241\134\43\134\43\330\330\330\370\374\370\134\43\134\43\134\43\200\200\200\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\20\134\43\12\134\43\134\43\2\35\204\217\251\26\273\41\206\103\120\304\11\252\275\157\173\231\150\236\5\62\343\131\2\303\312\266\51\226\24\134\43\73"]
image create photo Icons(maximize) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\24\134\43\17\134\43\362\134\43\134\43\330\330\330\177\177\177\377\377\134\43\377\377\377\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\24\134\43\17\134\43\134\43\3\101\10\272\334\276\41\306\367\2\20\27\130\12\63\306\222\344\4\103\151\236\145\100\64\344\347\171\52\73\274\56\270\62\55\15\337\320\134\134\277\61\334\340\127\13\366\164\56\243\42\107\274\50\65\241\150\210\267\40\130\257\130\54\147\313\110\134\43\134\43\73"]
image create photo Icons(folder) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\24\134\43\17\134\43\302\134\43\134\43\330\330\330\170\174\170\370\374\370\270\274\270\370\374\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\24\134\43\17\134\43\134\43\3\105\10\272\334\316\41\306\367\202\270\67\120\50\6\361\203\40\111\216\365\235\41\46\26\215\5\242\150\300\56\143\75\22\62\247\356\362\220\323\35\330\253\20\231\1\137\110\331\17\50\104\21\215\114\344\111\6\125\330\154\205\252\42\313\355\166\67\340\105\2\134\43\73"]
image create photo Icons(folderopen) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\24\134\43\17\134\43\362\134\43\134\43\330\330\330\177\177\177\377\377\134\43\377\377\377\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\24\134\43\17\134\43\134\43\3\105\10\272\334\276\41\306\367\2\20\27\130\12\63\306\222\344\4\103\151\236\145\100\64\344\27\174\236\312\16\227\4\203\53\323\206\157\234\103\64\220\47\43\323\15\134\134\267\332\117\101\42\362\160\263\344\255\10\341\131\43\113\5\141\313\355\166\71\140\106\2\134\43\73"]
image create photo Icons(folderup) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\17\134\43\17\134\43\241\134\43\134\43\330\330\330\170\174\170\370\374\370\134\43\134\43\134\43\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\17\134\43\17\134\43\134\43\2\62\204\217\151\301\315\12\202\230\263\51\111\205\113\222\325\66\40\130\126\205\107\347\224\42\111\5\346\242\245\332\33\261\352\31\67\67\154\273\242\3\244\1\6\304\242\21\202\64\24\134\43\134\43\73"]
image create photo Icons(textfile) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\22\134\43\22\134\43\204\134\43\134\43\330\330\330\170\174\170\134\43\370\360\360\370\360\134\43\134\43\134\43\360\374\360\134\43\374\360\134\43\370\370\360\370\370\134\43\170\170\134\43\374\370\370\370\360\134\43\174\170\134\43\134\43\360\134\43\134\43\170\134\43\134\43\370\134\43\134\43\160\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\22\134\43\22\134\43\134\43\5\144\40\40\216\144\151\212\101\32\234\145\52\14\57\101\260\100\134\43\303\205\220\317\147\140\14\277\327\141\300\153\275\4\210\237\62\121\34\331\24\260\5\122\260\140\64\121\57\45\20\310\64\331\250\103\341\300\332\313\231\165\344\336\21\361\142\60\257\43\31\143\156\45\64\32\360\270\214\340\160\30\356\171\47\16\2\200\64\45\203\17\170\206\44\20\177\201\47\62\213\64\41\134\43\73"]
image create photo Icons(browse) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\11\134\43\10\134\43\241\134\43\134\43\330\330\330\370\374\370\134\43\134\43\134\43\200\200\200\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\11\134\43\10\134\43\134\43\2\25\204\21\247\41\243\50\242\63\54\112\150\355\10\134\134\217\11\150\17\360\115\5\134\43\73"]
image create photo Icons(up) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\11\134\43\10\134\43\241\134\43\134\43\330\330\330\370\374\370\134\43\134\43\134\43\200\200\200\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\11\134\43\10\134\43\134\43\2\24\4\202\141\33\342\143\222\23\3\266\71\55\246\54\257\310\175\6\264\24\134\43\73"]
image create photo Icons(down) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\11\134\43\10\134\43\241\134\43\134\43\330\330\330\370\374\370\134\43\134\43\134\43\200\200\200\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\11\134\43\10\134\43\134\43\2\25\204\43\143\213\222\354\242\152\321\215\200\321\330\12\320\356\125\17\125\15\5\134\43\73"]
image create photo Icons(fastup) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\11\134\43\10\134\43\241\134\43\134\43\330\330\330\134\43\134\43\134\43\200\200\200\370\374\370\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\11\134\43\10\134\43\134\43\2\23\104\216\41\60\251\134\43\333\131\154\330\27\335\144\216\362\15\145\136\1\134\43\73"]
image create photo Icons(fastdown) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\34\134\43\24\134\43\245\134\43\134\43\370\370\370\340\340\370\230\230\340\150\150\300\370\340\370\134\43\134\43\300\134\43\134\43\230\134\43\134\43\150\300\230\150\370\370\300\250\300\370\340\300\134\43\300\300\230\300\300\134\43\150\134\43\300\340\340\300\370\370\340\150\150\150\250\254\230\150\134\43\150\340\340\134\43\370\370\230\150\150\340\230\150\134\43\150\150\134\43\300\300\340\340\340\150\300\230\134\43\370\370\150\340\370\370\230\150\150\370\370\134\43\134\43\150\340\230\150\300\340\340\340\300\300\150\370\340\134\43\150\150\230\230\230\300\134\43\150\300\150\134\43\230\340\340\230\134\43\134\43\340\230\230\230\300\230\300\230\230\134\43\340\300\150\300\230\340\370\340\150\370\340\230\370\340\300\340\300\230\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\34\134\43\24\134\43\134\43\6\375\100\200\160\110\54\32\217\110\100\100\60\150\22\222\120\245\240\140\60\34\14\210\104\62\200\124\120\253\13\206\241\241\65\6\12\216\7\244\50\250\32\42\15\111\141\102\131\263\251\207\205\135\330\256\322\37\163\13\25\106\26\125\27\30\24\104\31\137\6\13\11\4\31\32\203\154\125\33\21\33\223\112\214\15\34\104\1\4\35\240\134\43\213\6\33\36\21\211\103\205\206\37\103\113\5\5\40\5\41\42\124\227\245\231\1\156\215\166\147\273\6\27\43\206\300\44\104\253\300\235\232\225\45\140\46\156\164\173\134\43\3\156\15\223\175\33\15\206\44\47\156\202\105\323\225\203\276\36\15\124\320\137\325\204\156\50\51\1\40\277\245\51\52\324\107\35\214\6\367\273\124\36\53\125\54\134\134\105\2\230\30\200\342\300\204\26\54\340\35\150\341\202\24\76\21\107\136\344\203\127\5\226\241\124\256\346\255\243\270\353\340\2\30\321\134\43\264\271\320\300\205\206\30\51\144\244\170\200\62\305\14\15\51\122\304\110\20\122\110\134\43\21\20\152\106\51\22\4\134\43\73"]
image create photo Icons(cal) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\67\141\15\134\43\24\134\43\360\134\43\134\43\377\377\377\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\15\134\43\24\134\43\134\43\2\55\204\217\11\301\235\254\240\11\152\322\145\35\306\162\172\172\65\20\10\162\143\145\155\110\130\256\254\232\225\127\105\242\134\134\344\314\250\356\255\221\377\113\341\64\207\2\134\43\73"]
image create photo Icons(ear) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\67\141\20\134\43\20\134\43\360\134\43\134\43\377\377\377\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\20\134\43\20\134\43\134\43\2\51\204\17\21\310\271\353\40\202\312\120\106\157\332\107\147\316\171\226\3\116\326\327\164\222\324\150\151\7\277\343\374\262\45\326\246\166\154\352\271\121\134\43\134\43\73"]
image create photo Icons(hand) -data $imageObject__
WidgetClass MessageBox -superclass Dialog -configspec {
	{ -image image Image {} config_image  }
	{ -text  text  Text  {} config_text   }
	{ -type  type  Type  {ok} config_type }
} -default {
	{ .transient . }
	{ .title "Message" }
	{ *image.padX 10 }
	{ *image.padY 5 }
	{ *text.wrapLength 3i }
	{ *ImageTextButton.borderWidth 1 }
	{ *ImageTextButton.highlightThickness 1 }	
}
MessageBox instproc build_widget { path } {
	frame $path.bot -relief raised -bd 1
	pack  $path.bot -side bottom -fill x
	frame $path.top -relief raised -bd 1
	pack  $path.top -side top -fill both -expand 1
	label $path.image
	label $path.text -justify left
	pack $path.image -side left -in $path.top
	pack $path.text -side right -fill both -expand 1 -in $path.top
}
MessageBox instproc config_image { option args } {
	if { [llength $args]==0 } {
		return [$self subwidget image cget -image]
	} else {
		$self subwidget image configure -image [lindex $args 0]
	}
}
MessageBox instproc config_text { option args } {
	if { [llength $args]==0 } {
		return [$self subwidget text cget -text]
	} else {
		$self subwidget text configure -text [lindex $args 0]
	}
}
MessageBox instproc config_type { option args } {
	if { [llength $args]==0 } {
		return [$self set type_]
	}
	$self instvar type_
	set type_ [lindex $args 0]
	foreach button [pack slaves [$self subwidget bot]] {
		destroy $button
	}
	switch -exact -- $type_ {
		abortretryignore {
			set buttons {
				{abort  -text Abort -under 0 \
						-image Icons(cross)}
				{retry  -text Retry -under 0 
						-image Icons(redo) }
				{ignore -text Ignore -under 0 -style text}
			}
		}
		ok {
			set buttons {
				{ok -text OK -under 0 -image Icons(check)}
			}
		}
		okcancel {
			set buttons {
				{ok -text OK -under 0 -image Icons(check) }
				{cancel -text Cancel -under 0 \
						-image Icons(cross) }
			}
		}
		retrycancel {
			set buttons {
				{retry  -text Retry  -under 0 \
						-image Icons(redo) }
				{cancel -text Cancel -under 0 \
						-image Icons(cross) }
			}
		}
		yesno {
			set buttons {
				{yes -text Yes -under 0 -image Icons(check) }
				{no  -text No  -under 0 -image Icons(cross) }
			}
		}
		yesnocancel {
			set buttons {
				{yes -text Yes -under 0 -image Icons(check) }
				{no  -text No  -under 0 -image Icons(cross) }
				{cancel -text Cancel -under 0 -style text}
			}
		}
		none {
			set buttons {}
		}
		default {
			set buttons $type_
		}
	}
	set i 0
	set path [$self info path]
	foreach button [subst $buttons] {
		set name [lindex $button 0]
		set opts [lrange $button 1 end]
		if ![string compare $opts {}] {
			set capName [string toupper [string index \
					$name 0]][string range $name 1 end]
			set opts [list -text $capName]
		}
		eval ImageTextButton $path.$name $opts -orient horizontal \
				-command [list "$self configure -result $name"]
		pack $path.$name -in $path.bot -side left -expand 1 -fill y \
				-padx 3m -pady 2m
		set underIdx [$path.$name cget -under]
		if {$underIdx >= 0} {
			set key [string index [$path.$name cget -text] \
					$underIdx]
			bind $path <Alt-[string tolower $key]> \
					"$path.$name invoke_with_ui"
			bind $path <Alt-[string toupper $key]> \
					"$path.$name invoke_with_ui"
			bind $path <KeyPress-[string tolower $key]> \
					"$path.$name invoke_with_ui"
			bind $path <KeyPress-[string toupper $key]> \
					"$path.$name invoke_with_ui"
		}
		incr i
	}
}
MessageBox instproc config_type_ { option args } {
	if { [llength $args]==0 } {
		return [$self set type_]
	}
	$self instvar type_
	set type_ [lindex $args 0]
	set path [$self info path]
	foreach button [pack slaves [$self subwidget bot]] {
		if { $button == "$path.default" } {
			eval destroy [pack slaves $button]
		}
		destroy $button
	}
	switch -exact -- $type_ {
		abortretryignore {
			set buttons {
				{abort  -width 6 -text Abort -under 0 \
						-image Icons(cross)}
				{retry  -width 6 -text Retry -under 0 \
						-image Icons(redo) }
				{ignore -width 6 -text Ignore -under 0}
			}
		}
		ok {
			set buttons {
				{ok -width 6 -text OK -under 0 \
						-image Icons(check)}
			}
		}
		okcancel {
			set buttons {
				{ok     -width 6 -text OK     -under 0 \
						-image Icons(check) }
				{cancel -width 6 -text Cancel -under 0 \
						-image Icons(cross) }
			}
		}
		retrycancel {
			set buttons {
				{retry  -width 6 -text Retry  -under 0 \
						-image Icons(redo) }
				{cancel -width 6 -text Cancel -under 0 \
						-image Icons(cross) }
			}
		}
		yesno {
			set buttons {
				{yes    -width 6 -text Yes -under 0 \
						-image Icons(check) }
				{no     -width 6 -text No  -under 0 \
						-image Icons(cross) }
			}
		}
		yesnocancel {
			set buttons {
				{yes    -width 6 -text Yes -under 0 \
						-image Icons(check) }
				{no     -width 6 -text No  -under 0 \
						-image Icons(cross) }
				{cancel -width 6 -text Cancel -under 0}
			}
		}
		default {
			error "invalid message box type \"$type_\",\
					must be abortretryignore, ok,\
					okcancel, retrycancel, yesno or\
					yesnocancel"
		}
	}
	set default [$self cget -default]
	if { $default=="" } {
		set default [lindex [lindex $buttons 0] 0]
		$self configure -default $default
	} else {
		set valid 0
		foreach button $buttons {
			if { ![string compare $default [lindex $button 0]] } {
				set valid 1
				break
			}
		}
		if { ! $valid } {
			error "invalid default button \"$default\""
		}
	}
	set i 0
	set path [$self info path]
	foreach button [subst $buttons] {
		set name [lindex $button 0]
		set opts [lrange $button 1 end]
		if ![string compare $opts {}] {
			set capName [string toupper [string index \
					$name 0]][string range $name 1 end]
			set opts [list -text $capName]
		}
		eval ImageTextButton $path.$name $opts \
				-command [list "$self configure -result $name"]
		if ![string compare $name $default] {
			frame $path.default -relief flat -bd 1 -bg black
			raise $path.$name $path.default
			pack $path.default -in $path.bot -side left -expand 1 \
					-padx 3m -pady 2m
			pack $path.$name -in $path.default
		} else {
			pack $path.$name -in $path.bot -side left -expand 1 \
					-padx 3m -pady 2m
		}
		set underIdx [$path.$name cget -under]
		if {$underIdx >= 0} {
			set key [string index [$path.$name cget -text] \
					$underIdx]
			bind $path <Alt-[string tolower $key]> \
					"$path.$name invoke_with_ui"
			bind $path <Alt-[string toupper $key]> \
					"$path.$name invoke_with_ui"
		}
		incr i
	}
	bind $path <Return> "$path.$default invoke_with_ui"
}
Class Log
Log proc name s {
	Log set name_ $s
}
Log proc warn s {
	Log instvar name_
	puts stderr "$name_: $s"
}
Log proc fatal s {
	Log warn $s
	exit 1
}
Class Application
Application public init name {
	$self next
	$self instvar name_ class_
	set name_ $name
	$self add_option appname $name
	Log set name_ $name
	set class_ [string toupper [string index $name_ 0]][string \
		range $name_ 1 end]
	catch "tk appname $name"
	Application set instance_ $self
}
Application proc instance {} {
	return [Application set instance_]
}
Application proc name {} {
	return [[Application instance] set name_]
}
Application proc class {} {
	return [[Application instance] set class_]
}
Application proc toplevel w {
	Application instvar visual_ colormap_
	if [info exists visual_] {
		toplevel $w -class [Application class] \
			-visual $visual_ -colormap $colormap_
	} else {
		toplevel $w -class [Application class]
	}
}
global font
set font(helvetica10) {
	normal--*-100-75-75-*-*-*-*
	normal--10-*-*-*-*-*-*-*
	normal--11-*-*-*-*-*-*-*
	normal--*-100-*-*-*-*-*-*
	normal--*-*-*-*-*-*-*-*
}
set font(helvetica12) {
	normal--*-120-75-75-*-*-*-*
	normal--12-*-*-*-*-*-*-*
	normal--14-*-*-*-*-*-*-*
	normal--*-120-*-*-*-*-*-*
	normal--*-*-*-*-*-*-*-*
}
set font(helvetica14) {
	normal--*-140-75-75-*-*-*-*
	normal--14-*-*-*-*-*-*-*
	normal--*-140-*-*-*-*-*-*
	normal--*-*-*-*-*-*-*-*
}
set font(times14) {
	normal--*-140-75-75-*-*-*-*
	normal--14-*-*-*-*-*-*-*
	normal--*-140-*-*-*-*-*-*
	normal--*-*-*-*-*-*-*-*
}
Application instproc search_font { foundry style weight points slant } {
	global font tcl_version tcl_platform
 	if {$tcl_version >= 8} {
 		if {$slant == "r"} {
 			set slant ""
 		} elseif {$slant == "o"} {
 			set slant "italic"
 		}
		if {$weight == "medium"} {
			set weight ""
		}
 		return "$style -$points $weight $slant"
 	}
	foreach f $font($style$points) {
		set fname -$foundry-$style-$weight-$slant-$f
		if [havefont $fname] {
			return $fname
		}
	}
	$self instvar name_
	puts stderr "$name_: can't find $weight $fname font (using fixed)"
	if ![havefont fixed] {
		puts stderr "$name_: can't find fixed font"
		exit 1
	}
	return fixed
}
Application public init_local {} {
	$self instvar name_
	set f ~/.$name_.tcl
	if [file exists $f] {
		uplevel #0 "source $f"
	}
	set script [$self resource startupScript]
	if { $script != "" } {
		uplevel #0 "source $script"
	}
}
Application instproc user_hook {} {
}
Object instproc options {} {
	$self instvar options_
	if ![info exists options_] {
		Object instvar options_
		if ![info exists options_] {
			set options_ [new Configuration]
			global tcl_platform
			if {"$tcl_platform(platform)"=="windows"} {
				$options_ add_default \
					background SystemButtonFace
				$options_ add_default \
					infoHighlightColor SystemHighlightText
			}
		}
	}
	$options_ add_default appname mash
	return $options_
}
Object instproc optionsFrom o {
	$self set options_ $o
}
Class instproc configuration a {
 	$self instvar options_
	if ![info exists options_] {
		set options_ [new Configuration]
	}
	foreach { option value } $a {
		$options_ add_default $option $value
	}
}
Object instproc get_option r {
	set v [[$self options] get_option $r]
	if { $v != "" } {
		return $v
	}
	set cl [$self info class]
	foreach cl "$cl [$cl info heritage]" {
		$cl instvar options_
		if [info exists options_] {
			set v [$options_ get_option $r]
			if { $v != "" } {
				return $v
			}
		}
	}
	return ""
}
Object instproc resource r {
	return [$self get_option $r]
}
Object instproc add_option { r v } {
	return [[$self options] add_option $r $v]
}
Object instproc add_default { r v } {
	return [[$self options] add_default $r $v]
}
Object instproc yesno r {
	set v [$self get_option $r]
	if [string match \[0-9\]* $v] {
		return $v
	}
	if [string match \[tT\]* $v] {
		return 1
	}
	return 0
}
Object instproc debug s {
	if [$self yesno debug] {
		Log warn $s
	}
}
Object instproc warn s {
	Log warn $s
}
Object instproc fatal s {
	Log fatal $s
}
Class Configuration
Configuration public get_option r {
	$self instvar table_ default_
	if [info exists table_($r)] {
		return $table_($r)
	}
	if [info exists default_($r)] {
		return $default_($r)
	}
	return ""
}
Configuration public add_option { r v } {
	$self instvar table_
	set table_($r) $v
}
Configuration public add_default { r v } {
	$self set default_($r) $v
}
Configuration public register_option  { flag option args } {
	$self instvar arg_option_ usage_
	set arg_option_($flag) $option
	set usage_($flag) $args
}
Configuration public register_boolean_option  { flag option args } {
	$self instvar arg_bool_ arg_bool_val_
	set arg_bool_($flag) $option
	if { $args == "" } {
		set args 1
	}
	set arg_bool_val_($flag) $args
}
Configuration public register_list_option {flag option args} {
	$self instvar arg_list_option_
	set arg_list_option_($flag) $option
	set usage_($flag) $args
}
Configuration private is_arg argv {
	if { $argv != "" } {
		return [string match -* [lindex $argv 0]]
	}
	return 0
}
Configuration instproc parse_args argv {
	$self instvar arg_resource_ bool_resource_ 
	$self instvar arg_option_ arg_bool_ arg_bool_val_ arg_list_option_
	if { [info exists arg_resource_] || [info exists bool_resource_] } {
		puts stderr "your application class needs to be fixed"
		exit 1
	}
	while 1 {
		if ![$self is_arg $argv] {
			break
		}
		set arg [lindex $argv 0]
		set argv [lrange $argv 1 end]
		set val [lindex $argv 0]
		if { $arg == "-help" } {
			$self usage
			exit
		}
		if { $arg == "-X" } {
			set L [split $val =]
			if { [llength $L] != 2 } {
				puts stderr "malformed -X argument"
				exit 1
			}
			$self add_option [lindex $L 0] [lindex $L 1]
			set argv [lrange $argv 1 end]
			continue
		}
		if [info exists arg_option_($arg)] {
			$self add_option $arg_option_($arg) $val
			set argv [lrange $argv 1 end]
			continue
		}
		if [info exists arg_bool_($arg)] {
			$self add_option $arg_bool_($arg) $arg_bool_val_($arg)
			continue
		}
		if [info exists arg_list_option_($arg)] {
			set o $arg_list_option_($arg)
			set l [$self get_option $o]
			lappend l $val
			$self add_option $o $l
			set argv [lrange $argv 1 end]
			continue
		}
		$self usage
		$self fatal "unknown command option: $arg"
	}
	return $argv
}
Configuration public usage {} {
	set display_args_on_single_line 0
	if { $display_args_on_single_line } {
		puts "usage: [Application name] [join [$self arg_info]]"
	} else {
		puts "usage: [Application name]" 
		foreach arg [$self arg_info] {
			puts $arg
		}
	}
}
Configuration private arg_info {} {
	$self instvar arg_option_ arg_bool_ usage_
	foreach arg [array names arg_option_] {
		set r $arg_option_($arg)
		set d [$self get_option $r]
		if { $d != "" || $usage_($arg) != "required"} {
			lappend opt "\[$arg $r ($d)\]"
		} else {
			lappend req "$arg $r"
		}
	}
	foreach arg [array names arg_bool_] {
		set r $arg_bool_($arg)
		set d [$self get_option $r]
		if { $d != "" } {
		        lappend opt "\[$arg ($d)\]"
		} else {
			lappend opt "\[$arg\]"
		}
	}
	if [info exists opt] {
		if [info exists req] {
			return [concat $opt $req]
		} else {
			return $opt
		}
	} else {
		if [info exists req] {
			return $req
		} else {
			return ""
		}
	}
}
Configuration public load_preferences suffixList {
	set mash [glob ~]/.mash
	if [file isdirectory $mash] {
		$self load_file $mash/prefs
		foreach suffix $suffixList {
			$self load_file $mash/prefs-$suffix
		}
	}
}
Configuration private load_file fname {
	if ![file readable $fname] {
		return
	}
	set f [open $fname r]
	set count 0
	while 1 {
		incr count
		if [eof $f] {
			close $f
			return
		}
		set line [string trim [gets $f]]
		if { $line == {} || [string index $line 0]=="#" } {
			continue
		}
		set colon [string first ":" $line]
		if { $colon==-1 } {
			puts stderr "Invalid line $count in $fname:\
					Must be of the form \"key: value\""
			continue
		}
		set option [string trim [string range $line 0 [expr $colon-1]]]
		set value [string trim [string range $line \
				[expr $colon+1] end]]
		$self add_option $option $value
	}
}
Class MashScriptLoader
MashScriptLoader proc.public instance { } {
	return [$self set instance_]
}
MashScriptLoader public init { mimetype } {
	MashScriptLoader set instance_ $self
	$self instvar mplug_
	set mplug_ [new MPlug]
	set o [new Configuration]
	$self optionsFrom $o
	$o load_preferences "mplug"
	if { ![$self confirm_download] } {
		$self do_error "User decided not to execute script"
	}
	if { [$mplug_ wait_for_stream] } {
		puts stderr "Could not retrieve stream"
		exit
	}
	if { [$mplug_ get mimetype] != $mimetype } {
		$self do_error "The loader cannot handle mimetype:\
			[$mplug_ get mimetype]"
	}
	set stream [$mplug_ get stream]
	$self exec $stream
}
MashScriptLoader private exec { stream } {	
	uplevel #0 $stream
	vwait forever
}
MashScriptLoader private do_error { msg } {
	$self instvar mplug_
	label .label -text $msg -justify left -anchor w
	pack .label  -fill both -expand 1 -padx 10 -pady 10
	vwait forever
}
MashScriptLoader private confirm_download { } {
	set r [$self get_option mash-script.run_without_asking]
	if { $r == 1 || $r == 0 } { return $r }
	$self instvar mplug_
	ConfirmDownloadDlg .dlg$self -image Icons(warning) -text \
			"\nYou are about to run a MASH script that has\
			\nbeen downloaded from the Web. This is a\
			\npotential security risk.\
			\nDo you want to continue?\n\n"
	set retval [.dlg$self invoke]
	if { [.dlg$self never_ask] } {
		set mash [glob ~]/.mash
		if ![file exists $mash] {
			file mkdir $mash
		}
		set f [open $mash/prefs-mplug a+ 0644]
		set comment "# the run_without_asking flag has the following\
				semantics\
				\n#     1 => always download without asking\
				\n#     0 => never download and run\
				\n#     anything else => prompt the user"
		puts $f "\n${comment}\nmash-script.run_without_asking: 1\n"
		close $f		
	}
	destroy .dlg$self
	if { $retval=="yes" } { return 1 } else { return 0 }
}
MashScriptLoader public import { args } {
	$self instvar mplug_ http_
	set url_prefix [$mplug_ get url]
	set end [string length $url_prefix]
	if { [string index $url_prefix [expr $end-1]] != "/" } {
		set end [string last "/" $url_prefix]
		set url_prefix [string range $url_prefix 0 $end]
	}
	set list_of_urls {}
	foreach entry $args {
		lappend list_of_urls "${url_prefix}${entry}.mash"
	}
	Dialog transient MessageBox -text "List of urls '$list_of_urls'"
	set retval [$http_ get $list_of_urls]
	if { $retval=={} } {
		foreach child [winfo children .] {
			destroy $child
		}
		$self do_error "\nImport error:\n[$http_ error]\n"
	}
	foreach script $retval {
		uplevel #0 $script
	}
}
WidgetClass ConfirmDownloadDlg -superclass MessageBox -default {
	{ .title "Are you sure?" }
	{ *ImageTextButton.borderWidth 1 }
	{ *Label.font WidgetDefault }
	{ *Label.wrapLength 0 }
	{ *Checkbutton.borderWidth 1 }
	{ .type yesno }
}
ConfirmDownloadDlg private build_widget { path } {
	$self next $path
	checkbutton $path.never_ask -anchor w -variable \
			[$self tkvarname never_ask_] -text \
			"Don't ask this question in the future"
	pack $path.never_ask -fill x -side top -anchor w -padx 15 -pady 5
}
ConfirmDownloadDlg public never_ask { } {
	$self tkvar never_ask_
	return $never_ask_
}
new MashScriptLoader "x-mash/x-script"
