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

#
# 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
	}
	bind <Destroy> $widget "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_]
		}
		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(trcVerb)      {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 { } {
	$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 { } {
	$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 { flag args } {
        global MTrace
        set bits [lindex $MTrace($flag) 0]
        [MTrace set 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
			}
		}
	}
	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 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_
	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
		}
		$self usage
		$self fatal "unknown command option: $arg"
	}
	return $argv
}
Configuration public usage {} {
	puts "usage: [Application name] [join [$self arg_info]]"
}
Configuration private arg_info {} {
	$self instvar arg_option_ arg_bool_ usage_
	set req ""
	set opt ""
	foreach arg [array names arg_option_] {
		set r $arg_option_($arg)
		set d [$self get_option $r]
		if { $d != "" || $usage_($arg) != "required"} {
			set opt [join "$opt \[$arg $r ($d)\]"]
		} else {
			set req [join "$req $arg $r"]
		}
	}
	foreach arg [array names arg_bool_] {
		set r $arg_bool_($arg)
		set d [$self get_option $r]
		if { $d != "" } {
		        set opt [join "$opt \[$arg ($d)\]"]
		} else {
			set opt [join "$opt \[$arg\]"]
		}
	}
	return "{$opt} {$req}"
}
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
	}
}
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 set_var \[%W get\]"
	bind $path.entry <FocusOut> "$self restore_var"
}
DropDown/Text instproc restore_var {} {
	upvar #0 [$self set var_] global_var
	if [info exists global_var] {
		$self set_var $global_var
	}
}
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 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]
}
WidgetClass ScrolledText -superclass ScrolledWidget
ScrolledText instproc create_main_widget { path } {
	return [text $path.text]
}
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 $id
	}
}
ScrolledListbox instproc invoke { id } {
	set command [$self cget -command]
	if { $command!="" } {
		uplevel #0 $command $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 Dialog -configspec {
	{ -defaultfocus defaultFocus DefaultFocus {} config_defaultfocus } 
	{ -title title Title {} config_wm_option }
	{ -transient transient Transient {} config_transient }
	{ -result result Result {} config_result cget_result }
	{ -modal modal Modal 1 config_option }
	{ -closecmd closeCmd CloseCmd {} config_option }
}
Dialog instproc create_root_widget { path } {
	toplevel $path -class [$self info class]
	wm withdraw $path
	wm protocol $path WM_DELETE_WINDOW "$self cancel"
}
Dialog instproc config_defaultfocus { option args } {
	if { [llength $args]==0 } {
		return [$self set default_focus_]
	} else {
		$self set default_focus_ [string trim [lindex $args 0]]
	}
}
Dialog instproc config_wm_option { option args } {
	if { [llength $args]==0 } {
		return [wm [string range [string trim $option] 1 end] \
				[$self info path]]
	} else {
		wm [string range [string trim $option] 1 end] \
				[$self info path] [lindex $args 0]
	}
}
Dialog instproc config_transient { option args } {
	set path [$self info path]
	if { [llength $args]==0 } {
		return [wm transient $path]
	} else {
		set is_mapped [winfo ismapped $path]
		wm transient $path [lindex $args 0]
		if { !$is_mapped } {
			wm withdraw $path
		}
	}
}
Dialog instproc center { } {
	set path [$self info path]
	wm withdraw $path
	update idletasks
	update
	set x [expr [winfo screenwidth $path]/2 - [winfo reqwidth $path]/2 \
			- [winfo vrootx [winfo parent $path]]]
	set y [expr [winfo screenheight $path]/2 - [winfo reqheight $path]/2 \
			- [winfo vrooty [winfo parent $path]]]
	wm geom $path +$x+$y
	wm deiconify $path
	raise $path
}
Dialog instproc grab { {start_focus {}} } {
	$self instvar old_focus_ old_grab_ grab_status_	
	set path [$self info path]
	set old_focus_ [focus]
	set old_grab_ [grab current $path]
	if {$old_grab_ != ""} {
		set grab_status_ [grab status $old_grab_]
	}
	grab $path
	if { [string trim $start_focus]=={} } {
		set start_focus [$self cget -defaultfocus]
	}
	if { $start_focus != {} } {
		focus [eval [list $self] subwidget $start_focus]
	}
}
Dialog instproc release { } {
	$self instvar old_focus_ old_grab_ grab_status_
	catch {focus $old_focus_}
	grab release [$self info path]
	if {$old_grab_ != ""} {
		if {$grab_status_ == "global"} {
			grab -global $old_grab_
		} else {
			grab $old_grab_
		}
	}
}
Dialog instproc wait { } {
	$self tkvar result_
	catch { unset result_ }
	tkwait variable [$self tkvarname result_]
	return $result_
}
Dialog instproc invoke { {start_focus {}} } {
	$self instvar old_focus_ old_grab_ grab_status_
	set path [$self info path]
	$self center
	if { [$self cget -modal] } {
		$self grab $start_focus
		set result [$self wait]
		$self release
		wm withdraw $path
		$self invoke_closecmd
		return $result
	} else {
		if { [string trim $start_focus]=={} } {
			set start_focus [$self cget -defaultfocus]
		}
		if { $start_focus != {} } {
			focus [eval [list $self] subwidget $start_focus]
		}
		$self tkvar result_
		catch { unset result_ }
		trace variable result_ w "Dialog nonmodal_result_ [list $self]\
				; $self ignore_args"
		return ""
	}
}
Dialog instproc cancel { } {
	$self configure -result {}
}
Dialog instproc config_result { option value } {
	$self tkvar result_
	set result_ $value
}
Dialog instproc cget_result { option } {
	$self tkvar result_
	if { [info exists result_] } {
		return $result_
	} else {
		return ""
	}
}
Dialog instproc config_option { option args } {
	$self instvar config_
	if { [llength $args]==0 } {
		return $config_($option)
	} else {
		set config_($option) [lindex $args 0]
	}
}
Dialog instproc invoke_closecmd { } {
	set closecmd [$self cget -closecmd]
	if { [string trim $closecmd]!={} } {
		uplevel #0 $closecmd
	}
}
Dialog proc nonmodal_result_ { dlg } {
	if { [info command $dlg]==$dlg } {
		set path [$dlg info path]
		if { ![winfo exists $path] } return
		wm deiconify [$dlg info path]
		$dlg tkvar result_
		trace vdelete result_ w "Dialog nonmodal_result_ $dlg"
		$dlg invoke_closecmd
	}
}
Dialog proc transient { cl args } {
	set count 0
	set path .dialog__$count
	while { [winfo exists $path] } {
		set path .dialog__$count
		incr count
	}
	eval $cl [list $path] $args
	set modal [$path cget -modal]
	if { ! $modal } {
		set command [$path cget -closecmd]
		append command "; destroy $path"
		$path configure -closecmd $command
		return [$path invoke]
	} else {
		set result [$path invoke]
		destroy $path
		return $result
	}
}
WidgetClass CompoundButton -configspec {
	{ -relief relief Relief raised config_all }
	{ -background background Background WidgetDefault config_all }
	{ -foreground foreground Foreground WidgetDefault config_all }
	{ -state state State normal config_all }
	{ -font font Font WidgetDefault config_all }
	{ -command command Command "" config_command }
} -alias {
	{ -bg -background }
	{ -fg -foreground }
} -default {
	{ .highlightThickness WidgetDefault }
	{ .takeFocus 1 }
	{ .borderWidth WidgetDefault }
	{ .relief raised }
}
CompoundButton proc root { className path } {
	while { $path!="" && [winfo class $path]!=$className } {
		set path [winfo parent $path]
	}
	return $path
}
CompoundButton proc init_ { cl } {
	$self instvar init_done_
	if [info exists init_done_($cl)] return
	set init_done_($cl) 1
	bind $cl <B1-Motion> "\[$self root $cl %W\] b1_motion %W %x %y"
	bind $cl <Button-1>  "\[$self root $cl %W\] button_down"
	bind $cl <ButtonRelease-1> "\[$self root $cl %W\] button_up"
}
CompoundButton instproc init { args } {
	CompoundButton init_ [$self info class]
	eval [list $self] next $args
	$self set button_down_ 0
	$self set entered_ 0
}
CompoundButton instproc build_widget { path } {
	bind $path <Enter> "$self enter"
	bind $path <Leave> "$self leave"
	bind $path <Key-space> "$self invoke_with_ui"
}
CompoundButton instproc add { args } {
	set widget_type [lindex $args 0]
	set subwidget   [lindex $args 1]
	set path        [$self info path].$subwidget
	eval [list $widget_type] [list $path] [lrange $args 2 end]
	$self instvar config_
	foreach name [array names config_] {
		$path configure $name $config_($name)
	}
	if { ![catch {$path configure -takefocus}] } {
		$path configure -takefocus 0
	}
	if { ![catch {$path configure -highlightthickness}] } {
		$path configure -highlightthickness 0
	}
	set tags [bindtags $path]
	set idx [lsearch $tags [winfo class $path]]
	if { $idx!=-1 } {
		set tags [lreplace $tags $idx $idx]
	}
	set cl [$self info class]
	if { [lsearch $tags $cl] == -1 } {
		set tags [concat $cl $tags]
	}
	bindtags $path $tags
	return $subwidget
}
CompoundButton instproc remove { subwidget } {
	destroy [$self info path].$subwidget
}
CompoundButton instproc invoke { } {
	set command [$self cget -command]
	if { [string trim $command]!={} } {
		uplevel #0 $command
	}
}
CompoundButton instproc config_command { option args } {
	$self instvar config_
	if { [llength $args] == 0 } {
		return $config_(-command)
	} else {
		set config_(-command) [lindex $args 0]
	}
}
CompoundButton instproc config_all { option args } {
	$self instvar config_
	if { [llength $args]==0 } {
		return $config_($option)
	} else {
		set value [lindex $args 0]
		set config_($option) $value
		if { ![catch {$self widget_proc configure $option}] } {
			$self widget_proc configure $option $value
		}
		foreach child [winfo children [$self info path]] {
			if { ![catch {$child configure $option}] } {
				$child configure $option $value
			}
		}
	}
}
CompoundButton instproc button_down { } {
	$self instvar button_down_ saved_relief_
	set saved_relief_ [$self cget -relief]
	if { [$self cget -state] != "disabled" } {
		set button_down_ 1
		$self configure -relief sunken
	}
}
CompoundButton instproc button_up { } {
	$self instvar entered_ button_down_ saved_relief_
	if { $button_down_ } {
		set button_down_ 0
		$self configure -relief $saved_relief_
		if { $entered_ && [$self cget -state] != "disabled" } {
			$self invoke
		}
	}
}
CompoundButton instproc b1_motion { widget x y } {
	$self instvar button_down_ entered_
	if { !$button_down_ } return
	set root [$self info path]
	if { $widget!=$root } {
		incr x [winfo x $widget]
		incr y [winfo y $widget]
	}
	if { $x >= 0 && $y >= 0 && $x < [winfo width $root] && \
			$y < [winfo height $root] } {
		if { ! $entered_ } {
			$self enter
		}
	} else {
		if { $entered_ } {
			$self leave
		}
	}
}
CompoundButton instproc enter { } {
	$self instvar entered_ button_down_
	if { [$self cget -state] != "disabled" } {
		if { $button_down_ } {
			$self configure -relief sunken
		}
		set entered_ 1
	}
}
CompoundButton instproc leave { } {
	$self instvar entered_ button_down_ saved_relief_
	if { $button_down_ } {
		$self configure -relief $saved_relief_
	}
	set entered_ 0
}
CompoundButton instproc invoke_with_ui { } {
	if {[$self cget -state] != "disabled"} {
		set oldRelief [$self cget -relief]
		$self configure -relief sunken
		update idletasks
		after 100
		$self configure -relief $oldRelief
		$self invoke
	}
}
WidgetClass ImageTextButton -superclass CompoundButton -configspec {
	{ -orient orient Orient horizontal config_orient }
	{ -style style Style imagetext config_style }
	{ -image image Image {} config_imageoption }
	{ -text text Text {} config_textoption }
	{ -underline underline Underline -1 config_textoption }
	{ -command command Command {} config_textoption }
} -alias {
	{ -under -underline }
} -default {
	{ *Button.borderWidth 0 }
	{ *Button.highlightThickness 0 }
	{ *Button.padX 1 }
	{ *Button.padY 1 }
}
ImageTextButton instproc build_widget { path } {
	$self next $path
	$self add button image
	$self add button text
}
ImageTextButton instproc repack { } {
	set path   [$self info path]
	catch { pack forget $path.image }
	catch { pack forget $path.text  }
	switch [$self cget -orient] {
		horizontal {
			set side left
		}
		vertical -
		default {
			set side top
		}
	}
	switch [$self cget -style] {
		imagetext {
			set list "[list $path.image] [list $path.text]"
		}
		image {
			set list $path.image
		}
		text {
			set list $path.text
		}
	}
	eval pack $list -side [list $side] -expand 1 -fill both -padx 2
}
ImageTextButton instproc config_orient { option {orient {}} } {
	$self instvar orient_
	switch -exact -- $orient {
		{} {
			if { [info exists orient_] } {
				return $orient_
			} else {
				return vertical
			}
		}
		vertical -
		horizontal {
			set orient_ $orient
			$self repack
		}
		default {
			error "invalid orientation $orient"
		}
	}
}
ImageTextButton instproc config_style { option {style {}} } {
	$self instvar style_
	switch -exact -- $style {
		{} {
			if { [info exists style_] } {
				return $style_
			} else {
				return imagetext
			}
		}
		imagetext -
		image -
		text {
			set style_ $style
			$self repack
		}
		default {
			error "invalid style $style"
		}
	}
}
ImageTextButton instproc config_imageoption { option args } {
	if { [llength $args]==0 } {
		return [$self subwidget image cget $option]
	} else {
		$self subwidget image configure $option [lindex $args 0]
	}
}
ImageTextButton instproc config_textoption { option args } {
	if { [llength $args]==0 } {
		return [$self subwidget text cget $option]
	} else {
		$self subwidget text configure $option [lindex $args 0]
	}
}
WidgetClass LabeledWidget -configspec {
	{ -label  label Label {} config_label }
	{ -underline underline Underline -1 config_underline }
	{ -widget widget Widget {} config_widget }
	{ -orient orient Orient horizontal config_orient }
} -alias {
	{ -under -underline }
}
LabeledWidget instproc build_widget { path } {
	label $path.label -anchor w
	$self set widget_ ""
}
LabeledWidget instproc config_label { option args } {
	if { [llength $args]==0 } {
		return [$self subwidget label cget -text]
	} else {
		$self subwidget label configure -text [lindex $args 0]
	}
}
LabeledWidget instproc config_underline { option args } {
	if { [llength $args]==0 } {
		return [$self subwidget label cget -underline]
	} else {
		$self subwidget label configure -underline [lindex $args 0]
	}
}
LabeledWidget instproc config_widget { option args } {
	$self instvar widget_
	if { [llength $args]==0 } {
		return $widget_
	} else {
		set widget [lindex $args 0]
		if { $widget != "" && [winfo parent $widget]!=[winfo parent \
				[$self info path]] } {
			error "\"$widget\" must have the same parent as\
					\"[$self info path]\""
		}
		catch { pack forget $widget_ }
		set widget_ $widget
		$self repack
	}
}
LabeledWidget instproc config_orient { option args } {
	$self instvar orient_
	if { [llength $args]==0 } {
		if { [info exists orient_] } {
			return $orient_
		} else {
			return horizontal
		}
	} else {
		$self set orient_ [lindex $args 0]
		$self repack
	}
}
LabeledWidget instproc repack { } {
	$self instvar widget_
	set label [$self subwidget label]
	catch { pack forget $label $widget_ }
	set orient [$self cget -orient]
	switch -exact -- $orient {
		horizontal {
			set side left
			set label_fill x
		}
		vertical {
			set side top
			set label_fill y
		}
		default {
			error "invalid orientation \"$orient\""
		}
	}
	pack $label -side $side -fill $label_fill -anchor w
	if { $widget_!="" } {
		set path [$self info path]
		pack $widget_ -side $side -fill both -expand 1 -in $path
		raise $widget_ $path
	}
}
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]
}
WidgetClass FileDialog/Archive -superclass FileDialog -default {
	{ .preview.Checkbutton.borderWidth 1 }
	{ .preview.Checkbutton.highlightThickness 1 }
	{ .preview.info.text.borderWidth 1 }
	{ .preview.info.text.highlightThickness 0 }
	{ .preview.info.text.width 25 }
	{ .preview.info.text.height 6 }
	{ .preview.info.scrollbar both }
	{ .preview.info*Scrollbar.width 10 }
	{ .preview.info*Scrollbar.borderWidth 1 }
	{ .preview.info*Scrollbar.highlightThickness 1 }
	{ *MultiColumnListbox*bbox.width 300 }
}
FileDialog/Archive instproc build_widget { path } {
	$self next $path
	$self subwidget filebox configure \
			-browsecmd "$self browse_preview; $self ignore_args"
	frame $path.preview
	checkbutton $path.preview.button -text "Preview" -anchor w \
			-variable [$self tkvarname preview_] \
			-command "$self browse_preview"
	ScrolledText $path.preview.info -options {
		{ text.state disabled }
		{ text.wrap none }
	}
	$self tkvar preview_
	set preview_ 1
	pack $path.preview.button -side top -fill x -anchor w
	pack $path.preview.info -fill both -expand 1 -padx 5 -pady 5
	pack $path.preview -fill both -side right
}
FileDialog/Archive instproc browse_preview { } {
	set filetypes [$self subwidget filebox cget -filetypes]
	set ext [string trim [lindex [lindex $filetypes 0] 1]]
	switch -exact -- $ext {
		.dat {
			$self browse_preview_ browse_data_index DAT
		}
		.idx {
			$self browse_preview_ browse_data_index IDX
		}
		.ctg {
			$self browse_preview_ browse_catalog
		}
	}
}
FileDialog/Archive instproc browse_preview_ { method args } {
	$self tkvar preview_
	if { $preview_ } {
		set text [[$self subwidget preview].info subwidget text]
		$text configure -state normal
		$text delete 1.0 end
		set path [file join \
				[$self subwidget filebox cget -directory] \
				[$self subwidget filebox cget -filename]]
		eval [list $self] [list $method] [list $path] $args
		$text configure -state disabled
	}
}
FileDialog/Archive instproc browse_data_index { filename filetype } {
	set afile [new ArchiveFile]
	if ![catch {$afile open $filename; $afile header hdr} ] {
		if { [string match "M${filetype}*" $hdr(version)] } {
			set duration [expr $hdr(end) - $hdr(start)]
			if { $duration < 0.0 } {
				set duration 0.0
			}
			set    string "Version: $hdr(version)\n"
			append string "Protocol: $hdr(protocol)\n"
			append string "Media: $hdr(media)\n"
			append string "CName: $hdr(cname)\n"
			append string "Name: $hdr(name)\n"
			append string "Start: [ArchiveFile ts2string \
					$hdr(start)]\n"
			append string "End: [ArchiveFile ts2string \
					$hdr(end)]\n"
			append string "Duration: $duration seconds\n"
		} else {
			set string "Cannot preview file"
		}
	} else {
		set string "Cannot preview file"
	}
	[$self subwidget preview].info subwidget text insert end $string
	delete $afile
}
FileDialog/Archive instproc browse_catalog { filename } {
	set catalog [new SessionCatalog]
	set text [[$self subwidget preview].info subwidget text]
	if [catch {$catalog open $filename}] {
		$text insert end "Cannot open file"
		delete $catalog
		return
	}
	if [catch {$catalog read}] {
		global errorInfo
		$text insert end "Cannot preview session catalog"
		delete $catalog
		return
	}
	foreach id [$catalog info streams] {
		lappend session([$catalog info session $id]) $id
	}
	foreach s [array names session] {
		$text insert end "$s:\n"
		foreach id $session($s) {
			$text insert end "    Data file: [file tail \
					[$catalog info datafile $id]]\n"
			$text insert end "    Index file: [file tail \
					[$catalog info indexfile $id]]\n"
		}
	}
	delete $catalog
}
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_heursitic {} {
	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
		}
	}
}
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__
Class SessionCatalog
SessionCatalog instproc init { } {
	$self instvar sdp_
	$self next
	$self set file_ ""
	$self set filename_ ""
	set sdp_ ""
}
SessionCatalog instproc destroy { } {
	$self close
	$self next
}
SessionCatalog instproc open { filename { mode "r" } { permissions 0644 } } {
	$self instvar file_ filename_ line_no_
	set file_ [open $filename $mode $permissions]
	$self clear
	set filename_ $filename
}
SessionCatalog instproc 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_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 instproc read { } {
	$self instvar file_
	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 instproc 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 instproc 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_sdp_ { msg } {
	$self instvar sdp_
	set sdp_ $msg
	puts "SDP----"
	puts $msg
	puts "SDP----"
	return
}
SessionCatalog instproc get_sdp {} {
	$self instvar sdp_
	return $sdp_
}
SessionCatalog instproc 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)
}
proc address_check { addr } {
	set addr [split $addr "/"]
	if { [llength $addr] != 2 } {
		return 0
	}
	set port [string trim [lindex $addr 1]]
	set addr [string trim [lindex $addr 0]]
	if { $port=={} || $addr=={} } {
		return 0
	}
	set addr [split $addr "."]
	if { [llength $addr]!=4 } {
		return 0
	}
	return 1
}
WidgetClass PlayerUI/Main -superclass Dialog -default {
	{ .modal 0 }
	{ .title "MASH Archive System: Player" }
	{ .session_list.bbox.width 250 }
	{ .session_list.scrollbar both }
	{ *session_list.scrollbar both }
	{ *session_list.borderWidth 1  }
	{ *session_list.relief sunken  }
	{ *session_list.bbox.highlightThickness 1 }
	{ *session_list.Scrollbar.borderWidth 1 }
	{ *session_list.Scrollbar.highlightThickness 1 }
	{ *session_list.Scrollbar.width 10 }
	{ *ImageTextButton.borderWidth 1 }
	{ *ImageTextButton.highlightThickness 1 }
	{ *font WidgetDefault }
	{ .scale.width 10 }
	{ .scale.borderWidth 1 }
	{ .scale.highlightThickness 1 }
	{ .menu.tearOff 0 }
	{ .menu.borderWidth 1 }
	{ .menu.highlightThickness 1 }
}
PlayerUI/Main instproc build_widget { path } {
	$self set count_ 0
	frame $path.buttons
	frame $path.f1
	ScrolledListbox $path.session_list -itemclass PlayerUI/SessionListItem\
			-browsecmd "$self browse_session_list"
	frame $path.session_frame
	label $path.rightbutton \
			-text "(click right mouse button for more options)"
	ImageTextButton $path.catalog -image Icons(browse) \
			-text "Read catalog" \
			-command "$self catalog"
	ImageTextButton $path.startplay -image VcrIcons(play) \
			-text "Start playback" -state disabled \
			-command "$self start_play"
	ImageTextButton $path.cancel -image Icons(cross) -text Cancel \
			-command "exit" \
			-options { { text.justify left } }
	menu $path.menu
	$path.menu add command -label "New session" \
			-command "$self new_session"
	$path.menu add command -label "New stream" -command "$self new_stream"
	$path.menu add command -label "Delete" -command "$self delete"
	$path.menu add command -label "Start tool" -command "$self start_tool"
	$path.menu add command -label "Advanced options" \
			-command "$self advanced_options"
	bind $path <Button-3> "$self popup_menu %X %Y"
	pack $path.cancel $path.startplay $path.catalog $path.rightbutton \
			-side right -in $path.buttons -fill y -padx 2
	pack $path.session_list -fill both -side left -in $path.f1 \
			-padx 5 -pady 5
	pack $path.session_frame -fill both -expand 1 -side right -in $path.f1\
			-padx 5 -pady 5
	pack $path.buttons -side bottom -fill x -anchor e -pady 2
	pack $path.f1 -side top -fill both -expand 1
	$self dummy_session
	$self set ttl_ 16
	$self set advanced_ [PlayerUI/Advanced $path.advanced]
}
PlayerUI/Main instproc dummy_session { } {
	$self instvar dummy_session_
	set dummy_session_ [PlayerUI/Session [$self subwidget \
			session_frame].dummy_session]
	set bg [WidgetClass widget_default -disabledforeground]
	$dummy_session_ configure -takefocus 0 -bg $bg
	$dummy_session_ subwidget bbox configure -takefocus 0 -bg $bg
	$dummy_session_ subwidget window configure -takefocus 0 -bg $bg
	$dummy_session_ subwidget hscroll configure -takefocus 0 -bg $bg
	$dummy_session_ subwidget vscroll configure -takefocus 0 -bg $bg
	pack $dummy_session_ -fill both -expand 1
}
PlayerUI/Main instproc start_play { } {
	set list [$self subwidget session_list]
	foreach session_widget [$list info all] {
		set item_widget [$list info widget -id $session_widget]
		set address [string trim [lindex [$item_widget cget -value] 2]]
		if [info exists addrlist($address)] {
			Dialog transient MessageBox -image Icons(warning) \
					-text "Duplicate address \"$address\"\
					found in session list. Please fix it\
					before starting playback"
			return
		}
		set addrlist($address) 1
	}
	$self instvar started_play_
	set started_play_ 1
	$self tkvar input_done_
	set input_done_ yes
}
PlayerUI/Main instproc popup_menu { x y } {
	$self instvar menu_widget_ started_play_
	set menu [$self subwidget menu]
	set menu_widget_ [$self find_widget $x $y]
	if { $menu_widget_ != "" } {
		if { [$menu_widget_ info class]=="PlayerUI/SessionListItem" } {
			set type session
		} else {
			set type stream
		}
	} else {
		set type ""
	}
	if [info exists started_play_] {
		set delete_state disabled
		$menu entryconfigure "Advanced options" -state disabled
	} else {
		set delete_state normal
		$menu entryconfigure "Advanced options" -state normal
	}
	switch -exact -- $type {
		session {
			$menu entryconfigure "Delete*" -label "Delete session"\
					-state $delete_state
			$menu entryconfigure "Start tool" -state normal
		}
		stream {
			$menu entryconfigure "Delete*" -label "Delete stream"\
					-state $delete_state
			$menu entryconfigure "Start tool" -state disabled
		}
		default {
			$menu entryconfigure "Delete*" -label "Delete" \
					-state disabled
			$menu entryconfigure "Start tool" -state disabled
		}
	}
	tk_popup $menu $x $y
}
PlayerUI/Main instproc add_session { protocol media address } {
	$self instvar count_
	set widget [PlayerUI/Session [$self subwidget \
			session_frame].session_$count_]
	$widget subwidget bbox configure
	incr count_
	set list [$self subwidget session_list]
	$list insert end "-id $widget [list $protocol] [list $media] \
			[list $address]"
	if { [llength [$list selection get]]==0 } {
		$list selection set -id $widget
		$self browse_session_list $widget
	}
	return $widget
}
PlayerUI/Main instproc delete_session { widget } {
	destroy $widget
	set list [$self subwidget session_list]
	if { [$list selection get -id $widget]!="" } {
		set selected 1
	} else {
		set selected 0
	}
	$list delete -id $widget
	if { [$list info numelems] <= 0 } {
		$self instvar dummy_session_
		pack $dummy_session_ -fill both -expand 1
		$self subwidget startplay configure -state disabled
	} elseif { $selected } {
		$list selection set 0
		$self browse_session_list [$list selection get]
	}
}
PlayerUI/Main instproc browse_session_list { widget } {
	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_frame]] }
	pack $widget -fill both -expand 1
	set old_focus [focus]
	if { $old_focus != [[$list info widget -id $widget] subwidget \
			address] && $old_focus!="" } {
		focus [$list subwidget window]
	}
}
PlayerUI/Main instproc new_session { } {
	set new [Dialog transient PlayerUI/NewSession]
	if { $new=="" } return
	set protocol [lindex $new 0]
	set media    [lindex $new 1]
	set address  [lindex $new 2]
	$self add_session $protocol $media $address
}
PlayerUI/Main instproc new_stream { } {
	set dialog [[Application/Player instance] edit_stream_dialog]
	$dialog configure -protocol "" -media ""
	$dialog configure -datafile ""
	$dialog configure -indexfile ""
	set result [$dialog invoke]
	if { $result == "" } return
	$self add_stream [lindex $result 4] [lindex $result 0] \
			[lindex $result 1] [lindex $result 2] \
			[lindex $result 3]
}
PlayerUI/Main instproc add_stream { name datafile indexfile protocol media } {
	set session [$self get_session $protocol $media]
	if { $session!="" } {
		$session new_stream $name $datafile $indexfile
		$self subwidget session_list selection set -id $session
		$self browse_session_list $session
	}
}
PlayerUI/Main instproc start_tool { } {
	$self instvar menu_widget_
	$menu_widget_ start_tool
}
PlayerUI/Main instproc advanced_options { } {
	$self instvar advanced_
	$advanced_ tkvar {ttl_ dlg_ttl}
	$self instvar ttl_
	set dlg_ttl $ttl_
	if { [$advanced_ invoke] != "" } {
		set $ttl_ $dlg_ttl
	}
}
PlayerUI/Main instproc get_session { protocol media } {
	set list ""
	set session_list [$self subwidget session_list]
	foreach session_widget [$session_list info all] {
		set item_widget [$session_list info widget -id $session_widget]
		set value [$item_widget cget -value]
		set p [lindex $value 0]
		set m [lindex $value 1]
		if { $protocol==$p && $media==$m } {
			lappend list "$session_widget $item_widget"
		}
	}
	set len [llength $list]
	switch -exact -- $len {
		0 {
			return [$self add_session $protocol $media \
					224.8.8.1/8000]
		}
		1 {
			return [lindex [lindex $list 0] 0]
		}
		default {
			return [$self select_session $list]
		}
	}
}
PlayerUI/Main instproc select_session { list } {
	set dlg [PlayerUI/SelectSession .select_session]
	set listbox [$dlg subwidget listbox]
	foreach s $list {
		set session_widget [lindex $s 0]
		set item_widget [lindex $s 1]
		$listbox insert end "-id $session_widget \
				[$item_widget cget -value]"
		set new_item [$listbox info widget -id $session_widget]
		$new_item subwidget address configure -state disabled
	}
	$listbox selection set 0
	set result [$dlg invoke]
	destroy $dlg
	return $result
}
PlayerUI/Main instproc delete { } {
	$self instvar menu_widget_
	if { [$menu_widget_ info class] == "PlayerUI/SessionListItem" } {
		$self delete_session [$self subwidget session_list info id \
				-widget $menu_widget_]
	} else {
		[$self subwidget session_list selection get] delete_stream \
				$menu_widget_
	}
}
PlayerUI/Main instproc try_to_delete { x y } {
	set widget [$self find_widget $x $y]
	if { [$widget info class] == "PlayerUI/SessionListItem" } {
		$self delete_session [$self subwidget session_list info id \
				-widget $widget]
	} else {
		[$self subwidget session_list selection get] delete_stream \
				$widget
	}
}
PlayerUI/Main instproc try_to_delete___________ { x y } {
	set list [$self subwidget session_list]
	foreach session [$list info all] {
		set item_widget [$list info widget -id $session]
		if { [$self is_inside $item_widget $x $y] } {
			$self delete_session $session
			return
		}
	}
	set session [lindex [$list selection get] 0]
	if { $session!="" } {
		foreach stream [$session streams] {
			if { [$self is_inside $stream $x $y] } {
				$session delete_stream $stream
				return
			}
		}
	}
}
PlayerUI/Main instproc find_widget { x y } {
	set list [$self subwidget session_list]
	foreach session [$list info all] {
		set item_widget [$list info widget -id $session]
		if { [$self is_inside $item_widget $x $y] } {
			return $item_widget
		}
	}
	set session [lindex [$list selection get] 0]
	if { $session!="" } {
		foreach stream [$session streams] {
			if { [$self is_inside $stream $x $y] } {
				return $stream
			}
		}
	}
	return ""
}
PlayerUI/Main instproc is_inside { widget x y } {
	set geom [winfo geometry $widget]
	set geom [split $geom "+"]
	set geom_wh [split [lindex $geom 0] "x"]
	set geom_w  [lindex $geom_wh 0]
	set geom_h  [lindex $geom_wh 1]
	set geom_x [expr [winfo rootx $widget] - [winfo vrootx $widget]]
	set geom_y [expr [winfo rooty $widget] - [winfo vrooty $widget]]
	if { $x >= $geom_x && $y >= $geom_y && $x < [expr $geom_x + $geom_w] \
			&& $y < [expr $geom_y + $geom_h] } {
		return 1
	} else {
		return 0
	}
}
PlayerUI/Main instproc playback_ui { } {
	set list [$self subwidget session_list]
	foreach widget [$list info all] {
		set item_widget [$list info widget -id $widget]
		$item_widget no_modify
		$widget no_modify
	}
	foreach widget [pack slaves [$self subwidget buttons]] {
		destroy $widget
	}
	set path [$self info path]
	set menu [$self subwidget menu]
	$menu entryconfigure "New session" -state disabled
	$menu entryconfigure "New stream"  -state disabled
	scale $path.scale -orient horizontal -showvalue 0
	bind $path.scale <ButtonPress-1> "$self scale_start_move"
	bind $path.scale <ButtonRelease-1> "$self scale_stop_move"
	ImageTextButton $path.playpause -image VcrIcons(pause) -text "Pause" \
			-command "$self pause" \
			-options { { text.width 5 } }
	ImageTextButton $path.exit -image Icons(cross) -text "Exit" \
			-command "exit"
	pack $path.exit $path.playpause -side right -in $path.buttons
	pack $path.scale -side left -fill x -expand 1 -in $path.buttons \
			-padx 15
}
PlayerUI/Main instproc pause { } {
	set lts [[Application/Player instance] lts]
	$lts speed 0.0
	$self subwidget playpause configure -image VcrIcons(play) \
			-text "Play" -command "$self play"
	$self tkvar scale_
	if [info exists scale_(after_id)] {
		catch {after cancel $scale_(after_id)}
		unset scale_(after_id)
	}
}
PlayerUI/Main instproc play { } {
	set lts [[Application/Player instance] lts]
	$lts speed 1.0
	$self subwidget playpause configure -image VcrIcons(pause) \
			-text "Pause" -command "$self pause"
	$self tkvar scale_
	set scale_(after_id) [after 1000 "$self update_scale"]
}
PlayerUI/Main instproc scale_start_move { } {
	$self tkvar scale_
	set scale_(start_move) $scale_(current)
	set lts [[Application/Player instance] lts]
	set scale_(orig_speed) [$lts speed]
	$lts speed 0.0
	if { [info exists scale_(after_id)] } {
		catch {after cancel $scale_(after_id)}
		unset scale_(after_id)
	}
}
PlayerUI/Main instproc scale_stop_move { } {
	$self tkvar scale_
	set lts [[Application/Player instance] lts]
	if { $scale_(start_move) != $scale_(current) } {
		$lts now_logical $scale_(current)
	}
	$lts speed $scale_(orig_speed)	
	set scale_(after_id) [after 1000 "$self update_scale"]
	unset scale_(start_move) scale_(orig_speed)
}
PlayerUI/Main instproc catalog { } {
	set file_dialog [[Application/Player instance] file_dialog]
	$file_dialog subwidget filebox configure -filetypes {
		{ {Session catalog files} {.ctg} }
		{ {All files}  { * }  }
	}
	set result [$file_dialog invoke]
	if { $result=="" } {
		return
	}
	$self read_catalog $result
}
PlayerUI/Main instproc read_catalog { catalog_filename } {
	set catalog [new SessionCatalog]
	if { [catch {$catalog open $catalog_filename} error] } {
		$self invoke_error "Could not open catalog file:\n$error"
		delete $catalog
		return
	}
	if { [catch {$catalog read} error] } {
		$self invoke_error "Could not read catalog file:\n$error"
		delete $catalog
		return
	}
	set list [$self subwidget session_list]
	foreach session [$list info all] {
		$self delete_session $session
	}
	foreach id [$catalog info streams] {
		lappend sessions([$catalog info session $id]) $id
	}
	set file [new ArchiveFile]
	set addr_lobyte 1
	foreach s [array names sessions] {
		set address "224.8.8.$addr_lobyte/8000"
		set session_widget [$self add_session "" "" $address]
		set item_widget [$list info widget -id $session_widget]
		incr addr_lobyte
		set protocol ""
		set media ""
		foreach id $sessions($s) {
			set my_datafile  [$catalog info datafile $id]
			set my_indexfile [$catalog info indexfile $id]
			if [catch {$file open $my_datafile} error] {
				$self invoke_error "Error opening data\
						file:\n$error"
				delete $catalog
				delete $file
				return
			}
			if [catch {$file header data_hdr} error] {
				$self invoke_error "Error reading data\
						header:\n$error"
				delete $catalog
				delete $file
				return
			}
			$file close
			if [catch {$file open $my_indexfile} error] {
				$self invoke_error "Error opening index\
						file:\n$error"
				delete $catalog
				delete $file
				return
			}
			if [catch {$file header index_hdr} error] {
				$self invoke_error "Error reading data\
						header:\n$error"
				delete $catalog
				delete $file
				return
			}
			$file close
			if { $data_hdr(protocol)!=$index_hdr(protocol) } {
				$self invoke_error "Protocol fields do not\
						match in data and index files"
				delete $catalog
				delete $file
				return
			}
			if { $data_hdr(media)!=$index_hdr(media) } {
				$self invoke_error "Media fields do not\
						match in data and index files"
				delete $catalog
				delete $file
				return
			}
			if { $data_hdr(cname)!=$index_hdr(cname) } {
				$self invoke_error "cname fields do not\
						match in data and index files"
				delete $catalog
				delete $file
				return
			}
			if { $data_hdr(name)!=$index_hdr(name) } {
				$self invoke_error "Name fields do not\
						match in data and index files"
				delete $catalog
				delete $file
				return
			}
			$file close
			if { $protocol=="" } {
				set protocol $data_hdr(protocol)
				$item_widget configure -value \
						"[list $protocol] \
						[list $media] \
						[list $address]"
			}
			if { $media=="" } {
				set media $data_hdr(media)
				$item_widget configure -value \
						"[list $protocol] \
						[list $media] \
						[list $address]"
			}
			if { $protocol!=$data_hdr(protocol) } {
				$self invoke_error "Streams within the same\
						session seem to have different\
						protocols"
				delete $catalog
				delete $file
				return
			}
			if { $media!=$data_hdr(media) } {
				$self invoke_error "Streams within the same\
						session seem to have different\
						media"
				delete $catalog
				delete $file
				return
			}
			$session_widget new_stream $data_hdr(name) \
					$my_datafile $my_indexfile
		}
	}
	delete $catalog
	delete $file
}
PlayerUI/Main instproc invoke_error { error } {
	Dialog transient MessageBox -image Icons(warning) -text $error
}
PlayerUI/Main instproc config_scale { start end } {
	$self tkvar scale_
	set scale [$self subwidget scale]
	set scale_(start) $start
	set scale_(end) $end
	set scale_(current) $start
	$scale configure -from [expr int($start)] -to [expr int($end)] \
			-variable [$self tkvarname scale_(current)]
	$self tkvar scale_
	set scale_(after_id) [after 1000 "$self update_scale"]
}
PlayerUI/Main instproc update_scale { } {
	set lts [[Application/Player instance] lts]
	set now [$lts now_logical]
	$self tkvar scale_
	if { $now < $scale_(start) } {
		set now $scale_(start)
	}
	if { $now > $scale_(end) } {
		set now $scale_(end)
	}
	set scale_(current) $now
	$self tkvar scale_
	set scale_(after_id) [after 1000 "$self update_scale"]
}
WidgetClass PlayerUI/SessionListItem -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 1 }
	{ *font WidgetDefault }
	{ *LabeledWidget.label.font WidgetDefault(-boldfont) }
	{ .address.borderWidth 0 }
	{ .address.highlightThickness 0 }
	{ .address.width 18 }
}
PlayerUI/SessionListItem instproc build_widget { path } {
	$self instvar config_
	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
	label $path.protocol -anchor w
	label $path.media -anchor w
	entry $path.address -textvariable [$self tkvarname address_]
	pack $path.protocol $path.media -side left -anchor w
	pack $path.address -fill x -expand 1 -side left -anchor w
	set window [winfo parent $path]
	bind $path.address <KeyPress-Up> "focus $window; \
			event generate $window <KeyPress-Up>"
	bind $path.address <KeyPress-Down> "focus $window; \
			event generate $window <KeyPress-Down>"
}
PlayerUI/SessionListItem instproc config_value { option args } {
	$self tkvar address_
	if { [llength $args]==0 } {
		set protocol [$self subwidget protocol cget -text]
		set protocol [string range $protocol 0 \
				[expr [string length $protocol]-2]]
		set media    [$self subwidget media    cget -text]
		return "[list $protocol] [list $media] [list $address_]"
	} else {
		set value [lindex $args 0]
		$self subwidget protocol configure -text "[lindex $value 0]:"
		$self subwidget media    configure -text [lindex $value 1]
		set address_ [lindex $value 2]
	}
}
PlayerUI/SessionListItem 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
	}
}
PlayerUI/SessionListItem instproc config_background { value } {
	$self configure -bg $value
	$self subwidget protocol_label subwidget label configure -bg $value
	$self subwidget protocol configure -bg $value
	$self subwidget media_label subwidget label configure -bg $value
	$self subwidget media configure -bg $value
	$self subwidget address_label subwidget label configure -bg $value
	$self subwidget address configure -bg $value
}
PlayerUI/SessionListItem instproc config_foreground { value } {
	$self subwidget protocol_label subwidget label configure -fg $value
	$self subwidget protocol configure -fg $value
	$self subwidget media_label subwidget label configure -fg $value
	$self subwidget media configure -fg $value
	$self subwidget address_label subwidget label configure -fg $value
	$self subwidget address configure -fg $value
}
PlayerUI/SessionListItem instproc config_background { value } {
	$self configure -bg $value
	$self subwidget protocol configure -bg $value
	$self subwidget media configure -bg $value
	$self subwidget address configure -bg $value
}
PlayerUI/SessionListItem instproc config_foreground { value } {
	$self subwidget protocol configure -fg $value
	$self subwidget media configure -fg $value
	$self subwidget address configure -fg $value
}
PlayerUI/SessionListItem instproc config_relief { value } {
	$self configure -relief $value
}
PlayerUI/SessionListItem instproc config_normalbackground { value } {
	if { ![$self set config_(-select)] } {
		$self config_background $value
	}
}
PlayerUI/SessionListItem instproc config_normalforeground { value } {
	if { ![$self set config_(-select)] } {
		$self config_foreground $value
	}
}
PlayerUI/SessionListItem instproc config_normalrelief { value } {
	if { ![$self set config_(-select)] && \
			![$self set config_(-highlight)] } {
		$self config_relief $value
	}
}
PlayerUI/SessionListItem instproc config_selectbackground { value } {
	if { [$self set config_(-select)] } {
		$self config_background $value
	}
}
PlayerUI/SessionListItem instproc config_selectforeground { value } {
	if { [$self set config_(-select)] } {
		$self config_foreground $value
	}
}
PlayerUI/SessionListItem instproc config_selectrelief { value } {
	if { [$self set config_(-select)] && \
		![$self set config_(-highlight)] } {
		$self config_relief $value
	}
}
PlayerUI/SessionListItem instproc config_highlightrelief { value } {
	if { [$self set config_(-highlight)] } {
		$self config_relief $value
	}
}
PlayerUI/SessionListItem 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)
		}
	}
}
PlayerUI/SessionListItem 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)
		}
	}
}
PlayerUI/SessionListItem instproc no_modify { } {
	$self subwidget address configure -state disabled
}
PlayerUI/SessionListItem instproc start_tool { } {
	set value [$self cget -value]
	set media [lindex $value 1]
	set address [lindex $value 2]
	switch -exact -- $media {
		video {
			set argv "vic $address"
		}
		audio {
			set argv "vat -r $address"
		}
		mediaboard {
			set argv "mb -sa $address"
		}
	}
	if [info exists argv] {
		eval exec $argv &
	}
}
WidgetClass PlayerUI/Session -superclass { ScrolledWindow/Expand Observer } \
		-default {
	{ .scrollbar both }
	{ .bbox.width 250 }
	{ .scrollbar both }
	{ .borderWidth 1  }
	{ .relief sunken  }
	{ .bbox.highlightThickness 1 }
	{ .Scrollbar.borderWidth 1 }
	{ .Scrollbar.highlightThickness 1 }
	{ .Scrollbar.width 10 }
}
PlayerUI/Session instproc build_widget { path } {
	$self next $path
	$self set count_ 0
	$self set streams_ ""
}
PlayerUI/Session instproc new_stream { {name {}} {datafile {}} \
		{indexfile {}} } {
	$self instvar streams_ count_
	set widget [PlayerUI/Stream [$self subwidget window].stream_$count_]
	incr count_
	pack $widget -side top -fill x -expand 1 -anchor w -padx 1 -pady 1
	lappend streams_ $widget
	$widget attach_session [$self info path]
	$widget subwidget name configure -text $name
	$widget subwidget datafile  configure -text $datafile
	$widget subwidget indexfile configure -text $indexfile
	set main_ui [[Application/Player instance] main_ui]
	$main_ui subwidget startplay configure -state normal
}
PlayerUI/Session instproc delete_stream { stream_widget } {
	$self instvar streams_
	set idx [lsearch $streams_ $stream_widget]
	if { $idx==-1 } return
	set streams_ [lreplace $streams_ $idx $idx]
	destroy $stream_widget
	if { [llength $streams_] > 0 } return
	set main_ui [[Application/Player instance] main_ui]
	set no_stream 1
	foreach session [$main_ui subwidget session_list info all] {
		if { [llength [$session streams]] > 0 } {
			set no_stream 0
			break
		}
	}
	if { $no_stream } {
		$main_ui subwidget startplay configure -state disabled
	}
}
PlayerUI/Session instproc streams { } {
	return [$self set streams_]
}
PlayerUI/Session instproc no_modify { } {
	foreach stream [$self set streams_] {
		$stream no_modify
	}
}
PlayerUI/Session instproc attach_session { session } {
	$self instvar streams_
	set lts [[Application/Player instance] lts]
	foreach stream_widget $streams_ {
		set datafile  [$stream_widget subwidget datafile  cget -text]
		set indexfile [$stream_widget subwidget indexfile cget -text]
		set df [new ArchiveFile/Data]
		$df open $datafile
		set if [new ArchiveFile/Index]
		$if open $indexfile
		set stream [$session create_stream]
		$stream datafile  $df
		$stream indexfile $if
		$stream lts $lts
		$session attach_stream $stream
		$stream attach_observer $stream_widget
		$stream_widget attach_stream $stream
		$df header hdr
		[Application/Player instance] clip_time $hdr(start) $hdr(end)
	}
}
WidgetClass PlayerUI/NewSession -superclass Dialog -default {
	{ .transient . }
	{ *ImageTextButton.borderWidth 1 }
	{ *ImageTextButton.highlightThickness 1 }
	{ *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 }
	{ *font WidgetDefault }
	{ *LabeledWidget.label.font WidgetDefault(-boldfont) }
}
PlayerUI/NewSession instproc build_widget { path } {
	$self instvar protocols_
	set protocols_(mediaboard) SRM
	set protocols_(video)      RTP
	set protocols_(audio)      RTP
	frame $path.buttons
	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
	ImageTextButton $path.ok -image Icons(check) -text OK \
			-command "$self ok"
	ImageTextButton $path.cancel -image Icons(cross) -text Cancel \
			-command "$self cancel"
	pack $path.ok $path.cancel -side left -in $path.buttons -padx 5
	pack $path.buttons -side bottom -pady 3
	pack $path.protocol_label -fill x -side top -padx 3 -pady 2
	pack $path.media_label    -fill x -side top -padx 3
	pack $path.address_label  -fill x -side top -padx 3 -pady 2
	bind $path <KeyPress-Return> "$path.ok invoke_with_ui"
	bind $path <KeyPress-Escape> "$path.cancel invoke_with_ui"
	wm resizable $path 1 0
	$self tkvar addr_ media_
	trace variable media_ w "$self media_changed_"
	set addr_ "224.2.55.66/8001"
	set media_ "mediaboard"
}
PlayerUI/NewSession instproc ok { } {
	$self tkvar protocol_ media_ addr_
	if { ![address_check $addr_] } {
		Dialog transient MessageBox -image Icons(warning) \
				-text "Invalid session address"
		return
	}
	$self configure -result "[list $protocol_] [list $media_]\
			[list $addr_]"
}
PlayerUI/NewSession 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 PlayerUI/Stream -superclass Observer -configspec {
	{ -minimized minimized Minimized 0 config_minimized }
} -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(-boldfont) }
	{ *datafile.font WidgetDefault }
	{ *indexfile.font WidgetDefault }
}
PlayerUI/Stream instproc build_widget { path } {
	frame $path.name_frame
	frame $path.data_frame
	frame $path.index_frame
	button $path.minimize -command "\
			if \{ \[$self cget -minimized\] \} \{ \
			$self configure -minimized 0 \} else \{ \
			$self configure -minimized 1 \}"
	button $path.browse -image VcrIcons(browse_small) \
			-command "$self browse_file"
	label $path.name -anchor w
	pack $path.browse -side left -fill y \
			-in $path.name_frame
	label $path.data_label -text "   Data file:"
	label $path.datafile -anchor w
	label $path.index_label -text "   Index file:"
	label $path.indexfile -anchor w
	pack $path.minimize $path.browse -side left -fill y \
			-in $path.name_frame
	pack $path.name -side left -fill both -expand 1 -in $path.name_frame
	pack $path.data_label  -side left -fill y -in $path.data_frame
	pack $path.datafile -side left -fill both -expand 1 \
			-in $path.data_frame
	pack $path.index_label  -side left -fill y -in $path.index_frame
	pack $path.indexfile -side left -fill both -expand 1 \
			-in $path.index_frame
	pack $path.name_frame  -fill x
	pack $path.data_frame  -fill x -expand 1	
	pack $path.index_frame -fill x -expand 1	
}
PlayerUI/Stream instproc config_minimized { option args } {
	set path [$self info path]
	if { [llength $args]==0 } {
		if { [lsearch [pack slaves $path] $path.data_frame] != -1 } {
			return 0
		} else {
			return 1
		}
	} else {
		set value [lindex $args 0]
		if { $value } {
			catch {
				pack forget $path.data_frame
				pack forget $path.index_frame
			}
			$path.minimize configure -image Icons(maximize)
		} else {
			if { [lsearch [pack slaves $path] \
					$path.data_frame] == -1 } {
				pack $path.data_frame -fill x -expand 1
			}
			if { [lsearch [pack slaves $path] \
					$path.index_frame] == -1 } {
				pack $path.index_frame -fill x -expand 1
			}
			$path.minimize configure -image Icons(minimize)
		}
	}
}
PlayerUI/Stream instproc attach_session { session_widget } {
	$self set session_widget_ $session_widget
}
PlayerUI/Stream instproc browse_file { } {
	$self instvar session_widget_
	set dialog [[Application/Player instance] edit_stream_dialog]
	set item_widget [[[Application/Player instance] main_ui] subwidget \
			session_list info widget -id $session_widget_]
	set value [$item_widget cget -value]
	$dialog configure -protocol [lindex $value 0] -media [lindex $value 1]
	$dialog configure -datafile  [$self subwidget datafile  cget -text]
	$dialog configure -indexfile [$self subwidget indexfile cget -text]
	set result [$dialog invoke]
	if { $result != "" } {
		$self subwidget datafile  configure -text [lindex $result 0]
		$self subwidget indexfile configure -text [lindex $result 1]
		$self subwidget name configure -text [lindex $result 4]
	}
}
PlayerUI/Stream instproc no_modify { } {
	set path [$self info path]
	destroy $path.browse
	label $path.blink -image VcrIcons(redbullet)
	pack $path.blink -side left -in $path.name_frame -before $path.name \
			-padx 3
}
PlayerUI/Stream instproc attach_stream { stream } {
}
PlayerUI/Stream instproc bytes_sent { bytes } {
	$self instvar after_id_
	if { [info exists after_id_] } {
		after cancel $after_id_
	} else {
		$self subwidget blink configure -image VcrIcons(greenbullet)
	}
	set after_id_ [after 250 "$self bytes_sent_done"]
}
PlayerUI/Stream instproc bytes_sent_done { } {
	$self instvar after_id_
	$self subwidget blink configure -image VcrIcons(redbullet)
	unset after_id_
}
WidgetClass PlayerUI/EditStream -superclass FileDialog/Archive -default {
	{ *Radiobutton.borderWidth 1 }
	{ *Radiobutton.highlightThickness 1 }
	{ *clear_datafile.borderWidth 1 }
	{ *clear_datafile.highlightThickness 1 }
	{ *clear_indexfile.borderWidth 1 }
	{ *clear_indexfile.highlightThickness 1 }
	{ *Radiobutton.font WidgetDefault(-boldfont) }
	{ *LabeledWidget.label.font WidgetDefault(-boldfont) }
} -configspec {
	{ -type type Type {} ignore }
	{ -datafile dataFile DataFile {} config_file cget_file }
	{ -indexfile indexFile IndexFile {} config_file cget_file }
	{ -protocol protocol Protocol {} config_option }
	{ -media media Media {} config_option }
}
PlayerUI/EditStream instproc build_widget { path } {
	$self set archive_file_ [new ArchiveFile]
	frame $path.data_index
	frame $path.frame1 -bd 1 -relief sunken
	frame $path.frame2 -bd 1 -relief sunken
	frame $path.dframe
	frame $path.iframe
	label $path.protocol -anchor w
	LabeledWidget $path.protocol_label -label "Protocol:" \
			-widget $path.protocol
	label $path.media -anchor w
	LabeledWidget $path.media_label -label "    Media:" -widget $path.media
	label $path.name -anchor w
	LabeledWidget $path.name_label -label "    Name:" -widget $path.name
	radiobutton $path.datafile -text "Data file: " \
			-value datafile -anchor w \
			-variable [$self tkvarname data_index_]
	radiobutton $path.indexfile -text "Index file: " \
			-value indexfile -anchor w \
			-variable [$self tkvarname data_index_]
	button $path.clear_datafile  -text "Clear" -padx 1 -pady 0 \
			-command "$self configure -datafile {}"
	button $path.clear_indexfile -text "Clear" -padx 1 -pady 0 \
			-command "$self configure -indexfile {}"
	$self next $path
	pack $path.clear_datafile -side right -fill y -in $path.dframe
	pack $path.datafile -side left -fill both -expand 1 -in $path.dframe
	pack $path.clear_indexfile -side right -fill y -in $path.iframe
	pack $path.indexfile -side right -fill both -expand 1 -in $path.iframe
	pack $path.protocol_label $path.media_label -side left -anchor w \
			-in $path.frame2
	pack $path.name_label -side left -fill x -anchor w -in $path.frame2
	pack $path.dframe $path.iframe -fill both -expand 1 -in $path.frame1
	pack $path.frame1 $path.frame2 -fill both -expand 1 -side top \
			-in $path.data_index -padx 3 -pady 2
	pack $path.data_index -fill x -side top -before $path.frame
	$self tkvar data_index_
	trace variable data_index_ w "$self data_index_; $self ignore_args"
	$self subwidget ok configure -text "OK" \
			-command "$self set done_ ok; $self configure \
			-result {}"
	set data_index_ datafile
}
PlayerUI/EditStream instproc destroy { } {
	$self instvar archive_file_
	delete $archive_file_
	$self next
}
PlayerUI/EditStream instproc ignore { args } {
}
PlayerUI/EditStream instproc config_file { option value } {
	set widget [$self subwidget [string range [string trim $option] \
			1 end]]
	set text [$widget cget -text]
	set index [string first ":" $text]
	incr index
	set text "[string range $text 0 $index]$value"
	$widget configure -text $text
	if { $option=="-datafile" } {
		$self read_header_ $value
	}
}
PlayerUI/EditStream instproc cget_file { option } {
    set widget [$self subwidget [string range [string trim $option] 1 end]]
    set text [$widget cget -text]
    set index [string first ":" $text]
    incr index 2
    return [string range $text $index end]
}
PlayerUI/EditStream instproc config_option { option args } {
	$self instvar config_
	if { [llength $args]==0 } {
		return $config_($option)
	} else {
		set config_($option) [string trim [lindex $args 0]]
	}
}
PlayerUI/EditStream instproc data_index_ { } {
	$self tkvar data_index_
	switch -exact -- $data_index_ {
		datafile {
			set filebox [$self subwidget filebox]
			$filebox subwidget filename_label configure \
					-text "Data file:" -under -1
			$filebox configure -filetypes {
				{ { Data files } { .dat } }
				{ { All files }  { * } }
			}
			set datafile [string trim [$self cget -datafile]]
			if { $datafile != "" } {
				set dir  [file dirname $datafile]
				set file [file tail $datafile]
				$filebox configure -directory $dir
				$filebox configure -filename $file
			}
		}
		indexfile {
			set filebox [$self subwidget filebox]
			$filebox subwidget filename_label configure \
					-text "Index file:" -under -1
			$filebox configure -filetypes {
				{ { Index files } { .idx } }
				{ { All files }  { * } }
			}
			set indexfile [string trim [$self cget -indexfile]]
			if { $indexfile != "" } {
				set dir  [file dirname $indexfile]
				set file [file tail $indexfile]
				$filebox configure -directory $dir
				$filebox configure -filename $file
			}
		}
	}
}
PlayerUI/EditStream instproc invoke { {start_focus {}} } {
	set path [$self info path]
	$self center
	$self grab $start_focus
	$self instvar done_
	$self tkvar data_index_
	while { 1 } {
		set done_ ""
		set result [$self wait]
		if { $result=="" } {
			if { $done_!="" && ![$self check_files_] } {
				continue
			} else {
				break
			}
		}
		$self configure -$data_index_ $result
	}
	$self release
	wm withdraw $path
	$self invoke_closecmd
	if { $done_=="" } {
		return ""
	} else {
		set datafile  [string trim [$self cget -datafile]]
		set indexfile [string trim [$self cget -indexfile]]
		set protocol  [string trim [$path.protocol cget -text]]
		set media     [string trim [$path.media cget -text]]
		set name      [string trim [$path.name cget -text]]
		return "[list $datafile] [list $indexfile] [list $protocol]\
				[list $media] [list $name]"
	}
}
PlayerUI/EditStream instproc read_header_ { datafile } {
	$self instvar archive_file_
	if { ![catch {
		$archive_file_ open $datafile
		$archive_file_ header hdr
	} ] } {
		if { [string match "MDAT*" $hdr(version)] } {
			$self subwidget protocol configure -text $hdr(protocol)
			$self subwidget media configure -text $hdr(media)
			$self subwidget name configure -text $hdr(name)
		}
	} else {
		$self subwidget protocol configure -text ""
		$self subwidget media configure -text ""
		$self subwidget name configure -text ""
	}
	catch {$archive_file_ close}
}
PlayerUI/EditStream instproc check_files_ { } {
	set datafile  [string trim [$self cget -datafile]]
	set indexfile [string trim [$self cget -indexfile]]
	if { $datafile=="" || $indexfile=="" } {
		Dialog transient MessageBox -image Icons(warning) \
				-text "Must specify both data and index files"
		return 0
	}
	if { $datafile!="" && ![$self check_file_ DAT "a data file" \
			$datafile  datahdr] } { return 0 }
	if { $indexfile!="" && ![$self check_file_ IDX "an index file" \
			$indexfile indexhdr] } { return 0 }
	catch {
		if { $datahdr(protocol) != $indexhdr(protocol) || \
				$datahdr(media) != $indexhdr(media) || \
				$datahdr(cname) != $indexhdr(cname) || \
				$datahdr(name)  != $indexhdr(name) } {
			set result [Dialog transient MessageBox \
					-image Icons(warning)\
					-text "The data and index files you\
					have selected seem to differ in one or\
					more of their protocol, media, cname\
					and name fields.\n\
					\nDo you wish to continue?" \
					-type yesno -defaultfocus no]
			if { $result=="no" } { return 0 }
		}
	}
	return 1
}
PlayerUI/EditStream instproc check_file_ { type error_string name hdr_var } {
	upvar $hdr_var hdr
	$self instvar archive_file_
	if { [catch {
		$archive_file_ open $name
		$archive_file_ header hdr
	} error] } {
		catch {$archive_file_ close}
		set result [Dialog transient MessageBox -image Icons(warning)\
				-text "Error reading file: $name\n$error\n\
				\nDo you wish to continue?" \
				-type yesno -defaultfocus no]
		if { $result=="no" } { return 0 } else { return 1 }
	}
	catch {$archive_file_ close}
	if { ![string match "M${type}*" $hdr(version)] } {
		set result [Dialog transient MessageBox -image Icons(warning)\
				-text "File \"$name\" may not be\
				$error_string\n\nDo you wish to continue?" \
				-type yesno -defaultfocus no]
		if { $result=="no" } { return 0 } else { return 1 }
	}
	set protocol [$self cget -protocol]
	set media [$self cget -media]
	if { $protocol!="" && $protocol!=$hdr(protocol) } {
		set result [Dialog transient MessageBox -image Icons(warning)\
				-text "File \"$name\" uses incorrect protocol\
				\"$hdr(protocol)\". Must be \"$protocol\".\n\
				\nDo you wish to continue?" \
				-type yesno -defaultfocus no]
		if { $result=="no" } { return 0 } else { return 1 }
	}
	if { $media!="" && $media!=$hdr(media) } {
		set result [Dialog transient MessageBox -image Icons(warning)\
				-text "File \"$name\" has incorrect media type\
				\"$hdr(media)\". Must be \"$media\".\n\
				\nDo you wish to continue?" \
				-type yesno -defaultfocus no]
		if { $result=="no" } { return 0 } else { return 1 }
	}
	return 1
}
WidgetClass PlayerUI/SelectSession -superclass Dialog -default {
	{ .listbox.bbox.width  250 }
	{ .listbox.bbox.height 70  }
	{ .listbox.scrollbar both }
	{ .listbox.scrollbar both }
	{ .listbox.borderWidth 1  }
	{ .listbox.relief sunken  }
	{ .listbox.bbox.highlightThickness 1 }
	{ .listbox.Scrollbar.borderWidth 1 }
	{ .listbox.Scrollbar.highlightThickness 1 }
	{ .listbox.Scrollbar.width 10 }
	{ *ImageTextButton.borderWidth 1 }
	{ *ImageTextButton.highlightThickness 1 }
	{ *font WidgetDefault }
	{ .transient . }
}
PlayerUI/SelectSession instproc build_widget { path } {
	label $path.label -text "The stream you've chose can be inserted into\
			\nmultiple sessions. Choose one of the\
			following:" -anchor w -justify left
	ScrolledListbox $path.listbox -itemclass PlayerUI/SessionListItem \
			-browsecmd "$self list_browse" \
			-command "$self list_invoke; $self ignore_args"
	frame $path.buttons
	ImageTextButton $path.select -image Icons(check) -text "Select" \
			-command "$self list_invoke"
	ImageTextButton $path.cancel -image Icons(cross) -text "Cancel" \
			-command "$self cancel"
	pack $path.label -fill x -side top -anchor w
	pack $path.select $path.cancel -anchor e -side left -in $path.buttons \
			-padx 3 -pady 2
	pack $path.buttons -anchor e -side bottom
	pack $path.listbox -fill both -expand 1 -side top -padx 3
}
PlayerUI/SelectSession instproc list_browse { widget } {
	set listbox [$self subwidget listbox]
	if { [llength [$listbox selection get]]==0 } {
		$listbox selection set -id $widget
	}
}
PlayerUI/SelectSession instproc list_invoke { } {
	set session [$self subwidget listbox selection get]
	$self configure -result $session
}
WidgetClass PlayerUI/Advanced -superclass Dialog -default {
	{ .title "Advanced Options" }
	{ .Entry.width 5 }
	{ .Entry.borderWidth 1 }
	{ .Entry.highlightThickness 1 }
	{ .ImageTextButton.borderWidth 1 }
	{ .ImageTextButton.highlightThickness 1 }
}
PlayerUI/Advanced instproc build_widget { path } {
	entry $path.ttl -textvariable [$self tkvarname ttl_]
	LabeledWidget $path.ttl_label -label "Time-to-live" -widget $path.ttl
	frame $path.buttons
	ImageTextButton $path.ok -text "Ok" -image Icons(check) \
			-command "$self configure -result ok"
	ImageTextButton $path.cancel -text "Cancel" -image Icons(cross) \
			-command "$self cancel"
	pack $path.ok $path.cancel -side left -anchor e -in $path.buttons \
			-padx 3 -pady 2
	pack $path.buttons -side bottom -anchor e -padx 2
	pack $path.ttl_label -fill both -expand 1 -padx 5 -pady 2
}
Class RTPApplication -superclass Application
RTPApplication instproc init name {
	$self next $name
}
RTPApplication instproc 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_heursitic]
	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 } {
	$self instvar name_
	if { $argv == "" } {
		if { [$self get_option megaSession] == "" } {
			$self fatal "destination address required"
		}
	} elseif { [llength $argv] > 1 } {
		set extra [lindex $argv 0]
		$self fatal "extra arguments (starting with $extra)"
	}
	return $argv
}
Class AddressBlock -configuration { defaultTTL 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 {
	return [$self set addr_($k)]
}
AddressBlock instproc sport k {
	return [$self set sport_($k)]
}
AddressBlock instproc rport k {
	return [$self set rport_($k)]
}
AddressBlock instproc ttl k {
	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 != "" } {
		$self add_option defaultFormat $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]
}
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 {
	$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]
	$self instvar session_
	set i 0
	while { $i <= $n } {
		$net_($i) enable
		incr i
	}
	while { $i < $nchan_ } {
		$net_($i) disable
		incr i
	}
}
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_
	set active_ 0
	$dn_ drop-membership
	$cn_ drop-membership
}
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 {} {
	$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
		$session_ data-net "" $channel_
		$session_ ctrl-net "" $channel_
	}
}
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_
	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_]
		incr nchan_
	}
	$net_(0) enable
	$self set-subscription-level [expr $nchan_ - 1]
}
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 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
	if { [$sm info vars network_] != "" } {
		set net [$sm set network_]
		set n [$net set nchan_]
	} else {
		set n [SourceLayer/RTP set nchan_]
	}
	while { $k < $n } {
		set l [new SourceLayer/RTP]
		lappend layers_ $l
		$self layer $k $l
		incr k
	}
}
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 {} \
		"\$self instvar sm_ ; \$sm_ $method \$self"
	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
RTPAgent public init ab {
	$self next
	$self instvar session_ mtu_
	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 [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.]
	catch {[Application instance] reset $ab}
}
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/RTPPlay instproc init {} {
	$self next
}
Class RTPPlayAgent -superclass RTPAgent
RTPPlayAgent instproc init { session addr } {
	$self set options_ [new Configuration]
	$self add_default defaultTTL 1
	set ab [new AddressBlock $addr]
	$self next $ab
	$self instvar archive_session_
	$self instvar bufferPool_
	set archive_session_ $session
	set media [$session media]
	set Media_ [string toupper [string index $media 0]][string range \
                        $media 1 end]
	set bufferPool_ [new BufferPool/RTP] 
}
RTPPlayAgent instproc destroy {} {
	$self instvar bufferPool_
	delete $bufferPool_
	$self next
}
RTPPlayAgent instproc buffer_pool {} {
	$self instvar bufferPool_
	return $bufferPool_
}
RTPPlayAgent instproc get_session {} {
	$self instvar session_
	return $session_
}
RTPPlayAgent public reset ab {
	$self instvar network_ session_ sources_
	if [info exists network_] {	
		delete $network_
	}
	set network_ [new NetworkManager $ab $session_ $self]
	$self app_loopback 0
	$self net_loopback 1
	set key [$self get_option sessionKey]
	if { $key != "" } {
		$network_ install-key $key
	}
	$session_ max-bandwidth [expr [$ab set maxbw_(0)]/1000.]
	catch {[Application instance] reset $ab}
}
RTPPlayAgent instproc mk_local_source {ssrc ccname rtpName rtpEmail} {
	$self instvar network_ session_ local_
	set net [$network_ data-net 0]
	set srcid $ssrc
	set src [$self create-local $srcid [$net interface]]
	set local_ $src
	$self notify_observers register $local_
	set cname $ccname
	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 $rtpName
	$src sdes email $rtpEmail
	$src sdes cname $cname
	set tool [$self get_option appname]\-[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
}
RTPPlayAgent instproc create_session {} {
	$self instvar Media_
	$self instvar session_
	set session_ [new Session/RTP/Play]
	if { $session_ == "" } {
		$self fatal "creation of Session/RTP/Play failed!"
	}
	$self app_loopback 0
	$self set-bandwidth 1024
	return $session_
}
RTPPlayAgent instproc activate src {
	$self instvar decoders_
	set h [new Module/RTPPlay]  
	lappend decoders_ $h
	$src data-handler $h
	$self next $src
}
RTPPlayAgent instproc deactivate src {
	$self instvar decoders_
	set d [$src handler]
	set k [lsearch -exact $decoders_ $d]
	set decoders_ [lreplace $decoders_ $k $k]
	$self next $src
	delete $d
}
Class ArchiveSession/Play -superclass Observable
set classes [ArchiveStream info superclass]
set objectIdx [lsearch $classes Observable]
if { $objectIdx == -1 } {
	ArchiveStream superclass [concat Observable $classes]
}
ArchiveSession/Play instproc media { args } {
	switch -exact -- [llength $args] {
		0 {
			if [info exists media_] {
				return $media_
			} else {
				return ""
			}
		}
		1 {
			$self set media_ [lindex $args 0]
			return
		}
		default {
			error "too many arguments"
		}
	}
}
Class RTPApplication/Player -superclass RTPApplication
RTPApplication/Player instproc init {media} {
	$self next player
	$self add_option sessionType rtpv2
	$self add_option defaultTTL 15
	$self add_option cname Archive
}
Class ArchiveSession/Play/RTP -superclass ArchiveSession/Play
ArchiveSession/Play/RTP instproc init { media addr} {
	$self next
	$self instvar media_
	$self instvar agent_
	$self instvar stream_num_
	$self instvar vcn_ vdn_
	set stream_num_ 0
	$self set media_ $media
	puts "Pre-agent"
	$self set agent_ [new RTPPlayAgent $self $addr]
	puts "Agent: $agent_"
}
ArchiveSession/Play/RTP instproc destroy {} {
	$self instvar agent_
	$self instvar stream_list_
	puts "ArchiveSession/Play/RTP destroy"
	foreach stream $stream_list_ {
		delete $stream
	}
	delete $agent_
	$self next
}
ArchiveSession/Play/RTP instproc media {} {
	$self instvar media_
	return $media_
}
ArchiveSession/Play/RTP instproc attach_stream { stream } {
	$self instvar vdn_ vcn_
	$self instvar agent_
	$self instvar stream_list_
	set session [$agent_ get_session]
	$stream attach_agent $session
	$stream buffer_pool [$agent_ buffer_pool]
	$stream header_info hdr
	lappend stream_list_ $stream
	if {[string first "Recorded Source" $hdr(name)] == -1} {
		set hdr(name) "Recorded Source:$hdr(name)" }
	set src [$agent_ mk_local_source $hdr(ssrc) $hdr(cname) $hdr(name) $hdr(email)]
}
ArchiveSession/Play/RTP instproc create_stream { } {
	return [new ArchiveStream/Play/RTP]
}
ArchiveSession/Play/RTP instproc stream_done { stream } {
}
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/Play/Mediaboard \
		-superclass {ArchiveSession/Play MB_Manager/Play}
Class ArchiveSession/Play/SRM -superclass ArchiveSession/Play/Mediaboard
ArchiveSession/Play/Mediaboard instproc init { media addr } {
	$self next
        ArchiveSession/Play/Mediaboard instvar count_
	if ![info exists count_] {
		set count_ 1
	}
	$self set stream_list_ ""
	$self create_session $addr
	$self media $media
}
ArchiveSession/Play/Mediaboard instproc destroy {} {
	$self instvar agent_ stream_list_
	foreach stream $stream_list_ {
		delete $stream
	}
	delete $agent_
	$self next
}
ArchiveSession/Play/Mediaboard instproc create_session { addr \
		{src_update_handler {}} } {
	$self instvar session_ agent_
        set agent_ [new SRMAgent]
	set session_ [$agent_ create-session $self $src_update_handler]
	$agent_ set default_local_ ""
	$self reset $addr
	$self attach_session $session_
}
ArchiveSession/Play/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/Play/Mediaboard instproc srm_session { } {
	return [$self set session_]
}
ArchiveSession/Play/Mediaboard instproc srm_source_mgr { } {
	return [$self set agent_]
}
ArchiveSession/Play/Mediaboard instproc source_id { original uidVar addrVar } {
	upvar $uidVar uid $addrVar addr
	$self instvar agent_
	ArchiveSession/Play/Mediaboard instvar count_
	set uid 0x[$agent_ default-local-uid]
	puts "uid: $uid count: $count_"
	set uid [expr ($uid << 16) | $count_]
	set uid [format "%x" $uid]
	incr count_
	puts "uid: $uid count: $count_"
	set addr {}
}
ArchiveSession/Play/Mediaboard instproc attach_stream { stream } {
	set datafile [$stream datafile]
	if { $datafile=={} } {
		error "no data file associated with stream"
	}
	$datafile header hdr
	$self instvar stream_list_
	lappend stream_list_ $stream
	$self source_id $hdr(cname) uid addr
	$self create_srm_source $stream $uid $addr "Recorded stream: $hdr(name)"
}
ArchiveSession/Play/Mediaboard instproc create_stream { } {
	return [new ArchiveStream/Play/Mediaboard]
}
Class Application/Player -superclass Application
Application/Player instproc init { } {
	$self next player
	set options_ [$self options]
	$self init_resources $options_
	$class set instance_ $self
	wm withdraw .
	$self set file_dialog_ [FileDialog/Archive .file_dialog \
			-transient . ]
	$self set edit_stream_dialog_ [PlayerUI/EditStream .edit_stream_dialog\
			-transient . ]
	$self set main_ui_ [PlayerUI/Main .player_ui \
			-closecmd "delete $self; exit"]
}
Application/Player 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/Player instproc destroy { } {
	$self instvar file_dialog_ main_ui_
	if [info exists file_dialog_] { destroy $file_dialog_ }
	if [info exists main_ui_] { destroy $main_ui_ }
}
Application/Player proc instance { } {
	return [$self set instance_]
}
Application/Player instproc file_dialog { } {
	return [$self set file_dialog_]
}
Application/Player instproc edit_stream_dialog { } {
	return [$self set edit_stream_dialog_]
}
Application/Player instproc lts { } {
	return [$self set lts_]
}
Application/Player instproc main_ui { } {
	return [$self set main_ui_]
}
Application/Player instproc parse_args { argv } {
	$self instvar no_input_ main_ui_
	set no_input_ 0
	set len [llength $argv]
	set idx 0
	while { $idx < $len } {
		set option [lindex $argv $idx]
		incr idx
		switch -exact -- $option {
			-catalog {
				if { $idx >= $len } {
					error "missing argument for\
							-catalog"
				}
				$main_ui_ read_catalog \
						[lindex $argv $idx]
				incr idx
			}
			-addsession {
				if { $idx >= $len } {
					error "missing argument for\
							-addsession"
				}
				set arg [lindex $argv $idx]
				if { [llength $arg] != 3 } {
					error "invalid argument to\
							-addsession: $arg.\
							must be	\"<protocol>\
							<media> <addr>\""
				}
				$main_ui_ add_session [lindex $arg 0] \
						[lindex $arg 1] [lindex $arg 2]
				incr idx
			}
			-addstream {
				if { $idx >= $len } {
					error "missing argument for\
							-addstream"
				}
				set arg [lindex $argv $idx]
				if { [llength $arg] != 2 } {
					error "invalid argument to\
							-addstream: $arg.\
							must be	\"<datafile>\
							<indexfile>\""
				}
				eval [list $self] add_stream $arg
				incr idx
			}
			-noinput {
				set no_input_ 1
			}
			default {
				$self usage
			}
		}
	}	
}
Application/Player instproc add_stream { datafile indexfile } {
	set file [new ArchiveFile]
	if [catch {$file open $datafile} error] {
		error "Error opening data file:\n$error"
	}
	if [catch {$file header data_hdr} error] {
		error "Error reading data header:\n$error"
	}
	$file close
	if [catch {$file open $indexfile} error] {
		error "Error opening index file:\n$error"
	}
	if [catch {$file header index_hdr} error] {
		error "Error reading data header:\n$error"
	}
	$file close
	if { $data_hdr(protocol)!=$index_hdr(protocol) } {
		error "Protocol fields do not match in data and index files"
	}
	if { $data_hdr(media)!=$index_hdr(media) } {
		error "Media fields do not match in data and index files"
	}
	if { $data_hdr(cname)!=$index_hdr(cname) } {
		error "cname fields do not match in data and index files"
	}
	if { $data_hdr(name)!=$index_hdr(name) } {
		error "Name fields do not match in data and index files"
	}
	delete $file
	$self instvar main_ui_
	$main_ui_ add_stream $data_hdr(name) $datafile $indexfile \
			$data_hdr(protocol) $data_hdr(media)
}
Application/Player instproc usage { } {
	puts "\n The MASH Archive System: Player"
	puts   "-----------------------------------"
	puts "Usage: player \[options\]"
	puts "\t-catalog <file>: read session information from session catalog"
	puts "\t                    (this flag erases any previous sessions"
	puts "\t                    added using -addsession/-addstream)"
	puts "\t-addsession \"<protocol> <media> <address>\": add this session"
	puts "\t                                       to the play 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-addstream \"<datafile> <indexfile>\": add this stream to the"
	puts "\t                                       play list"
	puts "\t-noinput: do not pop up the initial input dialog\n"
	exit
}
Application/Player instproc run { } {
	$self instvar main_ui_ no_input_
	$main_ui_ center
	if { ! $no_input_ } {
		tkwait variable [$main_ui_ tkvarname input_done_]
	}
	$self start_play
	return 1
}
Application/Player instproc start_play { } {
	$self instvar main_ui_ start_ end_ lts_
	set start_ 0
	set end_ 0
	$main_ui_ playback_ui
	set list [$main_ui_ subwidget session_list]
	set lts_ [new LTS]
	set ttl  [$main_ui_ set ttl_]
	foreach session_widget [$list info all] {
		set item_widget [$list info widget -id $session_widget]
		set value [$item_widget cget -value]
		set protocol [string trim [lindex $value 0]]
		set media    [string trim [lindex $value 1]]
		set address  "[string trim [lindex $value 2]]/none/$ttl"
		set session [new ArchiveSession/Play/$protocol $media \
				$address]
		$session attach_observer $session_widget
		$session_widget attach_session $session
	}
	$main_ui_ config_scale $start_ $end_
	$lts_ now_logical $start_
	$lts_ speed 1.0
}
Application/Player instproc clip_time { start end } {
	$self instvar start_ end_
	if { $start_==0 || $start < $start_ } {
		set start_ $start
	}
	if { $end_==0 || $end > $end_ } {
		set end_ $end
	}
}
set app [new Application/Player]
$app parse_args $argv
if ![$app run] {
	delete $app
}
