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

#
# 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)
#
Import enable
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
set MTrace(trcNone)      {0x00000000 {none}}
set MTrace(trcNet)       {0x00000001 {Network}}
set MTrace(trcSRM)       {0x00000002 {SRM}}
set MTrace(trcArchive)   {0x00000004 {Archive}}
set MTrace(trcMB)        {0x00000008 {Mediaboard}}
set MTrace(trcFCA)       {0x00000010 {Floor control}}
set MTrace(trcLTS)       {0x00000020 {Logical Time System}}
set MTrace(trcTGMB)      {0x00000040 {TopGun MediaBoard}}
set MTrace(trcCB)        {0x00000080 {Coordination Bus}}
set MTrace(trcVerbose)   {0x20000000 {Verbose}}
set MTrace(trcExcessive) {0x40000000 {Excessive}}
set MTrace(trcTmp)       {0x80000000 {Temp}}
set MTrace(trcAll)       {0xFFFFFFFF {All}}
if { [Class info instances MTrace]=="" } {
    proc MTrace { args } {
	    return MTrace
    }
}
MTrace proc init { flags } {
	global MTrace
	MTrace instvar mtrace
	set mtrace [new MTrace]
	$mtrace create_window
	foreach flag $flags {
		if { [info exists MTrace($flag)] } {
			set bits [lindex $MTrace($flag) 0]
			set msg  [lindex $MTrace($flag) 1]
			$mtrace tkvar flag_$flag
			set flag_$flag 1
			$mtrace set_flag $bits
		}
	}
	return $mtrace
}
MTrace instproc create_window { } {
	global mash
	if { $mash(environ) == "smash" } return
	$self instvar path_
	global MTrace
	set count 0
	while { [winfo exists ".mtrace_$count"] } { incr count }
	set path_ ".mtrace_$count"
	toplevel $path_
	wm title $path_ "MASH Trace"
	wm withdraw $path_
	set main [frame $path_.main -bd 1 -relief sunken]
	pack $main -side top -fill both -expand 1 -padx 5 -pady 3
	foreach flag [array names MTrace] {
		$self tkvar flag_$flag
		set flag_$flag 0
		checkbutton $main.$flag -text [lindex $MTrace($flag) 1] \
				-variable [$self tkvarname flag_$flag] \
				-command "$self toggle_flag $flag" \
				-bd 1 -pady 0 -anchor w
		pack $main.$flag -pady 0 -padx 5 -fill x -expand 1
	}
	button $path_.button -text "Dismiss" -command "$self toggle_window" \
			-pady 0
	pack $path_.button -anchor e -padx 5 -pady 2
	return $path_
}
MTrace instproc toggle_window { } {
	global mash
	if { $mash(environ) == "smash" } return
	$self instvar path_
	if { [winfo ismapped $path_] } {
		wm withdraw $path_
	} else {
		wm deiconify $path_
	}
}
MTrace instproc toggle_flag { flag } {
	global MTrace
	$self tkvar flag_$flag
	if { [set flag_$flag] } {
		$self set_flag [lindex $MTrace($flag) 0]
	} else {
		$self reset_flag [lindex $MTrace($flag) 0]
	}
}
proc mtrace { flags args } {
        global MTrace
	set bits 0
	foreach flag [split $flags "|"] {
		set bits [expr $bits | [lindex $MTrace($flag) 0]]
	}
	MTrace instvar mtrace
	if [info exists mtrace] {
		$mtrace trace $bits $args
	}
}
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
	}
}
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
	}
}
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
	}
}
Object instproc has_method { method } {
	if { [$self info procs $method]!="" } {
		return 1
	}
	return [[$self info class] has_method $method]
}
Class instproc has_method { method } {
	if { [$self info instprocs $method]!="" } {
		return 1
	}
	foreach cl [$self info heritage] {
		if { [$cl info instprocs $method]!="" } {
			return 1
		}
	}
	return 0
}
proc version {} {
	global mash
	return $mash(version)
}
proc local_fqdn {} {
	set host ""
	catch {set host [lookup_host_name [localaddr]]}
	if { [string first . $host] < 0 } {
		return ""
	}
	return $host
}
proc email_heuristic {} {
	set user [user_heuristic]
	set addr [local_fqdn]
	if { $addr == "" } {
		return ""
	}
	return $user@$addr
}
proc user_heuristic {} {
	global env
	if [info exists env(USER)] {
		set user $env(USER)
	} elseif [info exists env(LOGNAME)] {
		set user $env(LOGNAME)
	} else {
		catch {set env(USER) [getusername]}
		if [info exists env(USER)] {
			return $env(USER)
		}
		return "UNKNOWN"
	}
}
proc format_fps f {
	set fps $f
	if { $fps < .1 } {
		set fps "0 f/s"
	} elseif { $fps < 10 } {
		set fps [format "%.1f f/s" $fps]
	} else {
		set fps [format "%2.0f f/s" $fps]
	}
	return $fps
}
proc format_bps b {
	set bps $b
	if { $bps < 1 } {
		set bps "0 bps"
	} elseif { $bps < 1000 } {
		set bps [format "%3.0f bps" $bps]
	} elseif { $bps < 1000000 } {
		set bps [format "%3.1f kb/s" [expr $bps / 1000.]]
	} else {
		set bps [format "%.2f Mb/s" [expr $bps / 1000000.]]
	}
	return $bps
}
proc gettime {sec} {
    clock format $sec
}
proc sdr_gettimeofday {} {
    clock seconds
}
proc gettimenow {} {
    gettime [clock seconds]
}
proc getreadabletime {} {
    return [clock format [clock seconds] -format {%H:%M, %d/%m/%y}]
}
proc unix_to_ntp {unixtime} {
    set oddoffset 2208988800
    if {$unixtime==0} {return 0}
    return [format %u [expr $unixtime + $oddoffset]]
}
proc ntp_to_unix {ntptime} {
    set oddoffset 2208988800
    if {($ntptime==0)||($ntptime==1)} {return $ntptime}
    return [format %u [expr $ntptime - $oddoffset]]
}
proc duration_readable {secs {option terse}} {
	set ret ""
	set r [expr round($secs)]
	set h [expr $r / 3600]
	set r [expr $r % 3600]
	set m [expr $r / 60]
	set s [expr $r % 60]
	if {$option == "verbose"} then {
		if {$h} {
			set ret "$ret $h\h"
		} 
		if {$m} {
			set ret "$ret $m\m"
		} 
		if {$s} {
			set ret "$ret and $s\s"
		} 
	} else {
		set ret "$h:$m:$s"
	}
		return $ret
}
Class Observer
Observer instproc init { args } {
	eval [list $self] next $args
}
Observer instproc update { method args } {
	if [$self has_method $method] {
		eval [list $self] [list $method] $args
	}
}
Class Observable
Observable instproc init { args } {
	eval [list $self] next $args
	$self set observers_ { }
}
Observable instproc attach_observer { observer } {
	$self instvar observers_
	lappend observers_ $observer
}
Observable instproc detach_observer { observer } {
	$self instvar observers_
	set idx [lsearch $observers_ $observer]
	if { $idx != -1 } {
		set observers_ [lreplace $observers_ $idx $idx]
	}
}
Observable instproc notify_observers { method args } {
	$self instvar observers_
	if [info exists observers_] {
		foreach observer $observers_ {
			eval [list $observer] update [list $method] $args
		}
	}
}
WidgetClass ScrolledWidget -configspec {
	{ -scrollbar scrollbar Scrollbar {none} config_scroll cget_scroll }
}
ScrolledWidget instproc build_widget { path } {
	$self instvar main_
	frame  $path.dummy -borderwidth 0 -relief flat
	set main_ [$self create_main_widget $path]
	scrollbar $path.vscroll -command "$main_ yview" -orient vertical
	scrollbar $path.hscroll -command "$main_ xview" \
			-orient horizontal
	$main_ configure -yscrollcommand "$path.vscroll set"
	$main_ configure -xscrollcommand "$path.hscroll set"
	pack $path.dummy -side top -fill both -expand 1
	pack $main_ -side left -anchor nw -fill both -expand 1 \
			-in $path.dummy
}
ScrolledWidget instproc create_main_widget { path } {
	error "cannot create object of class [$self info class];\
			every subclass MUST redefine the create_main_widget\
			method"
}
ScrolledWidget instproc config_scroll { option scroll } {
	$self instvar main_
	set path [$self info path]
	catch {
		pack forget $path.vscroll
		pack forget $path.hscroll
	}
	switch $scroll {
		horizontal {
			pack $path.hscroll -side bottom -fill x \
					-before $path.dummy
		}
		vertical {
			pack $path.vscroll -side right -fill y \
					-in $path.dummy -before $main_
		}
		both {
			pack $path.hscroll -side bottom -fill x \
					-before $path.dummy
			pack $path.vscroll -side right -fill y \
					-in $path.dummy -before $main_
		}
		auto {
			error "function not implemented"
		}
		default {
			set scroll none
		}
	}
	$self set scroll_ $scroll
}
ScrolledWidget instproc cget_scroll { option } {
	$self instvar scroll_
	if [info exists scroll_] { return $scroll_ } else { return none }
}
WidgetClass ScrolledCanvas -superclass ScrolledWidget
ScrolledCanvas instproc create_main_widget { path } {
	return [canvas $path.bbox]
}
WidgetClass ScrolledText -superclass ScrolledWidget
ScrolledText instproc create_main_widget { path } {
	return [text $path.text]
}
WidgetClass ScrolledWindow -superclass ScrolledCanvas
ScrolledWindow instproc build_widget { path } {
	$self next $path
	frame $path.bbox.window
	$path.bbox create window 0 0 -anchor nw -window $path.bbox.window
	$self set_subwidget window $path.bbox.window
	bind $path.bbox.window <Configure> "+$self ev_window_resize %w %h"
}
ScrolledWindow instproc ev_window_resize { width height } {
	[$self subwidget bbox] configure -scrollregion "0 0 $width $height"
}
WidgetClass ScrolledWindow/Expand -superclass ScrolledWindow
ScrolledWindow/Expand instproc build_widget { path } {
	$self next $path
	set dummy [frame [$self subwidget bbox].dummy_ -width 0 -height 0 \
			-relief flat -bg [[$self subwidget window] cget -bg]]
	pack $dummy -side top -in [$self subwidget window]
	bind [$self subwidget bbox] <Configure> "+$self ev_bbox_resize_ %w %h"
}
ScrolledWindow/Expand instproc ev_bbox_resize_ { w h } {
	set window [$self subwidget window]
	set bbox   [$self subwidget bbox]
	$bbox.dummy_ configure \
			-width [expr $w - ([$bbox cget -bd] + \
			[$window cget -bd] + [$bbox cget -highlightthickness] \
			+ [$window cget -highlightthickness]) * 2]
}
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 DropDown -configspec {
	{ -variable variable Variable {} config_var cget_var }
	{ -value value Value {} config_value cget_value }
	{ -state state State {normal} config_state }
} -alias {
	{ -var -variable }
} -default {
	{ *button.relief raised }
	{ *button.indicatorOn 1 }
	{ *button.highlightThickness 2 }
	{ *button.takeFocus 1 }
	{ *button.padX 2 }
	{ *button.padY 1 }
	{ *menu.tearOff 0 }
	{ *menu*borderWidth 1 }
	{ *menu*activeBorderWidth 1 }
}
DropDown instproc build_widget { path } {
	menubutton $path.button -menu $path.button.menu
	pack $path.button -fill both -expand 1 -padx 0 -pady 0 -side left
	menu $path.button.menu
	$self set_subwidget menu $path.button.menu
	$self config_var -variable {}
	set script [bind Menubutton <Key-space>]
	bind $path.button <Key-Down> $script
}
DropDown instproc config_var { option var } {
	$self instvar var_
	if { [info exists var_] && $var_!="" } {
		upvar #0 $var_ global_var
		catch { trace vdelete global_var w "$self var_trace" }
	}
	if { $var=="" } {
		set var_ [$self tkvarname defvar_]
	} else {
		set var_ $var
	}
	upvar #0 $var_ global_var
	trace variable global_var w "$self var_trace"
	if { ![info exists global_var] || $global_var=="" } {
		$self set_default_var
	} else {
		$self var_trace $var_ "" w
	}
}
DropDown instproc cget_var { option } {
	$self instvar var_
	if { $var_==[$self tkvarname defvar_] } {
		return ""
	} else {
		return $var_
	}
}
DropDown instproc config_value { option value } {
	$self set_var $value
}
DropDown instproc cget_value { option } {
	upvar #0 [$self set var_] global_var
	if [info exists global_var] {
		return $global_var
	} else {
		return ""
	}
}
DropDown instproc config_state { option {value {}} } {
	if { $value=={} } {
		return [$self subwidget button cget -state]
	} else {
		$self subwidget button configure -state $value
	}
}
DropDown instproc index { index } {
	if { $index=="end" } {
		set index [$self subwidget menu index $index]
		if { $index=="none" } {
			set index -1
		} else {
			incr index
		}
	} else {
		set index [$self subwidget menu index $index]
		if { $index=="none" } {
			set index -1
		}
	}
	return $index
}
DropDown instproc insert { index args } {
	set index [$self index $index]
	if { $index==-1 } {
		set index 0
	}
	foreach arg $args {
		$self insert_item $index $arg
		incr index
	}
	upvar #0 [$self set var_] global_var
	if { ![info exists global_var] || $global_var=="" } {
		$self set_default_var
	}
}
DropDown instproc insert_separator { index } {
	$self subwidget menu insert $index separator
}
DropDown instproc insert_item { index value } {
	$self subwidget menu insert $index command -label $value \
			-command "[list $self] set_var [list $value]"
}
DropDown instproc delete { index1 {index2 {}} } {
	if { $index2=="" } { set index2 $index1 }
	$self subwidget menu delete $index1 $index2
}
DropDown instproc set_var { value } {
	upvar #0 [$self set var_] global_var
	set global_var $value
}
DropDown instproc set_default_var { } {
	set menu [$self subwidget menu]
	set last [$self index end]
	if { $last=="none" } { set last -1 }
	for { set idx 0 } { $idx < $last } { incr idx } {
		if { [$menu type $idx]=="command" } break
	}
	if { $idx < $last } {
		$menu invoke $idx
	} else {
		upvar #0 [$self set var_] global_var
		set global_var ""
	}
}
DropDown instproc var_trace { args } {
	upvar #0 [$self set var_] global_var
	$self subwidget button configure -text $global_var
}
WidgetClass DropDown/Color -superclass DropDown
DropDown/Color instproc insert_item { index value } {
	if { [string index $value 0]=="/" } {
		$self subwidget menu insert $index command \
				-label [list [string range $value 1 end]] \
				-command "[list $self] set_var [list $value]"
	} else {
		$self subwidget menu insert $index command -label {    } \
				-background [list $value] \
				-activebackground [list $value] \
				-command "[list $self] set_var [list $value]"
	}
}
DropDown/Color instproc var_trace { args } {
	upvar #0 [$self set var_] global_var
	if { $global_var=="" } return
	if { $global_var=="/custom" } {
		set current_color [$self subwidget button cget -background]
		set color [tk_chooseColor -title "Choose color" \
				-initialcolor $current_color]
		if { $color=={} } return
		$self insert end $color
		set global_var $color
	}
	$self subwidget button configure -background $global_var \
			-activebackground $global_var -text "    "
}
WidgetClass DropDown/Font -superclass DropDown
DropDown/Font instproc insert_item { index value } {
	$self subwidget menu insert $index command -label ABCabc \
			-font [list $value] \
			-command "[list $self] set_var [list $value]"
}
DropDown/Font instproc var_trace { args } {
	upvar #0 [$self set var_] global_var
	if { $global_var=="" } return
	$self subwidget button configure -font $global_var -text "ABCabc"
}
WidgetClass DropDown/Text -superclass DropDown -configspec {
	{-entryVal entryVal EntryVal {} config_entryVal cget_entryVal}	
} -default {
	{ .highlightThickness 2 }
	{ .takeFocus 0 }
	{ .relief sunken }
	{ .borderWidth 2 }
	{ *button.highlightThickness 0 }
	{ *button.takeFocus 0 }
	{ *button.padX 0 }
	{ *button.padY 0 }
	{ *entry.highlightThickness 0 }
	{ *entry.takeFocus 1 }
	{ *entry.relief flat }
	{ *entry.borderWidth 0 }
}
DropDown/Text instproc config_entryVal { option value} {
	$self subwidget entry delete 0 end
	$self subwidget entry insert 0 $value
}
DropDown/Text instproc cget_entryVal { option value} {
	return [$self subwidget entry get]
}
DropDown/Text instproc build_widget { path } {
	entry $path.entry
	pack $path.entry -side left -fill both -expand 1
	$self next $path
	pack configure $path.button -side right -fill y -expand 0
	set script [bind Menubutton <Key-space>]
	regsub -all -- {%W} $script $path.button new_script
	bind $path.entry <Key-Down> $new_script
	bind $path.entry <Return> "$self return_pressed \[%W get\]"
	bind $path.entry <FocusOut> "$self restore_entry"
}
DropDown/Text instproc return_pressed { text } {
	$self set_var $text
	set path [$self info path]
	$path.entry selection from 0
	$path.entry selection to end
	$path.entry icursor end	
}
DropDown/Text instproc restore_entry {} {
	upvar #0 [$self set var_] global_var
	if [info exists global_var] {
		$self config_entryVal {} $global_var
	} else {
		$self config_entryVal {} {}
	}
}
DropDown/Text instproc config_state { option {value {}} } {
	if { $value=={} } {
		return [$self subwidget cget button -state]
	} else {
		$self subwidget button configure -state $value
		$self subwidget entry  configure -state $value
	}
}
DropDown/Text instproc set_var { value } {
	$self config_entryVal {} $value
	$self next $value
}
DropDown/Text instproc clear { } {
	$self set_var ""
}
DropDown/Text instproc var_trace { args } {
	set path [$self info path]
	if { [$path.entry selection present] && [focus]==$path } {
		$path.entry selection from 0
		$path.entry selection to   end
		$path.entry icursor end
	}
}
DropDown/Text instproc ev_key_down_ { } {
	set button [$self subwidget button]
	set takefocus [$button cget -takefocus]
	$button configure -takefocus 1
	set oldfocus [focus]
	focus $button
	event generate $button <Key-space>
	focus $oldfocus
	$button configure -takefocus $takefocus
}
WidgetClass EntryWithHistory -superclass DropDown/Text -configspec {
	{ -maxhistory maxHistory MaxHistory 15 config_maxhist cget_maxhist }
}
EntryWithHistory instproc add_history { } {
	set value [$self cget -value]
	regsub -all -- {\*} $value {\*} val1
	regsub -all -- {\?} $val1  {\?} val2
	regsub -all -- {\[} $val2  {\[} val1
	regsub -all -- {\]} $val1  {\]} val2
	catch { $self subwidget menu delete "$val2" }
	$self insert 0 $value
	set index [$self subwidget menu index end]
	set maxhistory [$self cget_maxhist -maxhistory]
	if { $index!="none" && $index >= $maxhistory } {
		$self subwidget menu delete $maxhistory end
	}
}
EntryWithHistory instproc config_maxhist { option value } {
	$self instvar max_history_
	set max_history_ $value
	set index [$self subwidget menu index end]
	if { $index!="none" && $index >= $max_history_ } {
		$self subwidget menu delete $index end
	}
}
EntryWithHistory instproc cget_maxhist { option } {
	$self instvar max_history_
	if [info exists max_history_] { return $max_history_ } else {return 0}
}
WidgetClass ListLabelItem -configspec {
	{ -value       value       Value       {}            config_value }
	{ -select      select      Select      0             config_option }
	{ -highlight   highlight   Highlight   0             config_option }
	{ -relief relief Relief flat config_relief cget_relief }
	{ -normalbackground normalBackground NormalBackground \
			WidgetDefault(-background) config_option }
	{ -normalforeground normalForeground NormalForeground \
			WidgetDefault(-foreground) config_option }
	{ -normalrelief normalRelief NormalRelief flat config_option }
	{ -selectbackground selectBackground SelectBackground WidgetDefault \
			config_option }
	{ -selectforeground selectForeground SelectForeground WidgetDefault \
			config_option }
	{ -selectrelief selectRelief SelectRelief sunken config_option }
	{ -highlightrelief highlightRelief HighlightRelief raised \
			config_option }
}
ListLabelItem instproc init { args } {
	$self instvar config_
	set config_(-value) {}
	set config_(-select) 0
	set config_(-highlight) 0
	set config_(-normalbackground) Black
	set config_(-normalforeground) Black
	set config_(-normalrelief)     flat
	set config_(-selectbackground) Black
	set config_(-selectforeground) Black
	set config_(-selectrelief)     sunken
	set config_(-highlightrelief)  raised
	eval [list $self] next $args	
}
ListLabelItem instproc create_root_widget { path } {
	label $path -anchor w
	if { [option get $path padX Label]=="" } {
		$path configure -padx 1
	}
	if { [option get $path padX Label]=="" } {
		$path configure -pady 1
	}
}
ListLabelItem instproc config_value { option args } {
	$self instvar config_
	if { [llength $args]==0 } {
		return [$self widget_proc cget -text]
	} else {
		$self widget_proc configure -text [lindex $args 0]
	}
}
ListLabelItem instproc config_option { option args } {
	$self instvar config_
	if { [llength $args]==0 } {
		return $config_($option)
	} else {
		set value [lindex $args 0]
		set config_($option) $value
		$self config_[string range $option 1 end] $value
	}
}
ListLabelItem instproc config_relief { option value } {
	$self widget_proc configure -relief $value
}
ListLabelItem instproc cget_relief { option } {
	$self widget_proc cget -relief
}
ListLabelItem instproc config_normalbackground { value } {
	if { ![$self set config_(-select)] } {
		$self widget_proc configure -bg $value
	}
}
ListLabelItem instproc config_normalforeground { value } {
	if { ![$self set config_(-select)] } {
		$self widget_proc configure -fg $value
	}
}
ListLabelItem instproc config_normalrelief { value } {
	if { ![$self set config_(-select)] && \
			![$self set config_(-highlight)] } {
		$self widget_proc configure -relief $value
	}
}
ListLabelItem instproc config_selectbackground { value } {
	if { [$self set config_(-select)] } {
		$self widget_proc configure -bg $value
	}
}
ListLabelItem instproc config_selectforeground { value } {
	if { [$self set config_(-select)] } {
		$self widget_proc configure -fg $value
	}
}
ListLabelItem instproc config_selectrelief { value } {
	if { [$self set config_(-select)] && \
		![$self set config_(-highlight)] } {
		$self widget_proc configure -relief $value
	}
}
ListLabelItem instproc config_highlightrelief { value } {
	if { [$self set config_(-highlight)] } {
		$self widget_proc configure -relief $value
	}
}
ListLabelItem instproc config_select { value } {
	$self instvar config_
	if { $value } {
		$self widget_proc configure -bg $config_(-selectbackground)
		$self widget_proc configure -fg $config_(-selectforeground)
		if { !$config_(-highlight) } {
			$self widget_proc configure \
					-relief $config_(-selectrelief)
		}
	} else {
		$self widget_proc configure -bg $config_(-normalbackground)
		$self widget_proc configure -fg $config_(-normalforeground)
		if { !$config_(-highlight) } {
			$self widget_proc configure \
					-relief $config_(-normalrelief)
		}
	}
}
ListLabelItem instproc config_highlight { value } {
	$self instvar config_
	if { $value } {
		$self widget_proc configure -relief $config_(-highlightrelief)
	} else {
		if { $config_(-select) } {
			$self widget_proc configure \
					-relief $config_(-selectrelief)
		} else {
			$self widget_proc configure \
					-relief $config_(-normalrelief)
		}
	}
}
WidgetClass ScrolledListbox -superclass ScrolledWindow -configspec {
	{ -itemclass itemClass ItemClass ListLabelItem config_option }
	{ -browsecmd browseCmd BrowseCmd "" config_option }
	{ -command command Command "" config_option }
	{ -selectmode selectMode SelectMode single config_selectmode }
} -default {
	{ *window.takeFocus 1 }
	{ *window.highlightThickness 0 }
}
ScrolledListbox instproc build_widget { path } {
	$self next $path
	set window [$self subwidget window]
	frame $window.dummy_ -width 0 -height 0 -relief flat \
			-bg [$window cget -bg]
	pack $window.dummy_ -side top
	$self create_bindtag
	$self set count_ 0
	$self set highlight_ ""
}
ScrolledListbox instproc create_bindtag { } {
	bind [$self subwidget bbox] <Configure> "+$self ev_bbox_resize_ %w %h"
	set window [$self subwidget window]
	bind $window <KeyPress-Up> "$self ev_key_up_"
	bind $window <KeyPress-Down> "$self ev_key_down_"
	bind $window <KeyPress-space> "$self ev_key_space_"
	bind Bindings_$self <ButtonPress-1> "+$self selection.toggle -widget \
			\[$self root_widget_ %W\]; $self browse \
			\[$self widget_to_id_ \[$self root_widget_ %W\]\]"
	bind Bindings_$self <Double-1> "+$self invoke \
			\[$self widget_to_id_ \[$self root_widget_ %W\]\]"
	bind Bindings_$self <Enter> "+if \{ \[$self root_widget_ %W\] == \
			\"%W\" \} \{ $self highlight.set -widget %W \}"
	bind Bindings_$self <Leave> "+if \{ \[$self root_widget_ %W\] == \
			\"%W\" \} \{ $self highlight.clear -widget %W \}"
}
ScrolledListbox instproc ev_bbox_resize_ { w h } {
	set window [$self subwidget window]
	set bbox   [$self subwidget bbox]
	$window.dummy_ configure \
			-width [expr $w - ([$bbox cget -bd] + \
			[$window cget -bd] + [$bbox cget -highlightthickness] \
			+ [$window cget -highlightthickness]) * 2]
}
ScrolledListbox instproc ev_key_up_ { } {
	set highlight [$self highlight.get]
	if { $highlight != "" } {
		set list [$self widget_list_]
		set idx [lsearch $list [$self id_to_widget_ $highlight]]
		if { $idx <= 0 } {
			return
		}
		incr idx -1
	} else {
		set idx 0
	}
	$self see $idx
	$self highlight.set $idx
}
ScrolledListbox instproc ev_key_down_ { } {
	set highlight [$self highlight.get]
	if { $highlight != "" } {
		set list [$self widget_list_]
		set idx [lsearch $list [$self id_to_widget_ $highlight]]
		if { $idx < 0 || $idx >= [expr [llength $list]-1] } {
			return
		}
		incr idx 1
	} else {
		set idx 0
	}
	$self see $idx
	$self highlight.set $idx
}
ScrolledListbox instproc ev_key_space_ { } {
	set highlight [$self highlight.get]
	if { $highlight != "" } {
		$self selection.toggle -id $highlight
		$self browse $highlight
	}
}
ScrolledListbox instproc root_widget_ { path } {
	set window [$self subwidget window]
	set widget $path
	while { $widget!="" && [winfo parent $widget] != $window } {
		set widget [winfo parent $widget]
	}
	if { $widget=="" } {
		error "invalid widget $path"
	}
	return $widget
}
ScrolledListbox instproc widget_list_ { } {
	set list [pack slaves [$self subwidget window]]
	return [lrange $list 1 end]
}
ScrolledListbox instproc config_option { option args } {
	$self instvar config_
	if { [llength $args]==0 } {
		return $config_($option)
	} else {
		set config_($option) [lindex $args 0]
	}
}
ScrolledListbox instproc config_selectmode { option args } {
	$self instvar config_
	if { [llength $args]==0 } {
		return $config_(-selectmode)
	}
	set value [lindex $args 0]
	switch -exact -- $value {
		single {
			set config_(-selectmode) "single"
			set selection [lindex [$self selection.get all] 0]
			$self selection.clear all
			if { $selection!="" } {
				$self selection.set -id $selection
			}
		}
		multiple {
			set config_(-selectmode) "multiple"
		}
		none {
			set config_(-selectmode) "none"
			$self selection.clear all
		}
		default {
			error "invalid selectmode \"$value\". must be one of\
					\"single\", \"multiple\", or \"none\""
		}
	}
}
ScrolledListbox instproc browse { id } {
	set browsecmd [$self cget -browsecmd]
	if { $browsecmd!="" } {
		uplevel #0 $browsecmd [list $id]
	}
}
ScrolledListbox instproc invoke { id } {
	set command [$self cget -command]
	if { $command!="" } {
		uplevel #0 $command [list $id]
	}
}
ScrolledListbox instproc ID { idVar arguments { idx 0 } } {
	upvar $idVar id
	if { [llength $arguments] <= $idx } {
		error "missing arguments"
	}
	set arg [lindex $arguments $idx]
	switch -exact -- $arg {
		-id {
			set end [expr $idx+2]
			if { [llength $arguments] < $end } {
				error "missing argument for \"-id\""
			}
			set id [lindex $arguments [expr $idx+1]]
			return $end
		}
		-widget {
			set end [expr $idx+2]
			if { [llength $arguments] < $end } {
				error "missing argument for \"-widget\""
			}
			set widget [lindex $arguments [expr $idx+1]]
			set id [$self widget_to_id_ $widget]
			return $end
		}
		-value {
			set end [expr $idx+2]
			if { [llength $arguments] < $end } {
				error "missing argument for \"-value\""
			}
			set widget [lindex $arguments [expr $idx+1]]
			set id [$self value_to_id_ $widget]
			return $end
		}
		default {
			set id [$self index_to_id_ $arg]
			return [expr $idx+1]
		}
	}
}
ScrolledListbox instproc widget_to_id_ { widget } {
	$self instvar widget_to_id_
	if [info exists widget_to_id_($widget)] {
		return $widget_to_id_($widget)
	} else {
		error "invalid widget \"$widget\""
	}
}
ScrolledListbox instproc value_to_id_ { value } {
	foreach widget [self widget_list_] {
		if { $value == [$self info.value -widget $widget] } {
			return $id
		}
	}
	error "invalid value \"$value\""
}
ScrolledListbox instproc index_to_id_ { index } {
	set widget [lindex [$self widget_list_] $index]
	if { $widget=="" } {
		error "invalid index \"$index\""
	}
	return [$self widget_to_id_ $widget]
}
ScrolledListbox instproc id_to_widget_ { id } {
	$self instvar id_to_widget_
	if [info exists id_to_widget_($id)] {
		return $id_to_widget_($id)
	} else {
		error "invalid id \"$id\""
	}
}
ScrolledListbox instproc id_to_value_ { id } {
	set widget [$self id_to_widget_ $id]
	return [$widget cget -value]
}
ScrolledListbox instproc insert { where args } {
	$self instvar count_ id_to_widget_ widget_to_id_
	switch -exact -- $where {
		end {
			set where ""
		}
		after {
			set idx [$self ID where_id $args]
			set where "-after [$self id_to_widget_ $where_id]"
			set args [lrange $args $idx end]
		}
		before {
			set idx [$self ID where_id $args]
			set where "-before [$self id_to_widget_ $where_id]"
			set args [lrange $args $idx end]
		}
		default {
			error "invalid argument \"$where\". must be one of\
					\"end\", \"after\", or \"before\""
		}
	}
	set window [$self subwidget window]
	set item_class [$self cget -itemclass]
	if { $item_class=="" } {
		error "must configure -itemclass before inserting any elements"
	}
	foreach arg $args {
		if { [lindex $arg 0] == "-id" } {
			if { [llength $arg] <= 1 } {
				error "missing argument for \"-id\""
			}
			set id [lindex $arg 1]
			set arg [lrange $arg 2 end]
		} else {
			set id #$count_
		}
		if { [info exists id_to_widget_($id)] } {
			error "id \"$id\" already exists"
		}
		set widget $window.item_$count_
		incr count_
		$item_class $widget -value $arg
		$self bindtag_recursive_ $widget
		if { $where=="" } {
			pack $widget -side top -fill x -expand 1
		} else {
			eval pack [list $widget] -side top -fill x -expand 1 \
					$where
		}
		set id_to_widget_($id) $widget
		set widget_to_id_($widget) $id
	}
}
ScrolledListbox instproc delete { args } {
	$self instvar id_to_widget_ widget_to_id_ selection_ highlight_
	if { [lindex $args 0]=="all" } {
		if { [llength $args]!=1 } {
			error "extra arguments starting at argument 2"
		}
		foreach widget [$self widget_list_] {
			destroy $widget
		}
		catch {
			unset id_to_widget_
			unset widget_to_id_
			unset selection_
		}
		set highlight_ ""
	} else {
		set id [eval [list $self] info.id $args]
		set widget [$self id_to_widget_ $id]
		destroy $widget
		catch {
			unset id_to_widget_($id)
			unset widget_to_id_($widget)
			unset selection_($id)
		}
		if { $highlight_==$id } {
			set highlight_ ""
		}
	}
}
ScrolledListbox instproc bindtag_recursive_ { widget } {
	$self bindtag_ $widget
	foreach path [winfo children $widget] {
		$self bindtag_recursive_ $path
	}
}
ScrolledListbox instproc bindtag_ { widget } {
	set tags [bindtags $widget]
	if {[lsearch -exact $tags Bindings_$self] == -1} {
		bindtags $widget [concat [list Bindings_$self] $tags]
	}
}
ScrolledListbox instproc see { args } {
	set id [eval [list $self] info.id $args]
	set widget [$self id_to_widget_ $id]
	set y1 [winfo y $widget]
	set y2 [expr $y1 + [winfo height $widget] - 1]
	set viewable [$self subwidget bbox yview]
	set scrollregion [$self subwidget bbox cget -scrollregion]
	set height [expr [lindex $scrollregion 3] - [lindex $scrollregion 1]]
	set bbox_y1 [expr $height * [lindex $viewable 0] + \
			[lindex $scrollregion 1]]
	set bbox_y2 [expr $height * [lindex $viewable 1] + \
			[lindex $scrollregion 1]]
	if { $y1 < $bbox_y1 } {
		set bbox_y1 $y1
		$self subwidget bbox yview moveto \
				[expr double($bbox_y1)/double($height)]
	} elseif { $y2 > $bbox_y2 } {
		set bbox_y1 [expr $y2 - ($bbox_y2 - $bbox_y1)]
		$self subwidget bbox yview moveto \
				[expr double($bbox_y1)/double($height)]
	}
}
ScrolledListbox instproc info { method args } {
	if { [$class info instprocs info.$method] == "info.$method" } {
		return [eval [list $self] [list info.$method] $args]
	} else {
		return [eval [list $self] next [list $method] $args]
	}
}
ScrolledListbox instproc info.id { args } {
	set idx [$self ID id $args]
	if { [llength $args] > $idx } {
		error "extra arguments starting with argument $idx"
	}
	return $id
}
ScrolledListbox instproc info.widget { args } {
	set id [eval [list $self] info.id $args]
	return [$self id_to_widget_ $id]
}
ScrolledListbox instproc info.value { args } {
	set id [eval [list $self] info.id $args]
	return [$self id_to_value_ $id]
}
ScrolledListbox instproc info.all { {what {}} } {
	switch -exact -- $what {
		{} -
		-id {
			set ids {}
			foreach widget [$self widget_list_] {
				lappend ids [$self widget_to_id_ $widget]
			}
			return $ids
		}
		-widget {
			return [$self widget_list_]
		}
		-value {
			set values
			foreach widget [$self widget_list_] {
				set id [$self widget_to_id_ $widget]
				lappend values [$self id_to_value_ $id]
			}
			return $values
		}
		default {
			error "invalid argument \"$what\". must be one of\
					\"-id\", \"-widget\", or \"-value\""
		}
	}
}
ScrolledListbox instproc info.exists { args } {
	set len [llength $args]
	if { $len > 2 } {
		error "extra arguments"
	}
	switch -exact -- [lindex $args 0] {
		-id {
			if { $len < 2 } {
				error "missing argument for \"-id\""
			}
			return [info exists id_to_widget_([lindex $args 1])]
		}
		-widget {
			if { $len < 2 } {
				error "missing argument for \"-widget\""
			}
			return [info exists widget_to_id_([lindex $args 1])]
		}
		-value {
			if { $len < 2 } {
				error "missing argument for \"-widget\""
			}
			return ![catch {$self value_to_id_ [lindex $args 1]}]
		}
		default {
			if { $len > 1 } {
				error "extra arguments"
			}
			return ![catch {$self index_to_id_ [lindex $args 1]}]
		}
	}
}
ScrolledListbox instproc info.numelems { } {
	return [llength [$self widget_list_]]
}
ScrolledListbox instproc selection { method args } {
	eval [list $self] [list selection.$method] $args
}
ScrolledListbox instproc selection.set { args } {
	$self instvar selection_
	set selectmode [$self cget -selectmode]
	if { $selectmode=="none" } {
		return
	}
	if { [lindex $args 0]=="all" } {
		if { [llength $args] > 1 } {
			error "extra arguments starting at argument 2"
		}
		foreach widget [$self widget_list_] {
			$self selection.set -widget $widget
		}
	}
	set id [eval [list $self] info.id $args]
	if { [info exists selection_($id)] } {
		return
	}
	if { [$self cget -selectmode]=="single" } {
		$self selection.clear all
	}
	set selection_($id) 1
	set widget [$self id_to_widget_ $id]
	$widget configure -select 1
}
ScrolledListbox instproc selection.get { args } {
	$self instvar selection_
	if { [llength $args]==0 } {
		return [array names selection_]
	}
	if { [lindex $args 0]=="all" } {
		if { [llength $args] > 1 } {
			error "extra arguments starting at argument 2"
		}
		return [array names selection_]
	}
	set id [eval [list $self] info.id $args]
	if { [info exists selection_($id)] } {
		return $id
	} else {
		return ""
	}
}
ScrolledListbox instproc selection.clear { args } {
	$self instvar selection_
	if { [llength $args]==0 } {
		$self selection.clear_all_
		return
	}
	if { [lindex $args 0]=="all" } {
		if { [llength $args] > 1 } {
			error "extra arguments starting at argument 2"
		}
		$self selection.clear_all_
		return
	}
	set id [eval [list $self] info.id $args]
	if { [info exists selection_($id)] } {
		unset selection_($id)
		[$self id_to_widget_ $id] configure -select 0
	} else {
		return
	}
}
ScrolledListbox instproc selection.clear_all_ { } {
	$self instvar selection_
	foreach id [array names selection_] {
		unset selection_($id)
		[$self id_to_widget_ $id] configure -select 0
	}
}
ScrolledListbox instproc selection.toggle { args } {
	set id [eval [list $self] info.id $args]
	if { [$self selection.get -id $id]=="" } {
		$self selection.set -id $id
	} else {
		$self selection.clear -id $id
	}
}
ScrolledListbox instproc highlight { method args } {
	eval [list $self] [list highlight.$method] $args
}
ScrolledListbox instproc highlight.set { args } {
	$self instvar highlight_
	set id [eval [list $self] info.id $args]
	if { $id == $highlight_ } {
		return
	}
	if { $highlight_!="" } {
		[$self id_to_widget_ $highlight_] configure -highlight 0
	}
	set highlight_ $id
	[$self id_to_widget_ $id] configure -highlight 1
}
ScrolledListbox instproc highlight.get { args } {
	$self instvar highlight_
	if { [llength $args]==0 } {
		return $highlight_
	}
	set id [eval [list $self] info.id $args]
	if { $highlight_==$id } {
		return $id
	} else {
		return ""
	}
}
ScrolledListbox instproc highlight.clear { args } {
	$self instvar highlight_
	if { [llength $args]==0 } {
		[$self id_to_widget_ $highlight_] configure -highlight 0
		set highlight_ ""
	} else {
		set id [eval [list $self] info.id $args]
		if { $highlight_==$id } {
			[$self id_to_widget_ $highlight_] configure \
					-highlight 0
			set highlight_ ""
		}
	}
}
ScrolledListbox instproc highlight.toggle { args } {
	$self instvar highlight_
	if { [llength $args]==0 } {
		$self highlight.clear
	} else {
		set id [eval [list $self] info.id $args]
		if { $id == $highlight_ } {
			$self highlight.clear
		} else {
			$self highlight.set -id $id
		}
	}
}
WidgetClass HierarchicalListboxItem -configspec {
	{ -value       value       Value       {}            config_value }
	{ -select      select      Select      0             config_option }
	{ -highlight   highlight   Highlight   0             config_option }
	{ -normalbackground normalBackground NormalBackground \
			WidgetDefault(-background) config_option }
	{ -normalforeground normalForeground NormalForeground \
			WidgetDefault(-foreground) config_option }
	{ -normalrelief normalRelief NormalRelief flat config_option }
	{ -selectbackground selectBackground SelectBackground WidgetDefault \
			config_option }
	{ -selectforeground selectForeground SelectForeground WidgetDefault \
			config_option }
	{ -selectrelief selectRelief SelectRelief sunken config_option }
	{ -highlightrelief highlightRelief HighlightRelief raised \
			config_option }
} -default {
	{ .borderWidth WidgetDefault }
	{ *font WidgetDefault }
	{ *Label.padX 1 }
	{ *Label.padY 0 }
	{ *Label.borderWidth 0 }
}
HierarchicalListboxItem instproc init { args } {
	$self instvar config_
	set config_(-value) {}
	set config_(-select) 0
	set config_(-highlight) 0
	set config_(-normalbackground) Black
	set config_(-normalforeground) Black
	set config_(-normalrelief)     flat
	set config_(-selectbackground) Black
	set config_(-selectforeground) Black
	set config_(-selectrelief)     sunken
	set config_(-highlightrelief)  raised
	eval [list $self] next $args	
}
HierarchicalListboxItem instproc build_widget { path } {
	label $path.padding
	label $path.image
	label $path.text -anchor w
	pack $path.padding -side left
	pack $path.image -side left
	pack $path.text  -side left -fill x -anchor w
}
HierarchicalListboxItem instproc config_value { option args } {
	$self instvar config_
	if { [llength $args]==0 } {
		if [info exists config_(-value)] {
			return $config_(-value)
		} else {
			return ""
		}
	} else {
		set value [lindex $args 0]
		set image [lindex $value 0]
		set config_(-value) [lindex $value 1]
		set split [split $config_(-value) "/"]
		if { $config_(-value)=="/" || [llength $split] <= 1 } {
			set level 0
			set label $config_(-value)
		} else {
			set level [llength $split]
			set label [lindex $split [expr $level-1]]
		}
		$self subwidget padding configure -padx [expr $level * 4]
		$self subwidget image   configure -image $image
		$self subwidget text    configure -text  $label
	}
}
HierarchicalListboxItem instproc config_option { option args } {
	$self instvar config_
	if { [llength $args]==0 } {
		return $config_($option)
	} else {
		set value [lindex $args 0]
		$self config_[string range $option 1 end] $value
		set config_($option) $value
	}
}
HierarchicalListboxItem instproc config_background { value } {
	set path [$self info path]
	$path configure -bg $value
	foreach label [winfo children $path] {
		$label configure -bg $value
	}
}
HierarchicalListboxItem instproc config_foreground { value } {
	foreach label [winfo children [$self info path]] {
		$label configure -fg $value
	}
}
HierarchicalListboxItem instproc config_relief { value } {
	[$self info path] configure -relief $value
}
HierarchicalListboxItem instproc config_normalbackground { value } {
	if { ![$self set config_(-select)] } {
		$self config_background $value
	}
}
HierarchicalListboxItem instproc config_normalforeground { value } {
	if { ![$self set config_(-select)] } {
		$self config_foreground $value
	}
}
HierarchicalListboxItem instproc config_normalrelief { value } {
	if { ![$self set config_(-select)] && \
			![$self set config_(-highlight)] } {
		$self config_relief $value
	}
}
HierarchicalListboxItem instproc config_selectbackground { value } {
	if { [$self set config_(-select)] } {
		$self config_background $value
	}
}
HierarchicalListboxItem instproc config_selectforeground { value } {
	if { [$self set config_(-select)] } {
		$self config_foreground $value
	}
}
HierarchicalListboxItem instproc config_selectrelief { value } {
	if { [$self set config_(-select)] && \
		![$self set config_(-highlight)] } {
		$self config_relief $value
	}
}
HierarchicalListboxItem instproc config_highlightrelief { value } {
	if { [$self set config_(-highlight)] } {
		$self config_relief $value
	}
}
HierarchicalListboxItem instproc config_select { value } {
	$self instvar config_
	if { $value } {
		$self config_background $config_(-selectbackground)
		$self config_foreground $config_(-selectforeground)
		if { !$config_(-highlight) } {
			$self config_relief $config_(-selectrelief)
		}
	} else {
		$self config_background $config_(-normalbackground)
		$self config_foreground $config_(-normalforeground)
		if { !$config_(-highlight) } {
			$self config_relief $config_(-normalrelief)
		}
	}
}
HierarchicalListboxItem instproc config_highlight { value } {
	$self instvar config_
	if { $value } {
		$self config_relief $config_(-highlightrelief)
	} else {
		if { $config_(-select) } {
			$self config_relief $config_(-selectrelief)
		} else {
			$self config_relief $config_(-normalrelief)
		}
	}
}
WidgetClass MultiColumnListbox -superclass ScrolledCanvas -configspec {
	{ -browsecmd browseCmd BrowseCmd "" config_option }
	{ -command command Command "" config_option }
	{ -selectbackground selectBackground SelectBackground #a0a0ff \
			config_option }
	{ -font font Font WidgetDefault	config_option }
} -default {
	{ .scrollbar horizontal }
	{ *hscroll.highlightThickness 0 }
	{ *hscroll.takeFocus 0 }
	{ *bbox.borderWidth 2 }
	{ *bbox.width 400 }
	{ *bbox.height 120 }
}
MultiColumnListbox instproc config_option { option args } {
	$self instvar data
	if { [llength $args] == {} } {
		return $data($option)
	} else {
		set data($option) [lindex $args 0]
	}
}
MultiColumnListbox instproc build_widget { path } {
	$self instvar data
	$self next $path
	set data(canvas) [$self subwidget bbox]
	set data(sbar) [$self subwidget hscroll]
	set data(maxIW) 1
	set data(maxIH) 1
	set data(maxTW) 1
	set data(maxTH) 1
	set data(numItems) 0
	set data(curItem)  {}
	set data(noScroll) 1
	bind $data(canvas) <Configure> "+$self arrange"
	bind $data(canvas) <1>         "$self btn1 %x %y"
	bind $data(canvas) <B1-Motion> "$self motion1 %x %y"
	bind $data(canvas) <Double-1>  "$self double1 %x %y"
	bind $data(canvas) <ButtonRelease-1> "tkCancelRepeat"
	bind $data(canvas) <B1-Leave>  "$self leave1 %x %y"
	bind $data(canvas) <B1-Enter>  "tkCancelRepeat"
	bind $data(canvas) <Up>        "$self up_down -1"
	bind $data(canvas) <Down>      "$self up_down  1"
	bind $data(canvas) <Left>      "$self left_right -1"
	bind $data(canvas) <Right>     "$self left_right  1"
	bind $data(canvas) <Return>    "$self return_key"
	bind $data(canvas) <KeyPress>  "$self key_press %A"
	bind $data(canvas) <Control-KeyPress> ";"
	bind $data(canvas) <Alt-KeyPress>  ";"
	bind $data(canvas) <FocusIn>   "$self focus_in"
}
MultiColumnListbox instproc auto_scan { } {
	$self instvar data
	global tkPriv
	set x $tkPriv(x)
	set y $tkPriv(y)
	if $data(noScroll) {
		return
	}
	if {$x >= [winfo width $data(canvas)]} {
		$data(canvas) xview scroll 1 units
	} elseif {$x < 0} {
		$data(canvas) xview scroll -1 units
	} elseif {$y >= [winfo height $data(canvas)]} {
	} elseif {$y < 0} {
	} else {
		return
	}
	$self motion1 $x $y
	set tkPriv(afterId) [after 50 $self auto_scan]
}
MultiColumnListbox instproc delete_all {} {
	$self instvar data
	$self instvar itemList
	$data(canvas) delete all
	catch {unset data(selected)}
	catch {unset data(rect)}
	catch {unset data(list)}
	catch {unset itemList}
	set data(numItems) 0
	set data(curItem)  {}
}
MultiColumnListbox instproc add {image text} {
	$self instvar data
	$self instvar itemList
	$self instvar textList
	set iTag [$data(canvas) create image 0 0 -image $image -anchor nw]
	set tTag [$data(canvas) create text  0 0 -text  $text  -anchor nw \
			-font $data(-font)]
	set rTag [$data(canvas) create rect  0 0 0 0 -fill "" -outline ""]
	set b [$data(canvas) bbox $iTag]
	set iW [expr [lindex $b 2]-[lindex $b 0]]
	set iH [expr [lindex $b 3]-[lindex $b 1]]
	if {$data(maxIW) < $iW} {
		set data(maxIW) $iW
	}
	if {$data(maxIH) < $iH} {
		set data(maxIH) $iH
	}
	set b [$data(canvas) bbox $tTag]
	set tW [expr [lindex $b 2]-[lindex $b 0]]
	set tH [expr [lindex $b 3]-[lindex $b 1]]
	if {$data(maxTW) < $tW} {
		set data(maxTW) $tW
	}
	if {$data(maxTH) < $tH} {
		set data(maxTH) $tH
	}
	lappend data(list) [list $iTag $tTag $rTag $iW $iH $tW $tH \
			$data(numItems)]
	set itemList($rTag) [list $iTag $tTag $text $data(numItems)]
	set textList($data(numItems)) [string tolower $text]
	incr data(numItems)
}
MultiColumnListbox instproc arrange {} {
	$self instvar data
	if ![info exists data(list)] {
		if {[info exists data(canvas)] && \
				[winfo exists $data(canvas)]} {
			set data(noScroll) 1
			$data(sbar) config -command ""
		}
		return
	}
	set W [winfo width  $data(canvas)]
	set H [winfo height $data(canvas)]
	set pad [expr [$data(canvas) cget -highlightthickness] + \
			[$data(canvas) cget -bd]]
	incr W -[expr $pad*2]
	incr H -[expr $pad*2]
	set dx [expr $data(maxIW) + $data(maxTW) + 4]
	if {$data(maxTH) > $data(maxIH)} {
		set dy $data(maxTH)
	} else {
		set dy $data(maxIH)
	}
	set shift [expr $data(maxIW) + 4]
	set x [expr $pad * 2]
	set y [expr $pad * 1]
	set usedColumn 0
	foreach pair $data(list) {
		set usedColumn 1
		set iTag [lindex $pair 0]
		set tTag [lindex $pair 1]
		set rTag [lindex $pair 2]
		set iW   [lindex $pair 3]
		set iH   [lindex $pair 4]
		set tW   [lindex $pair 5]
		set tH   [lindex $pair 6]
		set i_dy [expr ($dy - $iH)/2]
		set t_dy [expr ($dy - $tH)/2]
		$data(canvas) coords $iTag $x                 [expr $y + $i_dy]
		$data(canvas) coords $tTag [expr $x + $shift] [expr $y + $t_dy]
		$data(canvas) coords $tTag [expr $x + $shift] [expr $y + $t_dy]
		$data(canvas) coords $rTag $x $y [expr $x+$dx] [expr $y+$dy]
		incr y $dy
		if {[expr $y + $dy] >= $H} {
			set y [expr $pad * 1]
			incr x $dx
			set usedColumn 0
		}
	}
	if {$usedColumn} {
		set sW [expr $x + $dx]
	} else {
		set sW $x
	}
	if {$sW < $W} {
		$data(canvas) config -scrollregion "$pad $pad $sW $H"
		$data(sbar) config -command ""
		$data(canvas) xview moveto 0
		set data(noScroll) 1
	} else {
		$data(canvas) config -scrollregion "$pad $pad $sW $H"
		$data(sbar) config -command "$data(canvas) xview"
		set data(noScroll) 0
	}
	set data(itemsPerColumn) [expr ($H-$pad)/$dy]
	if {$data(itemsPerColumn) < 1} {
		set data(itemsPerColumn) 1
	}
	if {$data(curItem) != {}} {
		$self select [lindex [lindex $data(list) $data(curItem)] 2] 0
	}
}
MultiColumnListbox instproc invoke {} {
	$self instvar data
	if {[string compare $data(-command) ""] && \
			[info exists data(selected)]} {
		eval $data(-command) [list $data(selected)]
	}
}
MultiColumnListbox instproc see {rTag} {
	$self instvar data
	$self instvar itemList
	if $data(noScroll) {
		return
	}
	set sRegion [$data(canvas) cget -scrollregion]
	if ![string compare $sRegion {}] {
		return
	}
	if ![info exists itemList($rTag)] {
		return
	}
	set bbox [$data(canvas) bbox $rTag]
	set pad [expr [$data(canvas) cget -highlightthickness] + \
			[$data(canvas) cget -bd]]
	set x1 [lindex $bbox 0]
	set x2 [lindex $bbox 2]
	incr x1 -[expr $pad * 2]
	incr x2 -[expr $pad * 1]
	set cW [expr [winfo width $data(canvas)] - $pad*2]
	set scrollW [expr [lindex $sRegion 2]-[lindex $sRegion 0]+1]
	set dispX [expr int([lindex [$data(canvas) xview] 0]*$scrollW)]
	set oldDispX $dispX
	if {[expr $x2 - $dispX] >= $cW} {
		set dispX [expr $x2 - $cW]
	}
	if {[expr $x1 - $dispX] < 0} {
		set dispX $x1
	}
	if {$oldDispX != $dispX} {
		set fraction [expr double($dispX)/double($scrollW)]
		$data(canvas) xview moveto $fraction
	}
}
MultiColumnListbox instproc select_at_XY {x y} {
	$self instvar data
	$self select [$data(canvas) find closest \
			[$data(canvas) canvasx $x] [$data(canvas) canvasy $y]]
}
MultiColumnListbox instproc select {rTag {callBrowse 1}} {
	$self instvar data
	$self instvar itemList
	if ![info exists itemList($rTag)] {
		return
	}
	set iTag   [lindex $itemList($rTag) 0]
	set tTag   [lindex $itemList($rTag) 1]
	set text   [lindex $itemList($rTag) 2]
	set serial [lindex $itemList($rTag) 3]
	if ![info exists data(rect)] {
		set data(rect) [$data(canvas) create rect 0 0 0 0 \
				-fill $data(-selectbackground) \
				-outline $data(-selectbackground)]
	}
	$data(canvas) lower $data(rect)
	set bbox [$data(canvas) bbox $tTag]
	eval $data(canvas) coords $data(rect) $bbox
	set data(curItem) $serial
	set data(selected) $text
	if {$callBrowse} {
		if [string compare $data(-browsecmd) ""] {
			eval $data(-browsecmd) [list $text]
		}
	}
}
MultiColumnListbox instproc unselect {} {
	$self instvar data
	if [info exists data(rect)] {
		$data(canvas) delete $data(rect)
		unset data(rect)
	}
	if [info exists data(selected)] {
		unset data(selected)
	}
	set data(curItem)  {}
}
MultiColumnListbox instproc get {} {
	$self instvar data
	if [info exists data(selected)] {
		return $data(selected)
	} else {
		return ""
	}
}
MultiColumnListbox instproc btn1 {x y} {
	$self instvar data
	focus $data(canvas)
	$self select_at_XY $x $y
}
MultiColumnListbox instproc motion1 {x y} {
	global tkPriv
	set tkPriv(x) $x
	set tkPriv(y) $y
	$self select_at_XY $x $y
}
MultiColumnListbox instproc double1 {x y} {
	$self instvar data
	if {$data(curItem) != {}} {
		$self invoke
	}
}
MultiColumnListbox instproc return_key {} {
	$self invoke
}
MultiColumnListbox instproc leave1 {x y} {
	global tkPriv
	set tkPriv(x) $x
	set tkPriv(y) $y
	$self auto_scan
}
MultiColumnListbox instproc focus_in {} {
	$self instvar data
	if ![info exists data(list)] {
		return
	}
	if {$data(curItem) == {}} {
		set rTag [lindex [lindex $data(list) 0] 2]
		$self select $rTag
	}
}
MultiColumnListbox instproc up_down {amount} {
	$self instvar data
	if ![info exists data(list)] {
		return
	}
	if {$data(curItem) == {}} {
		set rTag [lindex [lindex $data(list) 0] 2]
	} else {
		set oldRTag [lindex [lindex $data(list) $data(curItem)] 2]
		set rTag [lindex [lindex $data(list) [expr \
				$data(curItem)+$amount]] 2]
		if ![string compare $rTag ""] {
			set rTag $oldRTag
		}
	}
	if [string compare $rTag ""] {
		$self select $rTag
		$self see $rTag
	}
}
MultiColumnListbox instproc left_right {amount} {
	$self instvar data
	if ![info exists data(list)] {
		return
	}
	if {$data(curItem) == {}} {
		set rTag [lindex [lindex $data(list) 0] 2]
	} else {
		set oldRTag [lindex [lindex $data(list) $data(curItem)] 2]
		set newItem [expr $data(curItem)+($amount*\
				$data(itemsPerColumn))]
		set rTag [lindex [lindex $data(list) $newItem] 2]
		if ![string compare $rTag ""] {
			set rTag $oldRTag
		}
	}
	if [string compare $rTag ""] {
		$self select $rTag
		$self see $rTag
	}
}
MultiColumnListbox instproc key_press {key} {
	global tkPriv
	set w [$self info path]
	append tkPriv(ILAccel,$w) $key
	$self goto $tkPriv(ILAccel,$w)
	catch {
		after cancel $tkPriv(ILAccel,$w,afterId)
	}
	set tkPriv(ILAccel,$w,afterId) [after 500 $self reset]
}
MultiColumnListbox instproc goto {text} {
	$self instvar data
	$self instvar textList
	global tkPriv
	if ![info exists data(list)] {
		return
	}
	if {[string length $text] == 0} {
		return
	}
	if {$data(curItem) == {} || $data(curItem) == 0} {
		set start  0
	} else {
		set start  $data(curItem)
	}
	set text [string tolower $text]
	set theIndex -1
	set less 0
	set len [string length $text]
	set len0 [expr $len-1]
	set i $start
	while 1 {
		set sub [string range $textList($i) 0 $len0]
		if {[string compare $text $sub] == 0} {
			set theIndex $i
			break
		}
		incr i
		if {$i == $data(numItems)} {
			set i 0
		}
		if {$i == $start} {
			break
		}
	}
	if {$theIndex > -1} {
		set rTag [lindex [lindex $data(list) $theIndex] 2]
		$self select $rTag 0
		$self see $rTag
	}
}
MultiColumnListbox instproc reset { } {
	global tkPriv
	set w [$self info path]
	catch {unset tkPriv(ILAccel,$w)}
}
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"
}
WidgetClass FileBox -default {
	{ *font WidgetDefault }
	{ *Button.borderWidth 1 }
	{ *Menubutton.borderWidth 1 }
	{ *Menu.borderWidth 1 }
	{ *Entry.borderWidth 1 }
	{ *Button.highlightThickness 1 }
	{ *Menubutton.highlightThickness 1 }
	{ *MultiColumnListbox.bbox.highlightThickness 1 }
	{ *Entry.highlightThickness 1 }
	{ *MultiColumnListbox.bbox.borderWidth 1 }
	{ *MultiColumnListbox.bbox.relief sunken }
	{ *MultiColumnListbox.Scrollbar.borderWidth 1 }
	{ *MultiColumnListbox.Scrollbar.width 10 }
	{ *Menubutton.anchor w }
	{ *Menubutton.padX 5 }
} -configspec {
	{ -filetypes fileTypes FileTypes "" config_filetypes cget_filetypes }
	{ -directory directory Directory "" config_directory cget_directory }
	{ -filename  filename  Filename  "" config_filename  cget_filename  }
	{ -browsecmd browseCmd BrowseCmd "" config_browsecmd cget_browsecmd }
	{ -command   command   command   "" config_command   cget_command   }
}
FileBox instproc build_widget { path } {
	set f1 [frame $path.f1]
	label $f1.label -text "Directory:" -underline 0
	DropDown $f1.directory -variable [$self tkvarname directory_]
	button $f1.upbutton -image Icons(folderup) \
			-command "$self up_folder_cmd"
	pack $f1.upbutton -side right -padx 4 -fill both
	pack $f1.label -side left -padx 4 -fill both
	pack $f1.directory -expand yes -fill both -padx 4
	$self set_subwidget directory $f1.directory
	$self set_subwidget upbutton  $f1.upbutton
	MultiColumnListbox $path.listbox -browsecmd "$self list_browse" \
			-command "$self list_command"
	set f2 [frame $path.f2]
	label $f2.label -text "File name:" -anchor e -width 14 -underline 5
	entry $f2.filename -textvariable [$self tkvarname filename_]
	pack $f2.label -side left -padx 4
	pack $f2.filename -expand yes -fill both -padx 2 -pady 2
	$self set_subwidget filename $f2.filename
	$self set_subwidget filename_label $f2.label
	set f3 [frame $path.f3]
	label $f3.label -text "Files of type:" -anchor e -width 14 \
			-underline 9
	DropDown $f3.filetypes -variable [$self tkvarname filetypes_]
	pack $f3.label -side left -padx 4
	pack $f3.filetypes -expand yes -fill x -side right
	$self set_subwidget filetypes_label $f3.label
	$self set_subwidget filetypes $f3.filetypes
	pack $f1 -side top -fill x -pady 4
	pack $f3 -side bottom -fill x
	pack $f2 -side bottom -fill x
	pack $path.listbox -expand yes -fill both -padx 4 -pady 2
	set filename [$self subwidget filename]
	bind $filename <Return>   "$self entry_command"
	bind $filename <FocusIn>  "$self subwidget listbox unselect"
	set w [winfo toplevel $path]
	bind $w <Alt-d> "focus [$self subwidget directory subwidget button]"
	bind $w <Alt-t> "focus [$self subwidget filetypes subwidget button]"
	bind $w <Alt-n> "focus [$self subwidget filename]"
	$self tkvar directory_ filetypes_
	$self tkvar filter_
	trace variable directory_ w "$self do_when_idle \"$self update\"; \
			$self ignore_args"
	trace variable filetypes_ w "$self set_filter; \
			$self ignore_args"
	trace variable filter_(current) w "$self do_when_idle \
			\"$self update\"; $self ignore_args"
	$self do_when_idle "$self update"
}
FileBox instproc config_directory { option value } {
	if { $value=={} } {
		set value [pwd]
	}
	$self tkvar directory_
	set directory_ $value
}
FileBox instproc cget_directory { option } {
	$self tkvar directory_
	return $directory_
}
FileBox instproc config_filename { option value } {
	$self tkvar filename_
	set filename_ $value
}
FileBox instproc cget_filename { option } {
	$self tkvar filename_
	return $filename_
}
FileBox instproc config_filetypes { option value } {
	set filetypes [$self subwidget filetypes]
	$filetypes delete 0 end
	$self tkvar filetypes_
	set filetypes_ ""
	$self tkvar filter_
	catch { unset filter_ }
	if { [trace vinfo filter_(current)]=="" } {
		trace variable filter_(current) w "$self do_when_idle \
				\"$self update\"; $self ignore_args"
	}
	if { [llength $value]==0 } {
		$filetypes configure -state disabled
		$self subwidget filetypes_label configure -foreground \
				[$filetypes subwidget button cget \
				-disabledforeground]
		set filter_(all) ""
		set filter_(current) ""
	} else {
		$filetypes configure -state normal
		$self subwidget filetypes_label configure -foreground \
				[$filetypes subwidget button cget \
				-foreground]
		foreach filetype $value {
			set name [lindex $filetype 0]
			append name " ("
			set filter ""
			set first 1
			foreach ext [lindex $filetype 1] {
				set ext [string trim $ext]
				if { $first } {
					set first 0
				} else {
					append name ", "
				}
				if { $ext=="*" } {
					append name "*"
					lappend filter ".*" "*"
				} else {
					append name "*$ext"
					lappend filter "*$ext"
				}
			}
			append name ")"
			set filter_(filter_for_$name) $filter
			$filetypes insert end $name
		}
		set filter_(all) $value
	}
}
FileBox instproc cget_filetypes { option } {
	$self tkvar filter_
	if { [info exists filter_(all)] } {
		return $filter_(all)
	} else {
		return ""
	}
}
FileBox instproc config_browsecmd { option value } {
	$self instvar browsecmd_
	set browsecmd_ [string trim $value]
}
FileBox instproc cget_browsecmd { option } {
	$self instvar browsecmd_
	return $browsecmd_
}
FileBox instproc config_command { option value } {
	$self instvar command_
	set command_ [string trim $value]
}
FileBox instproc cget_command { option } {
	$self instvar command_
	return $command_
}
FileBox instproc set_filter { args } {
	$self tkvar filter_
	$self tkvar filetypes_
	if { [info exists filter_(filter_for_$filetypes_)] } {
		set filter_(current) $filter_(filter_for_$filetypes_)
	} else {
		set filter_(current) $filetypes_
	}
}
FileBox instproc current_filter { args } {
        $self tkvar filter_
        return $filter_(current)
}
FileBox instproc invoke { cmdType args } {
	set varname "${cmdType}_"
	$self instvar "$varname cmd"
	if { $cmd!="" } {
		uplevel #0 $cmd $args
	}
}
FileBox instproc list_browse { text } {
	$self tkvar directory_ filename_
	if {$text == ""} {
		return
	}
	set file [file join $directory_ $text]
		set filename_ $text
	$self invoke browsecmd $text
}
FileBox instproc list_command { text } {
	$self tkvar directory_ filename_
	if {$text == ""} {
		return
	}
	set file [file join $directory_ $text]
	if [file isdirectory $file] {
		set appPWD [pwd]
		if [catch {cd $file}] {
			Dialog transient MessageBox -type ok -text \
				"Cannot change to the directory \"$file\".\
				\nPermission denied." -image Icons(warning)
		} else {
			cd $appPWD
			set directory_ $file
		}
	} else {
		set filename_ $text
		$self invoke command $text
	}
}
FileBox instproc up_folder_cmd { } {
	$self tkvar directory_
	if [string compare $directory_ "/"] {
		set directory_ [file dirname $directory_]
	}
}
FileBox instproc entry_command { } {
	$self tkvar directory_ filename_ filetypes_
	set list [$self resolve_file $directory_ $filename_]
	set flag [lindex $list 0]
	set path [lindex $list 1]
	set file [lindex $list 2]
	case $flag {
		OK {
			set directory_ $path
			set filename_  $file
			if [string compare $file ""] {
				$self invoke command
			}
		}
		PATTERN {
			set directory_ $path
			set filetypes_ $file
		}
		FILE {
			set directory_ $path
			set filename_  $file
			$self invoke command
		}
		PATH {
			Dialog transient MessageBox -image Icons(warning) \
					-type ok -text \
					"Directory \"$path\" does not exist."
			set entry [$self subwidget filename]
			$entry select from 0
			$entry select to end
			$entry icursor end
		}
		CHDIR {
			Dialog transient MessageBox -type ok -text \
					"Cannot change to the directory \"$path\".\nPermission denied."	-image Icons(warning)
			set entry [$self subwidget filename]
			$entry select from 0
			$entry select to end
			$entry icursor end
		}
		ERROR {
			Dialog transient MessageBox -type ok -text \
					"Invalid file name \"$path\"."\
					-image Icons(warning)
			set entry [$self subwidget filename]
			$entry select from 0
			$entry select to end
			$entry icursor end
		}
	}
}
FileBox instproc resolve_file {context text} {
	set appPWD [pwd]
	set path [file join $context $text]
	if [catch {file exists $path}] {
		return [list ERROR $path ""]
	}
	if [file exists $path] {
		if [file isdirectory $path] {
			if [catch {
				cd $path
			}] {
				return [list CHDIR $path ""]
			}
			set directory [pwd]
			set file ""
			set flag OK
			cd $appPWD
		} else {
			if [catch {
				cd [file dirname $path]
			}] {
				return [list CHDIR [file dirname $path] ""]
			}
			set directory [pwd]
			set file [file tail $path]
			set flag OK
			cd $appPWD
		}
	} else {
		set dirname [file dirname $path]
		if [file exists $dirname] {
			if [catch {
				cd $dirname
			}] {
				return [list CHDIR $dirname ""]
			}
			set directory [pwd]
			set file [file tail $path]
			if [regexp {[*]|[?]} $file] {
				set flag PATTERN
			} else {
				set flag FILE
			}
			cd $appPWD
		} else {
			set directory $dirname
			set file [file tail $path]
			set flag PATH
		}
	}
	return [list $flag $directory $file]
}
FileBox instproc update { } {
	$self instvar updateId_
	catch {unset updateId_}
	set appPWD [pwd]
	set dir [$self cget -directory]
	if [catch {
		cd $dir
	}] {
		Dialog transient MessageBox -type ok -text \
				"Cannot change to the directory \"$dir\".\
				\nPermission denied." -image Icons(warning)
		cd $appPWD
		return
	}
	set entry [$self subwidget filename]
	set toplevel [winfo toplevel [$self info path]]
	set entryCursor [$entry cget -cursor]
	set toplevelCursor [$toplevel cget -cursor]
	$entry    config -cursor watch
	$toplevel config -cursor watch
	update idletasks
	set listbox [$self subwidget listbox]
	$listbox delete_all
	foreach f [lsort -command tclSortNoCase [glob -nocomplain .* *]] {
		if ![string compare $f .] {
			continue
		}
		if ![string compare $f ..] {
			continue
		}
		if [file isdirectory ./$f] {
			if ![info exists hasDoneDir($f)] {
				$listbox add Icons(folder) $f
				set hasDoneDir($f) 1
			}
		}
	}
	$self tkvar filter_
	if { ![string compare $filter_(current) *] || \
			$filter_(current)=="" } {
		set files [lsort -command tclSortNoCase \
				[glob -nocomplain .* *]]
	} else {
		set files [lsort -command tclSortNoCase \
				[eval glob -nocomplain $filter_(current)]]
	}
	set top 0
	foreach f $files {
		if ![file isdir $f] {
			if ![info exists hasDoneFile($f)] {
				$listbox add Icons(textfile) $f
				set hasDoneFile($f) 1
			}
		}
	}
	$listbox arrange
	set list ""
	set dir ""
	$self tkvar directory_
	foreach subdir [file split $directory_] {
		set dir [file join $dir $subdir]
		lappend list $dir
	}
	$self subwidget directory delete 0 end
	eval [list $self] subwidget directory insert end $list
	cd $appPWD
	$entry    config -cursor $entryCursor
	$toplevel config -cursor $toplevelCursor
}
WidgetClass DirectoryBox -configspec {
	{ -directory directory Directory { } config_directory cget_directory }
	{ -browsecmd browseCmd BrowseCmd { } config_option }
	{ -command command Command { } config_option }
	{ -allownonexistent allowNonexistent AllowNonexistent { 0 }
	config_option }
} -default {
	{ *font WidgetDefault }
	{ *Entry.borderWidth 1 }
	{ *Entry.highlightThickness 1 }
	{ *ScrolledListbox.borderWidth 1 }
	{ *ScrolledListbox.relief sunken }
	{ *ScrolledListbox.scrollbar both }
	{ *ScrolledListbox.itemClass HierarchicalListboxItem }
	{ *ScrolledListbox.bbox.highlightThickness 1 }
	{ *ScrolledListbox.Scrollbar.borderWidth 1 }
	{ *ScrolledListbox.Scrollbar.borderWidth 1 }
	{ *ScrolledListbox.Scrollbar.highlightThickness 1 }
	{ *ScrolledListbox.Scrollbar.width 10 }
	{ *HierarchicalListboxItem.borderWidth 1 }
}	
DirectoryBox instproc build_widget { path } {
	ScrolledListbox $path.dirbox -browsecmd "$self browse" \
			-command "$self invoke; $self ignore_args"
	frame $path.f1
	label $path.entry_label -text "Directory:"
	entry $path.entry -textvariable [$self tkvarname entry_]
	pack $path.entry_label -side left -in $path.f1
	pack $path.entry -side right -fill x -expand 1 -in $path.f1
	pack $path.f1 -side bottom -fill x
	pack $path.dirbox -side top -fill both -expand 1
	bind $path <Map> "$self set_trace"
	bind $path.entry <Return>   "$self entry_invoke"
	bind $path.entry <FocusIn>  "$self entry_focus_in"
	bind $path.entry <FocusOut> "$self entry_focus_out"
}
DirectoryBox instproc config_directory { option dir } {
	$self tkvar directory_
	if { [string trim $dir]=={} } {
		set directory_ [pwd]
	} else {
		set directory_ $dir
	}
}
DirectoryBox instproc cget_directory { option } {
	$self tkvar directory_
	return $directory_
}
DirectoryBox private set_trace { } {
	$self tkvar directory_
	trace variable directory_ w "$self do_when_idle \"$self update\"; \
			$self ignore_args"
	if [info exists directory_] {
		set directory_ $directory_
	}
	bind [$self info path] <Map> ""
}
DirectoryBox instproc config_option { option args } {
	$self instvar config_
	if { [llength $args]==0 } {
		return $config_($option)
	} else {
		set config_($option) [string trim [lindex $args 0]]
	}
}
DirectoryBox instproc entry_invoke { } {
	$self tkvar entry_ directory_
	set path [file join $directory_ $entry_]
	if { ![file isdirectory $path] } {
		if { ![$self cget -allownonexistent] } {
			Dialog transient MessageBox -type ok -text \
					"Invalid directory \"$path\"" \
					-image Icons(warning)
		} elseif { ![file exists $path] } {
			set retval [Dialog transient MessageBox \
					-type yesno -text \
					"Directory \"$path\" does\nnot exist\
					\n\nWould you like to create it?" \
					-image Icons(warning)]
			if { $retval=="yes" } {
				if [$self create_dir $path] {
					set directory_ $path
					set entry_ ""
				}
			}
		} else {
			Dialog transient MessageBox -type ok -text \
					"There is already a file with the\
					\nsame name" -image Icons(warning)
		}
	} else {
		set directory_ $path
		set entry_ ""
	}
}
DirectoryBox private create_dir { path } {
	set dir ""
	foreach split [file split $path] {
		set dir [file join $dir $split]
		if { ![file exists $dir] } {
			if [catch {file mkdir $dir}] {
				Dialog transient MessageBox -type ok -text \
						"Error occurred while creating\
						\"$dir\"" -image Icons(warning)
				return 0
			}
		}
	}
	return 1
}
DirectoryBox instproc entry_focus_in { } {
	$self tkvar entry_
	set entry [$self subwidget entry]
	if [string compare $entry_ ""] {
		$entry selection from 0
		$entry selection to   end
		$entry icursor end
	} else {
		$entry selection clear
	}
}
DirectoryBox instproc entry_focus_out { } {
	$self subwidget entry selection clear
}
DirectoryBox instproc browse { id } {
	$self tkvar directory_
	set directory [$self subwidget dirbox info value -id $id]
	if { [string compare $directory $directory_] } {
		focus [$self subwidget dirbox subwidget window]
		global tcl_platform
		if { $tcl_platform(platform) == "windows" } {
			if { [string first "/" $directory] == -1 } {
				append directory "/"
			}
		}
		set directory_ $directory
		set browsecmd [$self cget -browsecmd]
		if { $browsecmd != {} } {
			uplevel #0 $browsecmd $directory
		}
	}
}
DirectoryBox instproc invoke { } {
	set command [$self cget -command]
	if { $command != {} } {
		$self tkvar directory_
		uplevel #0 $command $directory_
	}
}
DirectoryBox instproc update { } {
	set directory [$self cget -directory]
	set appPWD [pwd]
	if [catch {
		cd $directory
		set directory [pwd]
	}] {
		Dialog transient MessageBox -type ok -text \
				"Cannot change to the directory \"$directory\"\
				\nPermission denied." -image Icons(warning)
		cd $appPWD
		return
	}
	set dirbox [$self subwidget dirbox]
	$dirbox delete all
	set toplevel [winfo toplevel [$self info path]]
	set toplevelCursor [$toplevel cget -cursor]
	$toplevel config -cursor watch
	update idletasks
	set split [file split $directory]
	set root [lindex $split 0]
	foreach volume [file volume] {
		global tcl_platform
		if { $tcl_platform(platform)=="windows" } {
			set print_vol [string toupper \
					[lindex [split $volume "/"] 0]]
		} else {
			set print_vol $volume
		}
		if { [string tolower $volume]==[string tolower $directory] } {
			$dirbox insert end [list -id curdir Icons(folderopen)\
					$print_vol]
		} else {
			$dirbox insert end [list Icons(folder)\
					$print_vol]
		}
		if { [string tolower $volume]==[string tolower $root] } {
			set dir $root
			foreach subdir [lrange $split 1 end] {
				set dir [file join $dir $subdir]
				if { $dir==$directory } {
					$dirbox insert end [list -id curdir \
							Icons(folderopen) $dir]
				} else {
					$dirbox insert end [list Icons(folder)\
							$dir]
				}
			}
			foreach dir [lsort -command tclSortNoCase \
					[glob -nocomplain .* *]] {
				if ![string compare $dir .] {
					continue
				}
				if ![string compare $dir ..] {
					continue
				}
				set isdir 0
				if { [catch {file isdir $dir} isdir]==0 && \
						$isdir } {
					if ![info exists hasDoneDir($dir)] {
						set path [file join $directory\
								$dir]
						$dirbox insert end [list \
								Icons(folder) \
								$path]
						set hasDoneDir($dir) 1
					}
				}
			}
		}
	}
	cd $appPWD
	$toplevel config -cursor $toplevelCursor
	$dirbox selection set -id curdir
	$self tkvar entry_
	set entry_ $directory
}
WidgetClass FileDialog -superclass Dialog -configspec {
	{ -type type Type open config_type cget_type }
} -default {
	{ *font WidgetDefault }
	{ *ImageTextButton.borderWidth 1 }
	{ *ImageTextButton.highlightThickness 1 }
}
FileDialog instproc build_widget { path } {
	frame   $path.frame
	FileBox $path.filebox -command "$self command; $self ignore_args"
	frame   $path.buttonbox
	ImageTextButton $path.buttonbox.ok -underline 0 -text "Open" \
			-image Icons(check) -orient horizontal \
			-command "$self invoke_ok_ \
			\[string tolower \[$path.buttonbox.ok cget -text\]\]"
	ImageTextButton $path.buttonbox.cancel -image Icons(cross) \
			-orient horizontal -text "Cancel" -underline 0 \
			-command "$self cancel"
	bind $path <Alt-o> "$self invoke_ok_ open"
	bind $path <Alt-s> "$self invoke_ok_ save"
	bind $path <KeyPress-Escape> "$self cancel"
	pack $path.buttonbox.ok $path.buttonbox.cancel -side left -anchor e\
			-padx 5 -pady 2
	pack $path.buttonbox -side bottom -in $path.frame -anchor e
	pack $path.filebox -side top -fill both -expand 1 -in $path.frame
	pack $path.frame -side left -fill both -expand 1
	$self set_subwidget ok     $path.buttonbox.ok
	$self set_subwidget cancel $path.buttonbox.cancel
}
FileDialog instproc config_type { option type } {
	set ok "[$self subwidget buttonbox].ok"
	switch -exact -- $type {
		open {
			$ok configure -text "Open"
		}
		save {
			$ok configure -text "Save"
		}
		default {
			error "invalid type specification; must be 'open' or\
					'save'"
		}
	}
}
FileDialog instproc cget_type { option } {
	set ok "[$self subwidget buttonbox].ok"
	return [string tolower [$ok cget -text]]
}
FileDialog instproc invoke_ok_ { type } {
	if { [$self cget -type] == $type } {
		$self subwidget filebox entry_command
	}
}
FileDialog instproc command { } {
	set filebox [$self subwidget filebox]
	set dir  [$filebox cget -directory]
	set file [$filebox cget -filename]
	if  { $file=="" } return
	set path [file join $dir $file]
	set exists [file exists $path]
	set type   [$self cget -type]
	if { ![string compare $type open] && !$exists } {
		Dialog transient MessageBox -image Icons(warning) -type ok \
				-text "File \"$path\" does not exist."
		return
	}
	if {![string compare $type save] && $exists} {
		set reply [Dialog transient MessageBox -image Icons(warning) \
				-type yesno -text \
				"File \"$path\" already exists.\
				\nDo you want to overwrite it?"]
		if ![string compare $reply "no"] {
			return
		}
	}
	$self config -result $path
}
FileDialog instproc cancel { } {
	$self config -result ""
}
WidgetClass DirectoryDialog -superclass Dialog -default {
	{ *font WidgetDefault }
	{ *ImageTextButton.borderWidth 1 }
	{ *ImageTextButton.highlightThickness 1 }
}
DirectoryDialog instproc build_widget { path } {
	frame  $path.frame
	DirectoryBox $path.dirbox -command "$self ok; $self ignore_args"
	frame  $path.buttonbox
	ImageTextButton $path.buttonbox.ok -underline 0 -text "Ok" \
			-image Icons(check) -orient horizontal \
			-command "$self ok"
	ImageTextButton $path.buttonbox.cancel -text "Cancel" -underline 0 \
			-image Icons(cross) -orient horizontal \
			-command "$self cancel"
	bind $path <KeyPress-Escape> "$self cancel"
	pack $path.buttonbox.ok $path.buttonbox.cancel -side left -anchor e\
			-padx 5 -pady 2
	pack $path.buttonbox -side bottom -in $path.frame -anchor e
	pack $path.dirbox -side top -fill both -expand 1 -in $path.frame
	pack $path.frame -side left -fill both -expand 1
	$self set_subwidget ok     $path.buttonbox.ok
	$self set_subwidget cancel $path.buttonbox.cancel
}
DirectoryDialog instproc ok { } {
	$self configure -result [$self subwidget dirbox cget -directory]
}
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\24\134\43\24\134\43\367\134\43\134\43\330\330\330\370\374\370\71\370\61\134\43\134\43\134\43\200\200\200\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\341\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\341\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\14\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\341\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\14\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\43\341\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\43\341\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\45\341\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\14\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\52\341\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\14\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\14\134\43\134\43\134\43\217\200\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\14\134\43\134\43\134\43\142\200\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\14\134\43\134\43\134\43\43\200\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\14\134\43\134\43\134\43\45\200\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\14\134\43\134\43\134\43\45\200\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\14\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\14\134\43\134\43\134\43\43\201\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\14\134\43\134\43\134\43\45\201\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\21\134\43\134\43\134\43\45\201\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\21\134\43\134\43\134\43\45\201\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\21\134\43\134\43\134\43\67\201\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\14\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\21\134\43\134\43\134\43\246\200\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\14\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\21\134\43\134\43\134\43\222\200\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\26\134\43\134\43\134\43\223\200\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\26\134\43\134\43\134\43\315\200\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\14\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\26\134\43\134\43\134\43\105\341\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\247\247\247\134\43\57\134\43\117\134\43\134\43\21\251\134\43\370\43\134\43\134\43\270\134\43\236\134\43\254\254\254\134\43\255\255\255\134\43\256\256\256\134\43\257\257\257\134\43\260\260\260\134\43\261\261\261\134\43\263\263\263\134\43\264\264\264\134\43\265\265\265\134\43\266\266\266\134\43\267\267\267\134\43\270\270\270\134\43\271\271\271\134\43\272\272\272\134\43\273\273\273\134\43\274\274\274\134\43\275\275\275\134\43\276\276\276\134\43\300\300\300\134\43\301\301\301\134\43\302\302\302\134\43\303\303\303\134\43\304\304\304\134\43\305\305\305\134\43\306\306\306\134\43\307\307\307\134\43\310\310\310\134\43\311\311\311\134\43\312\312\312\134\43\314\314\314\134\43\315\315\315\134\43\316\316\316\134\43\41\371\4\1\134\43\134\43\1\134\43\54\134\43\134\43\134\43\134\43\24\134\43\24\134\43\100\10\135\134\43\3\10\34\110\260\240\301\201\2\22\52\134\134\230\320\320\101\2\20\43\22\70\150\160\41\105\212\14\5\30\232\146\110\42\304\213\40\53\146\24\20\62\300\110\205\33\73\116\44\330\220\243\307\225\45\143\312\304\110\162\246\300\214\62\117\46\4\251\23\345\107\226\43\71\116\223\130\160\241\320\227\7\247\171\31\352\61\144\123\233\62\3\2\134\43\73"]
image create photo VcrIcons(play) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\24\134\43\24\134\43\367\134\43\134\43\330\330\330\370\374\370\71\370\61\134\43\134\43\134\43\200\200\200\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\341\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\341\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\14\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\341\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\14\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\43\341\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\43\341\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\45\341\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\14\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\52\341\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\14\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\14\134\43\134\43\134\43\217\200\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\14\134\43\134\43\134\43\142\200\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\14\134\43\134\43\134\43\43\200\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\14\134\43\134\43\134\43\45\200\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\14\134\43\134\43\134\43\45\200\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\14\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\14\134\43\134\43\134\43\43\201\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\14\134\43\134\43\134\43\45\201\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\21\134\43\134\43\134\43\45\201\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\21\134\43\134\43\134\43\45\201\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\21\134\43\134\43\134\43\67\201\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\14\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\21\134\43\134\43\134\43\246\200\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\14\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\21\134\43\134\43\134\43\222\200\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\26\134\43\134\43\134\43\223\200\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\26\134\43\134\43\134\43\315\200\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\14\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\26\134\43\134\43\134\43\105\341\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\247\247\247\134\43\101\134\43\117\134\43\134\43\21\251\134\43\300\134\43\236\134\43\300\134\43\236\134\43\254\254\254\134\43\255\255\255\134\43\256\256\256\134\43\257\257\257\134\43\260\260\260\134\43\261\261\261\134\43\263\263\263\134\43\264\264\264\134\43\265\265\265\134\43\266\266\266\134\43\267\267\267\134\43\270\270\270\134\43\271\271\271\134\43\272\272\272\134\43\273\273\273\134\43\274\274\274\134\43\275\275\275\134\43\276\276\276\134\43\300\300\300\134\43\301\301\301\134\43\302\302\302\134\43\303\303\303\134\43\304\304\304\134\43\305\305\305\134\43\306\306\306\134\43\307\307\307\134\43\310\310\310\134\43\311\311\311\134\43\312\312\312\134\43\314\314\314\134\43\315\315\315\134\43\316\316\316\134\43\41\371\4\1\134\43\134\43\1\134\43\54\134\43\134\43\134\43\134\43\24\134\43\24\134\43\100\10\173\134\43\3\10\34\110\260\240\301\201\2\22\52\134\134\50\134\43\32\1\2\7\13\302\103\207\356\241\305\210\5\27\42\203\130\220\134\134\105\213\14\5\30\172\210\261\144\311\220\11\35\162\24\10\340\41\112\205\43\127\112\244\150\221\100\302\215\62\115\6\134\43\200\16\34\134\43\235\100\117\212\4\247\63\44\50\2\330\16\276\114\170\124\46\277\245\12\161\22\4\200\15\44\312\230\6\301\221\43\127\123\43\111\214\133\271\76\204\206\25\50\134\43\217\125\311\5\215\30\20\134\43\73"]
image create photo VcrIcons(reverse) -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\270\274\270\134\43\134\43\134\43\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\111\10\272\334\376\360\205\31\26\255\60\210\75\224\346\331\46\14\4\361\215\245\163\222\246\310\252\156\271\246\315\334\162\64\143\333\60\176\243\204\36\220\127\213\375\136\105\37\121\147\134\134\132\232\306\307\140\372\242\42\35\245\254\42\233\153\160\203\200\157\144\114\56\3\22\134\43\73"]
image create photo VcrIcons(pause) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\20\134\43\24\134\43\302\134\43\134\43\330\330\330\134\43\134\43\134\43\270\274\270\120\124\120\370\374\370\200\200\200\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\20\134\43\24\134\43\134\43\3\74\10\272\334\376\60\262\100\253\15\142\216\315\73\321\135\110\24\205\22\204\42\151\242\236\12\234\354\66\226\157\54\273\160\74\257\366\136\367\70\333\300\47\40\30\217\110\237\202\304\154\62\31\316\50\115\102\255\132\1\11\134\43\73"]
image create photo VcrIcons(stop) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\24\134\43\20\134\43\200\134\43\134\43\134\43\134\43\134\43\277\277\277\41\371\4\1\134\43\134\43\1\134\43\54\134\43\134\43\134\43\134\43\24\134\43\20\134\43\134\43\2\34\214\217\251\313\355\17\27\230\224\276\212\57\266\156\363\346\115\232\67\156\145\326\205\321\312\266\114\1\134\43\73"]
image create photo VcrIcons(sstop) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\24\134\43\20\134\43\200\134\43\134\43\134\43\134\43\134\43\277\277\277\41\371\4\1\134\43\134\43\1\134\43\54\134\43\134\43\134\43\134\43\24\134\43\20\134\43\134\43\2\35\214\217\251\313\355\17\27\210\12\130\172\254\306\272\307\16\76\140\330\214\227\110\102\36\67\141\356\213\24\134\43\73"]
image create photo VcrIcons(splay) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\20\134\43\24\134\43\302\134\43\134\43\330\330\330\134\43\134\43\134\43\270\274\270\370\24\100\370\374\370\200\200\200\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\20\134\43\24\134\43\134\43\3\74\10\272\334\376\60\262\100\253\15\142\216\315\73\321\135\110\24\205\22\204\42\151\242\236\12\234\354\66\226\157\54\273\160\74\257\366\136\367\70\333\300\47\40\30\217\110\237\202\304\154\62\31\316\50\115\102\255\132\1\11\134\43\73"]
image create photo VcrIcons(record) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\12\134\43\12\134\43\302\134\43\134\43\330\330\330\370\140\100\370\134\43\134\43\370\244\134\43\260\40\40\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\12\134\43\12\134\43\134\43\3\32\10\272\334\276\41\10\27\106\234\320\136\262\304\25\2\247\200\44\41\216\241\351\230\347\263\44\134\43\73"]
image create photo VcrIcons(redbullet) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\12\134\43\12\134\43\302\134\43\134\43\330\330\330\134\43\374\134\43\370\134\43\134\43\230\370\230\60\314\60\50\210\120\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\12\134\43\12\134\43\134\43\3\32\10\272\334\276\41\10\27\106\44\254\306\100\312\42\27\321\175\242\130\170\344\211\62\352\343\44\134\43\73"]
image create photo VcrIcons(greenbullet) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\12\134\43\12\134\43\302\134\43\134\43\330\330\330\170\174\170\134\43\374\370\370\374\370\134\43\134\43\134\43\134\43\174\170\134\43\134\43\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\12\134\43\12\134\43\134\43\3\40\10\20\254\276\142\10\362\102\214\205\252\40\145\166\226\367\71\104\141\22\32\211\12\106\372\134\43\254\373\260\157\235\134\43\134\43\73"]
image create photo VcrIcons(browse_small) -data $imageObject__
WidgetClass RecorderUI/Input -superclass Dialog -default {
	{ .title "MASH Archive System: Recorder" }
	{ .address.width 15 }
	{ .listbox.scrollbar both }
	{ .listbox.selectMode multiple }
	{ .listbox.bbox.width 225 }
	{ .listbox.bbox.height 150 }
	{ .listbox*Label.borderWidth 1 }
	{ .listbox.bbox.highlightThickness 1 }
	{ .listbox.Scrollbar.borderWidth 1 }
	{ .listbox.Scrollbar.highlightThickness 1 }
	{ .listbox.Scrollbar.width 10 }
	{ .listbox.borderWidth 1 }
	{ .listbox.relief sunken }
	{ *Menubutton.borderWidth 1 }
	{ *Menubutton.highlightThickness 1 }
	{ *Entry.borderWidth 1 }
	{ *Entry.highlightThickness 1 }
	{ .protocol.button.anchor w }
	{ .media.borderWidth 1 }
	{ .media.relief raised }
	{ .media.highlightThickness 1 }
	{ .media.entry.borderWidth 0 }
	{ .media.entry.highlightThickness 0 }
	{ .media.entry.relief flat }
	{ .media.button.borderWidth 0 }
	{ .media.button.highlightThickness 0 }
	{ *ImageTextButton.borderWidth 1 }
	{ *ImageTextButton.highlightThickness 1 }
	{ *ImageTextButton.orient horizontal }
	{ *font WidgetDefault }
	{ *LabeledWidget.label.font WidgetDefault(-boldfont) }
	{ *dirbox.entry_label.font WidgetDefault(-boldfont) }
}
RecorderUI/Input instproc destroy { } {
	$self instvar filedlg_
	if [info exists filedlg_] {
		destroy $filedlg_
	}
	$self tkvar media_
	catch {trace vdelete media_ w "$self media_changed_"}
	$self next
}
RecorderUI/Input instproc build_widget { path } {
	$self instvar protocols_
	set protocols_(mediaboard) SRM
	set protocols_(video)      RTP
	set protocols_(audio)      RTP
	frame $path.f1
	frame $path.f2
	entry $path.session -textvariable [$self tkvarname session_id_]
	LabeledWidget $path.session_label -label Session-id: -underline 0 \
			-orient horizontal -widget $path.session
	entry $path.catalog -textvariable [$self tkvarname catalog_filename_]
	LabeledWidget $path.catalog_label -label "Catalog file:" -underline 0 \
			-orient horizontal -widget $path.catalog
	ImageTextButton $path.catalog_browse -image Icons(browse) -text \
			"Browse" -underline 0 -command "$self browse_catalog_"
	frame $path.sep1 -bd 1 -relief groove -height 2
	DropDown $path.protocol -variable [$self tkvarname protocol_]
	$path.protocol insert end RTP SRM
	LabeledWidget $path.protocol_label -label Protocol: -underline 0 \
			-orient horizontal -widget $path.protocol
	DropDown/Text $path.media -variable [$self tkvarname media_]
	eval [list $path.media] insert end [lsort [array names protocols_]]
	LabeledWidget $path.media_label -label Media: -underline 3 \
			-orient horizontal -widget $path.media
	entry $path.address -textvariable [$self tkvarname addr_]
	LabeledWidget $path.address_label -label Address: -underline 4 \
			-orient horizontal -widget $path.address
	ScrolledListbox $path.listbox -browsecmd "$self browse_listbox; \
			$self ignore_args"
	DirectoryBox $path.dirbox
	$path.dirbox subwidget entry_label configure -text "Save in:" \
			-underline 2
	frame $path.buttons
	ImageTextButton $path.add -image Icons(plus) -text Add -underline 0 \
			-command "$self add"
	ImageTextButton $path.delete -image Icons(trashcan) -text Delete \
			-underline 0 -state disabled -command "$self delete"
	ImageTextButton $path.record -image VcrIcons(record) -text Record \
			-underline 0 -state disabled \
			-command "$self config -result record"
	ImageTextButton $path.cancel -image Icons(cross) -text Cancel \
			-command "$self cancel"
	pack $path.cancel $path.record $path.delete $path.add -side right \
			-padx 3 -fill x -in $path.buttons
	pack $path.dirbox -fill both -expand 1 -side top -in $path.f1
	pack $path.buttons -fill x -side bottom -pady 3 -in $path.f1 -anchor e
	pack $path.session_label  -fill x -side top -in $path.f2
	pack $path.catalog_label  -fill x -side top -in $path.f2
	pack $path.catalog_browse -anchor e -side top -in $path.f2
	pack $path.sep1           -fill x -side top -in $path.f2 -pady 2
	pack $path.protocol_label -fill x -side top -in $path.f2
	pack $path.media_label    -fill x -side top -in $path.f2
	pack $path.address_label  -fill x -side top -in $path.f2
	pack $path.listbox -fill both -expand 1 -side top -in $path.f2
	pack $path.f2 $path.f1 -side left -fill both -expand 1 -padx 5 -pady 5
	$self tkvar addr_ session_id_ media_ catalog_filename_
	trace variable media_ w "$self media_changed_"
	set addr_ "224.2.55.66/8001"
	set session_id_ [clock format [clock seconds] -format "%m%d%H%M"]
	set catalog_filename_ "cat.ctg"
	set media_ "mediaboard"
	bind $path <Key-Escape> "$self subwidget cancel invoke_with_ui"
	$self bindkey_ a "if \{\[$path.add cget -state\]!={disabled}\} \{ \
			focus $path.add; $path.add invoke_with_ui \}"
	$self bindkey_ d "if \{\[$path.delete cget -state\]!={disabled}\} \{ \
			focus $path.delete; $path.delete invoke_with_ui \}"
	$self bindkey_ r "if \{\[$path.record cget -state\]!={disabled}\} \{ \
			focus $path.record; $path.record invoke_with_ui \}"
	$self bindkey_ b "if \{\[$path.catalog_browse cget -state\]!=\
			{disabled}\} \{ focus $path.catalog_browse; \
			$path.catalog_browse invoke_with_ui \}"
	$self bindkey_ s "focus $path.session"
	$self bindkey_ h "focus $path.catalog"
	$self bindkey_ p "focus [$path.protocol subwidget button]"
	$self bindkey_ i "focus [$path.media subwidget entry]"
	$self bindkey_ e "focus $path.address"
	$self bindkey_ v "focus [$self subwidget dirbox subwidget entry]"
}
RecorderUI/Input instproc bindkey_ { key script } {
	set path [$self info path]
	bind $path <Alt-[string tolower $key]> $script
	bind $path <Alt-[string toupper $key]> $script
}
RecorderUI/Input instproc add { } {
	$self tkvar protocol_ media_ addr_
	set addr_ [string trim $addr_]
	if { $addr_!={} } {
		if { ![catch {$self subwidget listbox insert end \
				"-id $protocol_+$media_+$addr_ \
				$protocol_: $media_ ($addr_)"}] } {
			$self subwidget record configure -state normal
		}
	}
}
RecorderUI/Input instproc delete { } {
	set listbox [$self subwidget listbox]
	foreach id [$listbox selection get] {
		$listbox delete -id $id
	}
	$self subwidget delete configure -state disabled
	if { [$listbox info numelems] <= 0 } {
		$self subwidget record configure -state disabled
	}
}
RecorderUI/Input instproc browse_listbox { } {
	if { [llength [$self subwidget listbox selection get]]==0 } {
		$self subwidget delete configure -state disabled
	} else {
		$self subwidget delete configure -state normal
	}
}
RecorderUI/Input instproc browse_catalog_ { } {
	$self instvar filedlg_
	if { ![info exists filedlg_] } {
		$self tkvar catalog_filename_
		set path [$self info path]
		set filedlg_ [FileDialog [winfo toplevel $path].filedlg \
				-type save -title "Catalog file name" \
				-transient $path]
		$filedlg_ subwidget filebox configure \
				-filename [file tail $catalog_filename_] \
				-filetypes "{ {Session catalog files} {.ctg} }\
				{ {All files} {*} }"
	}
	$filedlg_ subwidget filebox configure -directory \
			[$self subwidget dirbox cget -directory]
	set filename [$filedlg_ invoke]
	if { $filename!="" } {
		$self tkvar catalog_filename_
		set catalog_filename_ $filename
	}
}
RecorderUI/Input instproc add_direct { protocol media addr } {
	$self tkvar media_ addr_
	set media_ $media
	set addr_ $addr
	set protocol_ $protocol
	$self add
}
RecorderUI/Input instproc set_session_id { session_id } {
	$self tkvar session_id_
	set session_id_ $session_id
}
RecorderUI/Input instproc set_catalog_filename { filename } {
	$self tkvar catalog_filename_
	set catalog_filename_ $filename
}
RecorderUI/Input instproc set_directory { directory } {
	$self subwidget dirbox configure -directory $directory
}
RecorderUI/Input instproc get_session_id { } {
	$self tkvar session_id_
	return $session_id_
}
RecorderUI/Input instproc get_catalog_filename { } {
	$self tkvar catalog_filename_
	if { $catalog_filename_=="" } {
		return ""
	} else {
		return [file join [$self get_directory] $catalog_filename_]
	}
}
RecorderUI/Input instproc get_directory { } {
	return [$self subwidget dirbox cget -directory]
}
RecorderUI/Input instproc media_changed_ { args } {
	$self tkvar media_ protocol_
	$self instvar protocols_
	set media [string tolower $media_]
	if { [info exists protocols_($media)] } {
		set protocol_ $protocols_($media)
	}
}
WidgetClass RecorderUI/Stream -superclass Observer -configspec {
	{ -minimized minimized Minimized 0 config_minimized }
	{ -name name Name {unknown} config_option }
	{ -filename filename Filename {unknown} config_option }
	{ -bytes bytes Bytes {0} config_option }
} -default {
	{ .borderWidth 1 }
	{ .relief groove }
	{ *Button.padY 0 }
	{ *Button.borderWidth 0 }
	{ *Button.highlightThickness 1 }
	{ *Button.activeBackground WidgetDefault(-background) }
	{ *Label.padY 0 }
	{ *Label.borderWidth 0 }
	{ *font WidgetDefault }
	{ *LabeledWidget.label.font WidgetDefault(-boldfont) }
	{ .name.font WidgetDefault(-boldfont) }
}
RecorderUI/Stream instproc destroy { } {
	$self instvar after_id_
	if [info exists after_id_] {
		after cancel $after_id_
		unset after_id_
	}
	$self next
}
RecorderUI/Stream instproc build_widget { path } {
	frame $path.f1
	frame $path.f2
	button $path.minimize -command "\
			if \{ \[$self cget -minimized\] \} \{ \
			$self configure -minimized 0 \} else \{ \
			$self configure -minimized 1 \}"
	label $path.name -anchor w
	pack $path.minimize -side left -fill y -in $path.f1
	pack $path.name -side left -fill both -expand 1 -in $path.f1
	label $path.filename -anchor w
	LabeledWidget $path.filename_label -label "Filename:" \
			-widget $path.filename
	label $path.bytes -anchor w
	LabeledWidget $path.bytes_label -label "Bytes received:" \
			-widget $path.bytes
	pack $path.filename_label -side top -fill x -in $path.f2 -padx 20
	pack $path.bytes_label -side top -fill x -in $path.f2 -padx 20
	pack $path.f1 -fill x
	pack $path.f2 -fill x -expand 1
}
RecorderUI/Stream instproc disable { } {
	set fg [WidgetClass widget_default -disabledforeground]
	$self subwidget name configure -fg $fg
	$self subwidget filename configure -fg $fg
	$self subwidget bytes configure -fg $fg
	$self subwidget filename_label subwidget label configure -fg $fg
	$self subwidget bytes_label subwidget label configure -fg $fg
	$self instvar stream_
	if { [info exists stream_] } {
		delete $stream_
		unset stream_
	}
}
RecorderUI/Stream instproc config_minimized { option args } {
	set path [$self info path]
	if { [llength $args]==0 } {
		if { [lsearch [pack slaves $path] $path.f2] != -1 } {
			return 0
		} else {
			return 1
		}
	} else {
		set value [lindex $args 0]
		if { $value } {
			catch { pack forget $path.f2 }
			$path.minimize configure -image Icons(maximize)
		} else {
			if { [lsearch [pack slaves $path] $path.f2] == -1 } {
				pack $path.f2 -fill x -expand 1
			}
			$path.minimize configure -image Icons(minimize)
		}
	}
}
RecorderUI/Stream instproc config_option { option args } {
	set subwidget [string range $option 1 end]
	if { [llength $args]==0 } {
		return [$self subwidget $subwidget cget -text]
	} else {
		$self subwidget $subwidget configure -text [lindex $args 0]
	}
}
RecorderUI/Stream instproc attach_stream { stream } {
	$self set stream_ $stream
}
WidgetClass RecorderUI/Session -superclass { Observer ScrolledWindow/Expand }
RecorderUI/Session instproc build_widget { path } {
	$self next $path
	$self set count_ 0
}
RecorderUI/Session instproc disable { } {
	foreach widget [winfo children [$self subwidget window]] {
		$widget disable
	}
}
RecorderUI/Session instproc attach_session { session } {
	$self set session_ $session
}
WidgetClass RecorderUI/Status -superclass Dialog -default {
	{ .title "MASH Archive System: Recorder" }
	{ .modal 0 }
	{ *session_list.scrollbar both }
	{ *session_list.borderWidth 1  }
	{ *session_list.relief sunken  }
	{ *session_list*Label.borderWidth 1 }
	{ *session_list.bbox.highlightThickness 1 }
	{ *session_list.Scrollbar.borderWidth 1 }
	{ *session_list.Scrollbar.highlightThickness 1 }
	{ *session_list.Scrollbar.width 10 }
	{ *session_list.bbox.width 225 }
	{ *RecorderUI/Session.scrollbar both }
	{ *RecorderUI/Session.borderWidth 1  }
	{ *RecorderUI/Session.relief sunken  }
	{ *RecorderUI/Session.bbox.highlightThickness 1 }
	{ *RecorderUI/Session.Scrollbar.borderWidth 1 }
	{ *RecorderUI/Session.Scrollbar.highlightThickness 1 }
	{ *RecorderUI/Session.Scrollbar.width 10 }
	{ *Entry.borderWidth 1 }
	{ *Entry.width 5 }
	{ *ImageTextButton.borderWidth 1 }
	{ *ImageTextButton.highlightThickness 1 }
}
RecorderUI/Status instproc build_widget { path } {
	frame $path.f1
	frame $path.f2
	entry $path.session_id
	LabeledWidget $path.session_id_label -label Session-id: \
			-orient horizontal -widget $path.session_id
	entry $path.directory
	LabeledWidget $path.directory_label -label "Save in:" \
			-orient horizontal -widget $path.directory
	entry $path.catalog
	LabeledWidget $path.catalog_label -label "Catalog file:" \
			-orient horizontal -widget $path.catalog
	ScrolledListbox $path.session_list -browsecmd "$self browse"
	frame $path.session_ui
	frame $path.buttons
	ImageTextButton $path.stop -image VcrIcons(stop) \
			-text "Stop this session" -command "$self stop" \
			-state disabled
	ImageTextButton $path.exit -image Icons(cross) -text "Exit" \
			-command "$self stop_all"
	pack $path.exit $path.stop -fill x -anchor e -in $path.buttons \
			-side right
	pack $path.session_id_label -side top -fill x -in $path.f2
	pack $path.directory_label  -side top -fill x -in $path.f2
	pack $path.catalog_label    -side top -fill x -in $path.f2
	pack $path.session_list -fill both -expand 1 -side top -in $path.f2
	pack $path.f2 -fill both -side left -in $path.f1 -padx 5 -pady 5
	pack $path.session_ui -fill both -expand 1 -side right -in $path.f1 \
			-padx 5 -pady 5
	pack $path.buttons -side bottom -fill x -anchor e
	pack $path.f1 -side top -fill both -expand 1
	$self set count_ 0
}
RecorderUI/Status instproc add { session } {
	$self instvar count_ stop_status_
	set widget [RecorderUI/Session \
			[$self subwidget session_ui].session_$count_]
	incr count_
	set stop_status_($widget) 0
	set list [$self subwidget session_list]
	$list insert end "-id $widget $session"
	if { [llength [$list selection get]]==0 } {
		$list selection set -id $widget
		$self browse $widget
	}
	return $widget
}
RecorderUI/Status instproc stop { {widget {}} } {
	$self instvar stop_status_
	set list [$self subwidget session_list]
	if { $widget=={} } {
		set widget [$list selection get]
		if { $widget=={} } return
	}
	set list_widget [$list info widget -id $widget]
	$list_widget configure -normalforeground [WidgetClass \
			widget_default -disabledforeground]
	$list_widget configure -selectforeground [WidgetClass \
			widget_default -disabledforeground]
	$widget disable
	set stop_status_($widget) 1
	$self subwidget stop configure -state disabled	
}
RecorderUI/Status instproc stop_all { } {
	foreach widget [$self subwidget session_list info all] {
		$self stop $widget
	}
	$self configure -result "exit"
}
RecorderUI/Status instproc browse { widget } {
	$self instvar stop_status_
	set list [$self subwidget session_list]
	if { [llength [$list selection get]]==0 } {
		$list selection set -id $widget
	}
	catch { pack forget [pack slaves [$self subwidget session_ui]] }
	pack $widget -fill both -expand 1
	if { $stop_status_($widget) } {
		$self subwidget stop configure -state disabled
	} else {
	}
}
RecorderUI/Session instproc new_stream { stream } {
	$self instvar streams_
	$self instvar count_
	set widget [RecorderUI/Stream [$self subwidget window].stream_$count_]
	incr count_
	pack $widget -side top -fill x -expand 1 -anchor w -padx 1 -pady 1
	set streams_($stream) $widget
	$stream attach_observer $widget
	$widget attach_stream $stream
}
RecorderUI/Session instproc stream_done { stream } {
	$self instvar streams_
	if [info exists streams_($stream)] {
		$streams_($stream) disable
		$stream_detach_observer $streams_($stream)
		unset streams_($stream)
	}
}
RecorderUI/Stream instproc name { name } {
	$self configure -name $name
}
RecorderUI/Stream instproc filename { filename } {
	$self configure -filename $filename
}
RecorderUI/Stream instproc bytes_rcvd { bytes } {
	$self instvar bytes_ after_id_
	set bytes_ $bytes
	if { ![info exists after_id_] } {
		set after_id_ [after 1000 $self bytes_rcvd_helper]
	}
}
RecorderUI/Stream instproc bytes_rcvd_helper { } {
	$self instvar bytes_ after_id_
	$self configure -bytes $bytes_
	unset after_id_
}
Class UIRecorder
UIRecorder instproc init { path } {
	$self next
	$self set count_ 0
	$self build $path
	$self instvar hfile_
	set hfile_ "Default.hdr"
}
UIRecorder instproc hdrfile {fileid} {
	$self instvar hfile_
	set hfile_ $fileid
}
UIRecorder instproc build { path } {
	$self instvar list_ path_
	set path_ $path
	Frame $path
	Frame $path.main
	Pack $path.main -fill both -expand 1 -padx 5 -pady 5
	Within $path.main {
		Frame main
		Within main {
			Frame media
			Pack media -anchor w
			Within media {
				Label label -text "Media:"
				new DropDown [WithinPath media] Mediaboard \
						{Audio Video Mediaboard} \
						[$self tkvarname media_]
				Pack label media -side left
			}
			$self tkvar addr_
			set addr_ "224.2.55.66/8001"
			LabelEntry addr {-text "Address:"} {-width 15 \
					-textvariable [$self tkvarname addr_]}\
					{} {-fill x -expand 1}
			Pack addr -fill x -expand 1
		}
		set list_ [new UIList [WithinPath list] \
				{-width 100 -height 100 -bg white}]
		$self list_procs $list_
		Pack main list -fill x -expand 1 -pady 1
	}
	Frame $path.buttons
	Pack $path.buttons -fill x -expand 1 -padx 5 -pady 2
	Within $path.buttons {
		global add_icon delete_icon record_icon cancel_icon
		ImageButton add    -image $add_icon    -command "$self add"
		ImageButton delete -image $delete_icon -command "$self delete"\
				-state disabled
		ImageButton record -image $record_icon -command "$self record"\
				-state disabled
		ImageButton cancel -image $cancel_icon -command "destroy $path"
		Pack add delete record cancel -side left -anchor w
		$list_ buttons [WithinPath add] [WithinPath delete]
		$self set add_    [WithinPath add]
		$self set delete_ [WithinPath delete]
		$self set record_ [WithinPath record]
		$self set cancel_ [WithinPath cancel]
	}
	bind $path <Destroy> "+delete $self"
}
UIRecorder instproc add { } {
	$self instvar list_ count_ record_
	$self tkvar media_ addr_
	set addr_ [string trim $addr_]
	if { $addr_!={} } {
		if { ![catch {$list_ insert $media_+$addr_ \
				"$media_ ($addr_)"}] } {
			incr count_
			$record_ configure -state normal
		}
	}
}
UIRecorder instproc addsdr {media address} {
	$self instvar list_ count_ record_
	$self tkvar media_ addr_
	set media_ $media
	set addr_ $address
	set addr_ [string trim $addr_]
	if { $address!={} } {
		if { ![catch {$list_ insert $media_+$addr_ \
				"$media_ ($addr_)"}] } {
			incr count_
			$record_ configure -state normal
		}
	}
}
UIRecorder instproc delete { } {
	$self instvar list_ count_ record_
	set current [$list_ current]
	if { $current!={} } {
		$list_ remove $current
		incr count_ -1
		if { $count_==0 } {
			$record_ configure -state disabled
		}
	}
}
UIRecorder instproc record { } {
	$self instvar list_ add_ delete_ record_ cancel_ hfile_
	global stop_icon
	foreach id [$list_ all] {
		set id [split $id "+"]
		set media [lindex $id 0]
		set addr  [lindex $id 1]
		new ArchiveRecorder/$media $addr "default.hdr" "./test"
	}
	$add_    configure -state disabled
	$delete_ configure -state disabled
	$cancel_ configure -state disabled
	$record_ configure -image $stop_icon
	$record_ configure -command "exit"
}
UIRecorder instproc browse { tkvar {filetypes {{{All files} {*}}}} } {
	if { ![regexp {(.*)\(.*\)$} $tkvar dummy varname] } {
		set varname $tkvar
	}
	$self tkvar $varname
	set name [tk_getOpenFile -title Browse -filetypes $filetypes]
	if { $name != "" } {
		set $tkvar $name
	}
}
UIRecorder instproc list_procs { list } {
	$list proc on_ButtonPress_1 { id x y } {
		$self instvar current_ delete_
		if { [info exists current_] } {
			$self toggle_frame [$self get_frame $current_]
		}
		set current_ $id
		$self toggle_frame [$self get_frame $current_]
		$delete_ configure -state normal
	}
	$list proc toggle_frame { frame } {
		set bg [$frame cget -bg]
		set fg [$frame cget -fg]
		$frame configure -bg $fg
		$frame configure -fg $bg
	}
	$list proc current { } {
		$self instvar current_
		if { [info exists current_] } {
			return $current_
		} else {
			return ""
		}
	}
	$list proc buttons { add delete } {
		$self instvar add_ delete_
		set add_ $add
		set delete_ $delete
	}
	$list proc remove { id } {
		$self instvar current_ delete_
		if { [info exists current_] && $current_==$id } {
			$delete_ configure -state disabled
			unset current_
		}
		$self next $id
	}
}
Class SDPParser
Class SDPMedia
Class SDPTime
Class SDPMessage 
SDPParser instproc init { {ordered_syntax 1} } {
	$self next
	$self instvar nextsym_ ordered_syntax_ parse_error_
	set nextsym_(start) "v"
	set nextsym_(v) "o"
	set nextsym_(o) "s"
	set nextsym_(s) "i u e p c b t"
	set nextsym_(i) "u e p c b t"
	set nextsym_(u) "e p c b t"
	set nextsym_(e) "e p c b t"
	set nextsym_(p) "e p c b t"
	set nextsym_(c) "b t "
	set nextsym_(b) "t"
	set nextsym_(t) "t r z k a m"
	set nextsym_(r) "t z k a m"
	set nextsym_(z) "k a m"
	set nextsym_(k) "a m"
	set nextsym_(a) "a m"
	set nextsym_(m) "m i:m c:m b:m k:m a:m v"
	set nextsym_(i:m) "m c:m b:m k:m a:m v"
	set nextsym_(c:m) "m b:m k:m a:m v"
	set nextsym_(b:m) "m k:m a:m v"
	set nextsym_(k:m) "m a:m v"
	set nextsym_(a:m) "m a:m v"
	set ordered_syntax_ $ordered_syntax
	set parse_error_ ""
}
SDPParser instproc check_syntax { last cur media } {
	$self instvar nextsym_
	if ![info exists nextsym_($last)] {
		return ""
	}
	foreach s $nextsym_($last) {
		set t [split $s :]
		if { [lindex $t 0] == $cur } {
			return $s
		}
	}
	return ""
}
SDPParser instproc parse { announcement } {
	$self instvar parse_error_ ordered_syntax_
	set media ""
	set allmsgs ""
	set lasttag "start"
	set lines [split $announcement "\n"]
	set parse_error_ ""
	set lnum 0
	foreach line $lines {
		incr lnum
		if { $line=={} } continue
		set sline [split $line =]
		set tag [lindex $sline 0]
		set value [join [lrange $sline 1 end]]
		set ret [$self check_syntax $lasttag $tag $media]
		if { $ret == "" && $ordered_syntax_==1 } {
			set parse_error_ "$class: syntax error between\
					$lasttag and $tag in line $lnum."
			foreach m $allmsgs {
				delete $m
			}
			return ""
		}
		set lasttag $ret
		switch $tag {
		v { 
			set media ""
			set msg [new SDPMessage]
			lappend allmsgs $msg
			$msg set version_ $value
		}
		o {
			$msg set creator_ [lindex $value 0]
			$msg set createtime_ [lindex $value 1]
			$msg set modtime_  [lindex $value 2]
			$msg set nettype_ [lindex $value 3]	
			$msg set addrtype_ [lindex $value 3]
			$msg set createaddr_ [lindex $value 5]
		}
		s {	
			$msg set session_name_ $value 
		}
		i {	
			if { $media != "" } {
				$media set session_info_ $value 
			} else {
				$msg set session_info_ $value 
			}
		}
		p {
			set tmp "" 
			catch { set tmp [$msg set phonelist_] }
			lappend tmp $value
			$msg set phonelist_ $tmp
		}
		e { 
			set tmp "" 
			catch { set tmp [$msg set emaillist_] }
			lappend tmp $value
			$msg set emaillist_ $tmp
		}
		u { 
			$msg set uri_ $value
		} 
		c {
			if { $media != "" } {
				$media set nettype_ [lindex $value 0]
				$media set addrtype_ [lindex $value 1]
				$media set caddr_ [lindex $value 2]
			} else {
				$msg set nettype_ [lindex $value 0]
				$msg set addrtype_ [lindex $value 1]
				$msg set caddr_ [lindex $value 2]
			}
		}
		b {
			set bwspec [split $value :]
			if { $media != "" } {
				$media set bwmod_ [lindex $bwspec 0]
				$media set bwval_ [lindex $bwspec 1]
			} else {
				$msg set bwmod_ [lindex $bwspec 0]
				$msg set bwval_ [lindex $bwspec 1]
			}
		}
		t {
			set tdes [new SDPTime]
			$tdes set fields_(t) $value
			$tdes set starttime_ [lindex $value 0]
			$tdes set endtime_ [lindex $value 1]
			set tmp [$msg set alltimedes_]
			lappend tmp $tdes
			$msg set alltimedes_ $tmp
		}
		r {
			$tdes set fields_(r) $value
			$tdes set repeat_interval_ [lindex $value 0]
			$tdes set active_duration_ [lindex $value 1]
			$tdes set offlist_ [lrange $value 2 end]
		}
		z {
			set nval [llength $value]
			if [expr 2 * ($nval / 2) != $nval] {
				foreach m $allmsgs {
					delete $m
				}
				return ""
			}
			$self instvar zoneinfo_
			for { set n 0 } { $n < $nval } { incr n } {
				set adjtime [lindex $value $n]
				incr n
				set offset [lindex $value $n]
				lappend zoneinfo_ "$adjtime $offset"
			}
		}
		k {
			set tmp [split $value :]
			if { $media != "" } {
				$media set crypt_method_ [lindex $tmp 0]
				$media set crypt_key_ [lindex $tmp 1]
			} else {
				$msg set crypt_method_ [lindex $tmp 0]
				$msg set crypt_key_ [lindex $tmp 1]
			}
		}
		a {
			set attribute [split $value ":"]
			set attname [lindex $attribute 0]
			set attval [join [lrange $attribute 1 end] ":"]
			if { $media != "" } {
				set target $media
			} else {
				set target $msg
			}
			if [catch {$target set attributes_($attname)}] {
				$target set attributes_($attname) {}
			}
			$target set attributes_($attname) \
			    [concat [$target set attributes_($attname)] \
				 [list $attval]]
		}
		m {
			set media [new SDPMedia $msg]
			set mt [lindex $value 0]
			$media set mediatype_ $mt
			$media set port_  [lindex $value 1]
			$media set proto_ [lindex $value 2]
			$media set fmt_ [lrange $value 3 end]
			set tmp ""
			catch { set tmp [$msg set media_array_($mt)] }
			lappend tmp $media
			$msg set media_array_($mt) $media
			set tmp [$msg set allmedia_]
			lappend tmp $media
			$msg set allmedia_ $tmp
		}
		default {
			set parse_error_ "$class: error unknown modifier $tag."
			foreach m $allmsgs {
				delete $m
			}
			return ""
		}
		}
		set tmp [$msg set msgtext_]
		lappend tmp $line
		$msg set msgtext_ $tmp
		if { $media != "" } {
			$media set fields_($tag) $value
		} else {
			$msg set fields_($tag) $value
		}
	}
	foreach msg $allmsgs {
		set tmp [$msg set msgtext_]
		set tmp [join $tmp \n]
		append tmp \n
		$msg set msgtext_ $tmp
	}
	return $allmsgs
}
SDPParser instproc parse_error { } {
	return [$self set parse_error_]
}
SDPMessage instproc init {} {
	$self next
	$self instvar allmedia_ alltimedes_ msgtext_
	set allmedia_ ""
	set alltimedes_ ""
	set msgtext_ ""
}
SDPMessage instproc destroy {} {
	$self instvar allmedia_ alltimedes_
	foreach m $allmedia_ {
		delete $m
	}
	foreach t $alltimedes_ {
		delete $t
	}
	$self next
}
SDPMessage instproc media { media_type } {
	$self instvar media_array_
	if [info exists media_array_($media_type)] {
		return $media_array_($media_type)
	} else {
		return ""
	}
}
SDPMessage instproc have_field { field } {
	$self instvar fields_
	return [info exists fields_($field)]
}
SDPMessage instproc field_value { field } {
	$self instvar fields_
	if [info exists fields_($field)] {
		return $fields_($field)
	} else {
		return ""
	}
}
SDPMessage instproc attributes {} {
	$self instvar attributes_
	if [info exists attributes_] {
		return [array names attributes_]
	} else {
		return ""
	}
}
SDPMessage instproc have_attr { name } {
	$self instvar attributes_
	return [info exists attributes_($name)]
}
SDPMessage instproc attr_value { name } {
    $self instvar attributes_
    if [info exists attributes_($name)] {
	    return $attributes_($name)
    } else {
	    return ""
    }
}
SDPMessage instproc obj2str {} {
	$self instvar attributes_ alltimedes_ allmedia_
	set o "v=[$self field_value v]"
	foreach f { o s i u } {
		if [$self have_field $f] {
			set n "$f=[$self field_value $f]"
			set o $o\n$n
		}
	}
	$self instvar phonelist_ emaillist_
	if [info exists phonelist_] {
		foreach e $phonelist_ {
			set n "p=$e"
			set o $o\n$n
		}
	}
	if [info exists emaillist_] {
		foreach e $emaillist_ {
			set n "e=$e"
			set o $o\n$n
		}
	}
	foreach f { c b } {
		if [$self have_field $f] {
			set n "$f=[$self field_value $f]"
			set o $o\n$n
		}
	}
	foreach t $alltimedes_ {
		set n [$t obj2str]
		set o $o\n$n
	}
	foreach f { z k } {
		if [$self have_field $f] {
			set n "$f=[$self field_value $f]"
			set o $o\n$n
		}
	}
	foreach a [$self attributes] {
		if { $attributes_($a) == "" } {
			set n "a=$a"
		} else {
			set n "a=$a:$attributes_($a)"
		}
		set o $o\n$n
	}
	foreach m $allmedia_ {
		set n [$m obj2str]
		set o $o\n$n
	}
	return $o
}
SDPMessage public unique_key {} {
    if ![$self have_field o] {
	$self warn "in SDPMessage::unique_key without o= field"
	return ""
    }
    set l [split [$self field_value o]]
    set l [lreplace $l 2 2]
    set key [join $l :]
    return $key
}
SDPMessage instproc htmlify_media { } {
    set html {}
    foreach media [$self set allmedia_] {
	append html [$media create_dynamic_html \
		[DynamicHTMLifier set html_(media)]]
    }
    return $html
}
SDPMessage instproc htmlify_times { } {
    set html {}
    foreach time [$self set alltimedes_] {
	set repeat [string tolower [$time readable_repeat]]
	if { [$time set starttime_] != 0 } {
	    append html [$time create_dynamic_html \
		    [DynamicHTMLifier set html_(time_$repeat)]]
	} else {
	    append html "Unbounded session"
	}
    }
    return $html
}
SDPMessage instproc htmlify_url { } {
    $self instvar uri_
    if [info exists uri_] {
	return "<a href=\"$uri_\">$uri_</a>"
    } else {
	return ""
    }
}
SDPMessage instproc htmlify_list { varname } {
    set list {}
    foreach elt [$self get $varname] {
	if { $list!={} } {
	    append list ", $elt"
	} else {
	    append list $elt
	}
    }
    return $list
}
SDPMessage instproc get { varname } {
    $self instvar $varname
    if [info exists $varname] {
	return [set $varname]
    } else {
	return ""
    }
}
SDPMedia instproc htmlify_mediatype { } {
    return "[$self set mediatype_]"
}
SDPMedia instproc get { varname } {
    $self instvar $varname
    if [info exists $varname] {
	return [set $varname]
    } else {
	return ""
    }
}
SDPMedia instproc init {{msg ""}} {
	$self next
	if {$msg == ""} { return }
	$self instvar attributes_ fields_
	set alist [$msg attributes]
	foreach a $alist {
		set attributes_($a) [$msg set attributes_($a)]
	}
	set vlist [$msg info vars]
	foreach f { session_info_ nettype_ addrtype_ caddr_ bwmod_ bwval_ 
		crypt_method_ crypt_key_ } {
		if { [lsearch -exact $vlist $f] >= 0 } {
			$self set $f [$msg set $f]
		}
	}
	foreach f { i c b k a } {
		if [$msg have_field $f] {
			set fields_($f) [$msg field_value $f]
		}
	}
}
SDPMedia instproc have_field { field } {
	$self instvar fields_
	return [info exists fields_($field)]
}
SDPMedia instproc field_value { field } {
	$self instvar fields_
	if [info exists fields_($field)] {
		return $fields_($field)
	} else {
		return ""
	}
}
SDPMedia instproc have_attr { name } {
	$self instvar attributes_
	return [info exists attributes_($name)]
}
SDPMedia instproc attr_value { name } {
    $self instvar attributes_
    if [info exists attributes_($name)] {
	    return $attributes_($name)
    } else {
	    return ""
    }
}
SDPMedia instproc attributes {} {
	$self instvar attributes_
	if [info exists attributes_] {
		return [array names attributes_]
	} else {
		return ""
	}
}
SDPMedia instproc obj2str {} {
	$self instvar attributes_
	set o "m=[$self field_value m]"
	foreach f { i c b k } {
		if [$self have_field $f] {
			set n "$f=[$self field_value $f]"
			set o $o\n$n
		}
	}
	foreach a [array names attributes_] {
		if { $attributes_($a) == "" } {
			set n "a=$a"
		} else {
			set n "a=$a:$attributes_($a)"
		}
		set o $o\n$n
	}
	return $o
}
SDPTime instproc have_field { field } {
	$self instvar fields_
	return [info exists fields_($field)]
}
SDPTime instproc field_value { field } {
	$self instvar fields_
	if [info exists fields_($field)] {
		return $fields_($field)
	} else {
		return ""
	}
}
SDPTime instproc obj2str {} {
	set o "t=[$self field_value t]"
	if [$self have_field r] {
		set n "r=[$self field_value r]"
		set o $o\n$n
	}
	return $o
}
SDPTime public get { varname } {
    $self instvar $varname
    if [info exists $varname] {
	return [set $varname]
    } else {
	return ""
    }
}
SDPTime public sec_until_current { time_type } {
    set sdp_time [ntp_to_unix [$self get $time_type]]
    set current [clock seconds]
    return [expr $sdp_time - $current]
}
SDPTime public current_in_interval { start end } {
    set current [unix_to_ntp [clock seconds]]
    if { [expr $start == 0 && $end == 0] } {
	return 1
    } elseif { $start == 0 } {
	return [expr $end > $current]
    } elseif { $end == 0 } {
	return [expr $start <= $current]
    } else {
	return [expr $start <= $current && $end > $current]
    }
}
SDPTime public readable_time { time_type } {
    set sec [ntp_to_unix [$self get $time_type]]
    if { $sec == 0 } {
	return *unbounded*
    } else {
	return [clock format $sec -format {%H:%M}]
    }
}
SDPTime public readable_duration { } {
    set duration [$self get active_duration_]
    set hours [expr $duration / 3600]
    if { $hours < 24 } {
	return "$hours hour(s)"
    }
    set days [expr $hours / 24]
    if { $days < 7 } {
	return "$days day(s)"
    }
    set weeks [expr $days / 7]
    return "$weeks week(s)"
}
SDPTime public readable_date { time_type } {
    set sec [ntp_to_unix [$self get $time_type]]
    if { $sec == 0 } {
	return *unbounded*
    } else {
	return [clock format $sec -format {%B %d, %Y}]
    }
}
SDPTime public readable_day { time_type } {
    set sec [ntp_to_unix [$self get $time_type]]
    if { $sec == 0 } {
	return *unbounded*
    } else {
	return [clock format $sec -format {%a}]
    }
}
SDPTime public readable_day_full { time_type } {
    set sec [ntp_to_unix [$self get $time_type]]
    if { $sec == 0 } {
	return *unbounded*
    } else {
	return [clock format $sec -format {%A}]
    }
}
SDPTime public readable_zone { time_type } {
    set sec [ntp_to_unix [$self get $time_type]]
    return [clock format $sec -format {%Z}]
}
SDPTime public readable_repeat { } {
    set interval [$self get repeat_interval_]
    if { $interval == 86400 } {
	return Daily
    } elseif { $interval == 604800 } {
	return Weekly
    } else {
	return None
    }
}
Class SessionCatalog
SessionCatalog public init { } {
    $self instvar sdp_
    $self next
    $self set file_ ""
    $self set filename_ ""
    $self set sdp_ ""
    $self set info_ ""
}
SessionCatalog public destroy { } {
    $self close
    $self next
}
SessionCatalog public open { filename { mode "r" } { permissions 0644 } } {
    $self instvar file_ filename_ line_no_
    set file_ [open $filename $mode $permissions]
    $self clear
    set filename_ $filename
}
SessionCatalog private clear { } {
    $self set filename_ ""
    $self set line_no_ 0
    $self instvar streams_
    catch { unset streams_ }
    set streams_(all) ""
}
SessionCatalog instproc close { } {
    $self instvar file_
    if { $file_!="" } {
	close $file_
	set file_ ""
	set filename_ ""
    }
}
SessionCatalog instproc is_opened { } {
    $self instvar file_
    if { $file_=="" } { return 0 } else { return 1 }
}
SessionCatalog instproc filename { } {
    return [$self set filename_]
}
SessionCatalog instproc write_sdp { sdp } {
    $self instvar file_
    if { $file_=="" } { error "file not opened" }
    puts $file_ "START_SDP"
    puts $file_ $sdp
    puts $file_ "END_SDP"
    flush $file_
}
SessionCatalog instproc write_info { info } {
    $self instvar file_
    if { $file_ == "" } { error "file not opened" }
    puts $file_ "START_INFO"
    puts $file_ $info
    puts $file_ "END_INFO"
    flush $file_
}
SessionCatalog instproc write_stream { id session datafile indexfile } {
    $self instvar file_
    if { $file_=="" } { error "file not opened" }
    puts $file_ "START_STREAM"
    puts $file_ "\tid=$id"
    puts $file_ "\tsession=$session"
    puts $file_ "\tdatafile=$datafile"
    puts $file_ "\tindexfile=$indexfile"
    puts $file_ "END_STREAM"
    flush $file_
}
SessionCatalog public read { } {
    $self instvar file_ line_no_
    if { $file_=="" } { error "file not opened" }
    while { [$self read_line_ line] } {
	if { ![regexp "START_(.*)" $line dummy block_type] } {
	    error "parse error at line $line_no_ in header file"
	}
	$self read_block_ [string tolower $block_type]
    }
}
SessionCatalog public parse {msg } {
	$self instvar msg_ cur_line_
	$self clear
	set msg_ [split [string trim $msg] "\n"]
	for {set cur_line_ 0} {$cur_line_ < [llength $msg_]} {incr cur_line_} {
		set line [lindex $msg_ $cur_line_]
		if { ![regexp "START_(.*)" $line dummy block_type] } {
			error "parse error"
		}
		incr cur_line_
		$self parse_block_ [string tolower $block_type] 
    }
}
SessionCatalog private read_line_ { lineVar } {
    upvar $lineVar line
    $self instvar file_ line_no_
    while { ![eof $file_] } {
	incr line_no_
	gets $file_ line
	set line [string trim $line]
	if { [string length $line]!=0 && [string index $line 0]!="#"} {
	    return 1
	}
    }
    return 0
}
SessionCatalog private parse_block_ { block_type  } {
	$self instvar msg_ cur_line_
	set msg {}
	for {} {$cur_line_ < [llength $msg_]} {incr cur_line_} {
		set line [lindex $msg_ $cur_line_]
		if { [regexp "END_(.*)" $line dummy end_type] } {
			set end_type [string tolower $end_type]
			if { $block_type != $end_type } {
				error "expected END_$block_type;\
						got END_$end_type at\
						line $line_no_ in header file"
			}
			$self handle_read_${block_type}_ $msg
			return
		}
		append msg "$line\n"
	}
	error "unexpected EOF at line $cur_line_; expected END_$block_type"
}
SessionCatalog private read_block_ { block_type } {
    set msg {}
    while { [$self read_line_ line] } {
	if { [regexp "END_(.*)" $line dummy end_type] } {
	    set end_type [string tolower $end_type]
	    if { $block_type != $end_type } {
		error "expected END_$block_type;\
			got END_$end_type at\
			line $line_no_ in header file"
	    }
	    $self handle_read_${block_type}_ $msg
	    return
	}
	append msg "$line\n"
    }
    error "unexpected EOF at line $line_no_; expected END_$block_type"
}
SessionCatalog instproc handle_read_info_ { msg } {
    $self instvar info_
    append info_ $msg
    return
}
SessionCatalog private handle_read_descr_ {msg } {
	$self instvar desc_
	set desc_ $msg
	return
}
SessionCatalog private handle_read_sdp_ { msg } {
    $self instvar sdp_
    set sdp_ $msg
    return
}
SessionCatalog public get_sdp {} {
    $self instvar sdp_
    return $sdp_
}
SessionCatalog public get_info { type } {
    $self instvar info_
    set return_info ""
    set info_list [split $info_ "=\n"]
    set index [lsearch -exact $info_list $type]
    if { $index != -1 } {
	set return_info [lindex $info_list [expr $index + 1]]
    }
    return $return_info
}
SessionCatalog public get_desc {} {
    $self instvar desc_
    return $desc_
}
SessionCatalog private handle_read_stream_ { msg } {
    $self instvar streams_ filename_ line_no_
    foreach line [split $msg "\n"] {
	if { $line=={} } continue
	set line [split $line "="]
	set attribute [string trim [lindex $line 0]]
	set value     [string trim [lindex $line 1]]
	set header($attribute) $value
    }
    if { ![info exists header(id)] } {
	error "could not find the \"id\" field in STREAM block at\
		line $line_no_"
    }
    set id $header(id)
    if { ![info exists header(session)] } {
	error "could not find the \"session\" field in STREAM block at\
		line $line_no_"
    }
    set streams_($id,session) $header(session)
    if { ![info exists header(datafile)] } {
	error "could not find the \"datafile\" field in STREAM block\
		at line $line_no_"
    } else {
	set streams_($id,datafile) [file join \
		[file dirname $filename_] $header(datafile)]
    }
    if { [info exists header(indexfile)] } {
	if { $header(indexfile)=="" } {
	    set streams_($id,indexfile) ""
	} else {
	    set streams_($id,indexfile) [file join [file dirname \
		    $filename_] $header(indexfile)]
	}
    } else {
	set streams_($id,indexfile) "[file rootname \
		$streams_($id,datafile)].idx"
    }
    lappend streams_(all) $id
}
SessionCatalog instproc info { method args } {
    eval [list $self] [list info.$method] $args
}
SessionCatalog instproc info.streams { } {
    $self instvar streams_
    return $streams_(all)
}
SessionCatalog instproc info.session { id } {
    $self instvar streams_
    return $streams_($id,session)
}
SessionCatalog instproc info.datafile { id } {
    $self instvar streams_
    return $streams_($id,datafile)
}
SessionCatalog instproc info.indexfile { id } {
    $self instvar streams_
    return $streams_($id,indexfile)
}
Class RTPApplication -superclass Application
RTPApplication public init name {
	$self next $name
}
RTPApplication public run_resource_dialog { name email } {
	set font [$self get_option medfont]
	set w .form
	global V
	frame $w
	frame $w.msg -relief ridge
	label $w.msg.label -font $font -wraplength 4i \
		-justify left -text \
"Please specify values for the following resources. \
These strings will identify you by name and by email address \
in any RTP-based conference.  Please use your real name and \
affiliation instead of a ``handle'', e.g., ``Jane Doe (ACME Research)''. \
The values you enter will be saved in ~/.mash/prefs so you will \
not have to re-enter them." -relief ridge
	pack $w.msg.label -padx 6 -pady 6
	pack $w.msg -side top
	foreach i {name email} {
		frame $w.$i -bd 2
		entry $w.$i.entry -relief sunken
		label $w.$i.label -width 10 -anchor e
		pack $w.$i.label -side left
		pack $w.$i.entry -side left -fill x -expand 1 -padx 8
	}
	$w.name.label config -text rtpName:
	$w.email.label config -text rtpEmail:
	pack $w.msg -pady 10
	pack $w.name $w.email -side top -fill x
	$w.$i.entry insert 0 [email_heuristic]
	frame $w.buttons
	button $w.buttons.accept -text Accept -command "set dialogDone 1"
	button $w.buttons.dismiss -text Quit -command "set dialogDone -1"
	pack $w.buttons.accept $w.buttons.dismiss \
		-side left -expand 1 -padx 20 -pady 10
	pack $w.buttons
	pack $w -padx 10
	global dialogDone
	while { 1 } {
		set dialogDone 0
		focus $w.name.entry
		tkwait variable dialogDone
		if { $dialogDone < 0 } {
			exit 0
		}
		set name [string trim [$w.name.entry get]]
		if { [string length $name] <= 3 } {
			new ErrorWindow "please enter a reasonable name"
			continue
		}
		set email [string trim [$w.email.entry get]]
		if { [string first . $email] < 0 || \
			[string first @ $email] < 0 } {
			new ErrorWindow "email address should have form user@host.domain"
			continue
		}
		break
	}
	set mash [glob ~]/.mash
	if ![file exists $mash] {
		file mkdir $mash
	}
	set f [open $mash/prefs a+ 0644]
	puts $f "rtpName: $name"
	puts $f "rtpEmail: $email"
	close $f
	pack forget $w
	destroy $w
}
RTPApplication public check_rtp_sdes {} {
	set name [$self get_option rtpName]
	if { $name == "" } {
		set name [$self get_option sessionName]
		option add *rtpName $name startupFile
	}
	set email [$self get_option rtpEmail]
	if { $name == "" || $email == "" } {
		$self run_resource_dialog $name $email
	}
}
RTPApplication private check_hostspec { argv megaSession } {
	if { $argv == "" } {
		if { $megaSession == "" } {
			$self fatal "destination address required"
		}
	} elseif { [llength $argv] > 1 } {
		set extra [lindex $argv 1]
		$self fatal "extra arguments (starting with $extra)"
	}
	return $argv
}
Class ArchiveSession/Record -superclass Observable
set classes [ArchiveStream info superclass]
set objectIdx [lsearch $classes Observable]
if { $objectIdx == -1 } {
	ArchiveStream superclass [concat Observable $classes]
}
ArchiveSession/Record instproc init { media } {
	$self next
	$self set stream_count_ 0
	$self media $media
}
ArchiveStream/Record public destroy {} {
	$self next
}
ArchiveSession/Record instproc catalog { args } {
	$self instvar catalog_
	if { [llength $args]==0 } {
		if [info exists catalog_] {
			return $catalog_
		} else {
			return ""
		}
	} else {
		set catalog_ [lindex $args 0]
	}
}
ArchiveSession/Record instproc save_in { args } {
	switch -exact -- [llength $args] {
		0 {
			if [info exists directory_] {
				return $directory_
			} else {
				return ""
			}
		}
		1 {
			$self set directory_ [lindex $args 0]
			return
		}
		default {
			error "too many arguments"
		}
	}
}
ArchiveSession/Record instproc session_id { args } {
	switch -exact -- [llength $args] {
		0 {
			if [info exists session_id_] {
				return $session_id_
			} else {
				return ""
			}
		}
		1 {
			$self set session_id_ [lindex $args 0]
			return
		}
		default {
			error "too many arguments"
		}
	}
}
ArchiveSession/Record instproc media { args } {
	$self instvar media_
	switch -exact -- [llength $args] {
		0 {
			if [info exists media_] {
				return $media_
			} else {
				return ""
			}
		}
		1 {
			$self set media_ [lindex $args 0]
			$class instvar media_count_
			if { ![info exists media_count_($media_)] } {
				set media_count_($media_) 0
			}
			incr media_count_($media_)
			$self set media_count_ $media_count_($media_)
			return
		}
		default {
			error "too many arguments"
		}
	}
}
ArchiveSession/Record instproc generate_filename { } {
	$self instvar directory_ session_id_ media_ media_count_ stream_count_
	set name ""
	if { $session_id_!="" } {
		append name "${session_id_}-"
	}
	incr stream_count_
	append name "${media_}${media_count_}-${stream_count_}"
	return [file join $directory_ $name]
}
ArchiveStream/Record instproc bind { session } {
	$self set archive_session_ $session
	if { [catch {
		set filename [$session generate_filename]
		set dataFile  [new ArchiveFile/Data]
		$dataFile open "${filename}.dat" "w"
		set indexFile [new ArchiveFile/Index]
		$indexFile open "${filename}.idx" "w"
		$self write_to_catalog $session $filename
		$session notify_observers new_stream $self
		$self notify_observers filename "${filename}.dat \[.idx\]"
		$self datafile  $dataFile
		$self indexfile $indexFile
	} error] } {
		return $error
	}
	return ""
}
ArchiveStream/Record instproc write_to_catalog { session filename } {
	set catalog [$session catalog]
	if { $catalog=="" } return
	set dirname    [file dirname $filename]
	set catalogdir [file dirname [$catalog filename]]
	if { [string first $catalogdir $dirname]==0 } {
		set dirname [file split $dirname]
		set ignore [llength [file split $catalogdir]]
		set dirname [lrange $dirname $ignore end]
		if { [llength $dirname]==0 } {
			set filename [file tail $filename]
		} else {
			set filename [eval file join $dirname \
					[list [file tail $filename]]]
		}
	}
	$session instvar media_ media_count_
	$catalog write_stream $self "$media_$media_count_" \
			"${filename}.dat" "${filename}.idx"
}
ArchiveStream/Record instproc session { } {
	return [$self set archive_session_]
}
ArchiveStream/Record instproc media { } {
	return [[$self set archive_session_] media]
}
Class AddressBlock -configuration {
	defaultTTL 1
	maxbw -1
}
Class AddressBlock/RTP -superclass AddressBlock
Class AddressBlock/Simple -superclass AddressBlock
AddressBlock instproc init spec {
	$self next
	$self set nchan_ 0
	foreach s [split $spec ,] {
		set err [$self parse $s]
		if { $err != "" } {
			$self fatal $err
		}
	}
}
AddressBlock instproc data-port p {
	return [expr $p &~ 1]
}
AddressBlock instproc ctrl-port p {
	return [expr [$self data-port $p] + 1]
}
AddressBlock instproc addr {{k 0}} {
	return [$self set addr_($k)]
}
AddressBlock instproc sport {{k 0}} {
	return [$self set sport_($k)]
}
AddressBlock instproc rport {{k 0}} {
	return [$self set rport_($k)]
}
AddressBlock instproc ttl {{k 0}} {
	return [$self set ttl_($k)]
}
AddressBlock instproc nchan {} {
	return [$self set nchan_]
}
AddressBlock instproc parse s {
	set dst [split $s /]
	set n [llength $dst]
	if { $n < 2 } {
		return "must specify both address and port in the form addr/port"
	}
	set addr [lindex $dst 0]
	set ports [split [lindex $dst 1] :]
	set sport [lindex $ports 0]
	if { [llength $ports] == 1 } {
		set rport $sport
	} else {
		set rport [lindex $ports 1]
	}
	set firstchar [string index $addr 0]
	if [string match \[a-zA-Z\] $firstchar] {
		set s [gethostbyname $addr]
		if { $s == "" } {
			return "cannot lookup host name: $addr"
		}
		set addr $s
	}
	foreach port "$sport $rport" {
		if { ![string match \[0-9\]* $port] || $port >= 65536 } {
			$self fatal "illegal port '$port'"
		}
	}
	set ttl [$self get_option defaultTTL]
	set cnt 1
	if { $n >= 3 } {
		set fmt [lindex $dst 2]
		if { $n >= 4 } {
			set ttl [lindex $dst 3]
			if { $n > 4 } {
				set cnt [lindex $dst 4]
				if { ![string match \[0-9\]* $cnt] ||
				     $cnt >= 20 } {
					return "$dst: bad layered addr count"
					exit 1
				}
				if { $n > 5 } {
					return "$dst: malformed address"
				}
			}
		}
	}
	if { $ttl < 0 || $ttl > 255 } {
		return "$dst: invalid ttl ($ttl)"
	}
	set oct [split $addr .]
	set base [lindex $oct 0].[lindex $oct 1].[lindex $oct 2]
	set off [lindex $oct 3]
	$self instvar addr_ sport_ rport_ ttl_ nchan_
	set i 0
	while { $i < $cnt } {
		set sp [$self data-port $sport]
		set rp [$self data-port $rport]
		set addr_($nchan_) $base.$off
		set sport_($nchan_) $sp
		set rport_($nchan_) $rp
		set ttl_($nchan_) $ttl
		if [in_multicast $addr] {
			incr off
		}
		incr sport 2
		incr rport 2
		incr i
		incr nchan_
	}
	if { [info exists fmt] && $fmt != "" && $fmt != "1" } {
		$self add_option videoFormat $fmt
		$self add_option audioFormat $fmt
	}	
	if [info exists confid] {
		$self add_option confid $confid
	}	
	if [info exists ttl] {
		$self add_option defaultTTL $ttl
	}
	$self bandwidth_heuristic
}
AddressBlock instproc bandwidth_heuristic {} {
	$self instvar nchan_ addr_ ttl_ maxbw_
	set i 0
	while { $i < $nchan_ } {
		set maxbw [$self get_option maxbw]
		if { $maxbw <= 0 } {
			set ttl $ttl_($i)
			if { $ttl <= 16 || ![in_multicast $addr_($i)] } {
				set maxbw 3072000
			} elseif { $ttl <= 64 } {
				set maxbw 1024000
			} elseif  { $ttl <= 128 } {
				set maxbw 128000
			} elseif { $ttl <= 192 } {
				set maxbw 53000
			} else {
				set maxbw 32000
			}
		}
		set maxbw_($i) $maxbw
		incr i
	}
}
AddressBlock/Simple instproc data-port p {
	return $p
}
AddressBlock/RTP instproc data-port p {
	return [expr $p &~ 1]
}
set rlm_param(alpha) 4
set rlm_param(alpha) 2
set rlm_param(beta) 0.75
set rlm_param(init-tj) 1.5
set rlm_param(init-tj) 10
set rlm_param(init-tj) 5
set rlm_param(init-td) 5
set rlm_param(init-td-var) 2
set rlm_param(max) 600
set rlm_param(max) 60
set rlm_param(g1) 0.25
set rlm_param(g2) 0.25
Class MMG
MMG instproc init { levels } {
	$self next
	$self instvar debug_ env_ maxlevel_
	set debug_ 0
	set env_ [lindex [split [$self info class] /] 1]
	set maxlevel_ $levels
	global rlm_debug_flag
	if [info exists rlm_debug_flag] {
		set debug_ $rlm_debug_flag
	}
	$self instvar TD TDVAR state_ subscription_
	global rlm_param
	set TD $rlm_param(init-td)
	set TDVAR $rlm_param(init-td-var)
	set state_ /S
	$self instvar layer_ layers_
	set i 1
	while { $i <= $maxlevel_ } {
		set layer_($i) [$self create-layer [expr $i - 1]]
		lappend layers_ $layer_($i)
		incr i
	}
	set subscription_ 0
	$self add-layer
	set state_ /S
	$self set_TJ_timer
}
MMG instproc set-state s {
	$self instvar state_
	set old $state_
	set state_ $s
	$self debug "FSM: $old -> $s"
}
MMG instproc drop-layer {} {
	$self dumpLevel
	$self instvar subscription_ layer_
	set n $subscription_
	if { $n > 0 } {
		$self debug "DRP-LAYER $n"
		$layer_($n) leave-group 
		incr n -1
		set subscription_ $n
	}
	$self dumpLevel
}
MMG instproc add-layer {} {
	$self dumpLevel
	$self instvar maxlevel_ subscription_ layer_
	set n $subscription_
	if { $n < $maxlevel_ } {
		$self debug "ADD-LAYER"
		incr n
		set subscription_ $n
		$layer_($n) join-group
	}
	$self dumpLevel
}
MMG instproc current_layer_getting_packets {} {
	$self instvar subscription_ layer_ TD
	set n $subscription_
	if { $n == 0 } {
		return 0
	}
	set l $layer_($subscription_)
	$self debug "npkts [$l npkts]"
	if [$l getting-pkts] {
		return 1
	}
	set delta [expr [$self now] - [$l last-add]]
	if { $delta > $TD } {
		set TD [expr 1.2 * $delta]
	}
	return 0
}
MMG instproc mmg_loss {} {
	$self instvar layers_
	set loss 0
	foreach l $layers_ {
		incr loss [$l nlost]
	}
	return $loss
}
MMG instproc mmg_pkts {} {
	$self instvar layers_
	set npkts 0
	foreach l $layers_ {
		incr npkts [$l npkts]
	}
	return $npkts
}
MMG instproc check-equilibrium {} {
	global rlm_param
	$self instvar subscription_ maxlevel_ layer_
	set n [expr $subscription_ + 1]
	if { $n >= $maxlevel_ || [$layer_($n) timer] >= $rlm_param(max) } {
		set eq 1
	} else {
		set eq 0
	}
	$self debug "EQ $eq"
}
MMG instproc backoff-one { n alpha } {
	$self debug "BACKOFF $n by $alpha"
	$self instvar layer_
	$layer_($n) backoff $alpha
}
MMG instproc backoff n {
	$self debug "BACKOFF $n"
	global rlm_param
	$self instvar maxlevel_ layer_
	set alpha $rlm_param(alpha)
	set L $layer_($n)
	$L backoff $alpha
	incr n
	while { $n <= $maxlevel_ } {
		$layer_($n) peg-backoff $L
		incr n
	}
	$self check-equilibrium
}
MMG instproc highest_level_pending {} {
	$self instvar maxlevel_
	set m ""
	set n 0
	incr n
	while { $n <= $maxlevel_ } {
		if [$self level_pending $n] {
			set m $n
		}
		incr n
	}
	return $m
}
MMG instproc rlm_update_D  D {
	global rlm_param
	$self instvar TD TDVAR
	set v [expr abs($D - $TD)]
	set TD [expr $TD * (1 - $rlm_param(g1)) \
				+ $rlm_param(g1) * $D]
	set TDVAR [expr $TDVAR * (1 - $rlm_param(g2)) \
		       + $rlm_param(g2) * $v]
}
MMG instproc exceed_loss_thresh {} {
	$self instvar h_npkts h_nlost
	set npkts [expr [$self mmg_pkts] - $h_npkts]
	if { $npkts >= 10 } {
		set nloss [expr [$self mmg_loss] - $h_nlost]
		set loss [expr double($nloss) / ($nloss + $npkts)]
		$self debug "H-THRESH $nloss $npkts $loss"
		if { $loss > 0.25 } {
			return 1
		}
	}
	return 0
}
MMG instproc enter_M {} {
	$self set-state /M
	$self set_TD_timer_wait
	$self instvar h_npkts h_nlost
	set h_npkts [$self mmg_pkts]
	set h_nlost [$self mmg_loss]
}
MMG instproc enter_D {} {
	$self set-state /D
	$self set_TD_timer_conservative
}
MMG instproc enter_H {} {
	$self set_TD_timer_conservative
	$self set-state /H
}
MMG instproc log-loss {} {
	$self debug "LOSS [$self mmg_loss]"
	$self instvar state_ subscription_ pending_ts_
	if { $state_ == "/M" } {
		if [$self exceed_loss_thresh] {
			$self cancel_timer TD
			$self drop-layer
			$self check-equilibrium
			$self enter_D
		}
		return
	}
	if { $state_ == "/S" } {
		$self cancel_timer TD
		set n [$self highest_level_pending]
		if { $n != "" } {
			$self backoff $n
			if { $n == $subscription_ } {
				set ts $pending_ts_($subscription_)
				$self rlm_update_D [expr [$self now] - $ts]
				$self drop-layer
				$self check-equilibrium
				$self enter_D
				return
			}
			if { $n == [expr $subscription_ + 1] } {
				$self cancel_timer TJ
				$self set_TJ_timer
			}
		}
		if [$self our_level_recently_added] {
			$self enter_M
			return
		}
		$self enter_H
		return
	}
	if { $state_ == "/H" || $state_ == "/D" } {
		return
	}
	puts stderr "rlm state machine botched"
	exit -1
}
MMG instproc relax_TJ {} {
	$self instvar subscription_ layer_
	if { $subscription_ > 0 } {
		$layer_($subscription_) relax
		$self check-equilibrium
	}
}
MMG instproc trigger_TD {} {
	$self instvar state_
	if { $state_ == "/H" } {
		$self enter_M
		return
	}
	if { $state_ == "/D" || $state_ == "/M" } {
		$self set-state /S
		$self set_TD_timer_conservative
		return
	}
	if { $state_ == "/S" } {
		$self relax_TJ
		$self set_TD_timer_conservative
		return
	}
	puts stderr "trigger_TD: rlm state machine botched $state)"
	exit -1
}
MMG instproc set_TJ_timer {} {
	global rlm_param
	$self instvar subscription_ layer_
	set n [expr $subscription_ + 1]
	if ![info exists layer_($n)] {
		return
	}
	set I [$layer_($n) timer]
	set d [expr $I / 2.0 + [trunc_exponential $I]]
	$self debug "TJ $d"
	$self set_timer TJ $d
}
MMG instproc set_TD_timer_conservative {} {
	$self instvar TD TDVAR
	set delay [expr $TD + 1.5 * $TDVAR]
	$self set_timer TD $delay
}
MMG instproc set_TD_timer_wait {} {
	$self instvar TD TDVAR
	$self instvar subscription_
	set k [expr $subscription_ / 2. + 1.5]
	$self set_timer TD [expr $TD + $k * $TDVAR]
}
MMG instproc is-recent { ts } {
	$self instvar TD TDVAR
	set ts [expr $ts + ($TD + 2 * $TDVAR)]
	if { $ts > [$self now] } {
		return 1
	}
	return 0
}
MMG instproc level_pending n {
	$self instvar pending_ts_
	if { [info exists pending_ts_($n)] && \
		 [$self is-recent $pending_ts_($n)] } {
		return 1
	}
	return 0
}
MMG instproc level_recently_joined n {
	$self instvar join_ts_
	if { [info exists join_ts_($n)] && \
		 [$self is-recent $join_ts_($n)] } {
		return 1
	}
	return 0
}
MMG instproc pending_inferior_jexps {} {
	set n 0
	$self instvar subscription_
	while { $n <= $subscription_ } { 
		if [$self level_recently_joined $n] {
			return 1
		}
		incr n
	}
	$self debug "NO-PEND-INF"
	return 0
}
MMG instproc trigger_TJ {} {
	$self debug "trigger-TJ"
	$self instvar state_ ctrl_ subscription_
	if { ($state_ == "/S" && ![$self pending_inferior_jexps] && \
		  [$self current_layer_getting_packets])  } {
		$self add-layer
		$self check-equilibrium
		set msg "add $subscription_"
		$ctrl_ send $msg
		$self local-join
	}
	$self set_TJ_timer
}
MMG instproc our_level_recently_added {} {
	$self instvar subscription_ layer_
	return [$self is-recent [$layer_($subscription_) last-add]]
}
MMG instproc recv-ctrl msg {
	$self instvar join_ts_ pending_ts_ subscription_
	$self debug "X-JOIN $msg"
	set what [lindex $msg 0]
	if { $what != "add" } {
		return
	}
	set level [lindex $msg 1]
	set join_ts_($level) [$self now]
	if { $level > $subscription_ } {
		set pending_ts_($level) [$self now]
	}
}
MMG instproc local-join {} {
	$self instvar subscription_ pending_ts_ join_ts_
	set join_ts_($subscription_) [$self now]
	set pending_ts_($subscription_) [$self now]
}
MMG instproc debug { msg } {
	$self instvar debug_ subscription_ state_
	if {$debug_} {
		puts stderr "[gettimeofday] layer $subscription_ $state_ $msg"
	}
}
MMG instproc dumpLevel {} {
}
Class Layer
Layer instproc init { mmg } {
	$self next
	$self instvar mmg_ TJ npkts_
	global rlm_param
	set mmg_ $mmg
	set TJ $rlm_param(init-tj)
	set npkts_ 0
}
Layer instproc relax {} {
	global rlm_param
	$self instvar TJ
	set TJ [expr $TJ * $rlm_param(beta)]
	if { $TJ <= $rlm_param(init-tj) } {
		set TJ $rlm_param(init-tj)
	}
}
Layer instproc backoff alpha {
	global rlm_param
	$self instvar TJ
	set TJ [expr $TJ * $alpha]
	if { $TJ >= $rlm_param(max) } {
		set TJ $rlm_param(max)
	}
}
Layer instproc peg-backoff L {
	$self instvar TJ
	set t [$L set TJ]    
	if { $t >= $TJ } {
		set TJ $t
	}
}
Layer instproc timer {} {
	$self instvar TJ
	return $TJ
}
Layer instproc last-add {} {
	$self instvar add_time_
	return $add_time_
}
Layer instproc join-group {} {
	$self instvar npkts_ add_time_ mmg_
	set npkts_ [$self npkts]
	set add_time_ [$mmg_ now]
}
Layer instproc leave-group {} {
}
Layer instproc getting-pkts {} {
	$self instvar npkts_
	return [expr [$self npkts] != $npkts_]
}
set rlm_debug_flag 1
Class Layer/mash -superclass Layer
Layer/mash instproc init {mmg net n} {
	$self next $mmg
	$self instvar net_ l_ n_
	set net_ $net
	set n_ $n
	set l_ [$net_ set net_($n)]
}
Layer/mash instproc join-group {} {
	$self instvar mmg_ net_
	set level [expr [$mmg_ set subscription_] - 1]
	$net_ set-subscription-level $level
	$self next
}
Layer/mash instproc leave-group {} {
	$self instvar mmg_ net_
	set level [expr [$mmg_ set subscription_] - 1]
	$net_ set-subscription-level $level
	$self next
}
Layer/mash instproc nlost {} {
	$self instvar l_
	return [$l_ nlost]
}
Layer/mash instproc npkts {} {
	$self instvar l_ n_
	return [$l_ npkts $n_]
}
Class MMG/mash -superclass MMG
MMG/mash instproc init {net caddr} {
	$self instvar net_
	set net_ $net
	$self next [$net set nchan_]
	proc ctrl$self {args} { puts "ctrl: $args" }
	$self set ctrl_ ctrl$self
}
MMG/mash instproc create-layer {layerNo} {
	$self instvar net_
	return [new Layer/mash $self $net_ $layerNo]
}
MMG/mash instproc now {} {
	return [gettimeofday]
}
MMG/mash instproc set_timer {which delay} {
	$self instvar timers_
	if [info exists timers_($which)] {
		puts "timer botched ($which)"
		exit 1
	}
	set delay [expr int($delay * 1000)]
	set timers_($which) [after $delay "$self trigger_timer $which"]
}
MMG/mash instproc trigger_timer {which} {
	$self instvar timers_
	unset timers_($which)
	$self trigger_$which
}
MMG/mash instproc cancel_timer {which} {
	$self instvar ns_ timers_
	if [info exists timers_($which)] {
		after cancel $timers_($which)
		unset timers_($which)
	}
}
MMG/mash instproc debug { msg } {
	$self instvar debug_
	if {!$debug_} { return }
	$self instvar subscription_ state_
	set time [format %.05f [$self now]]
	puts stderr "$time layer $subscription_ $state_ $msg"
}
proc uniform01 {} {
    return [expr double(([random] % 10000000) + 1) / 1e7]
}
proc uniform { a b } {
	return [expr ($b - $a) * [uniform01] + $a]
}
proc exponential mean {
	return [expr - $mean * log([uniform01])]
}
proc trunc_exponential lambda {
	while 1 {
		set u [exponential $lambda]
		if { $u < [expr 4 * $lambda] } {
			return $u
		}
	}
}
Class Network/IP -superclass Network
Network/IP instproc init args {
	puts stderr "Network/IP called... change to Network"
	eval $self next $args
}
Network instproc port args {
	eval $self sport $args
}
proc in_multicast addr {
	return [expr ([lindex [split $addr .] 0] & 0xf0) == 0xe0]
}
Class NetworkLayer
Class NetworkManager
NetworkManager instproc graphics-init n {
	if {$n == 1 || [winfo exists .l]} { return }
	$self instvar nchan_
	set nchan_ $n
	toplevel .l
	set k 0
	while { $k < $nchan_ } {
		radiobutton .l.b$k -command "$self set-subscription-level $k" \
			-text "Level $k" \
			-variable nLayers -value $k
		pack .l.b$k
		incr k
	}
	wm withdraw .l
	bind . <l> { 
		if [winfo ismapped .l] {
			wm withdraw .l
		} else {
			wm deiconify .l
		}
	}
}
NetworkManager instproc set-subscription-level n {
	$self instvar agent_ nchan_ session_ net_
	$agent_ set_maxchannel $n
	$session_ set loopbackLayer_ [expr $n + 1]
	set i 0
	while { $i <= $n } {
		$net_($i) enable
		incr i
	}
	while { $i < $nchan_ } {
		$net_($i) disable
		incr i
	}
	global nLayers
	set nLayers $n
}
NetworkLayer instproc init { session addr sport rport ttl channel } {
	$self next
	$self instvar session_ addr_ port_ ttl_ dn_ cn_ channel_ active_
	set addr_ $addr
	set sport_ $sport
	set rport_ $rport
	set session_ $session
	set ttl_ $ttl
	set channel_ $channel
	set dn_ [new Network]
	$dn_ open $addr_ $sport_ $rport_ $ttl_
	set cn_ [new Network]
	$cn_ open $addr_ [expr $sport_ + 1] [expr $rport + 1] $ttl_
	$cn_ loopback 1
	$session_ data-net $dn_ $channel_
	$session_ ctrl-net $cn_ $channel_
	set active_ 0
	$dn_ drop-membership
	$cn_ drop-membership
	$self set tloss_ 0
}
NetworkLayer instproc destroy {} {
	$self instvar dn_ cn_
	delete $dn_
	delete $cn_
	$self next
}
NetworkLayer instproc data-net {} {
	return [$self set dn_]
}
NetworkLayer instproc ctrl-net {} {
	return [$self set cn_]
}
NetworkLayer instproc enable-send {} {
	$self instvar dn_ cn_ session_ channel_
	$session_ data-net $dn_ $channel_
	$session_ ctrl-net $cn_ $channel_
}
NetworkLayer instproc disable-send {} {
	$self instvar dn_ cn_ session_ channel_
	$session_ data-net "" $channel_
	$session_ ctrl-net "" $channel_
}
NetworkLayer instproc enable {} {
	$self instvar active_ dn_ cn_ session_ channel_
	if !$active_ {
		set active_ 1
		$dn_ add-membership
		$cn_ add-membership
		$session_ data-net $dn_ $channel_
		$session_ ctrl-net $cn_ $channel_
	}
}
NetworkLayer instproc disable {} {
	$self instvar dn_ cn_ active_ session_ channel_
	if $active_ {
		set active_ 0
		$dn_ drop-membership
		$cn_ drop-membership
	}
}
NetworkLayer instproc notify-loss {src} {
	$self instvar loss_ tloss_
	if ![info exists loss_($src)] {
		set loss_($src) 0
	}
	set nloss [$src missing]
	incr tloss_ [expr $nloss - $loss_($src)]
	set loss_($src) $nloss
}
NetworkLayer instproc nlost {} {
	$self instvar tloss_
	return $tloss_
}
NetworkLayer instproc npkts {n} {
	$self instvar agent_
	set npkts 0
	foreach s [$agent_ set sources_] {
		set l [lindex [$s set layers_] $n]
		incr npkts [$l set np_]
	}
	return $npkts
}
NetworkLayer instproc crypt { dc cc } {
	$self instvar dn_ cn_
	$dn_ crypt $dc
	$cn_ crypt $cc
}
NetworkManager instproc init { ab session agent } {
	$self next
	$self instvar session_ agent_ encrypt_ key_ fmt_
	set session_ $session
	set agent_ $agent
	set encrypt_ 0
	set key_ ""
        set fmt_ ""
	$self allocate $ab $session
}
NetworkManager instproc allocate { ab session } {
	$self instvar nchan_ net_ mmg_
	if [info exists nchan_] {
		set oldnchan $nchan_
	} else {
		set oldnchan 0
	}
	set nchan_ 0
	while { $nchan_ < [$ab nchan] } {
		set addr [$ab addr $nchan_]
		set sport [$ab sport $nchan_]
		set rport [$ab rport $nchan_]
		set ttl [$ab ttl $nchan_]
		if [info exists net_($nchan_)] {
			delete $net_($nchan_)
		}
		set net_($nchan_) [new NetworkLayer $session $addr \
					$sport $rport $ttl $nchan_]
		$self instvar agent_
		$net_($nchan_) set agent_ $agent_
		incr nchan_
	}
	set n $nchan_
	while {$n < $oldnchan} {
		if [info exists net_($n)] {
			delete $net_($n)
		}
		incr n
	}
	if [info exists mmg_] {
		delete $mmg_
	}
	$self set-subscription-level 0
	if {$nchan_ == 1} { return }
	if [$self yesno useLayersWindow] {
		$self graphics-init $nchan_
	}
	if [$self get_option useRLM] {
		set caddr ""
		set mmg_ [new MMG/mash $self $caddr]
	}
}
NetworkManager instproc nchan {} {
	return [$self set nchan_]
}
NetworkManager instproc reset ab {
	$self instvar session_
	$self allocate $ab $session_
}
NetworkManager instproc data-net args {
	if { $args == "" } {
		set k 0
	} else {
		set k $args
	}
	$self instvar net_
	return [$net_($k) data-net]
}
NetworkManager instproc ctrl-net args {
	if { $args == "" } {
		set k 0
	} else {
		set k $args
	}
	$self instvar net_
	return [$net_($k) ctrl-net]
}
NetworkManager public loopback enable {
	$self instvar nchan_ net_
	set i 0
	while { $i < $nchan_ } {
		set net $net_($i)
		set dn [$net data-net]
		set cn [$net ctrl-net]
		$dn loopback $enable
		$cn loopback $enable
		incr i
	}
}
NetworkManager instproc install-key key {
	return [$self set_key $key]
}
NetworkManager instproc crypt_all { dc cc } {
	$self instvar net_
	foreach n [array names net_] {
		$net_($n) crypt $dc $cc
	}
}
NetworkManager instproc destroy {} {
	$self instvar dc_ cc_ net_
	if [info exists dc_] {
		delete $dc_
	}
	if [info exists cc_] {
		delete $cc_
	}
	foreach dn [array names net_] {
		delete $net_($dn)
	}
	$self next
}
NetworkManager instproc usingRLM {} {
	$self instvar mmg_
	return [info exists mmg_]
}
NetworkManager instproc notify-loss {src layer} {
	$self instvar net_
	$net_($layer) notify-loss $src
}
NetworkManager instproc crypt_format { key } {
	set k [string first / $key]
	if { $k < 0 } {
		set fmt DES
	} else {
		set fmt [string range $key 0 [expr $k - 1]]
		set key [string range $key [expr $k + 1] end]
	}
	return "$fmt $key"
}
NetworkManager instproc set_key key {
	if { $key == "" } {
		$self crypt_clear
		return ""
	}
	$self instvar encrypt_ 
	set L [$self crypt_format $key]
	set fmt [lindex $L 0]
	set key [lindex $L 1]
	$self instvar key_
	set key_ $key
	$self instvar dc_ cc_ fmt_
	if { $fmt_ != $fmt } {
		if [info exists dc_] {
			delete $dc_
			unset dc_
		}
		if [info exists cc_] {
			delete $cc_
			unset cc_
		}
		set fmt_ $fmt
	}
	if ![info exists dc_] {
		set clist [Crypt/Data info subclass]
		if { [lsearch -exact $clist Crypt/Data/$fmt] < 0 } {
			return "no $fmt encryption support"
		}
		set dc_ [new Crypt/Data/$fmt]
		set cc_ [new Crypt/Control/$fmt]
	}
	if [$dc_ key $key] {
		$cc_ key $key
		$self crypt_all $dc_ $cc_
		set encrypt_ 1
		return ""
	} else {
		$self crypt_clear
		return "your key is cryptographically weak"
	}
}
NetworkManager instproc crypt_clear {} {
	$self instvar encrypt_ key_
	$self crypt_all "" ""
	set key_ ""
	set encrypt_ 0
}
Source/RTP set reportLoss_ 0
Session/RTP set nb_ 0
Session/RTP set nf_ 0
Session/RTP set np_ 0
Session/RTP set loopback_ 1
Source/RTP set badsesslen_ 0
Source/RTP set badsessver_ 0
Source/RTP set badsessopt_ 0
Source/RTP set badsdes_ 0
Source/RTP set badbye_ 0
SourceLayer/RTP set nchan_ 1
Session/RTP set badversion_ 0
Session/RTP set badoptions_ 0
Session/RTP set badfmt_ 0
Session/RTP set badext_ 0
Session/RTP set nrunt_ 0
Session/RTP set loopbackLayer_ 1000
Source/RTP public layer-stat which {
	$self instvar layers_
	set s 0
	foreach l $layers_ {
		set s [expr $s + [$l set $which]]
	}
	return $s
}
Source/RTP public ns {} {
	$self instvar layers_
	set s 0
	foreach l $layers_ {
		set s [expr $s + [$l set cs_] - [$l set fs_]]
	}
	return $s
}
Source/RTP public missing {} {
	$self instvar layers_
	set s 0
	foreach l $layers_ {
		set nm [expr [$l set cs_] - [$l set fs_] - [$l set np_]]
		if { $nm > 0 } {
			set s [expr $s + $nm]
		}
	}
	return $s
}
Source/RTP instproc is_mixer {} {
	return [expr [$self srcid] != [$self ssrc]]
}
SourceLayer/RTP set nrunt_ 0
SourceLayer/RTP set ndup_ 0
SourceLayer/RTP set fs_ 0
SourceLayer/RTP set cs_ 0
SourceLayer/RTP set np_ 0
SourceLayer/RTP set nf_ 0
SourceLayer/RTP set nb_ 0
SourceLayer/RTP set nm_ 0
Source/RTP public init { sm srcid ssrc addr } {
	$self next $srcid $ssrc $addr
	$self set sm_ $sm
	$self instvar layers_
	set k 0
	set report 0
	if { [$sm info vars network_] != "" } {
		set net [$sm set network_]
		set n [$net set nchan_]
		set report [$net usingRLM]
	} else {
		set n [SourceLayer/RTP set nchan_]
	}
	while { $k < $n } {
		set l [new SourceLayer/RTP]
		lappend layers_ $l
		$self layer $k $l
		incr k
	}
	$self set reportLoss_ $report
}
Source/RTP public getid {} {
	set name [$self sdes name]
	if { $name == "" } {
		set name [$self sdes cname]
		if { $name == "" } {
			set name [$self addr]
		}
	}
	return $name
}
Source/RTP public format_name {} {
	$self instvar sm_
	return [$sm_ rtp_type [$self format]]
}
Class MediaAgent -superclass {SourceManager Observable}
foreach method "unregister activate deactivate \
		trigger_media \
		trigger_format \
		trigger_sdes \
		trigger_idle \
		notify" {
	Source/RTP public $method {args} \
		"\$self instvar sm_ ; eval \$sm_ $method \$self \$args"
	MediaAgent public $method src "\$self notify_observers $method \$src"
}
MediaAgent public init {} {
	$self next
	$self set sources_ ""
}
MediaAgent public active_list {} {
	$self instvar active_
	if ![info exists active_] {
		return ""
	}
	return [array names active_]
}
MediaAgent public activate src {
	$self instvar active_
	set active_($src) 1
	$self notify_observers activate $src
}
MediaAgent public deactivate src {
	$self instvar active_
	unset active_($src)
	$self notify_observers deactivate $src
}
MediaAgent public unregister src {
	$self notify_observers unregister $src
	$self instvar sources_
	set k [lsearch -exact $sources_ $src]
	set sources_ [lreplace $sources_ $k $k]
}
MediaAgent public attach o {
	$self attach_observer $o
	$self instvar sources_ active_
	foreach s $sources_ {
		$o update register $s
		if [info exists active_($s)] {
			$o update activate $s
			$s enable_trigger
		}
	}
}
MediaAgent public detach o {
	$self detach_observer $o
	$self instvar sources_ active_
	foreach s $sources_ {
		if [info exists active_($s)] {
			$o update deactivate $s
		}
		$o update unregister $s
	}
}
MediaAgent public create-source { srcid ssrc addr srcsess } {
	set s [new Source/RTP $self $srcid $ssrc $addr]
	$s set session_ $srcsess
	$self instvar sources_
	lappend sources_ $s
	return $s
}
Class RTPAgent -superclass MediaAgent -configuration {
	mtu 1024 
	loopback 0
	siteDropTime "300"
}
RTPAgent public init {ab {callback {}} } {
	$self next
	$self instvar session_ mtu_ callback_
        if { $callback!={} } { set callback_ $callback }
	set session_ [$self create_session]
	$session_ sm $self
	$session_ buffer-pool [new BufferPool]
	if { $ab != "" } {
		$self reset $ab
	}
	set mtu_ [$self get_option mtu]
	global V
	set V(sm) $self
}
RTPAgent public destroy {} {
	$self instvar session_ network_
	delete $session_
	delete $network_
	$self next
}
RTPAgent public reset_spec spec {
	set ab [new AddressBlock $spec]
	$self reset $ab
	delete $ab
}
RTPAgent public reset ab {
	$self instvar network_ session_ sources_
    if {[$ab info class] != "AddressBlock"} {
	$self reset_spec $spec
    }
	if [info exists network_] {	
		delete $network_
	}
	set network_ [new NetworkManager $ab $session_ $self]
	$self app_loopback 1
	$self net_loopback [$self get_option loopback]
	set key [$self get_option sessionKey]
	if { $key != "" } {
		$network_ install-key $key
	}
	$self instvar local_
	if ![info exists local_] {
		$self mk_local_source
	}
	$session_ max-bandwidth [expr [$ab set maxbw_(0)]/1000.]
        $self instvar callback_
        if [info exists callback_] {
                eval $callback_ [list $ab]
	} else {
	        catch {[Application instance] reset $ab}
	}
}
RTPAgent private notify {src layer} {
	$self instvar network_
	if ![$network_ usingRLM] { return }
	$network_ notify-loss $src $layer
}
RTPAgent public stats {} {
	set s [$self set session_]
	return " \
		Bad-RTP-version [$s set badversion_] \
		Bad-RTPv1-options [$s set badoptions_] \
		Bad-Payload-Format [$s set badfmt_] \
		Bad-RTP-Extension [$s set badext_] \
		Runts [$s set nrunt_]"
}
RTPAgent private mk_local_source {} {
	$self instvar network_ session_ local_
	set net [$network_ data-net 0]
	set a [$net addr]
	set srcid [$session_ random-srcid $a]
	set src [$self create-local $srcid [$net interface]]
	set local_ $src
	$self notify_observers register $local_
	set cname [$self get_option cname]
	if { $cname == "" } {
		set interface [$net interface]
		if { $interface == "0.0.0.0" } {
			set interface [$session_ local-addr-heuristic]
		}
		set cname [user_heuristic]@$interface
	}
	$src sdes name [$self get_option rtpName]
	$src sdes email [$self get_option rtpEmail]
	$src sdes cname $cname
	set tool [Application name]\-[version]
	global tcl_platform
	if {[info exists tcl_platform(os)] && $tcl_platform(os) != "" && \
			$tcl_platform(os) != "unix"} {
		set p $tcl_platform(os)
		if {$tcl_platform(osVersion) != ""} {
			set p $p-$tcl_platform(osVersion)
		}
		if {$tcl_platform(machine) != ""} {
			set p $p-$tcl_platform(machine)
		}
		set tool "$tool/$p"
	}
	$src sdes tool $tool
	return $src
}
RTPAgent public have_network {} {
	$self instvar network_
	return [info exists network_]
}
RTPAgent public have_localsrc {} {
	$self instvar local_
	return [info exists local_]
}
RTPAgent public install-key key {
	$self instvar network_
	if [info exists network_] {
		$network_ install-key $key
	}
}
RTPAgent public network {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	return [$network_ data-net 0]
}
RTPAgent public session-addr {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	return [[$self network] addr]
}
RTPAgent public session-port {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	return [[$self network] port]
}
RTPAgent public session-rport {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	return [[$self network] rport]
}
RTPAgent public session-sport {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	return [[$self network] sport]
}
RTPAgent public get_local_srcid {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	$self instvar local_
	return [$local_ srcid]
}
RTPAgent public get_transmitter {} {
	return [$self set session_]
}
RTPAgent public session-ttl {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	return [[$self network] ttl]
}
RTPAgent public local-name {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	$self instvar local_
	return [$local_ sdes name]
}
RTPAgent public set_local_sdes { which value } {
	$self instvar local_
	$local_ sdes $which $value
}
RTPAgent public crypt_clear {} {
	if [info exists network_] {
		$network_ crypt_clear
	}
}
RTPAgent public shutdown {} {
	$self instvar session_
	$session_ exit
}
RTPAgent public set_maxchannel n {}
RTPAgent public set-bandwidth bps {
	[$self set session_] data-bandwidth $bps
}
RTPAgent public net_loopback enable {
	$self instvar network_
	$network_ loopback $enable
}
RTPAgent public app_loopback enable {
	$self instvar session_
	$session_ set loopback_ $enable
}
RTPAgent public set-bandwidth bps {
	[$self set session_] data-bandwidth $bps
}
Module/RTPRecord instproc init {} {
	set nb_ 0
	$self next
}
Class RTPRecordAgent -superclass RTPAgent 
RTPRecordAgent instproc init { session addr } {
	$self instvar Media_ archive_session_
	set archive_session_ $session
	set media [$session media]
	set Media_ [string toupper [string index $media 0]][string range \
			$media 1 end]
	set app [new RTPApplication/Recorder $media]
	set ab [new AddressBlock $addr]
	eval $self next $ab
}
RTPRecordAgent instproc destroy {} {
	$self instvar streams_
	if [info exists streams_] {
		foreach strm $streams_ {
			delete $strm
		}
	}
	$self next
}
RTPRecordAgent instproc activate src {
puts stderr "RTPRecordAgent::activate [$src getid]"
	$self instvar archive_session_ streams_
	set stream [new ArchiveStream/Record/RTP $archive_session_]
	set error [$stream bind $archive_session_]
	if { $error != "" } {
		$src data-handler [new Module/VideoDecoder/Null]
		$src ctrl-handler [new Module/VideoDecoder/Null]
		$self notify_observers archive_error $error
puts $error
exit 1
		return
	}
	$stream write_headers
	set rcvr [new Module/RTPRecord]
	set crcvr [new Module/RTPRecordCtrl]
	$stream attach $rcvr $crcvr
	$stream source $src
	$rcvr attach $stream
	$crcvr attach $stream
	$src data-handler $rcvr
	$src ctrl-handler $crcvr
	lappend streams_ $stream
	$self next $src
}
RTPRecordAgent instproc deactivate src {
	$self next $src
}
RTPRecordAgent instproc create_session {} {
	$self instvar Media_
	set session [new Session/RTP/${Media_}/Archive]
	if { $session == "" } {
		$self fatal "creation of Session/RTP/${Media_}/Archive failed"
		exit 1
	}
	return $session
}
ArchiveStream/Record/RTP instproc init { session } {
	$self instvar archive_session_
	set archive_session_ $session
	$self next $session
	$self init_file_header
}
Class RTPApplication/Recorder -superclass RTPApplication
RTPApplication/Recorder instproc init {media} {
	$self next recorder
	$self add_option sessionType rtpv2
	$self add_option network ip
	$self add_option defaultTTL 15
	$self add_option cname Archive
}
Class ArchiveSession/Record/RTP -superclass ArchiveSession/Record
ArchiveSession/Record/RTP instproc init { media addr } {
	set media [string tolower $media]
	$self next $media
	set Media [string toupper [string index $media 0]][string range \
			$media 1 end]
	$self set agent_ [new RTPRecordAgent $self $addr]
}
ArchiveSession/Record/RTP instproc destroy { } {
	$self instvar agent_
	delete $agent_
}
Session/SRM set nb_ 0
Session/SRM set nf_ 0
Session/SRM set np_ 0
Session/SRM set loopbackLayer_ 1000
Session/SRM set loopback_ 1
Class SRMAgent -superclass SourceManager/SRM
SourceManager/SRM instproc create-source { uid addr } {
    $self instvar map_ src_update_handler_
    if ![info exists map_($addr,$uid)] {
	set s [new Source/SRM $uid $addr]
	$self do_src_update $s
	set map_($addr,$uid) $s                
    } else {
	set s $map_($addr,$uid)      
    }
    return $s	
}
SourceManager/SRM instproc do_src_update { src } {
    $self instvar src_update_handler_
    if { [info exists src_update_handler_] } {
	if { $src_update_handler_ != {} } {
	    $src_update_handler_ new_source $src
	    set cname_update_body "$src_update_handler_ cname_update \
		    \{$src\} \$newname"
	    $src proc cname_update { newname } $cname_update_body
	}
    }
}
SourceManager/SRM instproc attach_src_update_handler { src_update_handler } {
    $self instvar map_ src_update_handler_
    set src_update_handler_ $src_update_handler
    foreach elem [array names map_ *] {
	$self do_src_update $map_($elem)
    }
}
SourceManager/SRM instproc get_source {addr uid} {
    $self instvar map_
    if [info exists map_($addr,$uid)] {
	return $map_($addr,$uid)
    } else {
	return ""
    }
}
SRMAgent instproc init { {luid {}} {laddr {}} {lcname {}} } {
	$self next 
	$self set luid_   $luid
	$self set laddr_  $laddr
	$self set lcname_ $lcname
}
SRMAgent instproc destroy {} {
	$self instvar network_ session_
	if [info exists network_] {
		delete $network_
	}
	if [info exists session_] {
	    delete $session_
	}
}
SRMAgent instproc net_loopback enable {
	$self instvar network_
	$network_ loopback $enable
}
SRMAgent instproc create-local { {uid {}} {addr {}} {cname {}} } {
        if { $uid=={} } {
                set uid [$self default-local-uid]
        }
        if { $addr=={} } {
                set addr [$self default-local-addr]
        }
        set local_src [$self local $uid $addr]
        if { $cname=={} } {
                set cname [$self get_option rtpName]
        }
        $local_src cname $cname
        return $local_src
}
SRMAgent instproc create-session { appmgr {src_update_handler {}} } {
        set session [new Session/SRM]
        $self app-mgr $appmgr
        $self set src_update_handler_ $src_update_handler
        $session app-mgr $appmgr
        $session agent $self
        $self set session_ $session
        return $session
}
SRMAgent instproc reset_spec spec {
	set ab [new AddressBlock $spec]
	$self reset $ab
	delete $ab
}
SRMAgent instproc reset { ab } {
	$self instvar default_local_ luid_ laddr_ lcname_ network_ session_
	if [info exists network_] {
		delete $network_
	}
	set network_ [new NetworkManager $ab $session_ $self]
	set key [$self get_option sessionKey]
	if { $key != "" } {
		$network_ install-key $key
	}
	if ![info exists default_local_] {
		set default_local_ [$self create-local $luid_ $laddr_ $lcname_]
	}
	catch {[Application instance] reset $ab}
}
SRMAgent instproc set_maxchannel { n } {} 
Session/SRM instproc destroy {} {
    	$self instvar bufferPool_ sa_timer_
    	if [info exists bufferPool_] {
	    	delete $bufferPool_
	}
	if [info exists sa_timer_] {
	    	delete $sa_timer_
	}
	$self next
}
Session/SRM instproc default-local { } {
    $self instvar agent_
    return [$agent_ default-local]
}
Session/SRM instproc create-local {args} {
        return [eval [$self set agent_] create-local $args]
}
Session/SRM instproc start_timers {} {
    $self instvar sa_timer_
    set sa_timer_ [new TimerSA]
    $self sa-timer $sa_timer_
    $sa_timer_ proc reset {} {
	$self period 3000
    }	
    $sa_timer_ proc faster {} {
	$self period 500
    }
    $sa_timer_ faster
}
Session/SRM instproc agent { a } {
	$self source-manager $a
        $self set agent_ $a
	$self instvar bufferPool_
	set bufferPool_ [new BufferPool/SRM]
	$bufferPool_ source-manager $a
	$self buffer-pool $bufferPool_
}
Session/SRM instproc get_agent {} {
	return [$self set agent_]
}
SRMAgent instproc default-local { } {
    $self instvar default_local_
    if { [info exists default_local_] } {
	return $default_local_
    } else {
	return ""
    }
}
SRMAgent instproc have_network {} {
	$self instvar network_
	return [info exists network_]
}
SRMAgent instproc install-key {key} {
	$self instvar network_
	if [info exists network_] {
		$network_ install-key $key
	}
}
SRMAgent instproc network {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	return [$network_ data-net 0]
}
SRMAgent instproc session-addr {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	return [[$self network] addr]
}
SRMAgent instproc session-port {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	return [[$self network] port]
}
SRMAgent instproc session-rport {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	return [[$self network] rport]
}
SRMAgent instproc session-sport {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	return [[$self network] sport]
}
SRMAgent instproc session-ttl {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	return [[$self network] ttl]
}
SRMAgent instproc crypt_clear {} {
	if [info exists network_] {
		$network_ crypt_clear
	}
}
Class ArchiveSession/Record/Mediaboard \
		-superclass {ArchiveSession/Record MB_Manager/Record}
Class ArchiveSession/Record/SRM -superclass ArchiveSession/Record/Mediaboard
ArchiveSession/Record/Mediaboard instproc init { media addr } {
	$self next $media
	$self instvar session_ sm_ agent_
        set agent_ [new SRMAgent 0xFFFFFF]
	set session_ [$agent_ create-session $self $self]
	$self reset $addr
	$self attach_session $session_
}
ArchiveSession/Record/Mediaboard instproc destroy { } {
    	$self instvar agent_
    	delete $agent_
	$self next
}
ArchiveSession/Record/Mediaboard instproc reset { addr } {
	$self instvar session_ agent_
	set had_network [$agent_ have_network] 
	set ab [new AddressBlock $addr]
	$agent_ reset $ab
	delete $ab
	set net [$agent_ set network_]
	[$net data-net] loopback 1
	[$net ctrl-net] loopback 1
	if !$had_network {
		$session_ start_timers
	}	
}
ArchiveSession/Record/Mediaboard instproc srm_session { } {
	return [$self set session_]
}
ArchiveSession/Record/Mediaboard instproc srm_source_mgr { } {
	return [$self set sm_] 
}
ArchiveSession/Record/Mediaboard instproc new_source { src } {
}
ArchiveStream/Record/Mediaboard instproc init { session } {
	$self next $session
	$self init_file_header
	$self set after_id_ [after 2000 "$self do_periodic"]
}
ArchiveStream/Record/Mediaboard instproc destroy { } {
	$self instvar after_id_
	if [info exists after_id_] {
		after cancel $after_id_
		unset after_id_
	}
	$self next
}
ArchiveStream/Record/Mediaboard private do_periodic { } {
	$self write_headers
	$self set after_id_ [after 2000 "$self do_periodic"]
}
Class Application/Recorder -superclass Application
Application/Recorder instproc init { } {
	$self next recorder
	$self instvar options_
	set options_ [$self options]
	$self init_resources $options_
	wm withdraw .
	$self set input_ui_ [RecorderUI/Input .input_ui]
	$self set protonames_(RTP/AVP) RTP
}
Application/Recorder instproc init_resources o {
        $o add_default drop 0
        $o add_default debug 0
        $o add_default rtPlay 0
        $o add_default record 0
        $o add_default uid none
        $o add_default trace none
        $o add_default delayParams default
	$o add_default defaultTTL 31
}
Application/Recorder instproc destroy { } {
	$self instvar input_ui_ status_ui_ catalog_
	set error ""
	if [info exists input_ui_ ] { destroy $input_ui_  }
	if [info exists status_ui_] { destroy $status_ui_ }
	if [info exists catalog_] { delete $catalog_ }
	$self next
}
Application/Recorder instproc parse_args { argv } {
	$self instvar no_input_ input_ui_ sdp_
	set no_input_ 0
	set len [llength $argv]
	set idx 0
	while { $idx < $len } {
		set option [lindex $argv $idx]
		incr idx
		switch -exact -- $option {
			-directory {
				if { $idx >= $len } {
					error "missing argument for -directory"
				}
				$input_ui_ set_directory [lindex $argv $idx]
				incr idx
			}
			-sessionid {
				if { $idx >= $len } {
					error "missing argument for -sessionid"
				}
				$input_ui_ set_session_id [lindex $argv $idx]
				incr idx
			}
			-catalog {
				if { $idx >= $len } {
					error "missing argument for\
							-catalog"
				}
				$input_ui_ set_catalog_filename \
						[lindex $argv $idx]
				incr idx
			}
			-add {
				if { $idx >= $len } {
					error "missing argument for -add"
				}
				set arg [lindex $argv $idx]
				if { [llength $arg] != 3 } {
					error "invalid argument to -add: $arg.\
							must be	\"<protocol>\
							<media> <addr>\""
				}
				$input_ui_ add_direct [lindex $arg 0] \
						[lindex $arg 1] [lindex $arg 2]
				incr idx
			}
			-noinput {
				set no_input_ 1
			}
			-sdp {
				if { $idx >= $len } {
					error "missing argument for\
							-sdp"
				}
				set sdp_ [lindex $argv $idx]
				$self handle_sdp
				incr idx
			}
			default {
				$self usage "Invalid argument \"$option\""
			}
		}
	}
}
Application/Recorder instproc usage { error } {
	puts "\n The MASH Archive System: Recorder"
	puts   "-----------------------------------"
	puts "\n$error"
	puts "Usage: recorder \[options\]"
	puts "\t-add \"<protocol> <media> <address>\": add this session to"
	puts "\t                                       the record list"
	puts "\t\t\t<protocol>: SRM or RTP"
	puts "\t\t\t<media>:    mediaboard, video, audio, etc."
	puts "\t\t\t<address>:  <multicast group>/<port number>"
	puts "\t-directory <dirname>: store all files in this directory"
	puts "\t-sessionid <id>: used as a prefix for all files generated in"
	puts "\t                 this session"
	puts "\t-catalog <file>: name of the catalog file to be created"
	puts "\t                    this session"
	puts "\t-noinput: do not pop up the initial input dialog"
	puts "\t-sdp <announcement>/-: if argument is '-', read standard input"
	puts "\t                       for an SDP announcement\n"
	exit -1
}
Application/Recorder instproc handle_sdp { } {
	$self instvar sdp_ input_ui_ protonames_
	if { $sdp_=="-" } {
		set sdp_ ""
		while { [gets stdin line] > 0} {
			if { [string length $line] > 0 } {
				append sdp_ "$line\n"
			}
		}
	}
	set sdp_ [string trim $sdp_]
	puts stderr "SDP announcement is:\n$sdp_------------\n"
	set parser [new SDPParser]
	set messages [$parser parse $sdp_]
	if { [llength $messages]==0 } {
		error "invalid SDP announcement"
	}
	foreach message $messages {
		foreach media [$message set allmedia_] {
			set proto [$media set proto_]
			if [info exists protonames_($proto)] {
				set proto $protonames_($proto)
			}
			set mediatype [$media set mediatype_]
			if { [Class info instances \
					ArchiveSession/Record/$proto]=="" } {
				puts stderr "Cannot find recorder for protocol\
						$proto:$mediatype; ignoring..."
				continue
			}
			set caddr [split [$media set caddr_] "/"]
			set addr [lindex $caddr 0]/[$media set port_]
			if { [llength $caddr] > 1 } {
				append addr /none/[lindex $caddr 1]
			}
			$input_ui_ add_direct $proto $mediatype $addr
		}
	}
}
Application/Recorder instproc run { } {
	$self instvar no_input_ input_ui_ catalog_
	while { 1 } {
		if { !$no_input_ } {
			if { [$input_ui_ invoke]=="" } {
				return 0
			}
		}
		set error [$self check]
		if { $error!="" } {
			$self invoke_error $error
			continue
		}
		if { ![info exists catalog_] } {
			set catalog_ [new SessionCatalog]
		}
		set catalog_filename [$input_ui_ get_catalog_filename]
		if { $catalog_filename!="" } {
			if [catch { $catalog_ open $catalog_filename "w"} \
					error] {
				$self invoke_error "$error (while trying to\
						open catalog file)"
				continue
			}
		}
		break
	}
	if { ![$catalog_ is_opened] } {
		delete $catalog_
		unset catalog_
	}
	$self record
	return 1
}
Application/Recorder instproc invoke_error { error } {
	$self instvar no_input_
	if { $no_input_ } {
		error $error
	}
	Dialog transient MessageBox -image Icons(warning) \
			-text $error
}
Application/Recorder instproc check { } {
	$self instvar input_ui_
	if { ![file isdirectory [$input_ui_ get_directory]] } {
		return "invalid directory: [$input_ui_ get_directory]"
	}
	if { [$input_ui_ subwidget listbox info numelems] <= 0 } {
		return "must have at least one session to record"
	}
	return ""
}
Application/Recorder instproc record { } {
	$self instvar input_ui_ status_ui_ catalog_ sdp_
	if { [info exists catalog_] && [info exists sdp_] } {
		$catalog_ write_sdp $sdp_
	}
	set directory [$input_ui_ get_directory]
	set catalog_filename [$input_ui_ get_catalog_filename]
	if { [file dirname $catalog_filename]==$directory } {
		set name [file tail $catalog_filename]
	} else {
		set name $catalog_filename
	}
	set status_ui_ [RecorderUI/Status .status_ui \
			-closecmd "delete $self; exit"]
	$status_ui_ subwidget session_id insert end [$input_ui_ get_session_id]
	$status_ui_ subwidget directory  insert end $directory
	$status_ui_ subwidget catalog    insert end $name
	$status_ui_ subwidget session_id configure -state disabled
	$status_ui_ subwidget directory  configure -state disabled
	$status_ui_ subwidget catalog    configure -state disabled
	foreach id [$input_ui_ subwidget listbox info all] {
		$self create_session $id
	}
	$status_ui_ invoke
}
Application/Recorder instproc create_session { id } {
	$self instvar input_ui_ status_ui_ catalog_
	set session_ui [$status_ui_ add [$input_ui_ subwidget listbox \
			info value -id $id]]
	set id [split $id "+"]
	set protocol [lindex $id 0]
	set session [new ArchiveSession/Record/$protocol [lindex $id 1] \
			[lindex $id 2]]
	if { [info exists catalog_] } {
		$session catalog $catalog_
	}
	$session save_in [$input_ui_ get_directory]
	$session session_id [$input_ui_ get_session_id]
	$session attach_observer $session_ui
	$session_ui attach_session $session
}
Application/Recorder instproc destroy_session { session } {
}
set app [new Application/Recorder]
$app parse_args $argv
if { ! [$app run] } {
	delete $app
	exit
}
