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

# head.tcl --
#
#       This header is added to the beginning of all mash-based tools.
#
# Copyright (c) 1993-2002 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:
#
# A. Redistributions of source code must retain the above copyright notice,
#    this list of conditions and the following disclaimer.
# B. 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.
# C. Neither the names of the copyright holders nor the names of its
#    contributors may be used to endorse or promote products derived from this
#    software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS 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/mash/src/repository/mash/mash-1/head.tcl,v 1.9 2002/02/03 04:41:06 lim Exp $

proc havefont { f } { return 1 }
Import enable
Class Log
Log proc name s {
	Log set name_ $s
}
Log proc warn s {
	Log instvar name_
	if [info exists name_] {
		set name $name_
	} else {
		global argv0
		if [info exists argv0] {
			set name [file tail $argv0]
		} else {
			set name mash
		}
	}
	puts stderr "$name_: $s"
}
Log proc fatal s {
	Log warn $s
	exit 1
}
Class Application
Application public init name {
	$self next
	$self instvar name_ class_
	set name_ $name
	$self add_option appname $name
	Log set name_ $name
	set class_ [string toupper [string index $name_ 0]][string \
		range $name_ 1 end]
	catch "tk appname $name"
	Application set instance_ $self
}
Application proc instance {} {
	return [Application set instance_]
}
Application proc name {} {
	return [[Application instance] set name_]
}
Application proc class {} {
	return [[Application instance] set class_]
}
Application proc toplevel w {
	Application instvar visual_ colormap_
	if [info exists visual_] {
		toplevel $w -class [Application class] \
			-visual $visual_ -colormap $colormap_
	} else {
		toplevel $w -class [Application class]
	}
}
global font
set font(helvetica10) {
	normal--*-100-75-75-*-*-*-*
	normal--10-*-*-*-*-*-*-*
	normal--11-*-*-*-*-*-*-*
	normal--*-100-*-*-*-*-*-*
	normal--*-*-*-*-*-*-*-*
}
set font(helvetica12) {
	normal--*-120-75-75-*-*-*-*
	normal--12-*-*-*-*-*-*-*
	normal--14-*-*-*-*-*-*-*
	normal--*-120-*-*-*-*-*-*
	normal--*-*-*-*-*-*-*-*
}
set font(helvetica14) {
	normal--*-140-75-75-*-*-*-*
	normal--14-*-*-*-*-*-*-*
	normal--*-140-*-*-*-*-*-*
	normal--*-*-*-*-*-*-*-*
}
set font(times14) {
	normal--*-140-75-75-*-*-*-*
	normal--14-*-*-*-*-*-*-*
	normal--*-140-*-*-*-*-*-*
	normal--*-*-*-*-*-*-*-*
}
Application instproc search_font { foundry style weight points slant } {
	global font tcl_version tcl_platform
 	if {$tcl_version >= 8} {
 		if {$slant == "r"} {
 			set slant ""
 		} elseif {$slant == "o"} {
 			set slant "italic"
 		}
		if {$weight == "medium"} {
			set weight ""
		}
 		return "$style -$points $weight $slant"
 	}
	foreach f $font($style$points) {
		set fname -$foundry-$style-$weight-$slant-$f
		if [havefont $fname] {
			return $fname
		}
	}
	$self instvar name_
	puts stderr "$name_: can't find $weight $fname font (using fixed)"
	if ![havefont fixed] {
		puts stderr "$name_: can't find fixed font"
		exit 1
	}
	return fixed
}
Application public init_local {} {
	$self instvar name_
	set f ~/.$name_.tcl
	if [file exists $f] {
		uplevel #0 "source $f"
	}
	set script [$self resource startupScript]
	if { $script != "" } {
		uplevel #0 "source $script"
	}
}
Application instproc user_hook {} {
}
Object instproc options {} {
	$self instvar options_
	if ![info exists options_] {
		Object instvar options_
		if ![info exists options_] {
			set options_ [new Configuration]
			global tcl_platform
			if {"$tcl_platform(platform)"=="windows"} {
				$options_ add_default \
					background SystemButtonFace
				$options_ add_default \
					infoHighlightColor SystemHighlightText
			}
		}
	}
	$options_ add_default appname mash
	return $options_
}
Object instproc optionsFrom o {
	$self set options_ $o
}
Class instproc configuration a {
 	$self instvar options_
	if ![info exists options_] {
		set options_ [new Configuration]
	}
	foreach { option value } $a {
		$options_ add_default $option $value
	}
}
Object instproc get_option r {
	set v [[$self options] get_option $r]
	if { $v != "" } {
		return $v
	}
	set cl [$self info class]
	foreach cl "$cl [$cl info heritage]" {
		$cl instvar options_
		if [info exists options_] {
			set v [$options_ get_option $r]
			if { $v != "" } {
				return $v
			}
		}
	}
	return ""
}
Object instproc resource r {
	return [$self get_option $r]
}
Object instproc add_option { r v } {
	return [[$self options] add_option $r $v]
}
Object instproc add_default { r v } {
	return [[$self options] add_default $r $v]
}
Object instproc yesno r {
	set v [$self get_option $r]
	if [string match \[0-9\]* $v] {
		return $v
	}
	if [string match \[tT\]* $v] {
		return 1
	}
	return 0
}
Object instproc debug s {
	if [$self yesno debug] {
		Log warn $s
	}
}
Object instproc warn s {
	Log warn $s
}
Object instproc fatal s {
	Log fatal $s
}
Class Configuration
Configuration public get_option r {
	$self instvar table_ default_
	if [info exists table_($r)] {
		return $table_($r)
	}
	if [info exists default_($r)] {
		return $default_($r)
	}
	return ""
}
Configuration public add_option { r v } {
	$self instvar table_
	set table_($r) $v
}
Configuration public add_default { r v } {
	$self set default_($r) $v
}
Configuration public register_option  { flag option args } {
	$self instvar arg_option_ usage_ arg_option_default_
	set arg_option_($flag) $option
	if { [lindex $args 0] == "-default" } {
		set arg_option_default_($flag) [lindex $args 1]
		set args [lrange $args 2 end]
	}
	set usage_($flag) $args
}
Configuration public register_boolean_option  { flag option args } {
	$self instvar arg_bool_ arg_bool_val_
	set arg_bool_($flag) $option
	if { $args == "" } {
		set args 1
	}
	set arg_bool_val_($flag) $args
}
Configuration public register_list_option {flag option args} {
	$self instvar arg_list_option_
	set arg_list_option_($flag) $option
	set usage_($flag) $args
}
Configuration private is_arg argv {
	if { $argv != "" } {
		return [string match -* [lindex $argv 0]]
	}
	return 0
}
Configuration instproc parse_args argv {
	$self instvar arg_resource_ bool_resource_
	$self instvar arg_option_ arg_bool_ arg_bool_val_ arg_list_option_ \
			arg_option_default_
	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
		}
		set fatal_msg ""
		if [info exists arg_option_($arg)] {
			if { [llength $argv] > 0 && \
					[string index $val 0]!="-" } {
				$self add_option $arg_option_($arg) $val
				set argv [lrange $argv 1 end]
				continue
			}
			set fatal_msg "must be followed by an argument"
		}
		if [info exists arg_bool_($arg)] {
			$self add_option $arg_bool_($arg) $arg_bool_val_($arg)
			continue
		}
		if [info exists arg_list_option_($arg)] {
			if { [llength $argv] > 0 || \
					[string index $val 0]!="-" } {
				set o $arg_list_option_($arg)
				set l [$self get_option $o]
				lappend l $val
				$self add_option $o $l
				set argv [lrange $argv 1 end]
				continue
			}
			set fatal_msg "must be followed by an argument"
		}
		$self usage
		$self fatal "unknown/invalid command option: $arg ($fatal_msg)"
	}
	return $argv
}
Configuration public usage {} {
	set display_args_on_single_line 0
	if { $display_args_on_single_line } {
		puts "usage: [Application name] [join [$self arg_info]]"
	} else {
		puts "usage: [Application name]"
		foreach arg [$self arg_info] {
			puts $arg
		}
	}
}
Configuration private arg_info {} {
	$self instvar arg_option_ arg_bool_ usage_
	foreach arg [array names arg_option_] {
		set r $arg_option_($arg)
		set d [$self get_option $r]
		if { $d != "" || $usage_($arg) != "required"} {
			lappend opt "\[$arg $r ($d)\]"
		} else {
			lappend req "$arg $r"
		}
	}
	foreach arg [array names arg_bool_] {
		set r $arg_bool_($arg)
		set d [$self get_option $r]
		if { $d != "" } {
		        lappend opt "\[$arg ($d)\]"
		} else {
			lappend opt "\[$arg\]"
		}
	}
	if [info exists opt] {
		if [info exists req] {
			return [concat $opt $req]
		} else {
			return $opt
		}
	} else {
		if [info exists req] {
			return $req
		} else {
			return ""
		}
	}
}
Configuration public load_preferences suffixList {
    global env
    if {![info exists env(HOME)]} {
        new ErrorWindow {Your HOME environment variable must be set.}
        exit 1
    }
	set mash [file join $env(HOME) .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
	}
}
Configuration public open_preferences { suffix {mode w} } {
    global env
    if {![info exists env(HOME)]} {
        new ErrorWindow {Your HOME environment variable must be set.}
        exit 1
    }
	set mash [file join $env(HOME) .mash]
	if {![file exists $mash]} {
		file mkdir $mash
	}
	set f [open $mash/prefs-$suffix $mode 0644]
	return $f
}
Configuration public write_preference { file key value } {
	puts $file "$key: $value"
}
Configuration public close_preferences { file } {
	close $file
}
Class TkWindow -configuration {
	background gray85
}
Class TopLevelWindow -superclass TkWindow
TkWindow public init {path} {
	$self next
	$self instvar path_
	set path_ $path
}
TkWindow public widget_path {} {
	$self instvar path_
	return $path_
}
TkWindow instproc destroy {} {
	$self instvar path_
	if [winfo exists $path_] {
		destroy $path_
	}
	$self next
}
TkWindow instproc highlight { color } {
	$self instvar path_
	if { $path_ != "" } {
		$path_ configure -background $color
		foreach child [winfo children $path_] {
			window_highlight $child $color
		}
	}
}
TkWindow instproc set_background { color } {
	$self instvar path_
	$path_ configure -background $color
}
TopLevelWindow public build_window {} {
	$self instvar path_
	if ![winfo exists $path_] {
		$self build $path_
	}
}
TopLevelWindow instproc toggle {} {
	$self build_window
	$self instvar path_
	set w $path_
	$self instvar __mappedBefore__
	if { [winfo ismapped $w] } {
		wm withdraw $w
		return
	} elseif ![info exists __mappedBefore__] {
		set __mappedBefore__ 1
		wm transient $w .
		update idletasks
		set x [winfo rootx .]
		set y [winfo rooty .]
		incr y [winfo height .]
		incr y -[winfo reqheight $w]
		incr y -20
		incr x [winfo vrootx .]
		incr y [winfo vrooty .]
		if { $y < 0 } { set y 0 }
		if { $x < 0 } {
			set x 0
		} else {
			set right [expr [winfo screenwidth .] - \
					[winfo reqwidth $w]]
			if { $x > $right } {
				set x $right
			}
		}
		wm geometry $w +$x+$y
	}
	wm deiconify $w
}
TopLevelWindow instproc create-window { w title } {
	Application toplevel $w
	set title "[$self get_option iconPrefix] $title"
	wm transient $w .
	wm title $w $title
	wm iconname $w $title
	bind $w <Enter> "focus $w"
	wm withdraw $w
}
Class HelpWindow -superclass TopLevelWindow
HelpWindow instproc create-window { w title items } {
	$self next $w $title
	frame $w.frame -borderwidth 0 -relief flat
	set p $w.frame
	set n 0
	foreach m $items {
		set h $w.h$n
		incr n
		frame $h
		$self helpitem $h $m
		pack $h -expand 1 -fill both
	}
	button $w.frame.ok -text " Dismiss " -borderwidth 2 -relief raised \
		-command "wm withdraw $w" -font [$self get_option medfont]
	pack $w.frame.ok -pady 6 -padx 6 -anchor e
	pack $w.frame -expand 1 -fill both
        wm protocol $w WM_DELETE_WINDOW "wm withdraw $w"
}
HelpWindow instproc helpitem { w text } {
	set f [$self get_option helpFont]
	canvas $w.bullet -width 12 -height 12
	$w.bullet create oval 6 3 12 9 -fill black
	message $w.msg -justify left -anchor w -font $f -width 450 -text $text
	pack $w.bullet -side left -anchor ne -pady 5
	pack $w.msg -side left -expand 1 -fill x -anchor nw
}
Class ErrorWindow -superclass TopLevelWindow
ErrorWindow public init text {
	set w .dialog
	$self next $w
	catch "destroy $w"
	global V
	set applname [Application name]
	if { $applname == "" } {
		set applname "mash shell"
	}
	$self create-window $w "$applname error"
	label $w.label -text "$applname: $text" -font [$self get_option medfont] \
		-borderwidth 2 -relief groove
	button $w.button -text OK -command "$self destroy" \
			-font [$self get_option medfont]
	pack $w.label -expand 1 -fill x -ipadx 4 -ipady 4
	pack $w.button -pady 4
	wm withdraw $w
	update idletasks
	set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
		- [winfo vrootx [winfo parent $w]]]
	set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
		- [winfo vrooty [winfo parent $w]]]
	wm geom $w +$x+$y
	wm deiconify $w
	bind $w <Enter> "focus $w"
	tkwait window .dialog
}
Class CheckButton
CheckButton public init { w args } {
	$self instvar var_ path_
	set path_ $w
	set var_ [TclObject getid]
	eval checkbutton $w -variable $var_ $args
}
CheckButton instproc get_val {} {
	$self instvar var_
	global $var_
	return [set $var_]
}
CheckButton instproc set_val v {
	$self instvar var_
	global $var_
	set $var_ $v
}
CheckButton instproc set-val v { $self set_val $v }
CheckButton instproc get-val {} { $self get_val }
CheckButton instproc unknown args {
	$self instvar path_
	eval $path_ $args
}
Class RadioButtonsObj
RadioButtonsObj public init { w labelsList args } {
    $self instvar var_ path_ numButtons_
    set path_ $w
    set var_ [TclObject getid]
    set c 0
    foreach i $labelsList {
	eval radiobutton $w.rb$c -variable $var_ $args
	$w.rb$c configure -text [list $i]
	$w.rb$c configure -value [list $i]
	pack $w.rb$c -in $w -anchor w
	incr c
    }
    set numButtons_ $c
}
RadioButtonsObj public get_val {} {
    $self instvar var_
    global $var_
    return [set $var_]
}
RadioButtonsObj public set_val {v} {
    $self instvar var_
    global $var_
    set $var_ $v
}
RadioButtonsObj private unknown args {
    $self instvar path_ numButtons_
    for {set i 0} {$i < $numButtons_} {incr i} {
	eval $path_.rb$i $args
    }
}
Class ScaleObj
ScaleObj public init { w args } {
    $self instvar var_ path_
    set path_ $w
    set var_ [TclObject getid]
    eval scale $w -variable $var_ $args
}
ScaleObj public get_val {} {
    $self instvar var_
    global $var_
    return [set $var_]
}
ScaleObj public set_val {v} {
    $self instvar var_
    global $var_
    set $var_ $v
}
ScaleObj private unknown args {
    $self instvar path_
    eval $path_ $args
}
Class EntryObj
EntryObj public init { w args } {
    $self instvar var_ path_
    set path_ $w
    set var_ [TclObject getid]
    eval entry $w -textvariable $var_ $args
}
EntryObj public get_val {} {
    $self instvar var_
    global $var_
    return [set $var_]
}
EntryObj private unknown args {
    $self instvar path_
    eval $path_ $args
}
Object instproc has_method { method } {
	if { [$self info procs $method]!="" } {
		return 1
	}
	return [[$self info class] has_method $method]
}
Class instproc has_method { method } {
	if { [$self info instprocs $method]!="" } {
		return 1
	}
	foreach cl [$self info heritage] {
		if { [$cl info instprocs $method]!="" } {
			return 1
		}
	}
	return 0
}
proc version {} {
	global mash
	return $mash(version)
}
proc local_fqdn {} {
	set host ""
	catch {set host [lookup_host_name [localaddr]]}
	if { [string first . $host] < 0 } {
		return ""
	}
	return $host
}
proc email_heuristic {} {
	set user [user_heuristic]
	set addr [local_fqdn]
	if { $addr == "" } {
		return ""
	}
	return $user@$addr
}
proc user_heuristic {} {
	global env
	if [info exists env(USER)] {
		set user $env(USER)
	} elseif [info exists env(LOGNAME)] {
		set user $env(LOGNAME)
	} else {
		catch {set env(USER) [getusername]}
		if [info exists env(USER)] {
			return $env(USER)
		}
		return "UNKNOWN"
	}
}
proc format_fps f {
	set fps $f
	if { $fps < .1 } {
		set fps "0 f/s"
	} elseif { $fps < 10 } {
		set fps [format "%.1f f/s" $fps]
	} else {
		set fps [format "%2.0f f/s" $fps]
	}
	return $fps
}
proc format_bps b {
	set bps $b
	if { $bps < 1 } {
		set bps "0 bps"
	} elseif { $bps < 1000 } {
		set bps [format "%3.0f bps" $bps]
	} elseif { $bps < 1000000 } {
		set bps [format "%3.1f kb/s" [expr $bps / 1000.]]
	} else {
		set bps [format "%.2f Mb/s" [expr $bps / 1000000.]]
	}
	return $bps
}
proc gettime {sec} {
    clock format $sec
}
proc sdr_gettimeofday {} {
    clock seconds
}
proc gettimenow {} {
    gettime [clock seconds]
}
proc getreadabletime {} {
    return [clock format [clock seconds] -format {%H:%M, %d/%m/%y}]
}
proc unix_to_ntp {unixtime} {
    set oddoffset 2208988800
    if {$unixtime==0} {return 0}
    return [format %u [expr $unixtime + $oddoffset]]
}
proc ntp_to_unix {ntptime} {
    set oddoffset 2208988800
    if {($ntptime==0)||($ntptime==1)} {return $ntptime}
    if {[catch {expr $ntptime - $oddoffset}] !=0} {
	    return 0
    }
    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
}
proc in_multicast addr {
	return [expr ([lindex [split $addr .] 0] & 0xf0) == 0xe0]
}
proc invalid_addr a {
    set l [split $a .]
    if {[llength $l] != 4} { return 1 }
    foreach i $l {
	if {![is_number $i] || $i<0 || $i>255} { return 1 }
    }
    return 0
}
proc is_number n {
    if [catch {expr $n}] {
	return 0
    }
	return 1
}
proc parray {a {pattern *}} {
    upvar 1 $a array
    if ![array exists array] {
        error "\"$a\" isn't an array"
    }
    set maxl 0
    foreach name [lsort [array names array $pattern]] {
        if {[string length $name] > $maxl} {
            set maxl [string length $name]
        }
    }
    set maxl [expr {$maxl + [string length $a] + 2}]
    foreach name [lsort [array names array $pattern]] {
        set nameString [format %s(%s) $a $name]
        puts stdout [format "%-*s = %s" $maxl $nameString $array($name)]
    }
}
Class RTPApplication -superclass Application
RTPApplication public init name {
	$self next $name
}
RTPApplication public run_resource_dialog { name email } {
	set font [$self get_option medfont]
	set w .form
	global V
	frame $w
	frame $w.msg -relief ridge
	label $w.msg.label -font $font -wraplength 4i \
		-justify left -text \
"Please specify values for the following resources. \
These strings will identify you by name and by email address \
in any RTP-based conference.  Please use your real name and \
affiliation instead of a ``handle'', e.g., ``Jane Doe (ACME Research)''. \
The values you enter will be saved in ~/.mash/prefs so you will \
not have to re-enter them." -relief ridge
	pack $w.msg.label -padx 6 -pady 6
	pack $w.msg -side top
	foreach i {name email} {
		frame $w.$i -bd 2
		entry $w.$i.entry -relief sunken
		label $w.$i.label -width 10 -anchor e
		pack $w.$i.label -side left
		pack $w.$i.entry -side left -fill x -expand 1 -padx 8
	}
	$w.name.label config -text rtpName:
	$w.email.label config -text rtpEmail:
	pack $w.msg -pady 10
	pack $w.name $w.email -side top -fill x
	$w.$i.entry insert 0 [email_heuristic]
	frame $w.buttons
	button $w.buttons.accept -text Accept -command "set dialogDone 1"
	button $w.buttons.dismiss -text Quit -command "set dialogDone -1"
	pack $w.buttons.accept $w.buttons.dismiss \
		-side left -expand 1 -padx 20 -pady 10
	pack $w.buttons
	pack $w -padx 10
	global dialogDone
	while { 1 } {
		set dialogDone 0
		focus $w.name.entry
		tkwait variable dialogDone
		if { $dialogDone < 0 } {
			exit 0
		}
		set name [string trim [$w.name.entry get]]
		if { [string length $name] <= 3 } {
			new ErrorWindow "please enter a reasonable name"
			continue
		}
		set email [string trim [$w.email.entry get]]
		if { [string first . $email] < 0 || \
			[string first @ $email] < 0 } {
			new ErrorWindow "email address should have form user@host.domain"
			continue
		}
		break
	}
    global env
    if {![info exists env(HOME)]} {
        new ErrorWindow {Your HOME environment variable must be set.}
        exit 1
    }
	set mash [file join $env(HOME) .mash]
	if {![file exists $mash]} {
		file mkdir $mash
	}
	set f [open [file join $mash prefs] a+ 0644]
	puts $f "rtpName: $name"
	puts $f "rtpEmail: $email"
	close $f
	pack forget $w
	destroy $w
}
RTPApplication public check_rtp_sdes {} {
	set name [$self get_option rtpName]
	if { $name == "" } {
		set name [$self get_option sessionName]
		option add *rtpName $name startupFile
	}
	set email [$self get_option rtpEmail]
	if { $name == "" || $email == "" } {
		$self run_resource_dialog $name $email
	}
}
RTPApplication private check_hostspec { argv megaSession } {
	if { $argv == "" } {
		if { $megaSession == "" } {
			$self fatal "destination address required"
		}
	} elseif { [llength $argv] > 1 } {
		set extra [lindex $argv 1]
		$self fatal "extra arguments (starting with $extra)"
	}
	return $argv
}
set MTrace(trcNone)      {0x00000000 {none}}
set MTrace(trcNet)       {0x00000001 {Network}}
set MTrace(trcSRM)       {0x00000002 {SRM}}
set MTrace(trcArchive)   {0x00000004 {Archive}}
set MTrace(trcMB)        {0x00000008 {Mediaboard}}
set MTrace(trcFCA)       {0x00000010 {Floor control}}
set MTrace(trcLTS)       {0x00000020 {Logical Time System}}
set MTrace(trcTGMB)      {0x00000040 {TopGun MediaBoard}}
set MTrace(trcCB)        {0x00000080 {Coordination Bus}}
set MTrace(trcWC)        {0x00000100 {Web Cache}}
set MTrace(trcVerbose)   {0x20000000 {Verbose}}
set MTrace(trcExcessive) {0x40000000 {Excessive}}
set MTrace(trcTmp)       {0x80000000 {Temp}}
set MTrace(trcAll)       {0xFFFFFFFF {All}}
if { [Class info instances MTrace]=="" } {
    proc MTrace { args } {
	    return MTrace
    }
}
MTrace proc init { flags } {
	global MTrace
	MTrace instvar mtrace
	set mtrace [new MTrace]
	$mtrace create_window
	foreach flag $flags {
		if { [info exists MTrace($flag)] } {
			set bits [lindex $MTrace($flag) 0]
			set msg  [lindex $MTrace($flag) 1]
			$mtrace tkvar flag_$flag
			set flag_$flag 1
			$mtrace set_flag $bits
		}
	}
	return $mtrace
}
MTrace instproc create_window { } {
	global mash
	if { $mash(environ) == "smash" } return
	$self instvar path_
	global MTrace
	set count 0
	while { [winfo exists ".mtrace_$count"] } { incr count }
	set path_ ".mtrace_$count"
	toplevel $path_
	wm title $path_ "MASH Trace"
	wm withdraw $path_
	set main [frame $path_.main -bd 1 -relief sunken]
	pack $main -side top -fill both -expand 1 -padx 5 -pady 3
	foreach flag [array names MTrace] {
		$self tkvar flag_$flag
		set flag_$flag 0
		checkbutton $main.$flag -text [lindex $MTrace($flag) 1] \
				-variable [$self tkvarname flag_$flag] \
				-command "$self toggle_flag $flag" \
				-bd 1 -pady 0 -anchor w
		pack $main.$flag -pady 0 -padx 5 -fill x -expand 1
	}
	button $path_.button -text "Dismiss" -command "$self toggle_window" \
			-pady 0
	pack $path_.button -anchor e -padx 5 -pady 2
        wm protocol $path_ WM_DELETE_WINDOW "$self toggle_window"
	return $path_
}
MTrace instproc toggle_window { } {
	global mash
	if { $mash(environ) == "smash" } return
	$self instvar path_
	if { [winfo ismapped $path_] } {
		wm withdraw $path_
	} else {
		wm deiconify $path_
	}
}
MTrace instproc toggle_flag { flag } {
	global MTrace
	$self tkvar flag_$flag
	if { [set flag_$flag] } {
		$self set_flag [lindex $MTrace($flag) 0]
	} else {
		$self reset_flag [lindex $MTrace($flag) 0]
	}
}
proc mtrace { flags args } {
        global MTrace
	set bits 0
	foreach flag [split $flags "|"] {
		set bits [expr $bits | [lindex $MTrace($flag) 0]]
	}
	MTrace instvar mtrace
	if [info exists mtrace] {
		$mtrace trace $bits $args
	}
}
Class Tcl_Recorder
Tcl_Recorder instproc init {classname args} {
        $self instvar theobj_ classname_ logf_ clock_ st_
        $self next
        set st_ [gettimeofday]
        set hn [info hostname]
        set hn [lindex [split $hn .] 0]
        set logf_ [open $hn.rlog "w+"]
        set classname_ $classname
        set theobj_ [eval new $classname_ $args]
}
Tcl_Recorder instproc unknown {m args} {
        $self instvar theobj_ classname_ clock_ st_ logf_
        puts $logf_ "[expr [gettimeofday] - $st_] $classname_ $m $args"
        set ret [eval $theobj_ $m $args]
        return $ret
}
Class Tcl_Player
Tcl_Player instproc init {logfn target isRealTime} {
        $self instvar logf_ tgt_ isRealTime_
        set logf_ [open $logfn "r+"]
        set tgt_ $target
        set isRealTime_ $isRealTime
}
Tcl_Player instproc start {} {
        $self instvar st_ now_ nextCmd_
        set now_ 0
        set next_ 0
        set nextCmd_ ""
        $self run_next
}
Tcl_Player instproc run_next {} {
        set nextCmd [$self set nextCmd_]
        if {$nextCmd!=""} {
                eval [$self set tgt_] $nextCmd
        }
        set c [gets [$self set logf_] line]
        if {$c == -1} {
                close [$self set logf_]
                delete $self
                return
        }
        $self instvar nextCmd_ isRealTime_ now_
        set nextCmd_ [lrange $line 2 end]
        if $isRealTime_ {
                set currTime $now_
                set nexttime [expr int ([lindex $line 0] * 1000)]
                set now_ $nexttime
                after [expr $nexttime - $currTime] "$self run_next"
        } else {
                after idle "$self run_next"
        }
}
Class AddressBlock -configuration {
	defaultTTL 1
	maxbw -1
}
Class AddressBlock/RTP -superclass AddressBlock
Class AddressBlock/Simple -superclass AddressBlock
AddressBlock instproc init spec {
	$self next
	$self set nchan_ 0
	foreach s [split $spec ,] {
		set err [$self parse $s]
		if { $err != "" } {
			$self fatal $err
		}
	}
}
AddressBlock instproc data-port p {
	return [expr $p &~ 1]
}
AddressBlock instproc fmt {} {
	$self instvar fmt_
	if [info exists fmt_] { return $fmt_ } else { return "" }
}
AddressBlock instproc ctrl-port p {
	return [expr [$self data-port $p] + 1]
}
AddressBlock instproc addr {{k 0}} {
	return [$self set addr_($k)]
}
AddressBlock instproc sport {{k 0}} {
	return [$self set sport_($k)]
}
AddressBlock instproc rport {{k 0}} {
	return [$self set rport_($k)]
}
AddressBlock instproc ttl {{k 0}} {
	$self instvar ttl_
	if [info exists ttl_($k)] { return $ttl_($k) } else { return {} }
}
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 ($s)"
	}
	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==3 && [regexp {^[0-9]+$} $fmt] } {
			set ttl $fmt
			set fmt {}
		}
		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 set fmt_ $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 10000000
			} elseif { $ttl <= 64 } {
				set maxbw 4000000
			} elseif  { $ttl <= 128 } {
				set maxbw 1000000
			} elseif { $ttl <= 192 } {
				set maxbw 128000
			} else {
				set maxbw 56000
			}
		}
		set maxbw_($i) $maxbw
		incr i
	}
}
AddressBlock/Simple instproc data-port p {
	return $p
}
AddressBlock/RTP instproc data-port p {
	return [expr $p &~ 1]
}
set rlm_param(alpha) 4
set rlm_param(alpha) 2
set rlm_param(beta) 0.75
set rlm_param(init-tj) 1.5
set rlm_param(init-tj) 10
set rlm_param(init-tj) 5
set rlm_param(init-td) 5
set rlm_param(init-td-var) 2
set rlm_param(max) 600
set rlm_param(max) 60
set rlm_param(g1) 0.25
set rlm_param(g2) 0.25
Class MMG
MMG instproc init { levels } {
	$self next
	$self instvar debug_ env_ maxlevel_
	set debug_ 0
	set env_ [lindex [split [$self info class] /] 1]
	set maxlevel_ $levels
	global rlm_debug_flag
	if [info exists rlm_debug_flag] {
		set debug_ $rlm_debug_flag
	}
	$self instvar TD TDVAR state_ subscription_
	global rlm_param
	set TD $rlm_param(init-td)
	set TDVAR $rlm_param(init-td-var)
	set state_ /S
	$self instvar layer_ layers_
	set i 1
	while { $i <= $maxlevel_ } {
		set layer_($i) [$self create-layer [expr $i - 1]]
		lappend layers_ $layer_($i)
		incr i
	}
	set subscription_ 0
	$self add-layer
	set state_ /S
	$self set_TJ_timer
}
MMG instproc set-state s {
	$self instvar state_
	set old $state_
	set state_ $s
	$self debug "FSM: $old -> $s"
}
MMG instproc drop-layer {} {
	$self dumpLevel
	$self instvar subscription_ layer_
	set n $subscription_
	if { $n > 0 } {
		$self debug "DRP-LAYER $n"
		$layer_($n) leave-group
		incr n -1
		set subscription_ $n
	}
	$self dumpLevel
}
MMG instproc add-layer {} {
	$self dumpLevel
	$self instvar maxlevel_ subscription_ layer_
	set n $subscription_
	if { $n < $maxlevel_ } {
		$self debug "ADD-LAYER"
		incr n
		set subscription_ $n
		$layer_($n) join-group
	}
	$self dumpLevel
}
MMG instproc current_layer_getting_packets {} {
	$self instvar subscription_ layer_ TD
	set n $subscription_
	if { $n == 0 } {
		return 0
	}
	set l $layer_($subscription_)
	$self debug "npkts [$l npkts]"
	if [$l getting-pkts] {
		return 1
	}
	set delta [expr [$self now] - [$l last-add]]
	if { $delta > $TD } {
		set TD [expr 1.2 * $delta]
	}
	return 0
}
MMG instproc mmg_loss {} {
	$self instvar layers_
	set loss 0
	foreach l $layers_ {
		incr loss [$l nlost]
	}
	return $loss
}
MMG instproc mmg_pkts {} {
	$self instvar layers_
	set npkts 0
	foreach l $layers_ {
		incr npkts [$l npkts]
	}
	return $npkts
}
MMG instproc check-equilibrium {} {
	global rlm_param
	$self instvar subscription_ maxlevel_ layer_
	set n [expr $subscription_ + 1]
	if { $n >= $maxlevel_ || [$layer_($n) timer] >= $rlm_param(max) } {
		set eq 1
	} else {
		set eq 0
	}
	$self debug "EQ $eq"
}
MMG instproc backoff-one { n alpha } {
	$self debug "BACKOFF $n by $alpha"
	$self instvar layer_
	$layer_($n) backoff $alpha
}
MMG instproc backoff n {
	$self debug "BACKOFF $n"
	global rlm_param
	$self instvar maxlevel_ layer_
	set alpha $rlm_param(alpha)
	set L $layer_($n)
	$L backoff $alpha
	incr n
	while { $n <= $maxlevel_ } {
		$layer_($n) peg-backoff $L
		incr n
	}
	$self check-equilibrium
}
MMG instproc highest_level_pending {} {
	$self instvar maxlevel_
	set m ""
	set n 0
	incr n
	while { $n <= $maxlevel_ } {
		if [$self level_pending $n] {
			set m $n
		}
		incr n
	}
	return $m
}
MMG instproc rlm_update_D  D {
	global rlm_param
	$self instvar TD TDVAR
	set v [expr abs($D - $TD)]
	set TD [expr $TD * (1 - $rlm_param(g1)) \
				+ $rlm_param(g1) * $D]
	set TDVAR [expr $TDVAR * (1 - $rlm_param(g2)) \
		       + $rlm_param(g2) * $v]
}
MMG instproc exceed_loss_thresh {} {
	$self instvar h_npkts h_nlost
	set npkts [expr [$self mmg_pkts] - $h_npkts]
	if { $npkts >= 10 } {
		set nloss [expr [$self mmg_loss] - $h_nlost]
		set loss [expr double($nloss) / ($nloss + $npkts)]
		$self debug "H-THRESH $nloss $npkts $loss"
		if { $loss > 0.25 } {
			return 1
		}
	}
	return 0
}
MMG instproc enter_M {} {
	$self set-state /M
	$self set_TD_timer_wait
	$self instvar h_npkts h_nlost
	set h_npkts [$self mmg_pkts]
	set h_nlost [$self mmg_loss]
}
MMG instproc enter_D {} {
	$self set-state /D
	$self set_TD_timer_conservative
}
MMG instproc enter_H {} {
	$self set_TD_timer_conservative
	$self set-state /H
}
MMG instproc log-loss {} {
	$self debug "LOSS [$self mmg_loss]"
	$self instvar state_ subscription_ pending_ts_
	if { $state_ == "/M" } {
		if [$self exceed_loss_thresh] {
			$self cancel_timer TD
			$self drop-layer
			$self check-equilibrium
			$self enter_D
		}
		return
	}
	if { $state_ == "/S" } {
		$self cancel_timer TD
		set n [$self highest_level_pending]
		if { $n != "" } {
			$self backoff $n
			if { $n == $subscription_ } {
				set ts $pending_ts_($subscription_)
				$self rlm_update_D [expr [$self now] - $ts]
				$self drop-layer
				$self check-equilibrium
				$self enter_D
				return
			}
			if { $n == [expr $subscription_ + 1] } {
				$self cancel_timer TJ
				$self set_TJ_timer
			}
		}
		if [$self our_level_recently_added] {
			$self enter_M
			return
		}
		$self enter_H
		return
	}
	if { $state_ == "/H" || $state_ == "/D" } {
		return
	}
	puts stderr "rlm state machine botched"
	exit -1
}
MMG instproc relax_TJ {} {
	$self instvar subscription_ layer_
	if { $subscription_ > 0 } {
		$layer_($subscription_) relax
		$self check-equilibrium
	}
}
MMG instproc trigger_TD {} {
	$self instvar state_
	if { $state_ == "/H" } {
		$self enter_M
		return
	}
	if { $state_ == "/D" || $state_ == "/M" } {
		$self set-state /S
		$self set_TD_timer_conservative
		return
	}
	if { $state_ == "/S" } {
		$self relax_TJ
		$self set_TD_timer_conservative
		return
	}
	puts stderr "trigger_TD: rlm state machine botched $state)"
	exit -1
}
MMG instproc set_TJ_timer {} {
	global rlm_param
	$self instvar subscription_ layer_
	set n [expr $subscription_ + 1]
	if ![info exists layer_($n)] {
		return
	}
	set I [$layer_($n) timer]
	set d [expr $I / 2.0 + [trunc_exponential $I]]
	$self debug "TJ $d"
	$self set_timer TJ $d
}
MMG instproc set_TD_timer_conservative {} {
	$self instvar TD TDVAR
	set delay [expr $TD + 1.5 * $TDVAR]
	$self set_timer TD $delay
}
MMG instproc set_TD_timer_wait {} {
	$self instvar TD TDVAR
	$self instvar subscription_
	set k [expr $subscription_ / 2. + 1.5]
	$self set_timer TD [expr $TD + $k * $TDVAR]
}
MMG instproc is-recent { ts } {
	$self instvar TD TDVAR
	set ts [expr $ts + ($TD + 2 * $TDVAR)]
	if { $ts > [$self now] } {
		return 1
	}
	return 0
}
MMG instproc level_pending n {
	$self instvar pending_ts_
	if { [info exists pending_ts_($n)] && \
		 [$self is-recent $pending_ts_($n)] } {
		return 1
	}
	return 0
}
MMG instproc level_recently_joined n {
	$self instvar join_ts_
	if { [info exists join_ts_($n)] && \
		 [$self is-recent $join_ts_($n)] } {
		return 1
	}
	return 0
}
MMG instproc pending_inferior_jexps {} {
	set n 0
	$self instvar subscription_
	while { $n <= $subscription_ } {
		if [$self level_recently_joined $n] {
			return 1
		}
		incr n
	}
	$self debug "NO-PEND-INF"
	return 0
}
MMG instproc trigger_TJ {} {
	$self debug "trigger-TJ"
	$self instvar state_ ctrl_ subscription_
	if { ($state_ == "/S" && ![$self pending_inferior_jexps] && \
		  [$self current_layer_getting_packets])  } {
		$self add-layer
		$self check-equilibrium
		set msg "add $subscription_"
		$ctrl_ send $msg
		$self local-join
	}
	$self set_TJ_timer
}
MMG instproc our_level_recently_added {} {
	$self instvar subscription_ layer_
	return [$self is-recent [$layer_($subscription_) last-add]]
}
MMG instproc recv-ctrl msg {
	$self instvar join_ts_ pending_ts_ subscription_
	$self debug "X-JOIN $msg"
	set what [lindex $msg 0]
	if { $what != "add" } {
		return
	}
	set level [lindex $msg 1]
	set join_ts_($level) [$self now]
	if { $level > $subscription_ } {
		set pending_ts_($level) [$self now]
	}
}
MMG instproc local-join {} {
	$self instvar subscription_ pending_ts_ join_ts_
	set join_ts_($subscription_) [$self now]
	set pending_ts_($subscription_) [$self now]
}
MMG instproc debug { msg } {
	$self instvar debug_ subscription_ state_
	if {$debug_} {
		puts stderr "[gettimeofday] layer $subscription_ $state_ $msg"
	}
}
MMG instproc dumpLevel {} {
}
Class Layer
Layer instproc init { mmg } {
	$self next
	$self instvar mmg_ TJ npkts_
	global rlm_param
	set mmg_ $mmg
	set TJ $rlm_param(init-tj)
	set npkts_ 0
}
Layer instproc relax {} {
	global rlm_param
	$self instvar TJ
	set TJ [expr $TJ * $rlm_param(beta)]
	if { $TJ <= $rlm_param(init-tj) } {
		set TJ $rlm_param(init-tj)
	}
}
Layer instproc backoff alpha {
	global rlm_param
	$self instvar TJ
	set TJ [expr $TJ * $alpha]
	if { $TJ >= $rlm_param(max) } {
		set TJ $rlm_param(max)
	}
}
Layer instproc peg-backoff L {
	$self instvar TJ
	set t [$L set TJ]
	if { $t >= $TJ } {
		set TJ $t
	}
}
Layer instproc timer {} {
	$self instvar TJ
	return $TJ
}
Layer instproc last-add {} {
	$self instvar add_time_
	return $add_time_
}
Layer instproc join-group {} {
	$self instvar npkts_ add_time_ mmg_
	set npkts_ [$self npkts]
	set add_time_ [$mmg_ now]
}
Layer instproc leave-group {} {
}
Layer instproc getting-pkts {} {
	$self instvar npkts_
	return [expr [$self npkts] != $npkts_]
}
set rlm_debug_flag 1
Class Layer/mash -superclass Layer
Layer/mash instproc init {mmg net n} {
	$self next $mmg
	$self instvar net_ l_ n_
	set net_ $net
	set n_ $n
	set l_ [$net_ set net_($n)]
}
Layer/mash instproc join-group {} {
	$self instvar mmg_ net_
	set level [expr [$mmg_ set subscription_] - 1]
	$net_ set-subscription-level $level
	$self next
}
Layer/mash instproc leave-group {} {
	$self instvar mmg_ net_
	set level [expr [$mmg_ set subscription_] - 1]
	$net_ set-subscription-level $level
	$self next
}
Layer/mash instproc nlost {} {
	$self instvar l_
	return [$l_ nlost]
}
Layer/mash instproc npkts {} {
	$self instvar l_ n_
	return [$l_ npkts $n_]
}
Class MMG/mash -superclass MMG
MMG/mash instproc init {net caddr} {
	$self instvar net_
	set net_ $net
	$self next [$net set nchan_]
	proc ctrl$self {args} { puts "ctrl: $args" }
	$self set ctrl_ ctrl$self
}
MMG/mash instproc create-layer {layerNo} {
	$self instvar net_
	return [new Layer/mash $self $net_ $layerNo]
}
MMG/mash instproc now {} {
	return [gettimeofday]
}
MMG/mash instproc set_timer {which delay} {
	$self instvar timers_
	if [info exists timers_($which)] {
		puts "timer botched ($which)"
		exit 1
	}
	set delay [expr int($delay * 1000)]
	set timers_($which) [after $delay "$self trigger_timer $which"]
}
MMG/mash instproc trigger_timer {which} {
	$self instvar timers_
	unset timers_($which)
	$self trigger_$which
}
MMG/mash instproc cancel_timer {which} {
	$self instvar ns_ timers_
	if [info exists timers_($which)] {
		after cancel $timers_($which)
		unset timers_($which)
	}
}
MMG/mash instproc debug { msg } {
	$self instvar debug_
	if {!$debug_} { return }
	$self instvar subscription_ state_
	set time [format %.05f [$self now]]
	puts stderr "$time layer $subscription_ $state_ $msg"
}
proc uniform01 {} {
    return [expr double(([random] % 10000000) + 1) / 1e7]
}
proc uniform { a b } {
	return [expr ($b - $a) * [uniform01] + $a]
}
proc exponential mean {
	return [expr - $mean * log([uniform01])]
}
proc trunc_exponential lambda {
	while 1 {
		set u [exponential $lambda]
		if { $u < [expr 4 * $lambda] } {
			return $u
		}
	}
}
Class Network/IP -superclass Network
Network/IP instproc init args {
	puts stderr "Network/IP called... change to Network"
	eval $self next $args
}
Network instproc port args {
	eval $self sport $args
}
proc in_multicast addr {
	return [expr ([lindex [split $addr .] 0] & 0xf0) == 0xe0]
}
Class NetworkLayer
Class NetworkManager
NetworkManager instproc graphics-init n {
	if {$n == 1 || [winfo exists .l]} { return }
	$self instvar nchan_
	set nchan_ $n
	toplevel .l
	set k 0
	while { $k < $nchan_ } {
		radiobutton .l.b$k -command "$self set-subscription-level $k" \
				-text "Level $k" \
				-variable nLayers -value $k
		pack .l.b$k
		incr k
	}
	wm withdraw .l
	bind . <l> {
		if [winfo ismapped .l] {
			wm withdraw .l
		} else {
			wm deiconify .l
		}
	}
}
NetworkManager instproc set-subscription-level n {
	$self instvar agent_ nchan_ session_ net_
	$agent_ set_maxchannel $n
	$session_ set loopbackLayer_ [expr $n + 1]
	set i 0
	while { $i <= $n } {
		$net_($i) enable
		incr i
	}
	while { $i < $nchan_ } {
		$net_($i) disable
		incr i
	}
	global nLayers
	set nLayers $n
}
NetworkLayer instproc init { session addr sport rport ttl channel } {
	$self next
	$self instvar session_ addr_ port_ ttl_ dn_ cn_ channel_ active_
	set addr_ $addr
	set port_ $rport
	set sport_ $sport
	set rport_ $rport
	set session_ $session
	set ttl_ $ttl
	set channel_ $channel
	set dn_ [new Network]
	set result [$dn_ open $addr_ $sport_ $rport_ $ttl_]
	if {$result == {0}} {
		new ErrorWindow {Cannot open network connection.}
		exit 1
	}
	set cn_ [new Network]
	set result [$cn_ open $addr_ [expr $sport_ + 1] [expr $rport_ + 1] $ttl_]
	if {$result == {0}} {
		new ErrorWindow {Cannot open network connection.}
		exit 1
	}
	$cn_ loopback 1
	$session_ data-net $dn_ $channel_
	$session_ ctrl-net $cn_ $channel_
	set active_ 0
	$dn_ drop-membership
	$cn_ drop-membership
	$session_ data-net "" $channel_
	$session_ ctrl-net "" $channel_
	$self set tloss_ 0
}
NetworkLayer instproc destroy {} {
	$self instvar dn_ cn_
	if [info exists dn_] {
		delete $dn_
	}
	if [info exists cn_] {
		delete $cn_
	}
	$self next
}
NetworkLayer instproc data-net {} {
	return [$self set dn_]
}
NetworkLayer instproc ctrl-net {} {
	return [$self set cn_]
}
NetworkLayer instproc enable-send {} {
	$self instvar dn_ cn_ session_ channel_
	$session_ data-net $dn_ $channel_
	$session_ ctrl-net $cn_ $channel_
}
NetworkLayer instproc disable-send {} {
	$self instvar dn_ cn_ session_ channel_
	$session_ data-net "" $channel_
	$session_ ctrl-net "" $channel_
}
NetworkLayer instproc enable {} {
	$self instvar active_ dn_ cn_ session_ channel_
	if !$active_ {
		set active_ 1
		$dn_ add-membership
		$cn_ add-membership
		$session_ data-net $dn_ $channel_
		$session_ ctrl-net $cn_ $channel_
	}
}
NetworkLayer instproc disable {} {
	$self instvar dn_ cn_ active_ session_ channel_
	if $active_ {
		set active_ 0
		$dn_ drop-membership
		$cn_ drop-membership
		$session_ data-net "" $channel_
		$session_ ctrl-net "" $channel_
	}
}
NetworkLayer instproc notify-loss {src} {
	$self instvar loss_ tloss_
	if ![info exists loss_($src)] {
		set loss_($src) 0
	}
	set nloss [$src missing]
	incr tloss_ [expr $nloss - $loss_($src)]
	set loss_($src) $nloss
}
NetworkLayer instproc nlost {} {
	$self instvar tloss_
	return $tloss_
}
NetworkLayer instproc npkts {n} {
	$self instvar agent_
	set npkts 0
	foreach s [$agent_ set sources_] {
		set l [lindex [$s set layers_] $n]
		incr npkts [$l set np_]
	}
	return $npkts
}
NetworkLayer instproc crypt { dc cc } {
	$self instvar dn_ cn_
	$dn_ crypt $dc
	$cn_ crypt $cc
}
NetworkManager instproc init { ab session agent } {
	$self next
	$self instvar session_ agent_ encrypt_ key_ fmt_
	set session_ $session
	set agent_ $agent
	set encrypt_ 0
	set key_ ""
	set fmt_ ""
	$self allocate $ab $session
}
NetworkManager instproc allocate { ab session } {
	$self instvar nchan_ net_ mmg_
	if [info exists nchan_] {
		set oldnchan $nchan_
	} else {
		set oldnchan 0
	}
	set nchan_ 0
	while { $nchan_ < [$ab nchan] } {
		set addr [$ab addr $nchan_]
		set sport [$ab sport $nchan_]
		set rport [$ab rport $nchan_]
		set ttl [$ab ttl $nchan_]
		if [info exists net_($nchan_)] {
			delete $net_($nchan_)
		}
		set net_($nchan_) [new NetworkLayer $session $addr \
				$sport $rport $ttl $nchan_]
		$self instvar agent_
		$net_($nchan_) set agent_ $agent_
		incr nchan_
	}
	set n $nchan_
	while {$n < $oldnchan} {
		if [info exists net_($n)] {
			delete $net_($n)
		}
		incr n
	}
	if [info exists mmg_] {
		delete $mmg_
	}
	$self set-subscription-level 0
	if {$nchan_ == 1} { return }
	if [$self yesno useLayersWindow] {
		$self graphics-init $nchan_
	}
	if [$self get_option useRLM] {
		set caddr ""
		set mmg_ [new MMG/mash $self $caddr]
	}
}
NetworkManager instproc nchan {} {
	return [$self set nchan_]
}
NetworkManager instproc reset ab {
	$self instvar session_
	$self allocate $ab $session_
}
NetworkManager instproc data-net args {
	if { $args == "" } {
		set k 0
	} else {
		set k $args
	}
	$self instvar net_
	return [$net_($k) data-net]
}
NetworkManager instproc ctrl-net args {
	if { $args == "" } {
		set k 0
	} else {
		set k $args
	}
	$self instvar net_
	return [$net_($k) ctrl-net]
}
NetworkManager public loopback enable {
	$self instvar nchan_ net_
	set i 0
	while { $i < $nchan_ } {
		set net $net_($i)
		set dn [$net data-net]
		set cn [$net ctrl-net]
		$dn loopback $enable
		$cn loopback $enable
		incr i
	}
}
NetworkManager instproc install-key key {
	return [$self set_key $key]
}
NetworkManager instproc crypt_all { dc cc } {
	$self instvar net_
	foreach n [array names net_] {
		$net_($n) crypt $dc $cc
	}
}
NetworkManager instproc destroy {} {
	$self instvar net_
	foreach chan [array names net_] {
		delete $net_($chan)
	}
	$self next
}
NetworkManager instproc usingRLM {} {
	$self instvar mmg_
	return [info exists mmg_]
}
NetworkManager instproc notify-loss {src layer} {
	$self instvar net_
	$net_($layer) notify-loss $src
}
NetworkManager instproc crypt_format { key } {
	set k [string first / $key]
	if { $k < 0 } {
		set fmt DES
	} else {
		set fmt [string range $key 0 [expr $k - 1]]
		set key [string range $key [expr $k + 1] end]
	}
	return "$fmt $key"
}
NetworkManager instproc set_key key {
	if { $key == "" } {
		$self crypt_clear
		return ""
	}
	$self instvar encrypt_
	set L [$self crypt_format $key]
	set fmt [lindex $L 0]
	set key [lindex $L 1]
	$self instvar key_
	set key_ $key
	$self instvar dc_ cc_ fmt_
	if { $fmt_ != $fmt } {
		if [info exists dc_] {
			delete $dc_
			unset dc_
		}
		if [info exists cc_] {
			delete $cc_
			unset cc_
		}
		set fmt_ $fmt
	}
	if ![info exists dc_] {
		set clist [Crypt/Data info subclass]
		if { [lsearch -exact $clist Crypt/Data/$fmt] < 0 } {
			return "no $fmt encryption support"
		}
		set dc_ [new Crypt/Data/$fmt]
		set cc_ [new Crypt/Control/$fmt]
	}
	if [$dc_ key $key] {
		$cc_ key $key
		$self crypt_all $dc_ $cc_
		set encrypt_ 1
		return ""
	} else {
		$self crypt_clear
		return "your key is cryptographically weak"
	}
}
NetworkManager instproc crypt_clear {} {
	$self instvar encrypt_ key_
	$self crypt_all "" ""
	set key_ ""
	set encrypt_ 0
}
proc DbgOut { args } {
	mtrace trcMB $args
}
package provide mb_utils
proc lsubst {list old new} {
    set ix [lsearch -exact $list $old]
    if {$ix >= 0} {
	    if {$new!={}} {
		    return [lreplace $list $ix $ix $new]
	    } else {
		    return [lreplace $list $ix $ix]
	    }
    }
}
proc removeFirst {varName} {
        upvar $varName l
        set f [lindex $l 0]
        set l [lrange $l 1 end]
        return $f
}
Class Callback
Callback instproc init {} {
}
Callback instproc add_callback {event cmd} {
	$self instvar callbacks_
	lappend callbacks_($event) $cmd
}
Callback instproc callback {event args} {
	$self instvar callbacks_
	if [info exists callbacks_($event)] {
		foreach cmd $callbacks_($event) {
			puts "callback: [concat $cmd $args]"
			uplevel #0 $cmd $args
		}
	}
}
Class MBDebugDlg -superclass Callback
MBDebugDlg instproc init {mgr showUI} {
        $self instvar appmgr_ f_ isActive_ showUI_
        $self tkvar drop_ cont_
        set appmgr_ $mgr
        set cont_ 5
        set drop_ 5
        set f_ ".__debug"
        set showUI_ $showUI
        set isActive_ 0
        $self build
        wm withdraw $f_
}
MBDebugDlg instproc disable_drop {} {
	$self change_state 0
	$self dismiss
	$self callback disable_drop
}
MBDebugDlg instproc dismiss {} {
        wm iconify [$self set f_]
}
MBDebugDlg instproc build {} {
        $self instvar f_ showUI_
        if [winfo exists $f_] {
                if $showUI_ { wm deiconify $f_ }
                return
        }
        set f_ [toplevel $f_]
        frame $f_.f1 -borderwidth 2 -relief groove
        label $f_.f1.drop -text "# pkts to drop: "
        entry $f_.f1.e -textvariable [$self tkvarname drop_]
        if $showUI_ {
                pack $f_.f1.drop $f_.f1.e  -side left -fill x
        }
        frame $f_.f2 -borderwidth 2 -relief groove
        label $f_.f2.cont -text "# pkts to receive : "
        entry $f_.f2.e -textvariable [$self tkvarname cont_]
        button $f_.d -text "Dismiss" -command "$self dismiss"
        button $f_.st -text "Disable pkt drop" -command "$self disable_drop"
        if $showUI_ {
                pack $f_.f2.cont $f_.f2.e -side left -fill x
                pack $f_.f2 $f_.f1 -fill x -side top
                pack $f_.d -side right -fill x
                pack $f_.st -side left -fill x
        }
}
MBDebugDlg instproc change_state {onoff} {
        $self instvar f_ isActive_ activate_ counters_ showUI_
        set isActive_ $onoff
        if {$isActive_==1} {
                foreach src [array names activate_] {
                        set activate_($src) [expr $counters_($src) + 1]
                }
                if {$showUI_} { $self build }
        } else {
                if {$showUI_ && [winfo exists $f_]} { wm withdraw $f_ }
        }
}
MBDebugDlg instproc get_state {} {
        $self instvar isActive_
        return $isActive_
}
MBDebugDlg instproc recv {src} {
        $self instvar counters_ action_ activate_ f_ drop_ cont_ \
                        isActive_
        $self tkvar drop_ cont_
        if {$isActive_ == 0} {
                return "cont"
        }
        if ![info exists counters_($src)] {
                set counters_($src) 0
                set action_($src) "drop"
                set activate_($src) 1
        }
        incr counters_($src)
        if {$activate_($src)==$counters_($src)} {
                if {$action_($src)=="drop"} {
                        if {$cont_>0} {
                                incr activate_($src) $cont_
                                set action_($src) "cont"
                        } else {
                                incr activate_($src)
                        }
                } else {
                        if {$drop_>0} {
                                incr activate_($src)  $drop_
                                set action_($src) "drop"
                        } else {
                                incr activate_($src)
                        }
                }
        }
        if {$action_($src) == "drop"}  {
                DbgOut "Drop pkt#=$counters_($src), n_actv=$activate_($src)"
                return "drop"
        } else {
                DbgOut "Recv pkt#:$counters_($src), actv=$activate_($src)"
                return "cont"
        }
}
Class DbgInfoWindow
DbgInfoWindow set id_ 0
DbgInfoWindow instproc init {title text} {
        global InfoWindowOK_
	set i [DbgInfoWindow set id_]
	incr i
	DbgInfoWindow set id_ $i
	set w .dbgw$i
	$self set path_ $w
        toplevel $w
        wm title $w $title
        set InfoWindowOK_ ""
        set f [frame $w.f]
        set txt [text $f.text -yscrollcommand "$f.sy set"]
        scrollbar $f.sy -orient vert -command "$f.text yview"
        pack $txt -side left -fill both -expand true
	pack $f.sy -side left -fill both -expand false
        $txt insert insert $text
        set dismiss [button $w.dismiss -text "dismiss" \
                        -command "delete $self"]
        pack $f $dismiss -side top -anchor c  -fill both
}
DbgInfoWindow instproc destroy {} {
	destroy [$self set path_]
}
proc DumpCanvas {canv} {
        set elements [$canv find withtag all]
        append result "item#\ttype\tcoords\t        text\n"
        append result "======\t====\t=====\t        ====\n"
        foreach elt $elements {
                append result "$elt\t"
                append result [$canv type $elt]\t
                append result [$canv coords $elt]
                if {[$canv type $elt]=="text"} {
                        append result \t
                        append result [$canv itemcget $elt -text]
                }
                append result \n
        }
	return $result
}
Class MBWidget
MBWidget instproc pack {args} {
	eval pack [$self set path_] $args
}
MBWidget instproc unpack {} {
	$self instvar path_
	pack forget [$self set path_]
}
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
		}
	}
}
Class SrcList -superclass { Callback Observable }
SrcList instproc init { } {
	$self instvar canv_ bottom_ mainW_ bg_ font_ \
			trackwidth_ trackX_ nameX_ srcHdr_
	set bottom_ 2
	set mainW_ [toplevel .srclist]
	wm withdraw $mainW_
	wm geometry $mainW_ 230x140
	bind $mainW_ <Enter> "focus $mainW_"
	wm title $mainW_ "MB Members"
	frame $mainW_.b -relief sunken -borderwidth 1
	scrollbar $mainW_.b.scroll -command "$mainW_.b.list yview" -width 12
	set canv_ [canvas $mainW_.b.list -relief groove -borderwidth 1 \
			-height 10 -width 10 -confine 1 -relief raised \
			-yscrollcommand "$mainW_.b.scroll set"]
	set bg_ [$canv_ cget -bg]
	$canv_ xview moveto 0
	$canv_ yview moveto 0
	bind $canv_ <Configure> "$self reconfig_canv %w %h"
	set bottom [frame $mainW_.bottom -borderwidth 0]
	button $bottom.dismiss -text "Dismiss" -command "$self dismiss" \
			-underline 0
	checkbutton $bottom.autoraise -text "Auto Raise" \
			-command "$self toggle_auto_raise"
	$self tkvar followAny_
	checkbutton $bottom.followany -text "Follow Activity" \
			-variable [$self tkvarname followAny_] \
			-command "$self followAny"
	pack $mainW_.b -fill both -expand 1
	pack $mainW_.b.list -side left -expand 1 -fill both
	pack $mainW_.b.scroll -side right -fill y -pady 2 -padx 0
	pack $bottom.dismiss $bottom.autoraise $bottom.followany -side right \
			-anchor se -padx 2 -pady 2
	pack $bottom -side bottom -expand false -fill x
	$self set auto_raise_ 0
	$self set currTrack_ {}
	set font_ [$self get_option medfont]
	set trackX_ 0
	set trackhdrbut [button $canv_.track -text "Follow" -pady 0 -anchor w]
	set trackhdr [$canv_ create window $trackX_ 0 \
			-anchor nw -window $trackhdrbut]
	set bbox [$canv_ bbox $trackhdr]
	set trackwidth_ [expr {[lindex $bbox 2] - [lindex $bbox 0]}]
	set nameX_ [expr [lindex $bbox 2] + 8]
	set srchdrbut [button $canv_.srchdr -text "Source Name" \
			-anchor w -pady 0]
	set srcHdr_ [$canv_ create window [lindex $bbox 2] 0 \
			-window $srchdrbut -anchor nw]
	set bottom_ [lindex [$canv_ bbox $srcHdr_ $trackhdr] 3]
	incr bottom_ 4
	return
	set entryheight_ [expr {[lindex [$canv_ bbox $srcHdr_ $trackhdr] 3] \
			- 2}]
	set y [expr {$entryheight_ + 2}]
	set separator [$canv_ create line $trackX_ $y 250 $y -width 1]
	set bottom_ [lindex [$canv_ bbox $separator] 3]
	incr bottom_ 2
}
SrcList instproc reconfig_canv {w h} {
	$self instvar nameX_ srcHdr_ canv_
puts "w:$w h:$h"
 puts "c: [winfo width $canv_] [$canv_ cget -width]"
	set w [expr {[winfo width $canv_] - $nameX_ + 3}]
	$canv_ itemconfig $srcHdr_ -width $w
}
SrcList instproc dismiss {} {
        $self toggle_window 0
        $self callback dismiss
}
SrcList instproc toggle_auto_raise {} {
	$self instvar auto_raise_
	if {$auto_raise_} {
		set auto_raise_ 0
	} else {
		set auto_raise_ 1
	}
}
SrcList instproc toggle_window {onoff} {
    $self instvar mainW_
    if {$onoff==0} {
        wm withdraw $mainW_
    } else {
        wm deiconify $mainW_
    }
}
SrcList instproc register {src} {
    $self notify_observers register $src
    $self instvar srcstate_ canv_ bottom_ nametag_ map_ unhilitId_ \
		    tracktag_ trackButton_ bg_ font_ nameX_ entryheight_
    DbgOut [array names nametag_]
    if [info exists nametag_($src)] {
        return
    }
    set srcstate_($src) 1
    set varname [$self tkvar trackSrc_]
    set nametag_($src) [$canv_ create text $nameX_ $bottom_ \
		    -font $font_ -text "[$src cname]" -anchor nw]
    if ![info exists entryheight_] {
	    set bbox [$canv_ bbox $nametag_($src)]
	    set entryheight_ [expr {[lindex $bbox 3] - [lindex $bbox 1]}]
    }
    $self instvar trackwidth_ trackX_
    set rectsize [expr {int(0.6*$entryheight_)}]
    set xoffset [expr {($trackwidth_ - $rectsize)/2}]
    set yoffset [expr {($entryheight_ - $rectsize)/2}]
    set tracktag_($src) [$canv_ create rect  \
		    [expr {$trackX_+$xoffset}] [expr {$bottom_+$yoffset}] \
		    [expr {$trackX_+$xoffset+$rectsize}] \
		    [expr {$bottom_+$yoffset+$rectsize}] \
		    -fill $bg_]
    $canv_ bind $tracktag_($src) <Button-1> "$self toggle_track $src"
    set left [lindex [$canv_ bbox $tracktag_($src)] 2]
    set bottom_ [lindex [$canv_ bbox $nametag_($src) $tracktag_($src)] 3]
    incr bottom_ 2
    $canv_ config -scrollregion "0 0 2.5i $bottom_"
    set unhilitId_($src) {}
}
SrcList instproc adjustNames { thresh h } {
    $self instvar nametag_ srclist bottom_
    foreach s [array names nametag_] {
        set y [lindex [$canv_ coords $nametag_($s)] 1]
        if { $y > $thresh } {
            $canv_ move $nametag_($s) 0 -$h
        }
    }
    incr bottom_ -$h
    $canv_ config -scrollregion "0 0 2.5i $bottom_"
}
SrcList instproc unregister {src} {
    $self notify_observers unregister $src
    $self instvar name_line_ info_line_ nametag_ canv_
    destroy_rtp_stats $src
    if [info exists name_line_($src)] {
        unset name_line_($src)
        unset info_line_($src)
    }
    set thresh [lindex [$canv_ coords $nametag_($src)] 1]
    set bb [$canv_ bbox $nametag_($src)]
    set height [expr [lindex $bb 3] - [lindex $bb 1]]
    incr height 2
    if [info exists canv_] {
        $canv_ delete $nametag_($src)
        unset nametag_($src)
        $self adjustNames $thresh $height
    }
}
SrcList instproc hilit {src} {
    $self notify_observers hilit $src
    $self instvar map_ canv_ nametag_ unhilitId_ mainW_
    if ![winfo ismapped $mainW_] {
        return
    }
    set tag $nametag_($src)
    $canv_ itemconfigure $tag -fill blue
    if [$self set auto_raise_] {
	    raise $mainW_
    }
    if {$unhilitId_($src)!={}} {
        after cancel $unhilitId_($src)
    }
    set unhilitId_($src) [after 200 $self unhilit $src $tag]
}
SrcList instproc update_src_info {src cname} {
	$self notify_observers update_src_info $src $cname
	$self instvar nametag_ canv_
	$canv_ itemconfigure $nametag_($src) -text "$cname"
}
SrcList instproc unhilit {src tag} {
	$self instvar canv_
	$canv_ itemconfigure $tag -fill black
	set unhilitId_($src) {}
}
SrcList instproc toggle_track {src} {
	$self instvar canv_ tracktag_ currTrack_ bg_
	$self notify_observers toggle_track $src
	if {$currTrack_!={}} {
		if {$currTrack_ == $src} {
			$canv_ itemconfig $tracktag_($src) -fill $bg_
			set currTrack_ {}
			$self callback track $src 0
			return
		} else {
			$canv_ itemconfig $tracktag_($currTrack_) -fill $bg_
		}
	}
	$canv_ itemconfig $tracktag_($src) -fill blue
	set currTrack_ $src
	$self callback track $src 1
	$self tkvar followAny_
	if {$followAny_ == 1} {
		set followAny_ 0
		$self callback followAny_ 0
	}
}
SrcList instproc set_followAny {on} {
	$self tkvar followAny_
	set followAny_ $on
}
SrcList instproc followAny {} {
	$self tkvar followAny_
	$self instvar currTrack_
	if {$currTrack_!={}} {
		$self toggle_track $currTrack_
	}
	$self callback followAny $followAny_
}
Class MBOptionMenu
MBOptionMenu instproc update {label value } {
    $self instvar varN_ labelN_ type_ menu_button_
    upvar #0 $varN_ v
    upvar #0 $labelN_ lv
    set v $value
    set lv $label
    case $type_ {
        "colors" {
            if {"$value" != ""} {
                $menu_button_ configure \
                        -bg $value -activebackground $value -text "    "
            } else {
                set bg [[winfo parent $menu_button_] cget -background]
                $menu_button_ configure \
                        -bg $bg -activebackground $bg -text $label
            }
        }
        "font" {
            $menu_button_ configure -text "Abc" -font $value
        }
        default {
            $menu_button_ configure -text $value
        }
    }
}
MBOptionMenu instproc new_color {} {
	set newcolor [tk_chooseColor -title "Choose color"]
	if {$newcolor!=""} {
		$self add_colors $newcolor $newcolor
		$self update $$newcolor $newcolor
	}
}
MBOptionMenu instproc add_colors {label value} {
    $self instvar menu_ font_
    if {"$label" == "custom"} {
        $menu_ add command -label $label -font $font_ \
                -command "$self new_color"
    } elseif {"$value" != ""} {
        $menu_ add command -label "    " -background $value \
                -activebackground $value -font $font_ \
                -command [list $self update $label $value]
    } else {
        $menu_ add command -label $label -font $font_ \
                -command [list $self update $label $value]
    }
}
MBOptionMenu instproc add_text {label value} {
    $self instvar menu_ font_
    $menu_ add command -label $label -font $font_ \
            -command [list $self update $label $value]
}
MBOptionMenu instproc add_font {label value} {
    $self instvar menu_
    $menu_ add command -label "ABCabc" -font $value \
            -command [list $self update $label $value]
}
MBOptionMenu instproc init {w varName labelName props} {
    upvar #0 $varName v
    upvar #0 $labelName lv
    $self instvar varN_ labelN_ menu_ menu_button_ type_
    set varN_ $varName
    set labelN_ $labelName
    $self instvar font_
    set font_ [$self get_option smallfont]
    set menu_button_ [menubutton $w \
            -indicatoron 0 -menu $w.menu -font $font_ \
            -relief raised -anchor c]
    set menu_ [menu $w.menu -tearoff 0]
    set type_ [lindex $props 0]
    set def [expr [lindex $props 1] * 2]
    set propslist [lrange $props 2 end]
    foreach {label value} $propslist {
        $self add_$type_ $label $value
    }
    set lv [lindex $props $def]
    set v [lindex $props [expr $def + 1] ]
    $self update $lv $v
}
proc mb_image_optionMenu {w varName firstValue args} {
    global env
    upvar #0 $varName var
    set img [image create photo -format GIF -gamma 1]
    $img read "$env(MB_BITMAPS)/red.gif" -to 0 0
    if ![info exists var] {
        set var $firstValue
    }
    menubutton $w -textvariable $varName -indicatoron 1 -menu $w.menu \
            -relief raised -bd 2 -highlightthickness 2 -anchor c
    menu $w.menu -tearoff 0
    $w.menu add command -label $firstValue\
            -command [list set $varName $firstValue]
    foreach i $args {
        $w.menu add command -image $img -command [list set $varName $i]
    }
}
proc CollapseArgsList {l} {
    set final { }
    foreach i $l {
	set var   [lindex $i 0]
	set value [lindex $i 3]
	if {[string length $value] != 0} {
	    set final [concat $final $var $value]
	}
    }
    DbgOut $final
    return $final
}
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
	radiobutton $dummy
	$self set_widget_default_ $dummy { -selectcolor }
	destroy $dummy
	entry $dummy
	$self set_widget_default_ $dummy { -font -selectbackground \
			-selectforeground -selectborderwidth }
	destroy $dummy
}
WidgetClass proc set_widget_default_ { path options } {
	$self instvar widget_defaults_
	foreach option $options {
		if { [llength $option]==1 } {
			set option [lindex $option 0]
			set widget_defaults_($option) [$path cget $option]
		} else {
			set widget_defaults_([lindex $option 0]) \
					[$path cget [lindex $option 1]]
		}
	}
}
WidgetClass proc widget_default { option } {
	$self instvar widget_defaults_
	if { [info exists widget_defaults_($option) ] } {
		return $widget_defaults_($option)
	} else {
		error "no such default option \"$option\""
	}
}
WidgetClass proc translate_default { option value } {
	if { ![string compare $value "WidgetDefault"] } {
		return [WidgetClass widget_default $option]
	} elseif { [regexp {WidgetDefault\((.*)\)} $value dummy \
			defaultOption] } {
		return [WidgetClass widget_default $defaultOption]
	}
	return $value
}
WidgetClass set_widget_default
WidgetClass instproc heritage_defaults { } {
	set heritage [$self info heritage]
	set len [expr [llength $heritage]-1]
	while { $len >= 0 } {
		set cl [lindex $heritage $len]
		incr len -1
		if { [isWidgetObject $cl] } {
			$self configspec_ [$cl info configspec] 1
			$self default_ [$cl info default]
		}
	}
}
WidgetClass instproc set_configspec { specs } {
	$self configspec_ $specs 0
}
WidgetClass instproc configspec_ { specs {isAncestor} } {
	$self instvar configspec_
	foreach spec $specs {
		if { ! $isAncestor } {
			set option  [lindex $spec 0]
			set default [lindex $spec 3]
			set spec [lreplace $spec 3 3 [WidgetClass \
					translate_default $option $default]]
			set configspec_($option) $spec
		}
		option add *$self.[lindex $spec 1] \
				[lindex $spec 3] widgetDefault
	}
}
WidgetClass instproc set_alias { aliases } {
	$self instvar configspec_
	foreach alias $aliases {
		set al   [lindex $alias 0]
		set orig [lindex $alias 1]
		if { ![info exists configspec_($orig)] } {
			error "no configspec $orig (specified in alias list)"
		}
		set configspec_($al) $configspec_($orig)
	}
}
WidgetClass instproc set_default { defaults } {
	$self default_ $defaults
	$self set defaults_ $defaults
}
WidgetClass instproc default_ { defaults } {
	foreach default $defaults {
		set option [lindex $default 0]
		set star [string last "*" $option]
		set dot  [string last "." $option]
		if { $star < $dot } {
			set idx [expr $dot+1]
		} else {
			set idx [expr $star+1]
		}
		option add *${self}$option [WidgetClass translate_default \
				-[string tolower [string range $option $idx \
				end]] [lindex $default 1]] widgetDefault
	}
}
WidgetClass instproc create { widget args } {
	eval [list $self] next [list _o$widget] [list $widget] $args
	return $widget
}
WidgetClass instproc info { option args } {
	if { $option == "default" } {
		if { $args != "" } {
			error "extra arguments in call to 'info $option'"
		}
		return [$self set defaults_]
	} elseif { $option == "configspec" } {
		$self instvar configspec_
		set len [llength $args]
		if { $len == 0 } {
			set list {}
			foreach el [array names configspec_] {
				lappend list $configspec_($el)
			}
			return $list
		}
		if { [llength $args] != 1 } {
			error "extra arguments in call to 'info $option'"
		}
		if { [info exists configspec_($args)] } {
			return $configspec_($args)
		} else {
			return ""
		}
		return [eval [list $self] next [list $option] $args]
	} else {
		return [eval [list $self] next [list $option] $args]
	}
}
WidgetClass WidgetObject -configspec {
	{-options options Options {} widget_options widget_options}
}
WidgetObject instproc init { widget args } {
	$self next
	$self instvar path_ widget_proc_
	set path_ $widget
	$self create_root_widget $widget
	if { ![winfo exists $widget] } {
		error "must create a widget $widget inside\
				[$self info class]::create_root_widget"
	}
	$self instvar widget_proc_
	set widget_proc_ "proc_$self"
	rename $widget $widget_proc_
	proc ::$widget { args } "return \[uplevel [list $self] \$args\]"
	$self build_widget $widget
	set heritage [[$self info class] info heritage]
	set idx 0
	for { set idx [expr [llength $heritage]-1] } {$idx>=0} {incr idx -1} {
		set cl [lindex $heritage $idx]
		if { [isWidgetObject $cl] } {
			$self configure_default $cl
		}
	}
	$self configure_default [$self info class]
	if { $args!="" } {
		eval [list $self] configure $args
	}
	if { [winfo toplevel $path_]==$path_ } {
		bind $widget <Destroy> "if \{\"%W\"==\"$path_\"\} \
				\{delete $self\}"
	} else {
		bind $widget <Destroy> "delete $self"
	}
}
WidgetObject instproc destroy { } {
	$self instvar path_ widget_proc_
	catch {rename $path_ {}}
	catch {rename $widget_proc_ {}}
	$self next
}
WidgetObject instproc create_root_widget { path } {
	frame $path -class [$self info class]
}
WidgetObject instproc build_widget { path } {
}
WidgetObject instproc info { option args } {
	switch $option {
		"path" {
			if { $args != "" } {
				error "extra arguments in call to 'info $option'"
			}
			return [$self set path_]
		}
		"self" { return $self }
		default {
			return [eval [list $self] next [list $option] $args]
		}
	}
}
WidgetObject instproc unknown { method args } {
	return [eval [list $self] widget_proc [list $method] $args]
}
WidgetObject instproc widget_proc { args } {
	$self instvar widget_proc_
	return [eval [list $widget_proc_] $args]
}
WidgetObject instproc config { args } {
	return [eval [list $self] configure $args]
}
WidgetObject instproc configure_default { cl } {
	set path [$self info path]
	set widget_class [winfo class $path]
	if { $widget_class == [$self info class] } {
		foreach spec [$cl info configspec] {
			set optVal [option get $path [lindex $spec 1] $cl]
			$self configure [lindex $spec 0] $optVal
		}
	} else {
		foreach spec [$cl info configspec] {
			$self configure [lindex $spec 0] [lindex $spec 3]
		}
	}
}
WidgetObject instproc configure { args } {
	set len [llength $args]
	switch $len {
		0 { return [$self configure_all] }
		1 { return [$self configure_one $args] }
		default {
			if { $len % 2 != 0 } {
				error "odd number of arguments for configure"
			}
			for { set i 0 } { $i < $len } { incr i 2 } {
				$self configure_one [lindex $args $i] \
						[lindex $args [expr $i+1]]
			}
		}
	}
}
WidgetObject instproc configure_one { args } {
	set option [lindex $args 0]
	if { [string index $option 0] != "-" } {
		error "invalid option $option: must start with -"
	}
	set option [string range $option 1 end]
	set spec [[$self info class] info configspec -$option]
	if { $spec!="" } {
		set config_proc [lindex $spec 4]
		set cget_proc   [lindex $spec 5]
		if { $cget_proc=={} } { set cget_proc $config_proc }
		if { [llength $args] < 2 } {
			return [lreplace $spec 4 end [$self $cget_proc \
					"-$option"]]
		} else {
			return [$self $config_proc "-$option" [lindex $args 1]]
		}
	}
	foreach cl [[$self info class] info heritage] {
		if { [isWidgetObject $cl] } {
			set spec [$cl info configspec -$option]
			if { $spec!="" } {
				set config_proc [lindex $spec 4]
				set cget_proc   [lindex $spec 5]
				if { $cget_proc=={} } {
					set cget_proc $config_proc
				}
				if { [llength $args] < 2 } {
					return [lreplace $spec 4 end \
							[$self $cget_proc \
							"-$option"]]
				} else {
					return [$self $config_proc "-$option" \
							[lindex $args 1]]
				}
			}
		}
	}
	return [eval [list $self] widget_proc configure $args]
}
WidgetObject instproc configure_all { } {
	set result [$self configure_all_ [$self info class]]
	foreach cl [[$self info class] info heritage] {
		if { [isWidgetObject $cl] } {
			set result [concat $result [$self configure_all_ $cl]]
		}
	}
	set result [concat $result [$self widget_proc configure]]
	return $result
}
WidgetObject instproc configure_all_ { cl } {
	set result ""
	foreach spec [$cl info configspec] {
		set option [lindex $spec 0]
		if { $option != "-options" } {
			lappend result [$self configure $option]
		}
	}
	return $result
}
WidgetObject instproc cget { option } {
	return [lindex [$self configure_one $option] 4]
}
WidgetObject instproc widget_options { option args } {
	if { [llength $args]==0 } {
		error "options has no value; cannot read it"
	}
	set root [$self info path]
	foreach option [lindex $args 0] {
		set opt [string trim [lindex $option 0]]
		set arg [lindex $option 1]
		set lastdot [string last . $opt]
		if { $lastdot <= 0 } {
			set path $root
		} else {
			set firstdot  [string first . $opt]
			set path [string range $opt 0 [expr $firstdot-1]]
			set path [$self subwidget $path]
			if { $firstdot < $lastdot } {
				set path $path.[string range $opt \
						[expr $firstdot+1] \
						[expr $lastdot -1]]
			}
		}
		set opt [string range $opt [expr $lastdot+1] end]
		$path configure -$opt $arg
	}
}
WidgetObject instproc subwidget { widget args } {
	set path "[$self info path].$widget"
	if { ![winfo exists $path] } {
		$self instvar subwidgets_
		if { ![info exists subwidgets_($widget)] } {
			error "no subwidget $widget inside [$self info path]"
		}
		set path $subwidgets_($widget)
	}
	if { [llength $args]==0 } {
		return $path
	}
	return [eval [list $path] $args]
}
WidgetObject instproc set_subwidget { name path } {
	$self instvar subwidgets_
	$self set subwidgets_($name) $path
}
WidgetObject instproc ignore_args { args } {
}
WidgetObject instproc do_when_idle { command } {
	$self instvar do_idle_ids_
	set command [string trim $command]
	if ![info exists do_idle_ids_($command)] {
		set do_idle_ids_($command) \
				[after idle "WidgetObject do_idle_ \
				[list $self] [list $command]"]
	}
}
WidgetObject proc do_idle_ { o command } {
	$o instvar do_idle_ids_
	catch {unset do_idle_ids_($command)}
	if { [info command $o]!=$o } {
		return
	}
	set w [$o info path]
	if {![winfo exists $w] || [string compare [winfo class $w] \
			[$o info class]] != 0} {
		return
	} else {
		uplevel #0 $command
	}
}
WidgetClass proc transparent_gif { {color {}} } {
	global TRANSPARENT_GIF_COLOR
	if { $color!={} } {
		set TRANSPARENT_GIF_COLOR $color
	} else {
		set TRANSPARENT_GIF_COLOR [$self widget_default -background]
	}
}
WidgetClass proc EntryBindings { tag } {
	bind $tag <FocusIn>  "$self EntryBindings_FocusIn %W"
	bind $tag <FocusOut> "$self EntryBindings_FocusOut %W"
}
WidgetClass proc EntryBindings_FocusIn { entry } {
	if [string compare [$entry get] ""] {
		$entry selection from 0
		$entry selection to   end
		$entry icursor end
	} else {
		$entry selection clear
	}
}
WidgetClass proc EntryBindings_FocusOut { entry } {
    $entry selection clear
}
WidgetClass EntryBindings Entry
if {$tcl_platform(platform)=="windows"} {
	WidgetClass transparent_gif SystemButtonFace
}
image create photo Icons(check)
Icons(check) put \x47\x49\x46\x38\x39\x61\x16\x0\x14\x0\xC2\x0\x0\xD8\xD8\xD8\xF8\xFC\xF8\x0\x0\x0\x38\xF8\x30\x80\x80\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x21\xF9\x4\x1\x0\x0\x0\x0\x2C\x0\x0\x0\x0\x16\x0\x14\x0\x0\x3\x53\x8\xBA\xDC\xFE\x50\x85\x20\x62\x9C\x43\x10\x62\x1B\xCE\x5B\xB7\x7C\x82\xC6\x49\xD3\x43\x9A\x27\x10\xC\x99\xF7\x66\xEC\x38\x9B\x28\x5C\x6E\xAD\xB\x83\x9C\xF\xB0\xE7\xD3\x6D\x84\x3B\x62\x11\x46\x40\xD6\x3C\xBF\x81\x93\xA7\x8A\x46\x93\x4A\x89\x55\xF7\x84\xCC\x7E\x58\x91\x0\xDC\xED\x94\xC2\xA2\x5\x2F\x94\x66\x50\xDB\xF0\x46\x2\x0\x3B
image create photo Icons(cross)
Icons(cross) put \x47\x49\x46\x38\x39\x61\x14\x0\x14\x0\xC2\x0\x0\xD8\xD8\xD8\xF8\xFC\xF8\x0\x0\x0\xF8\x14\x40\x80\x80\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x21\xF9\x4\x1\x0\x0\x0\x0\x2C\x0\x0\x0\x0\x14\x0\x14\x0\x0\x3\x56\x8\xBA\xBC\x11\x2D\x8A\xF6\xC6\x88\xCA\x4E\x17\xEC\xD8\x8C\x27\x6C\x95\x26\x10\x8D\xF7\x1\xE5\x77\x12\xA8\x23\xA\x9D\x9\xC3\x4C\xAD\xDA\x37\xB6\x6B\xB7\x98\x6F\xF7\x12\xE\x89\xC6\x23\x11\xB3\xF8\xA9\x40\xA9\x19\x11\x9A\x99\xB5\x5C\xC6\xE7\xAB\x34\xEA\x55\xB1\xB7\x4E\xD7\xB\xE0\xC5\x1E\xC5\xE4\x38\x19\x8C\xB4\xDD\xC9\x5\x8E\xD9\x48\x0\x0\x3B
image create photo Icons(plus)
Icons(plus) put \x47\x49\x46\x38\x39\x61\x12\x0\x12\x0\xC2\x0\x0\xD8\xD8\xD8\x0\x0\x0\xF8\xFC\xF8\xB8\xBC\xB8\x38\xF8\x30\x0\x0\x0\x0\x0\x0\x0\x0\x0\x21\xF9\x4\x1\x0\x0\x0\x0\x2C\x0\x0\x0\x0\x12\x0\x12\x0\x0\x3\x4A\x8\xBA\xDC\xFE\xF0\x85\x39\xA3\x9A\x22\xE7\x2A\xF3\x20\x44\x30\x6C\x4E\x20\xC\x28\x28\xA2\x43\xD0\x98\xAC\xCA\xB6\xC\x1C\x87\x33\x7D\x9\x60\xEF\xE3\xAE\xDD\xEF\x27\xA\x2\x4C\x94\x80\x2A\xA9\x3B\x9E\x6E\x2B\x96\xD1\x9\x9D\x4D\xA9\x29\x9C\xB4\x24\x9D\x6C\x25\x51\x14\x27\x92\xBC\x5A\x22\x9\x0\x3B
image create photo Icons(minus)
Icons(minus) put \x47\x49\x46\x38\x39\x61\x12\x0\x12\x0\xC2\x0\x0\xD8\xD8\xD8\x0\x0\x0\xF8\xFC\xF8\xB8\xBC\xB8\x38\xF8\x30\x0\x0\x0\x0\x0\x0\x0\x0\x0\x21\xF9\x4\x1\x0\x0\x0\x0\x2C\x0\x0\x0\x0\x12\x0\x12\x0\x0\x3\x41\x8\xBA\xDC\xFE\xF0\x85\x39\xA3\x9A\x22\xE7\x2A\xF3\xF8\xDF\xE6\x4\x2\x68\x82\x41\x43\x9E\x67\xBA\xAC\x6C\xFB\xA\x44\x6D\xDF\xC1\xE0\x2\xE4\xED\x13\xB9\x1D\x89\x42\x24\xEA\x66\x31\x19\x32\x79\x64\xC0\x92\xBB\x17\x33\xEA\xCC\x99\x38\x91\xA2\x65\xBB\x48\x0\x0\x3B
image create photo Icons(trashcan)
Icons(trashcan) put \x47\x49\x46\x38\x39\x61\x14\x0\x14\x0\xC2\x0\x0\xD8\xD8\xD8\x50\x54\x50\x0\x0\x0\xB8\xBC\xB8\xF8\xFC\xF8\x0\x0\x0\x0\x0\x0\x0\x0\x0\x21\xF9\x4\x1\x0\x0\x0\x0\x2C\x0\x0\x0\x0\x14\x0\x14\x0\x0\x3\x5C\x8\xBA\xDC\xEE\x21\xCA\xD7\xA2\xB8\x78\x44\x1A\xB0\xCF\xC1\x23\x7D\xD7\x4\x11\x9A\x24\xD\x1A\x14\xC\x4\xCA\x6\x72\xBA\xBC\x5A\xAC\xC1\x7B\x3A\x2B\xAB\xD8\xB\xF5\x52\x85\x18\x34\x22\xAF\xB8\x39\x9\x97\xBB\x63\x5\x46\x18\x46\x9B\x95\x58\x15\x6A\xCA\x2A\x95\x45\x11\xD5\x8A\xC3\x22\xB5\xB8\x5E\xB\xC2\x92\x45\x74\x6B\x17\x6B\x4E\x94\x72\x8C\x76\x8A\xBE\x91\x0\x0\x3B
image create photo Icons(warning)
Icons(warning) put \x47\x49\x46\x38\x39\x61\x28\x0\x28\x0\xC2\x0\x0\xD8\xD8\xD8\x78\x7C\x0\xF8\xFC\x0\xB8\xBC\xB8\x0\x0\x0\x78\x7C\x78\x0\x0\x0\x0\x0\x0\x21\xF9\x4\x1\x0\x0\x0\x0\x2C\x0\x0\x0\x0\x28\x0\x28\x0\x0\x3\xB8\x8\xBA\xDC\xFE\x30\xCA\x49\xAB\xBD\x38\xEB\x17\xFA\xCE\x81\x20\xC\xC4\x67\x85\xE2\x48\x14\xE6\x84\xA6\x2B\xDB\x72\x69\x4A\x16\xF2\xCC\xBC\x75\xAC\xEF\xB5\xDA\x2D\xA7\xE3\x5\x7D\x3F\x63\x70\x98\xB4\x11\x9E\x3\x18\xAE\xD8\x7B\x3E\x9D\xD3\x16\xCF\x7A\x95\x12\x35\x46\x2E\x41\x88\xDC\x84\xB9\xC7\x2C\x38\x28\x10\x2F\xCB\x18\x65\xC0\xAA\x84\x9F\xD8\x2A\x28\x9B\x19\xC7\xB7\xBB\x6C\x76\x2E\x7E\x2\x73\x4A\x22\x7C\x15\x87\x88\x4\x51\x7E\x82\x10\x8B\x30\x84\x2A\x6A\x12\x92\x94\x3D\x96\x91\x99\x24\x8D\x84\x89\x9C\x94\x68\x84\x90\xB\x98\x22\xA4\x7E\xA1\xD\xA8\x79\x8E\xA5\x9B\x40\x99\xB4\x5E\x5F\xA7\xB5\xB5\x43\xB7\xB8\xB9\xA0\x31\xB2\x3B\x62\xC3\xC4\xC3\x38\xC7\x14\xC7\xCA\xCB\xCC\xCD\xC1\xF\xCE\xD1\xCE\x3F\xD4\xD5\xD6\xD7\xD8\x9\x0\x3B
image create photo Icons(minimize)
Icons(minimize) put \x47\x49\x46\x38\x39\x61\x10\x0\xA\x0\xA1\x0\x0\xD8\xD8\xD8\xF8\xFC\xF8\x0\x0\x0\x80\x80\x80\x21\xF9\x4\x1\x0\x0\x0\x0\x2C\x0\x0\x0\x0\x10\x0\xA\x0\x0\x2\x1D\x84\x8F\x79\xC1\xED\x81\x82\x98\xB4\x8A\x11\x6D\x1D\x38\x6B\xAE\x0\xD2\xD6\x85\xE3\x55\x86\x22\xAA\xB6\xEE\x5B\x0\x0\x3B
image create photo Icons(maximize)
Icons(maximize) put \x47\x49\x46\x38\x39\x61\x10\x0\xA\x0\xA1\x0\x0\xD8\xD8\xD8\xF8\xFC\xF8\x0\x0\x0\x80\x80\x80\x21\xF9\x4\x1\x0\x0\x0\x0\x2C\x0\x0\x0\x0\x10\x0\xA\x0\x0\x2\x1D\x84\x8F\xA9\x16\xBB\x21\x86\x43\x50\xC4\x9\xAA\xBD\x6F\x7B\x99\x68\x9E\x5\x32\xE3\x59\x2\xC3\xCA\xB6\x29\x96\x14\x0\x3B
image create photo Icons(folder)
Icons(folder) put \x47\x49\x46\x38\x39\x61\x14\x0\xF\x0\xF2\x0\x0\xD8\xD8\xD8\x7F\x7F\x7F\xFF\xFF\x0\xFF\xFF\xFF\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x21\xF9\x4\x1\x0\x0\x0\x0\x2C\x0\x0\x0\x0\x14\x0\xF\x0\x0\x3\x41\x8\xBA\xDC\xBE\x21\xC6\xF7\x2\x10\x17\x58\xA\x33\xC6\x92\xE4\x4\x43\x69\x9E\x65\x40\x34\xE4\xE7\x79\x2A\x3B\xBC\x2E\xB8\x32\x2D\xD\xDF\xD0\x5C\xBF\x31\xDC\xE0\x57\xB\xF6\x74\x2E\xA3\x22\x47\xBC\x28\x35\xA1\x68\x88\xB7\x20\x58\xAF\x58\x2C\x67\xCB\x48\x0\x0\x3B
image create photo Icons(folderopen)
Icons(folderopen) put \x47\x49\x46\x38\x39\x61\x14\x0\xF\x0\xC2\x0\x0\xD8\xD8\xD8\x78\x7C\x78\xF8\xFC\xF8\xB8\xBC\xB8\xF8\xFC\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x21\xF9\x4\x1\x0\x0\x0\x0\x2C\x0\x0\x0\x0\x14\x0\xF\x0\x0\x3\x45\x8\xBA\xDC\xCE\x21\xC6\xF7\x82\xB8\x37\x50\x28\x6\xF1\x83\x20\x49\x8E\xF5\x9D\x21\x26\x16\x8D\x5\xA2\x68\xC0\x2E\x63\x3D\x12\x32\xA7\xEE\xF2\x90\xD3\x1D\xD8\xAB\x10\x99\x1\x5F\x48\xD9\xF\x28\x44\x11\x8D\x4C\xE4\x49\x6\x55\xD8\x6C\x85\xAA\x22\xCB\xED\x76\x37\xE0\x45\x2\x0\x3B
image create photo Icons(folderup)
Icons(folderup) put \x47\x49\x46\x38\x39\x61\x14\x0\xF\x0\xF2\x0\x0\xD8\xD8\xD8\x7F\x7F\x7F\xFF\xFF\x0\xFF\xFF\xFF\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x21\xF9\x4\x1\x0\x0\x0\x0\x2C\x0\x0\x0\x0\x14\x0\xF\x0\x0\x3\x45\x8\xBA\xDC\xBE\x21\xC6\xF7\x2\x10\x17\x58\xA\x33\xC6\x92\xE4\x4\x43\x69\x9E\x65\x40\x34\xE4\x17\x7C\x9E\xCA\xE\x97\x4\x83\x2B\xD3\x86\x6F\x9C\x43\x34\x90\x27\x23\xD3\xD\x5C\xB7\xDA\x4F\x41\x22\xF2\x70\xB3\xE4\xAD\x8\xE1\x59\x23\x4B\x5\x61\xCB\xED\x76\x39\x60\x46\x2\x0\x3B
image create photo Icons(textfile)
Icons(textfile) put \x47\x49\x46\x38\x39\x61\xF\x0\xF\x0\xA1\x0\x0\xD8\xD8\xD8\x78\x7C\x78\xF8\xFC\xF8\x0\x0\x0\x21\xF9\x4\x1\x0\x0\x0\x0\x2C\x0\x0\x0\x0\xF\x0\xF\x0\x0\x2\x32\x84\x8F\x69\xC1\xCD\xA\x82\x98\xB3\x29\x49\x85\x4B\x92\xD5\x36\x20\x58\x56\x85\x47\xE7\x94\x22\x49\x5\xE6\xA2\xA5\xDA\x1B\xB1\xEA\x19\x37\x37\x6C\xBB\xA2\x3\xA4\x1\x6\xC4\xA2\x11\x82\x34\x14\x0\x0\x3B
image create photo Icons(browse)
Icons(browse) put \x47\x49\x46\x38\x39\x61\x12\x0\x12\x0\x84\x0\x0\xD8\xD8\xD8\x78\x7C\x78\x0\xF8\xF0\xF0\xF8\xF0\x0\x0\x0\xF0\xFC\xF0\x0\xFC\xF0\x0\xF8\xF8\xF0\xF8\xF8\x0\x78\x78\x0\xFC\xF8\xF8\xF8\xF0\x0\x7C\x78\x0\x0\xF0\x0\x0\x78\x0\x0\xF8\x0\x0\x70\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x21\xF9\x4\x1\x0\x0\x0\x0\x2C\x0\x0\x0\x0\x12\x0\x12\x0\x0\x5\x64\x20\x20\x8E\x64\x69\x8A\x41\x1A\x9C\x65\x2A\xC\x2F\x41\xB0\x40\x0\xC3\x85\x90\xCF\x67\x60\xC\xBF\xD7\x61\xC0\x6B\xBD\x4\x88\x9F\x32\x51\x1C\xD9\x14\xB0\x5\x52\xB0\x60\x34\x51\x2F\x25\x10\xC8\x34\xD9\xA8\x43\xE1\xC0\xDA\xCB\x99\x75\xE4\xDE\x11\xF1\x62\x30\xAF\x23\x19\x63\x6E\x25\x34\x1A\xF0\xB8\x8C\xE0\x70\x18\xEE\x79\x27\xE\x2\x80\x34\x25\x83\xF\x78\x86\x24\x10\x7F\x81\x27\x32\x8B\x34\x21\x0\x3B
image create photo Icons(up)
Icons(up) put \x47\x49\x46\x38\x39\x61\x9\x0\x8\x0\xA1\x0\x0\xD8\xD8\xD8\xF8\xFC\xF8\x0\x0\x0\x80\x80\x80\x21\xF9\x4\x1\x0\x0\x0\x0\x2C\x0\x0\x0\x0\x9\x0\x8\x0\x0\x2\x15\x84\x11\xA7\x21\xA3\x28\xA2\x33\x2C\x4A\x68\xED\x8\x5C\x8F\x9\x68\xF\xF0\x4D\x5\x0\x3B
image create photo Icons(down)
Icons(down) put \x47\x49\x46\x38\x39\x61\x9\x0\x8\x0\xA1\x0\x0\xD8\xD8\xD8\xF8\xFC\xF8\x0\x0\x0\x80\x80\x80\x21\xF9\x4\x1\x0\x0\x0\x0\x2C\x0\x0\x0\x0\x9\x0\x8\x0\x0\x2\x14\x4\x82\x61\x1B\xE2\x63\x92\x13\x3\xB6\x39\x2D\xA6\x2C\xAF\xC8\x7D\x6\xB4\x14\x0\x3B
image create photo Icons(fastup)
Icons(fastup) put \x47\x49\x46\x38\x39\x61\x9\x0\x8\x0\xA1\x0\x0\xD8\xD8\xD8\xF8\xFC\xF8\x0\x0\x0\x80\x80\x80\x21\xF9\x4\x1\x0\x0\x0\x0\x2C\x0\x0\x0\x0\x9\x0\x8\x0\x0\x2\x15\x84\x23\x63\x8B\x92\xEC\xA2\x6A\xD1\x8D\x80\xD1\xD8\xA\xD0\xEE\x55\xF\x55\xD\x5\x0\x3B
image create photo Icons(fastdown)
Icons(fastdown) put \x47\x49\x46\x38\x39\x61\x9\x0\x8\x0\xA1\x0\x0\xD8\xD8\xD8\x0\x0\x0\x80\x80\x80\xF8\xFC\xF8\x21\xF9\x4\x1\x0\x0\x0\x0\x2C\x0\x0\x0\x0\x9\x0\x8\x0\x0\x2\x13\x44\x8E\x21\x30\xA9\x0\xDB\x59\x6C\xD8\x17\xDD\x64\x8E\xF2\xD\x65\x5E\x1\x0\x3B
image create photo Icons(cal)
Icons(cal) put \x47\x49\x46\x38\x39\x61\x1C\x0\x14\x0\xA5\x0\x0\xF8\xF8\xF8\xE0\xE0\xF8\x98\x98\xE0\x68\x68\xC0\xF8\xE0\xF8\x0\x0\xC0\x0\x0\x98\x0\x0\x68\xC0\x98\x68\xF8\xF8\xC0\xA8\xC0\xF8\xE0\xC0\x0\xC0\xC0\x98\xC0\xC0\x0\x68\x0\xC0\xE0\xE0\xC0\xF8\xF8\xE0\x68\x68\x68\xA8\xAC\x98\x68\x0\x68\xE0\xE0\x0\xF8\xF8\x98\x68\x68\xE0\x98\x68\x0\x68\x68\x0\xC0\xC0\xE0\xE0\xE0\x68\xC0\x98\x0\xF8\xF8\x68\xE0\xF8\xF8\x98\x68\x68\xF8\xF8\x0\x0\x68\xE0\x98\x68\xC0\xE0\xE0\xE0\xC0\xC0\x68\xF8\xE0\x0\x68\x68\x98\x98\x98\xC0\x0\x68\xC0\x68\x0\x98\xE0\xE0\x98\x0\x0\xE0\x98\x98\x98\xC0\x98\xC0\x98\x98\x0\xE0\xC0\x68\xC0\x98\xE0\xF8\xE0\x68\xF8\xE0\x98\xF8\xE0\xC0\xE0\xC0\x98\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x21\xF9\x4\x1\x0\x0\x0\x0\x2C\x0\x0\x0\x0\x1C\x0\x14\x0\x0\x6\xFD\x40\x80\x70\x48\x2C\x1A\x8F\x48\x40\x40\x30\x68\x12\x92\x50\xA5\xA0\x60\x30\x1C\xC\x88\x44\x32\x80\x54\x50\xAB\xB\x86\xA1\xA1\x35\x6\xA\x8E\x7\xA4\x28\xA8\x1A\x22\xD\x49\x61\x42\x59\xB3\xA9\x87\x85\x5D\xD8\xAE\xD2\x1F\x73\xB\x15\x46\x16\x55\x17\x18\x14\x44\x19\x5F\x6\xB\x9\x4\x19\x1A\x83\x6C\x55\x1B\x11\x1B\x93\x4A\x8C\xD\x1C\x44\x1\x4\x1D\xA0\x0\x8B\x6\x1B\x1E\x11\x89\x43\x85\x86\x1F\x43\x4B\x5\x5\x20\x5\x21\x22\x54\x97\xA5\x99\x1\x6E\x8D\x76\x67\xBB\x6\x17\x23\x86\xC0\x24\x44\xAB\xC0\x9D\x9A\x95\x25\x60\x26\x6E\x74\x7B\x0\x3\x6E\xD\x93\x7D\x1B\xD\x86\x24\x27\x6E\x82\x45\xD3\x95\x83\xBE\x1E\xD\x54\xD0\x5F\xD5\x84\x6E\x28\x29\x1\x20\xBF\xA5\x29\x2A\xD4\x47\x1D\x8C\x6\xF7\xBB\x54\x1E\x2B\x55\x2C\x5C\x45\x2\x98\x18\x80\xE2\xC0\x84\x16\x2C\xE0\x1D\x68\xE1\x82\x14\x3E\x11\x47\x5E\xE4\x83\x57\x5\x96\xA1\x54\xAE\xE6\xAD\xA3\xB8\xEB\xE0\x2\x18\xD1\x0\xB4\xB9\xD0\xC0\x85\x86\x18\x29\x64\xA4\x78\x80\x32\xC5\xC\xD\x29\x52\xC4\x48\x10\x52\x48\x0\x11\x10\x6A\x46\x29\x12\x4\x0\x3B
image create photo Icons(ear)
Icons(ear) put \x47\x49\x46\x38\x37\x61\xD\x0\x14\x0\xF0\x0\x0\xFF\xFF\xFF\x0\x0\x0\x2C\x0\x0\x0\x0\xD\x0\x14\x0\x0\x2\x2D\x84\x8F\x9\xC1\x9D\xAC\xA0\x9\x6A\xD2\x65\x1D\xC6\x72\x7A\x7A\x35\x10\x8\x72\x63\x65\x6D\x48\x58\xAE\xAC\x9A\x95\x57\x45\xA2\x5C\xE4\xCC\xA8\xEE\xAD\x91\xFF\x4B\xE1\x34\x87\x2\x0\x3B
image create photo Icons(hand)
Icons(hand) put \x47\x49\x46\x38\x37\x61\x10\x0\x10\x0\xF0\x0\x0\xFF\xFF\xFF\x0\x0\x0\x2C\x0\x0\x0\x0\x10\x0\x10\x0\x0\x2\x29\x84\xF\x11\xC8\xB9\xEB\x20\x82\xCA\x50\x46\x6F\xDA\x47\x67\xCE\x79\x96\x3\x4E\xD6\xD7\x74\x92\xD4\x68\x69\x7\xBF\xE3\xFC\xB2\x25\xD6\xA6\x76\x6C\xEA\xB9\x51\x0\x0\x3B
WidgetClass DropDown -configspec {
	{ -variable variable Variable {} config_var cget_var }
	{ -value value Value {} config_value cget_value }
	{ -state state State {normal} config_state }
	{ -label label Label {} config_label }
} -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 } {
	$self set label_ {}
	menubutton $path.button -menu $path.button.menu
	pack $path.button -fill both -expand 1 -padx 0 -pady 0 -side bottom
	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_label { option args } {
	$self instvar label_
	if { [llength $args] == 0 } {
		return $label_
	} else {
		set label_ [lindex $args 0]
		set path [$self info path]
		if { $label_=={} } {
			if [winfo exists $path.label] {
				set bd [$path cget -bd]
				set relief [$path cget -relief]
				destroy $path.label
				$path.button configure -bd $bd -relief $relief
				$path configure -bd 0 -relief flat
			}
		} else {
			if ![winfo exists $path.label] {
				button $path.label -bd 0 -highlightthickness 0\
						-relief flat \
						-activebackground \
						[WidgetClass widget_default \
						-background]
				set bd [$path.button cget -bd]
				set relief [$path.button cget -relief]
				$path configure -bd $bd -relief $relief
				$path.button configure -bd 0 -relief flat
			}
			eval $path.label configure $label_
			pack $path.label -side top -padx 0 -pady 0 -fill x
		}
	}
}
DropDown instproc config_state { option {value {}} } {
	$self instvar label_
	if { $value=={} } {
		return [$self subwidget button cget -state]
	} else {
		$self subwidget button configure -state $value
		if { $label_ != {} } {
			$self subwidget label 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 } {
	if { [lindex $value 0] == "-image" } {
		$self subwidget menu insert $index command -image \
				[lindex $value 1] \
				-command "[list $self] set_var [list $value]"
	} else {
		$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
	if { [lindex $global_var 0] == "-image" } {
		$self subwidget button configure -image [lindex $global_var 1]
	} else {
		$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" } {
		error "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
	}
	if { [string index $global_var 0]=="/" } {
		$self subwidget button configure -background \
				[WidgetClass widget_default -background] \
				-activebackground \
				[WidgetClass widget_default -background] \
				-text [string range $global_var 1 end]
	} else {
		$self subwidget button configure -background $global_var \
				-activebackground $global_var -text "    "
	}
}
WidgetClass DropDown/Font -superclass DropDown
DropDown/Font instproc insert_item { index value } {
	upvar \#0 [$self set var_] global_var
	$self subwidget menu insert $index command -label ABCabc \
			-font $value \
			-command "[list $self] set_var [list $value]"
	$self set index_($value) $index
	if { $global_var == $value } {
		$self var_trace
	}
}
DropDown/Font instproc var_trace { args } {
	upvar \#0 [$self set var_] global_var
	if { $global_var=="" } return
	$self subwidget button configure -text ""
	$self instvar index_ last_
	if { [array exists last_] && $last_(index)!={} } {
		$self subwidget menu entryconfigure $last_(index) \
				-background $last_(color)
	}
	if ![info exists index_($global_var)] return
	if { ![array exists last_] || $last_(index) != $index_($global_var) } {
		set last_(index) $index_($global_var)
		set last_(color) [$self subwidget menu entrycget $last_(index)\
				-background]
	}
	$self subwidget menu entryconfigure $index_($global_var) \
			-background [WidgetClass widget_default -selectcolor]
}
WidgetClass DropDown/Text -superclass DropDown -configspec {
	{-entryVal entryVal EntryVal {} config_entryVal cget_entryVal}
} -default {
	{ .highlightThickness 2 }
	{ .takeFocus 0 }
	{ .relief sunken }
	{ .borderWidth 2 }
	{ *button.highlightThickness 0 }
	{ *button.takeFocus 0 }
	{ *button.padX 0 }
	{ *button.padY 0 }
	{ *entry.highlightThickness 0 }
	{ *entry.takeFocus 1 }
	{ *entry.relief flat }
	{ *entry.borderWidth 0 }
}
DropDown/Text instproc config_entryVal { option value} {
	$self subwidget entry delete 0 end
	$self subwidget entry insert 0 $value
}
DropDown/Text instproc cget_entryVal { option value} {
	return [$self subwidget entry get]
}
DropDown/Text instproc build_widget { path } {
	entry $path.entry
	pack $path.entry -side left -fill both -expand 1
	$self next $path
	pack configure $path.button -side right -fill y -expand 0
	set script [bind Menubutton <Key-space>]
	regsub -all -- {%W} $script $path.button new_script
	bind $path.entry <Key-Down> $new_script
	bind $path.entry <Return> "$self return_pressed \[%W get\]"
	bind $path.entry <FocusOut> "$self restore_entry"
}
DropDown/Text instproc return_pressed { text } {
	$self set_var $text
	set path [$self info path]
	$path.entry selection from 0
	$path.entry selection to end
	$path.entry icursor end
}
DropDown/Text instproc restore_entry {} {
	upvar #0 [$self set var_] global_var
	if [info exists global_var] {
		$self config_entryVal {} $global_var
	} else {
		$self config_entryVal {} {}
	}
}
DropDown/Text instproc config_state { option {value {}} } {
	if { $value=={} } {
		return [$self subwidget cget button -state]
	} else {
		$self subwidget button configure -state $value
		$self subwidget entry  configure -state $value
	}
}
DropDown/Text instproc set_var { value } {
	$self next $value
}
DropDown/Text instproc clear { } {
	$self set_var ""
}
DropDown/Text instproc var_trace { args } {
	upvar #0 [$self set var_] global_var
	set path [$self info path]
	if { [$path.entry selection present] && [focus]==$path } {
		$self config_entryVal {} $global_var
		$path.entry selection from 0
		$path.entry selection to end
		$path.entry icursor end
	} else {
		$self config_entryVal {} $global_var
	}
}
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}
}
Class MBPageNavPanel -superclass {MBWidget Observer}
MBPageNavPanel public init {parent pageMgr} {
	$self set pageMgr_ $pageMgr
	$self set path_ [frame $parent.pgnavpanel]
	$pageMgr attach_observer $self
}
MBPageNavPanel private switch_page {page_id} {
	$self instvar pageList_ zoom_
	if [info exists pageList_] {
		$pageList_ switch_page $page_id
	}
	if [info exists zoom_] {
		after idle "$self update_zoomscale"
	}
}
MBPageNavPanel public add_page {page_id} {
	[$self set pageList_] add_page $page_id
}
MBPageNavPanel public build_widgets {widget_list} {
	foreach wgt $widget_list {
		$self build_$wgt
	}
}
MBPageNavPanel private build_pagelist {} {
	$self instvar path_ pageList_ pageMgr_
	set pageList_ [new MBPageList $pageMgr_ $path_ -padx 1 -pady 1 \
			-side left -anchor c -fill y]
}
MBPageNavPanel private build_prev {} {
	$self instvar path_ pageList_ prev_
	set prev_ [button $path_.p -fg blue -bitmap back  \
                        -command "$pageList_ nextPage -1"]
	pack $prev_ -after [$pageList_ get_menubutton] \
			-side left  -anchor e -padx 1 -pady 3 -fill y
}
MBPageNavPanel private build_next {} {
	$self instvar path_ pageList_ next_
	set next_ [button $path_.n -fg blue -bitmap forw  \
                        -command "$pageList_ nextPage 1"]
	pack $next_ -after [$pageList_ get_menubutton] \
			-side left  -anchor e -padx 1 -pady 3 -fill y
}
MBPageNavPanel private build_zoom {} {
	$self instvar path_ pageList_ zoom_ zoomValue_
	$self tkvar zoomValue_
	set zoom_ [DropDown/Text $path_.z -width 5 \
			-var [$self tkvarname zoomValue_] -options {
		{ entry.width 15 }
	}]
	trace variable zoomValue_ w "$self set_zoom"
	$zoom_ insert end "fix to view" 50% 100% 125% 150% 175% 200% \
			"fit width" "fit height" \
			"fit all"
	pack $zoom_ -side left -anchor e -padx 1 -pady 1 -fill y
}
MBPageNavPanel private set_zoom {args} {
	$self instvar zoom_ pageMgr_
	$self tkvar zoomValue_
	set currCanvas [$pageMgr_ current_canvas]
	if {$currCanvas!={}} {
		$currCanvas zoom_policy $zoomValue_
		$self update_zoomscale
	}
}
MBPageNavPanel public update_zoomscale {} {
	$self instvar pageMgr_ zoom_
	$self tkvar zoomValue_
	set canv [$pageMgr_ current_canvas]
	if {$canv!={}} {
		if {$zoomValue_!="fix to view"} {
			set label ""
		} else {
			set label "\[$zoomValue_\] "
		}
		append label [expr {int(100*([$canv getscale]+0.005))}] "%"
		$zoom_ configure -entryVal $label
	}
}
Class MBPageList
MBPageList public init {pageMgr parent args} {
	$self next
	$self set pageMgr_ $pageMgr
        $self instvar menubutton_ pagelist_ menus_
	set medfont [$self get_option medfont]
        set menubutton_ [menubutton $parent.pagelist -text "      " \
                        -menu $parent.pagelist.menu -indicator 0 \
			-font $medfont \
                        -relief raised -highlightthickness 2 -anchor c]
        lappend menus_ [menu $parent.pagelist.menu \
                        -tearoff 1 -tearoffcommand [list $self tearoff]]
        eval pack $menubutton_ $args
        set pagelist_ {}
}
MBPageList public get_menubutton {} {
        return [$self set menubutton_]
}
MBPageList public get_copy {parent} {
	global tcl_version
	if {$tcl_version >= 8} {
		set clonemenu $parent.pagelist
		[lindex [$self set menus_] 0] clone $clonemenu
		return $clonemenu
	}
        $self instvar menus_ pagelist_ pageMgr_
	set medfont [$self get_option medfont]
        set menu [menu $parent.pagelist -tearoff 0]
        foreach pageid $pagelist_ {
                $menu add radiobutton -label [$self page_label $page_id] \
                                -value $page_id -font $medfont\
				-variable [$self tkvarname currPage_] \
                                -command "$pageMgr_ switch_page_later $page_id"
        }
        lappend menus_ $menu
        return $menu
}
MBPageList public tearoff {menu newmenu} {
        $self instvar menus_
        lappend menus_ $newmenu
        wm title $newmenu "MB Pages"
        wm resizable $newmenu false false
}
MBPageList public switch_page {page_id} {
	[$self set menubutton_] configure -text [$self page_label $page_id]
	$self tkvar currPage_
	set currPage_ $page_id
}
MBPageList private page_label {page_id} {
	return [[$self set pageMgr_] page_label $page_id]
}
MBPageList public add_page {page_id} {
        $self instvar menubutton_ pagelist_ menus_ labels_
        set wrk [split $page_id :]
        set host [lindex $wrk 0]
        set puid "0x"
        append puid [lindex $wrk 1]
        set idx 0
        foreach elt $pagelist_ {
                set wrk [split $elt :]
                if {[lindex $wrk 0] > $host} {
                        incr idx
                        continue
                }
                if {[lindex $wrk 0] == $host} {
                        set p "0x"
                        append p [lindex $wrk 1]
                        if {$puid > $p} {
                                incr idx
                                continue
                        }
                }
                break
        }
	set sortedlist [linsert $pagelist_ $idx $page_id]
	set next_idx [lindex $sortedlist [expr $idx + 1]]
	if {$next_idx=={}} {
                set next_idx "end"
        } else {
                set next_idx $labels_($next_idx)
        }
	set medfont [$self get_option medfont]
	global tcl_version
	if {$tcl_version < 8} {
		set menu_list $menus_
	} else {
		set menu_list [lindex $menus_ 0]
	}
	$self instvar pageMgr_
        foreach menu $menu_list {
                $menu insert "$next_idx" radiobutton -label \
                                [$self page_label $page_id] \
                                -value $page_id \
				-variable [$self tkvarname currPage_] \
                                -command "$pageMgr_ switch_page_later $page_id" \
                                -font $medfont
        }
        set labels_($page_id) [$self page_label $page_id]
        if {$pagelist_==""} {
                $menubutton_ configure -text [$self page_label $page_id]
                set currPage_ $page_id
        }
        set pagelist_ $sortedlist
}
MBPageList instproc pagelist {} {
	return [$self set pagelist_]
}
MBPageList instproc nextPage { dir } {
        $self instvar pagelist_ pageMgr_
        if {$pagelist_=={}} { return }
        set c [lsearch -exact $pagelist_ [$pageMgr_ current_page]]
        set i $c
        if {$i==-1} {
                puts stderr "current page not in list! should not happen"
        }
        set l [llength $pagelist_]
        incr i $dir
        set i [ expr ($i < 0) ? ($l - 1) : (($i >= $l) ? 0 : $i) ]
        if {$i != $c} {
                set next_pg [lindex $pagelist_ $i]
                mtrace trcVerbose "next_pg=$next_pg i=$i l=$l"
                $pageMgr_ switch_page_later $next_pg
        }
}
MBPageList instproc update_src_info {src newcname} {
        $self instvar labels_ menus_ pagelist_
        foreach pageid $pagelist_ {
                set srcid [split [$src srcid] "@"]
                set patt [join [list [lindex $srcid 1] "_" \
                                [lindex $srcid 0] "*"] ""]
                if [string match $patt $pageid] {
                        set newLabel [$self page_label $pageid]
                        foreach menu $menus_ {
                                $menu entryconfigure $labels_($pageid) \
                                                -label $newLabel
                        }
                        set labels_($pageid) $newLabel
                }
        }
	$self instvar menubutton_
	$self tkvar currPage_
	if [info exists currPage_] {
		$menubutton_ configure -text [$self page_label $currPage_]
	}
}
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 local config_modal }
	{ -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_]
	}
	if { [$self cget -modal] == "global" } {
		grab -global $path
	} else {
		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] != "none" } {
		$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 config_modal { option args } {
	$self instvar config_
	if { [llength $args]==0 } {
		return $config_($option)
	} else {
		set value [lindex $args 0]
		if { $value == "0" } { set value none } \
				elseif { $value == "1" } { set value local }
		set config_($option) $value
	}
}
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 != "none" } {
		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 ScrolledWidget -configspec {
	{ -scrollbar scrollbar Scrollbar {none} config_scroll cget_scroll }
}
ScrolledWidget instproc build_widget { path } {
	frame  $path.dummy -borderwidth 0 -relief flat
	set main [$self create_main_widget $path]
	scrollbar $path.vscroll -orient vertical
	scrollbar $path.hscroll -orient horizontal
	pack $path.dummy -side top -fill both -expand 1
	$self replace_main_widget $main
}
ScrolledWidget instproc replace_main_widget { widget } {
	$self instvar main_
	if { [info exists main_] } {
		if { $main_ == $widget } return
		catch { pack forget $main_ }
	}
	set main_ $widget
	set path [$self info path]
	$path.vscroll configure -command "$main_ yview"
	$path.hscroll configure -command "$main_ xview"
	$main_ configure -yscrollcommand "$path.vscroll set"
	$main_ configure -xscrollcommand "$path.hscroll set"
	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 ScrolledWinMgr -superclass ScrolledCanvas
ScrolledWinMgr public add_window { path x y } {
	$self instvar windows_
	set bbox [$self subwidget bbox]
	if { [winfo parent $path] != $bbox } {
		error "$path is not a child of ScrolledWinMgr::holder"
	}
	set id [$bbox create window $x $y -anchor nw -window $path \
			-tags all_windows]
	set windows_($path) $id
	bind $path <Configure> "+$self recompute_scrollregion"
	$self recompute_scrollregion
}
ScrolledWinMgr public move_window { path x y } {
	$self instvar windows_
	set bbox [$self subwidget bbox]
	set current [$bbox coords $windows_($path)]
	set dx [expr $x - [lindex $current 0]]
	set dy [expr $y - [lindex $current 1]]
	$bbox move $windows_($path) $dx $dy
	raise $path
}
ScrolledWinMgr public remove_window { path } {
	$self instvar windows_
	set bbox [$self subwidget bbox]
	$bbox delete $windows_($path)
	unset windows_($path)
}
ScrolledWinMgr public holder { } {
	return [$self subwidget bbox]
}
ScrolledWinMgr private recompute_scrollregion { } {
	set bbox [$self subwidget bbox]
	$bbox configure -scrollregion [$bbox bbox all_windows]
}
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 padY Label]=="" } {
		$path configure -pady 1
	}
}
ListLabelItem instproc config_value { option args } {
	$self instvar config_
	if { [llength $args]==0 } {
		return [$self widget_proc cget -text]
	} else {
		$self widget_proc configure -text [lindex $args 0]
	}
}
ListLabelItem instproc config_option { option args } {
	$self instvar config_
	if { [llength $args]==0 } {
		return $config_($option)
	} else {
		set value [lindex $args 0]
		set config_($option) $value
		$self config_[string range $option 1 end] $value
	}
}
ListLabelItem instproc config_relief { option value } {
	$self widget_proc configure -relief $value
}
ListLabelItem instproc cget_relief { option } {
	$self widget_proc cget -relief
}
ListLabelItem instproc config_normalbackground { value } {
	if { ![$self set config_(-select)] } {
		$self widget_proc configure -bg $value
	}
}
ListLabelItem instproc config_normalforeground { value } {
	if { ![$self set config_(-select)] } {
		$self widget_proc configure -fg $value
	}
}
ListLabelItem instproc config_normalrelief { value } {
	if { ![$self set config_(-select)] && \
			![$self set config_(-highlight)] } {
		$self widget_proc configure -relief $value
	}
}
ListLabelItem instproc config_selectbackground { value } {
	if { [$self set config_(-select)] } {
		$self widget_proc configure -bg $value
	}
}
ListLabelItem instproc config_selectforeground { value } {
	if { [$self set config_(-select)] } {
		$self widget_proc configure -fg $value
	}
}
ListLabelItem instproc config_selectrelief { value } {
	if { [$self set config_(-select)] && \
		![$self set config_(-highlight)] } {
		$self widget_proc configure -relief $value
	}
}
ListLabelItem instproc config_highlightrelief { value } {
	if { [$self set config_(-highlight)] } {
		$self widget_proc configure -relief $value
	}
}
ListLabelItem instproc config_select { value } {
	$self instvar config_
	if { $value } {
		$self widget_proc configure -bg $config_(-selectbackground)
		$self widget_proc configure -fg $config_(-selectforeground)
		if { !$config_(-highlight) } {
			$self widget_proc configure \
					-relief $config_(-selectrelief)
		}
	} else {
		$self widget_proc configure -bg $config_(-normalbackground)
		$self widget_proc configure -fg $config_(-normalforeground)
		if { !$config_(-highlight) } {
			$self widget_proc configure \
					-relief $config_(-normalrelief)
		}
	}
}
ListLabelItem instproc config_highlight { value } {
	$self instvar config_
	if { $value } {
		$self widget_proc configure -relief $config_(-highlightrelief)
	} else {
		if { $config_(-select) } {
			$self widget_proc configure \
					-relief $config_(-selectrelief)
		} else {
			$self widget_proc configure \
					-relief $config_(-normalrelief)
		}
	}
}
WidgetClass ScrolledListbox -superclass ScrolledWindow -configspec {
	{ -itemclass itemClass ItemClass ListLabelItem config_option }
	{ -browsecmd browseCmd BrowseCmd "" config_option }
	{ -command command Command "" config_option }
	{ -selectmode selectMode SelectMode single config_selectmode }
} -default {
	{ *window.takeFocus 1 }
	{ *window.highlightThickness 0 }
}
ScrolledListbox instproc build_widget { path } {
	$self next $path
	set window [$self subwidget window]
	frame $window.dummy_ -width 0 -height 0 -relief flat \
			-bg [$window cget -bg]
	pack $window.dummy_ -side top
	$self create_bindtag
	$self set count_ 0
	$self set highlight_ ""
}
ScrolledListbox instproc create_bindtag { } {
	bind [$self subwidget bbox] <Configure> "+$self ev_bbox_resize_ %w %h"
	set window [$self subwidget window]
	bind $window <KeyPress-Up> "$self ev_key_up_"
	bind $window <KeyPress-Down> "$self ev_key_down_"
	bind $window <KeyPress-space> "$self ev_key_space_"
	bind Bindings_$self <ButtonPress-1> "+$self selection.toggle -widget \
			\[$self root_widget_ %W\]; $self browse \
			\[$self widget_to_id_ \[$self root_widget_ %W\]\]"
	bind Bindings_$self <Double-1> "+$self invoke \
			\[$self widget_to_id_ \[$self root_widget_ %W\]\]"
	bind Bindings_$self <Enter> "+if \{ \[$self root_widget_ %W\] == \
			\"%W\" \} \{ $self highlight.set -widget %W \}"
	bind Bindings_$self <Leave> "+if \{ \[$self root_widget_ %W\] == \
			\"%W\" \} \{ $self highlight.clear -widget %W \}"
}
ScrolledListbox instproc ev_bbox_resize_ { w h } {
	set window [$self subwidget window]
	set bbox   [$self subwidget bbox]
	$window.dummy_ configure \
			-width [expr $w - ([$bbox cget -bd] + \
			[$window cget -bd] + [$bbox cget -highlightthickness] \
			+ [$window cget -highlightthickness]) * 2]
}
ScrolledListbox instproc ev_key_up_ { } {
	set highlight [$self highlight.get]
	if { $highlight != "" } {
		set list [$self widget_list_]
		set idx [lsearch $list [$self id_to_widget_ $highlight]]
		if { $idx <= 0 } {
			return
		}
		incr idx -1
	} else {
		set idx 0
	}
	$self see $idx
	$self highlight.set $idx
}
ScrolledListbox instproc ev_key_down_ { } {
	set highlight [$self highlight.get]
	if { $highlight != "" } {
		set list [$self widget_list_]
		set idx [lsearch $list [$self id_to_widget_ $highlight]]
		if { $idx < 0 || $idx >= [expr [llength $list]-1] } {
			return
		}
		incr idx 1
	} else {
		set idx 0
	}
	$self see $idx
	$self highlight.set $idx
}
ScrolledListbox instproc ev_key_space_ { } {
	set highlight [$self highlight.get]
	if { $highlight != "" } {
		$self selection.toggle -id $highlight
		$self browse $highlight
	}
}
ScrolledListbox instproc root_widget_ { path } {
	set window [$self subwidget window]
	set widget $path
	while { $widget!="" && [winfo parent $widget] != $window } {
		set widget [winfo parent $widget]
	}
	if { $widget=="" } {
		error "invalid widget $path"
	}
	return $widget
}
ScrolledListbox instproc widget_list_ { } {
	set list [pack slaves [$self subwidget window]]
	return [lrange $list 1 end]
}
ScrolledListbox instproc config_option { option args } {
	$self instvar config_
	if { [llength $args]==0 } {
		return $config_($option)
	} else {
		set config_($option) [lindex $args 0]
	}
}
ScrolledListbox instproc config_selectmode { option args } {
	$self instvar config_
	if { [llength $args]==0 } {
		return $config_(-selectmode)
	}
	set value [lindex $args 0]
	switch -exact -- $value {
		single {
			set config_(-selectmode) "single"
			set selection [lindex [$self selection.get all] 0]
			$self selection.clear all
			if { $selection!="" } {
				$self selection.set -id $selection
			}
		}
		multiple {
			set config_(-selectmode) "multiple"
		}
		none {
			set config_(-selectmode) "none"
			$self selection.clear all
		}
		default {
			error "invalid selectmode \"$value\". must be one of\
					\"single\", \"multiple\", or \"none\""
		}
	}
}
ScrolledListbox instproc browse { id } {
	set browsecmd [$self cget -browsecmd]
	if { $browsecmd!="" } {
		uplevel #0 $browsecmd [list $id]
	}
}
ScrolledListbox instproc invoke { id } {
	set command [$self cget -command]
	if { $command!="" } {
		uplevel #0 $command [list $id]
	}
}
ScrolledListbox instproc ID { idVar arguments { idx 0 } } {
	upvar $idVar id
	if { [llength $arguments] <= $idx } {
		error "missing arguments"
	}
	set arg [lindex $arguments $idx]
	switch -exact -- $arg {
		-id {
			set end [expr $idx+2]
			if { [llength $arguments] < $end } {
				error "missing argument for \"-id\""
			}
			set id [lindex $arguments [expr $idx+1]]
			return $end
		}
		-widget {
			set end [expr $idx+2]
			if { [llength $arguments] < $end } {
				error "missing argument for \"-widget\""
			}
			set widget [lindex $arguments [expr $idx+1]]
			set id [$self widget_to_id_ $widget]
			return $end
		}
		-value {
			set end [expr $idx+2]
			if { [llength $arguments] < $end } {
				error "missing argument for \"-value\""
			}
			set widget [lindex $arguments [expr $idx+1]]
			set id [$self value_to_id_ $widget]
			return $end
		}
		default {
			set id [$self index_to_id_ $arg]
			return [expr $idx+1]
		}
	}
}
ScrolledListbox instproc widget_to_id_ { widget } {
	$self instvar widget_to_id_
	if [info exists widget_to_id_($widget)] {
		return $widget_to_id_($widget)
	} else {
		error "invalid widget \"$widget\""
	}
}
ScrolledListbox instproc value_to_id_ { value } {
	foreach widget [self widget_list_] {
		if { $value == [$self info.value -widget $widget] } {
			return $id
		}
	}
	error "invalid value \"$value\""
}
ScrolledListbox instproc index_to_id_ { index } {
	set widget [lindex [$self widget_list_] $index]
	if { $widget=="" } {
		error "invalid index \"$index\""
	}
	return [$self widget_to_id_ $widget]
}
ScrolledListbox instproc id_to_widget_ { id } {
	$self instvar id_to_widget_
	if [info exists id_to_widget_($id)] {
		return $id_to_widget_($id)
	} else {
		error "invalid id \"$id\""
	}
}
ScrolledListbox instproc id_to_value_ { id } {
	set widget [$self id_to_widget_ $id]
	return [$widget cget -value]
}
ScrolledListbox instproc insert { where args } {
	$self instvar count_ id_to_widget_ widget_to_id_
	switch -exact -- $where {
		end {
			set where ""
		}
		after {
			set idx [$self ID where_id $args]
			set where "-after [$self id_to_widget_ $where_id]"
			set args [lrange $args $idx end]
		}
		before {
			set idx [$self ID where_id $args]
			set where "-before [$self id_to_widget_ $where_id]"
			set args [lrange $args $idx end]
		}
		default {
			error "invalid argument \"$where\". must be one of\
					\"end\", \"after\", or \"before\""
		}
	}
	set window [$self subwidget window]
	set item_class [$self cget -itemclass]
	if { $item_class=="" } {
		error "must configure -itemclass before inserting any elements"
	}
	foreach arg $args {
		if { [lindex $arg 0] == "-id" } {
			if { [llength $arg] <= 1 } {
				error "missing argument for \"-id\""
			}
			set id [lindex $arg 1]
			set arg [lrange $arg 2 end]
		} else {
			set id #$count_
		}
		if { [info exists id_to_widget_($id)] } {
			error "id \"$id\" already exists"
		}
		set widget $window.item_$count_
		incr count_
		$item_class $widget -value $arg
		$self bindtag_recursive_ $widget
		if { $where=="" } {
			pack $widget -side top -fill x -expand 1
		} else {
			eval pack [list $widget] -side top -fill x -expand 1 \
					$where
		}
		set id_to_widget_($id) $widget
		set widget_to_id_($widget) $id
	}
}
ScrolledListbox instproc delete { args } {
	$self instvar id_to_widget_ widget_to_id_ selection_ highlight_
	if { [lindex $args 0]=="all" } {
		if { [llength $args]!=1 } {
			error "extra arguments starting at argument 2"
		}
		foreach widget [$self widget_list_] {
			destroy $widget
		}
		catch {
			unset id_to_widget_
			unset widget_to_id_
			unset selection_
		}
		set highlight_ ""
	} else {
		set id [eval [list $self] info.id $args]
		set widget [$self id_to_widget_ $id]
		destroy $widget
		catch {
			unset id_to_widget_($id)
			unset widget_to_id_($widget)
			unset selection_($id)
		}
		if { $highlight_==$id } {
			set highlight_ ""
		}
	}
}
ScrolledListbox instproc bindtag_recursive_ { widget } {
	$self bindtag_ $widget
	foreach path [winfo children $widget] {
		$self bindtag_recursive_ $path
	}
}
ScrolledListbox instproc bindtag_ { widget } {
	set tags [bindtags $widget]
	if {[lsearch -exact $tags Bindings_$self] == -1} {
		bindtags $widget [concat [list Bindings_$self] $tags]
	}
}
ScrolledListbox instproc see { args } {
	set id [eval [list $self] info.id $args]
	set widget [$self id_to_widget_ $id]
	set y1 [winfo y $widget]
	set y2 [expr $y1 + [winfo height $widget] - 1]
	set viewable [$self subwidget bbox yview]
	set scrollregion [$self subwidget bbox cget -scrollregion]
	set height [expr [lindex $scrollregion 3] - [lindex $scrollregion 1]]
	set bbox_y1 [expr $height * [lindex $viewable 0] + \
			[lindex $scrollregion 1]]
	set bbox_y2 [expr $height * [lindex $viewable 1] + \
			[lindex $scrollregion 1]]
	if { $y1 < $bbox_y1 } {
		set bbox_y1 $y1
		$self subwidget bbox yview moveto \
				[expr double($bbox_y1)/double($height)]
	} elseif { $y2 > $bbox_y2 } {
		set bbox_y1 [expr $y2 - ($bbox_y2 - $bbox_y1)]
		$self subwidget bbox yview moveto \
				[expr double($bbox_y1)/double($height)]
	}
}
ScrolledListbox instproc info { method args } {
	if { [$class info instprocs info.$method] == "info.$method" } {
		return [eval [list $self] [list info.$method] $args]
	} else {
		return [eval [list $self] next [list $method] $args]
	}
}
ScrolledListbox instproc info.id { args } {
	set idx [$self ID id $args]
	if { [llength $args] > $idx } {
		error "extra arguments starting with argument $idx"
	}
	return $id
}
ScrolledListbox instproc info.widget { args } {
	set id [eval [list $self] info.id $args]
	return [$self id_to_widget_ $id]
}
ScrolledListbox instproc info.value { args } {
	set id [eval [list $self] info.id $args]
	return [$self id_to_value_ $id]
}
ScrolledListbox instproc info.all { {what {}} } {
	switch -exact -- $what {
		{} -
		-id {
			set ids {}
			foreach widget [$self widget_list_] {
				lappend ids [$self widget_to_id_ $widget]
			}
			return $ids
		}
		-widget {
			return [$self widget_list_]
		}
		-value {
			set values
			foreach widget [$self widget_list_] {
				set id [$self widget_to_id_ $widget]
				lappend values [$self id_to_value_ $id]
			}
			return $values
		}
		default {
			error "invalid argument \"$what\". must be one of\
					\"-id\", \"-widget\", or \"-value\""
		}
	}
}
ScrolledListbox instproc info.exists { args } {
	set len [llength $args]
	if { $len > 2 } {
		error "extra arguments"
	}
	switch -exact -- [lindex $args 0] {
		-id {
			if { $len < 2 } {
				error "missing argument for \"-id\""
			}
			return [info exists id_to_widget_([lindex $args 1])]
		}
		-widget {
			if { $len < 2 } {
				error "missing argument for \"-widget\""
			}
			return [info exists widget_to_id_([lindex $args 1])]
		}
		-value {
			if { $len < 2 } {
				error "missing argument for \"-widget\""
			}
			return ![catch {$self value_to_id_ [lindex $args 1]}]
		}
		default {
			if { $len > 1 } {
				error "extra arguments"
			}
			return ![catch {$self index_to_id_ [lindex $args 1]}]
		}
	}
}
ScrolledListbox instproc info.numelems { } {
	return [llength [$self widget_list_]]
}
ScrolledListbox instproc selection { method args } {
	eval [list $self] [list selection.$method] $args
}
ScrolledListbox instproc selection.set { args } {
	$self instvar selection_
	set selectmode [$self cget -selectmode]
	if { $selectmode=="none" } {
		return
	}
	if { [lindex $args 0]=="all" } {
		if { [llength $args] > 1 } {
			error "extra arguments starting at argument 2"
		}
		foreach widget [$self widget_list_] {
			$self selection.set -widget $widget
		}
	}
	set id [eval [list $self] info.id $args]
	if { [info exists selection_($id)] } {
		return
	}
	if { [$self cget -selectmode]=="single" } {
		$self selection.clear all
	}
	set selection_($id) 1
	set widget [$self id_to_widget_ $id]
	$widget configure -select 1
}
ScrolledListbox instproc selection.get { args } {
	$self instvar selection_
	if { [llength $args]==0 } {
		return [array names selection_]
	}
	if { [lindex $args 0]=="all" } {
		if { [llength $args] > 1 } {
			error "extra arguments starting at argument 2"
		}
		return [array names selection_]
	}
	set id [eval [list $self] info.id $args]
	if { [info exists selection_($id)] } {
		return $id
	} else {
		return ""
	}
}
ScrolledListbox instproc selection.clear { args } {
	$self instvar selection_
	if { [llength $args]==0 } {
		$self selection.clear_all_
		return
	}
	if { [lindex $args 0]=="all" } {
		if { [llength $args] > 1 } {
			error "extra arguments starting at argument 2"
		}
		$self selection.clear_all_
		return
	}
	set id [eval [list $self] info.id $args]
	if { [info exists selection_($id)] } {
		unset selection_($id)
		[$self id_to_widget_ $id] configure -select 0
	} else {
		return
	}
}
ScrolledListbox instproc selection.clear_all_ { } {
	$self instvar selection_
	foreach id [array names selection_] {
		unset selection_($id)
		[$self id_to_widget_ $id] configure -select 0
	}
}
ScrolledListbox instproc selection.toggle { args } {
	set id [eval [list $self] info.id $args]
	if { [$self selection.get -id $id]=="" } {
		$self selection.set -id $id
	} else {
		$self selection.clear -id $id
	}
}
ScrolledListbox instproc highlight { method args } {
	eval [list $self] [list highlight.$method] $args
}
ScrolledListbox instproc highlight.set { args } {
	$self instvar highlight_
	set id [eval [list $self] info.id $args]
	if { $id == $highlight_ } {
		return
	}
	if { $highlight_!="" } {
		[$self id_to_widget_ $highlight_] configure -highlight 0
	}
	set highlight_ $id
	[$self id_to_widget_ $id] configure -highlight 1
}
ScrolledListbox instproc highlight.get { args } {
	$self instvar highlight_
	if { [llength $args]==0 } {
		return $highlight_
	}
	set id [eval [list $self] info.id $args]
	if { $highlight_==$id } {
		return $id
	} else {
		return ""
	}
}
ScrolledListbox instproc highlight.clear { args } {
	$self instvar highlight_
	if { [llength $args]==0 } {
		[$self id_to_widget_ $highlight_] configure -highlight 0
		set highlight_ ""
	} else {
		set id [eval [list $self] info.id $args]
		if { $highlight_==$id } {
			[$self id_to_widget_ $highlight_] configure \
					-highlight 0
			set highlight_ ""
		}
	}
}
ScrolledListbox instproc highlight.toggle { args } {
	$self instvar highlight_
	if { [llength $args]==0 } {
		$self highlight.clear
	} else {
		set id [eval [list $self] info.id $args]
		if { $id == $highlight_ } {
			$self highlight.clear
		} else {
			$self highlight.set -id $id
		}
	}
}
WidgetClass HierarchicalListboxItem -configspec {
	{ -value       value       Value       {}            config_value }
	{ -select      select      Select      0             config_option }
	{ -highlight   highlight   Highlight   0             config_option }
	{ -normalbackground normalBackground NormalBackground \
			WidgetDefault(-background) config_option }
	{ -normalforeground normalForeground NormalForeground \
			WidgetDefault(-foreground) config_option }
	{ -normalrelief normalRelief NormalRelief flat config_option }
	{ -selectbackground selectBackground SelectBackground WidgetDefault \
			config_option }
	{ -selectforeground selectForeground SelectForeground WidgetDefault \
			config_option }
	{ -selectrelief selectRelief SelectRelief sunken config_option }
	{ -highlightrelief highlightRelief HighlightRelief raised \
			config_option }
} -default {
	{ .borderWidth WidgetDefault }
	{ *font WidgetDefault }
	{ *Label.padX 1 }
	{ *Label.padY 0 }
	{ *Label.borderWidth 0 }
}
HierarchicalListboxItem instproc init { args } {
	$self instvar config_
	set config_(-value) {}
	set config_(-select) 0
	set config_(-highlight) 0
	set config_(-normalbackground) Black
	set config_(-normalforeground) Black
	set config_(-normalrelief)     flat
	set config_(-selectbackground) Black
	set config_(-selectforeground) Black
	set config_(-selectrelief)     sunken
	set config_(-highlightrelief)  raised
	eval [list $self] next $args
}
HierarchicalListboxItem instproc build_widget { path } {
	label $path.padding
	label $path.image
	label $path.text -anchor w
	pack $path.padding -side left
	pack $path.image -side left
	pack $path.text  -side left -fill x -anchor w
}
HierarchicalListboxItem instproc config_value { option args } {
	$self instvar config_
	if { [llength $args]==0 } {
		if [info exists config_(-value)] {
			return $config_(-value)
		} else {
			return ""
		}
	} else {
		set value [lindex $args 0]
		set image [lindex $value 0]
		set config_(-value) [lindex $value 1]
		set split [split $config_(-value) "/"]
		if { $config_(-value)=="/" || [llength $split] <= 1 } {
			set level 0
			set label $config_(-value)
		} else {
			set level [llength $split]
			set label [lindex $split [expr $level-1]]
		}
		$self subwidget padding configure -padx [expr $level * 4]
		$self subwidget image   configure -image $image
		$self subwidget text    configure -text  $label
	}
}
HierarchicalListboxItem instproc config_option { option args } {
	$self instvar config_
	if { [llength $args]==0 } {
		return $config_($option)
	} else {
		set value [lindex $args 0]
		$self config_[string range $option 1 end] $value
		set config_($option) $value
	}
}
HierarchicalListboxItem instproc config_background { value } {
	set path [$self info path]
	$path configure -bg $value
	foreach label [winfo children $path] {
		$label configure -bg $value
	}
}
HierarchicalListboxItem instproc config_foreground { value } {
	foreach label [winfo children [$self info path]] {
		$label configure -fg $value
	}
}
HierarchicalListboxItem instproc config_relief { value } {
	[$self info path] configure -relief $value
}
HierarchicalListboxItem instproc config_normalbackground { value } {
	if { ![$self set config_(-select)] } {
		$self config_background $value
	}
}
HierarchicalListboxItem instproc config_normalforeground { value } {
	if { ![$self set config_(-select)] } {
		$self config_foreground $value
	}
}
HierarchicalListboxItem instproc config_normalrelief { value } {
	if { ![$self set config_(-select)] && \
			![$self set config_(-highlight)] } {
		$self config_relief $value
	}
}
HierarchicalListboxItem instproc config_selectbackground { value } {
	if { [$self set config_(-select)] } {
		$self config_background $value
	}
}
HierarchicalListboxItem instproc config_selectforeground { value } {
	if { [$self set config_(-select)] } {
		$self config_foreground $value
	}
}
HierarchicalListboxItem instproc config_selectrelief { value } {
	if { [$self set config_(-select)] && \
		![$self set config_(-highlight)] } {
		$self config_relief $value
	}
}
HierarchicalListboxItem instproc config_highlightrelief { value } {
	if { [$self set config_(-highlight)] } {
		$self config_relief $value
	}
}
HierarchicalListboxItem instproc config_select { value } {
	$self instvar config_
	if { $value } {
		$self config_background $config_(-selectbackground)
		$self config_foreground $config_(-selectforeground)
		if { !$config_(-highlight) } {
			$self config_relief $config_(-selectrelief)
		}
	} else {
		$self config_background $config_(-normalbackground)
		$self config_foreground $config_(-normalforeground)
		if { !$config_(-highlight) } {
			$self config_relief $config_(-normalrelief)
		}
	}
}
HierarchicalListboxItem instproc config_highlight { value } {
	$self instvar config_
	if { $value } {
		$self config_relief $config_(-highlightrelief)
	} else {
		if { $config_(-select) } {
			$self config_relief $config_(-selectrelief)
		} else {
			$self config_relief $config_(-normalrelief)
		}
	}
}
WidgetClass MultiColumnListbox -superclass ScrolledCanvas -configspec {
	{ -browsecmd browseCmd BrowseCmd "" config_option }
	{ -command command Command "" config_option }
	{ -selectbackground selectBackground SelectBackground #a0a0ff \
			config_option }
	{ -font font Font WidgetDefault	config_option }
} -default {
	{ .scrollbar horizontal }
	{ *hscroll.highlightThickness 0 }
	{ *hscroll.takeFocus 0 }
	{ *bbox.borderWidth 2 }
	{ *bbox.width 400 }
	{ *bbox.height 120 }
}
MultiColumnListbox instproc config_option { option args } {
	$self instvar data
	if { [llength $args] == {} } {
		return $data($option)
	} else {
		set data($option) [lindex $args 0]
	}
}
MultiColumnListbox instproc build_widget { path } {
	$self instvar data
	$self next $path
	set data(canvas) [$self subwidget bbox]
	set data(sbar) [$self subwidget hscroll]
	set data(maxIW) 1
	set data(maxIH) 1
	set data(maxTW) 1
	set data(maxTH) 1
	set data(numItems) 0
	set data(curItem)  {}
	set data(noScroll) 1
	bind $data(canvas) <Configure> "+$self arrange"
	bind $data(canvas) <1>         "$self btn1 %x %y"
	bind $data(canvas) <B1-Motion> "$self motion1 %x %y"
	bind $data(canvas) <Double-1>  "$self double1 %x %y"
	bind $data(canvas) <ButtonRelease-1> "tkCancelRepeat"
	bind $data(canvas) <B1-Leave>  "$self leave1 %x %y"
	bind $data(canvas) <B1-Enter>  "tkCancelRepeat"
	bind $data(canvas) <Up>        "$self up_down -1"
	bind $data(canvas) <Down>      "$self up_down  1"
	bind $data(canvas) <Left>      "$self left_right -1"
	bind $data(canvas) <Right>     "$self left_right  1"
	bind $data(canvas) <Return>    "$self return_key"
	bind $data(canvas) <KeyPress>  "$self key_press %A"
	bind $data(canvas) <Control-KeyPress> ";"
	bind $data(canvas) <Alt-KeyPress>  ";"
	bind $data(canvas) <FocusIn>   "$self focus_in"
}
MultiColumnListbox instproc auto_scan { } {
	$self instvar data
	global tkPriv
	set x $tkPriv(x)
	set y $tkPriv(y)
	if $data(noScroll) {
		return
	}
	if {$x >= [winfo width $data(canvas)]} {
		$data(canvas) xview scroll 1 units
	} elseif {$x < 0} {
		$data(canvas) xview scroll -1 units
	} elseif {$y >= [winfo height $data(canvas)]} {
	} elseif {$y < 0} {
	} else {
		return
	}
	$self motion1 $x $y
	set tkPriv(afterId) [after 50 $self auto_scan]
}
MultiColumnListbox instproc delete_all {} {
	$self instvar data
	$self instvar itemList
	$data(canvas) delete all
	catch {unset data(selected)}
	catch {unset data(rect)}
	catch {unset data(list)}
	catch {unset itemList}
	set data(numItems) 0
	set data(curItem)  {}
}
MultiColumnListbox instproc add {image text} {
	$self instvar data
	$self instvar itemList
	$self instvar textList
	set iTag [$data(canvas) create image 0 0 -image $image -anchor nw]
	set tTag [$data(canvas) create text  0 0 -text  $text  -anchor nw \
			-font $data(-font)]
	set rTag [$data(canvas) create rect  0 0 0 0 -fill "" -outline ""]
	set b [$data(canvas) bbox $iTag]
	set iW [expr [lindex $b 2]-[lindex $b 0]]
	set iH [expr [lindex $b 3]-[lindex $b 1]]
	if {$data(maxIW) < $iW} {
		set data(maxIW) $iW
	}
	if {$data(maxIH) < $iH} {
		set data(maxIH) $iH
	}
	set b [$data(canvas) bbox $tTag]
	set tW [expr [lindex $b 2]-[lindex $b 0]]
	set tH [expr [lindex $b 3]-[lindex $b 1]]
	if {$data(maxTW) < $tW} {
		set data(maxTW) $tW
	}
	if {$data(maxTH) < $tH} {
		set data(maxTH) $tH
	}
	lappend data(list) [list $iTag $tTag $rTag $iW $iH $tW $tH \
			$data(numItems)]
	set itemList($rTag) [list $iTag $tTag $text $data(numItems)]
	set textList($data(numItems)) [string tolower $text]
	incr data(numItems)
}
MultiColumnListbox instproc arrange {} {
	$self instvar data
	if ![info exists data(list)] {
		if {[info exists data(canvas)] && \
				[winfo exists $data(canvas)]} {
			set data(noScroll) 1
			$data(sbar) config -command ""
		}
		return
	}
	set W [winfo width  $data(canvas)]
	set H [winfo height $data(canvas)]
	set pad [expr [$data(canvas) cget -highlightthickness] + \
			[$data(canvas) cget -bd]]
	incr W -[expr $pad*2]
	incr H -[expr $pad*2]
	set dx [expr $data(maxIW) + $data(maxTW) + 4]
	if {$data(maxTH) > $data(maxIH)} {
		set dy $data(maxTH)
	} else {
		set dy $data(maxIH)
	}
	set shift [expr $data(maxIW) + 4]
	set x [expr $pad * 2]
	set y [expr $pad * 1]
	set usedColumn 0
	foreach pair $data(list) {
		set usedColumn 1
		set iTag [lindex $pair 0]
		set tTag [lindex $pair 1]
		set rTag [lindex $pair 2]
		set iW   [lindex $pair 3]
		set iH   [lindex $pair 4]
		set tW   [lindex $pair 5]
		set tH   [lindex $pair 6]
		set i_dy [expr ($dy - $iH)/2]
		set t_dy [expr ($dy - $tH)/2]
		$data(canvas) coords $iTag $x                 [expr $y + $i_dy]
		$data(canvas) coords $tTag [expr $x + $shift] [expr $y + $t_dy]
		$data(canvas) coords $tTag [expr $x + $shift] [expr $y + $t_dy]
		$data(canvas) coords $rTag $x $y [expr $x+$dx] [expr $y+$dy]
		incr y $dy
		if {[expr $y + $dy] >= $H} {
			set y [expr $pad * 1]
			incr x $dx
			set usedColumn 0
		}
	}
	if {$usedColumn} {
		set sW [expr $x + $dx]
	} else {
		set sW $x
	}
	if {$sW < $W} {
		$data(canvas) config -scrollregion "$pad $pad $sW $H"
		$data(sbar) config -command ""
		$data(canvas) xview moveto 0
		set data(noScroll) 1
	} else {
		$data(canvas) config -scrollregion "$pad $pad $sW $H"
		$data(sbar) config -command "$data(canvas) xview"
		set data(noScroll) 0
	}
	set data(itemsPerColumn) [expr ($H-$pad)/$dy]
	if {$data(itemsPerColumn) < 1} {
		set data(itemsPerColumn) 1
	}
	if {$data(curItem) != {}} {
		$self select [lindex [lindex $data(list) $data(curItem)] 2] 0
	}
}
MultiColumnListbox instproc invoke {} {
	$self instvar data
	if {[string compare $data(-command) ""] && \
			[info exists data(selected)]} {
		eval $data(-command) [list $data(selected)]
	}
}
MultiColumnListbox instproc see {rTag} {
	$self instvar data
	$self instvar itemList
	if $data(noScroll) {
		return
	}
	set sRegion [$data(canvas) cget -scrollregion]
	if ![string compare $sRegion {}] {
		return
	}
	if ![info exists itemList($rTag)] {
		return
	}
	set bbox [$data(canvas) bbox $rTag]
	set pad [expr [$data(canvas) cget -highlightthickness] + \
			[$data(canvas) cget -bd]]
	set x1 [lindex $bbox 0]
	set x2 [lindex $bbox 2]
	incr x1 -[expr $pad * 2]
	incr x2 -[expr $pad * 1]
	set cW [expr [winfo width $data(canvas)] - $pad*2]
	set scrollW [expr [lindex $sRegion 2]-[lindex $sRegion 0]+1]
	set dispX [expr int([lindex [$data(canvas) xview] 0]*$scrollW)]
	set oldDispX $dispX
	if {[expr $x2 - $dispX] >= $cW} {
		set dispX [expr $x2 - $cW]
	}
	if {[expr $x1 - $dispX] < 0} {
		set dispX $x1
	}
	if {$oldDispX != $dispX} {
		set fraction [expr double($dispX)/double($scrollW)]
		$data(canvas) xview moveto $fraction
	}
}
MultiColumnListbox instproc select_at_XY {x y} {
	$self instvar data
	$self select [$data(canvas) find closest \
			[$data(canvas) canvasx $x] [$data(canvas) canvasy $y]]
}
MultiColumnListbox instproc select {rTag {callBrowse 1}} {
	$self instvar data
	$self instvar itemList
	if ![info exists itemList($rTag)] {
		return
	}
	set iTag   [lindex $itemList($rTag) 0]
	set tTag   [lindex $itemList($rTag) 1]
	set text   [lindex $itemList($rTag) 2]
	set serial [lindex $itemList($rTag) 3]
	if ![info exists data(rect)] {
		set data(rect) [$data(canvas) create rect 0 0 0 0 \
				-fill $data(-selectbackground) \
				-outline $data(-selectbackground)]
	}
	$data(canvas) lower $data(rect)
	set bbox [$data(canvas) bbox $tTag]
	eval $data(canvas) coords $data(rect) $bbox
	set data(curItem) $serial
	set data(selected) $text
	if {$callBrowse} {
		if [string compare $data(-browsecmd) ""] {
			eval $data(-browsecmd) [list $text]
		}
	}
}
MultiColumnListbox instproc unselect {} {
	$self instvar data
	if [info exists data(rect)] {
		$data(canvas) delete $data(rect)
		unset data(rect)
	}
	if [info exists data(selected)] {
		unset data(selected)
	}
	set data(curItem)  {}
}
MultiColumnListbox instproc get {} {
	$self instvar data
	if [info exists data(selected)] {
		return $data(selected)
	} else {
		return ""
	}
}
MultiColumnListbox instproc btn1 {x y} {
	$self instvar data
	focus $data(canvas)
	$self select_at_XY $x $y
}
MultiColumnListbox instproc motion1 {x y} {
	global tkPriv
	set tkPriv(x) $x
	set tkPriv(y) $y
	$self select_at_XY $x $y
}
MultiColumnListbox instproc double1 {x y} {
	$self instvar data
	if {$data(curItem) != {}} {
		$self invoke
	}
}
MultiColumnListbox instproc return_key {} {
	$self invoke
}
MultiColumnListbox instproc leave1 {x y} {
	global tkPriv
	set tkPriv(x) $x
	set tkPriv(y) $y
	$self auto_scan
}
MultiColumnListbox instproc focus_in {} {
	$self instvar data
	if ![info exists data(list)] {
		return
	}
	if {$data(curItem) == {}} {
		set rTag [lindex [lindex $data(list) 0] 2]
		$self select $rTag
	}
}
MultiColumnListbox instproc up_down {amount} {
	$self instvar data
	if ![info exists data(list)] {
		return
	}
	if {$data(curItem) == {}} {
		set rTag [lindex [lindex $data(list) 0] 2]
	} else {
		set oldRTag [lindex [lindex $data(list) $data(curItem)] 2]
		set rTag [lindex [lindex $data(list) [expr \
				$data(curItem)+$amount]] 2]
		if ![string compare $rTag ""] {
			set rTag $oldRTag
		}
	}
	if [string compare $rTag ""] {
		$self select $rTag
		$self see $rTag
	}
}
MultiColumnListbox instproc left_right {amount} {
	$self instvar data
	if ![info exists data(list)] {
		return
	}
	if {$data(curItem) == {}} {
		set rTag [lindex [lindex $data(list) 0] 2]
	} else {
		set oldRTag [lindex [lindex $data(list) $data(curItem)] 2]
		set newItem [expr $data(curItem)+($amount*\
				$data(itemsPerColumn))]
		set rTag [lindex [lindex $data(list) $newItem] 2]
		if ![string compare $rTag ""] {
			set rTag $oldRTag
		}
	}
	if [string compare $rTag ""] {
		$self select $rTag
		$self see $rTag
	}
}
MultiColumnListbox instproc key_press {key} {
	global tkPriv
	set w [$self info path]
	append tkPriv(ILAccel,$w) $key
	$self goto $tkPriv(ILAccel,$w)
	catch {
		after cancel $tkPriv(ILAccel,$w,afterId)
	}
	set tkPriv(ILAccel,$w,afterId) [after 500 $self reset]
}
MultiColumnListbox instproc goto {text} {
	$self instvar data
	$self instvar textList
	global tkPriv
	if ![info exists data(list)] {
		return
	}
	if {[string length $text] == 0} {
		return
	}
	if {$data(curItem) == {} || $data(curItem) == 0} {
		set start  0
	} else {
		set start  $data(curItem)
	}
	set text [string tolower $text]
	set theIndex -1
	set less 0
	set len [string length $text]
	set len0 [expr $len-1]
	set i $start
	while 1 {
		set sub [string range $textList($i) 0 $len0]
		if {[string compare $text $sub] == 0} {
			set theIndex $i
			break
		}
		incr i
		if {$i == $data(numItems)} {
			set i 0
		}
		if {$i == $start} {
			break
		}
	}
	if {$theIndex > -1} {
		set rTag [lindex [lindex $data(list) $theIndex] 2]
		$self select $rTag 0
		$self see $rTag
	}
}
MultiColumnListbox instproc reset { } {
	global tkPriv
	set w [$self info path]
	catch {unset tkPriv(ILAccel,$w)}
}
WidgetClass 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_] {
		catch {$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]"
		}
		textimage {
			set list "[list $path.text] [list $path.image]"
		}
		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 -
		textimage -
		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 } {
	wm resizable $path 0 0
	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   }
	{ -current_filetype currentFileType CurrentFileType ""
	config_currentfiletype }
}
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 parse_filetype { filetype } {
	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 ")"
	return [list $name $filter]
}
FileBox instproc config_currentfiletype { option args } {
	$self tkvar filetypes_ filter_
	if { [llength $args] == 0 } {
		if [info exists filetypes_] { return $filetypes_ } \
				else { return "" }
	}
	set value [lindex $args 0]
	if { $value == "" } return
	set name_filter [$self parse_filetype $value]
	set name   [lindex $name_filter 0]
	if ![info exists filter_(filter_for_$name)] {
		error "'$name' does not exist in list of filetypes"
	}
	set filetypes_ $name
}
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_filter [$self parse_filetype $filetype]
			set name   [lindex $name_filter 0]
			set filter [lindex $name_filter 1]
			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 -dictionary [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 -dictionary \
				[glob -nocomplain .* *]]
	} else {
		set files [lsort -dictionary \
				[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 }
	{ *Button.borderWidth 1 }
	{ *Button.highlightThickness 1 }
	{ *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
	button $path.goto -text "Go to:" -command "$self entry_invoke"
	entry $path.entry -textvariable [$self tkvarname entry_]
	pack $path.goto -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 -dictionary \
					[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 {
	{ .transient . }
	{ *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 MBUI_Print -superclass Dialog -configspec {
	{ -colorMode colorMode ColorMode gray set_colorMode colorMode }
	{ -orient orient Orient portrait set_orient orient }
	{ -content content Content full set_content content }
	{ -range range Range current set_range range }
	{ -pageMgr pageMgr PageMgr {} set_pageMgr pageMgr }
} -default {
	{ *Radiobutton.font WidgetDefault }
	{ *font WidgetDefault }
}
MBUI_Print instproc build_widget {path} {
	set topf [frame $path.topf -bd 2 -relief ridge]
	wm title $path "Save to Postscript"
	set optionL [label $topf.optionL -text Options]
	pack $optionL -side left -fill x
	pack $topf -side top -fill x
	set colorf [frame $topf.colorf -bd 1 -relief sunken]
	set colorb [radiobutton $colorf.pscolor -text color -underline 0 \
			-variable [$self tkvarname colorMode_] -value color]
	set grayb [radiobutton $colorf.psgray -text gray -underline 0 \
			-variable [$self tkvarname colorMode_] -value gray]
	pack $colorb $grayb -side bottom -anchor w -expand 1
	set orientf [frame $topf.orientf -bd 1 -relief sunken]
	set portb [radiobutton $orientf.port -text portrait -underline 0 \
			-variable [$self tkvarname orient_] -value portrait]
	set landb [radiobutton $orientf.land -text landscape -underline 0 \
			-variable [$self tkvarname orient_] \
			-value landscape]
	pack $landb $portb -side bottom -expand 1 -anchor w
	set contentf [frame $topf.contentf -bd 1 -relief sunken]
	set fullB [radiobutton $contentf.fullB -text "fit all items" \
			-underline 0 \
			-variable [$self tkvarname content_] -value full]
	set displayB [radiobutton $contentf.displayB -text "displayed view" \
			-underline 3 -variable [$self tkvarname content_] \
			-value displayed]
	pack $fullB $displayB  -side top -expand 1 -anchor w
	set rangef [frame $topf.rangef -bd 1 -relief sunken]
	set currB [radiobutton $rangef.currB -text "current page" \
			-underline 0 \
			-variable [$self tkvarname range_] -value current]
	set allB [radiobutton $rangef.allB -text "all pages" \
			-underline 0 \
			-variable [$self tkvarname range_] -value all]
	pack $currB $allB -side top -expand 1 -anchor w
	pack $orientf $colorf $contentf $rangef -side left -fill x \
			-padx 2 -pady 4 -expand 1
	$self tkvar filename_
	set filef [frame $path.filef -bd 2 -relief ridge]
	set filebox [FileBox $filef.filebox -filetypes {{postscript .ps}} \
			-command "$self save; $self ignore_args" ]
	$self set_subwidget filebox $filebox
 	pack $filef $filebox -side top -fill x -pady 3
	set botf [frame $path.botf -bd 2]
	set dismissb [button $botf.dismiss -text dismiss -width 10 \
			-command "$self hide" -underline 0]
	set okb [button $botf.ok -text ok -width 10 -command "$self save" \
			-underline 0]
	pack $dismissb $okb -side left
	pack $botf -side right
}
MBUI_Print proc decl_accessor {className varName {instvarName {}}} {
	if {"$instvarName"==""} {
		set instvarName $varName
		append instvarName "_"
	}
	$className instproc set_$varName {option value} \
			"\$self set $instvarName \$value"
	$className instproc $varName {} \
			"return \[\$self set $instvarName \$value\]"
}
MBUI_Print proc decl_tk_accessor {className varName {tkvarName {}}} {
	if {"$tkvarName" == ""}  {
		set tkvarName $varName
		append tkvarName "_"
	}
	$className instproc set_$varName {option value} \
			"\$self tkvar $tkvarName; set $tkvarName \$value"
	$className instproc $varName {} \
			"\$self tkvar $tkvarName; return \$tkvarname"
}
MBUI_Print proc decl_wgt_accessor { className varName {tkvarName {}} } {
	if {$tkvarName == {}}  {
		set tkvarName $varName
		append tkvarName _
	}
	eval [list $className instproc set_$varName {option value} \
		"\$self tkvar $tkvarName; set $tkvarName \$value"]
	eval [list $className instproc $varName {option} \
			"\$self tkvar $tkvarName; return \$tkvarname"]
}
MBUI_Print decl_wgt_accessor MBUI_Print colorMode {}
MBUI_Print decl_wgt_accessor MBUI_Print orient {}
MBUI_Print decl_wgt_accessor MBUI_Print content {}
MBUI_Print decl_wgt_accessor MBUI_Print range {}
MBUI_Print decl_accessor  MBUI_Print pageMgr {}
MBUI_Print instproc show {} {
	$self instvar path_
	wm deiconify $path_
	wm title $path_ "Save to Postscript"
}
MBUI_Print instproc hide {} {
	wm withdraw [$self set path_]
}
MBUI_Print instproc save {} {
	set filebox [$self subwidget filebox]
	set dir [$filebox cget -directory]
	set file [$filebox cget -filename]
	if  { $file=="" } return
	set path [file join $dir $file]
	if [file exists $path] {
		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
		}
	}
	set f [open $path "w"]
	$self tkvar orient_ colorMode_ content_ range_
	set pageMgr [$self set pageMgr_]
	if {$range_ == "all"} {
		set pagelist [MBPageMgr sort_pages [$pageMgr pagelist]]
	} else {
		set pagelist [$pageMgr current_page]
	}
	set p [removeFirst pagelist]
	if {"$p" == ""} return
	set i 1
	set confName [$pageMgr get_option conferenceName]
	set hdr "Page $i --- \[[$pageMgr page_label $p]\]     $confName     [gettimeofday ascii]"
        TkCanvPsHeader $f "Conference Name: $confName"
        puts $f "%%Page: 1 1\nsave\n"
	[$pageMgr page2canv $p] to_ps $content_ $orient_ $hdr \
			-channel $f -colormode $colorMode_ \
			-prolog 0 -trailer 0
	foreach p $pagelist {
		incr i
		puts $f "\n%%Page: $i $i\n"
		set hdr "Page $i --- \[[$pageMgr page_label $p]\]     $confName     [gettimeofday ascii]"
		[$pageMgr page2canv $p] to_ps $content_ $orient_ $hdr \
				-channel $f -colormode $colorMode_ \
				-prolog 0 -trailer 0
		puts $f "%%PageTrailer\n"
	}
	puts $f "%%Trailer\n%%Pages:$i\nend\n%%EOF\n"
	close $f
	$self hide
}
MBCanvas public create_canvas {parent ops} {
	$self instvar path_ hilitC_
        $self add_default canvHighlighColor blue
	$self add_default showOwnerTip 1
	set path_ [eval canvas $parent.$self $ops -closeenough 2 \
			-confine 0 \
			-bd 0 -highlightthickness 0 -relief flat \
			-highlightcolor grey]
	$self setpath $path_
	WidgetClass transparent_gif [$path_ cget -bg]
	mtrace trcVerbose "created canvas $path_"
	set hilitC_ [$self get_option canvHighlightColor]
	if {$hilitC_ == {}} {
		set hilitC_ blue
	}
	$self set ownerTip_ [$self get_option showOwnerTip]
	$self set after_id_ 0
	$self set omittedSrc_ {}
	$self set zoomPolicy_ "fix to view"
	bind $path_ <Configure> [list $self reconfig %w %h]
}
MBCanvas public omitShowOwner {src} {
	$self set omittedSrc_ $src
}
MBCanvas instproc showOwner {show} {
	$self set ownerTip_ $show
}
MBCanvas public get_win {} {
	return [$self set path_]
}
MBCanvas public unhilit {} {
 	$self instvar path_ marker_
	if ![info exists marker_] { return }
	$path_ itemconfig marker -outline {}
	set tags [$path_ gettags current]
	set item [$path_ find withtag current]
	if {$tags == {}} {
		set item [$path_ find closest 0 0]
		if {$item == {}} {
			return
		}
		set tags [$path_ gettags $item]
	}
	while {-1 != [lsearch -exact $tags ignore]} {
		set item [$path_ find above $item]
		if {$item == {}} {
			return
		}
		set tags [$path_ gettags $item]
	}
 	eval $path_ coords marker [$path_ bbox $item]
}
MBCanvas public hilit { {itemId {}} } {
	$self instvar marker_ path_ hilitC_
	if {$itemId == {}} {
		set tags [$path_ gettags current]
		if {-1 != [lsearch -exact $tags ignore]} {
			return
		}
		set currId [$path_ find withtag current]
		set coords [$path_ bbox $currId]
	} else {
		set coords [$path_ bbox $itemId]
		set currId $itemId
	}
	if {$coords!={}} {
		if ![info exists marker_] {
			set marker_ [$path_ create rect 1 1 1 1 \
					-tags {marker ignore} \
					-width 1 -outline {}]
		}
		$path_ coords $marker_ \
			    [expr {[lindex $coords 0] - 2}] \
			    [expr {[lindex $coords 1] - 2}] \
			    [expr {[lindex $coords 2] + 2}] \
			    [expr {[lindex $coords 3] + 2}]
		$path_ itemconfigure $marker_ -outline $hilitC_
		$path_ raise $marker_
	}
}
MBCanvas public enable_tip {tipping} {
	$self instvar ownerTip_ path_ arAfterId_ tip_id_
	set ownerTip_ $tipping
	if {$ownerTip_} {
		set tip_id_ 0
		$path_ bind all <Enter> "$self sched_tip 0 1"
	} else {
		foreach i [array names arAfterId_] {
			after cancel $arAfterId_($i)
			set arAfterId_($i) 0
		}
		$path_ bind all <Enter> {}
		$path_ bind all <Leave> {}
	}
}
MBCanvas private sched_tip {id atpoint} {
	$self instvar tip_id_
	after cancel $tip_id_
	set tip_id_ [after 1000 "$self show_owner $id $atpoint"]
}
MBCanvas private show_owner {id atpoint} {
	$self instvar path_ arLabelw_ arLabel_ arAfterId_ tip_id_ omittedSrc_
	if {$id == 0} {
		set id [$path_ find withtag current]
		if {$id == {}} return
		set tags [$path_ gettags $id]
	}
	set owner [$self owner $id]
	if {$owner == {}} {
		return
	}
	if {$owner == $omittedSrc_} {
		return
	}
	if $atpoint {
		set rx [winfo rootx $path_]
		set wx [winfo pointerx $path_]
		set ry [winfo rooty $path_]
		set wy [winfo pointery $path_]
		set px [$path_ canvasx [expr {$wx - $rx + 5}]]
		set py [$path_ canvasy [expr {$wy - $ry + 10}]]
		set anchor nw
	} else {
		set bbox [$path_ bbox $id]
		set result [$self clipxy [expr {[lindex $bbox 0] - 5}] \
				[expr {[lindex $bbox 1] - 5}]]
		set px [lindex $result 0]
		set py [lindex $result 1]
		set anchor [lindex $result 2]
	}
	if {![info exists arLabel_($owner)]} {
		set arLabel_($owner) [label .l$self$owner \
				-font [$self get_option smallfont] \
				-bg beige -relief raised -text [$owner cname]]
	} else {
		$arLabel_($owner) configure -text [$owner cname]
	}
	if {![info exists arLabelw_($owner)]} {
		set arLabelw_($owner) [$path_ create window $px $py \
				-anchor nw]
		set arAfterId_($owner) {}
	}
	$path_ itemconfigure $arLabelw_($owner) -window $arLabel_($owner) \
			-anchor $anchor
	$path_ coord $arLabelw_($owner) $px $py
	after cancel $arAfterId_($owner)
	if {$atpoint} {
		$path_ bind $id <Leave> "$self hide_owner $owner"
		set arAfterId_($owner) [after 5000 "$self hide_owner $owner"]
	} else {
		set arAfterId_($owner) [after 5000 "$self hide_owner $owner"]
	}
}
MBCanvas private hide_owner {owner} {
	$self instvar arLabelw_ arLabel_ arAfterId_ path_
	after cancel $arAfterId_($owner)
	set arAfterId_($owner) 0
	if [info exists arLabel_($owner)] {
		destroy $arLabel_($owner)
		unset arLabel_($owner)
	}
}
MBCanvas public resetBindings {} {
	$self instvar path_
	$path_ bind local <Enter> {}
	bind $path_ <Button-1> {}
	bind $path_ <B1-Motion> {}
	bind $path_ <ButtonRelease-1> {}
	$path_ focus {}
	$self unhilit
	$self enable_tip [$self set ownerTip_]
}
MBCanvas public resetMarker {} {
	$self instvar path_
	set tags [$path_ gettags current]
	if {-1 != [lsearch -exact $tags local]} {
		$self hilit
	} else {
		$self unhilit
	}
}
MBCanvas public setHilit {} {
	$self instvar path_ marker_
	$path_ bind local <Enter> "$self hilit"
	if [info exists marker_] {
		$path_ bind $marker_ <Enter> {}
	}
}
MBCanvas private overlap {itemid x1 y1 x2 y2} {
	set overlap [[$self set path_] find overlapping $x1 $y1 $x2 $y2]
	return [expr {([lsearch -exact $overlap $itemid]==-1) ? 0 : 1}]
}
MBCanvas public to_ps {content orient header args} {
	$self instvar path_
	set hdrStart "gsave
%helv font size 10
/Helvetica-Bold findfont 10 scalefont ISOEncode setfont
%black
0.000 0.000 0.000 setrgbcolor AdjustColor\n"
	set hdrEnd ") show\ngrestore\n"
	if {$orient == "portrait"} {
		set ph 10
		set pw 7.5
		set hx 27
		set hy 27
	} else {
		set pw 10
		set ph 7.5
		set hx 27
		set hy -27
		lappend args -rotate 1
		append hdrStart "90 rotate\n"
	}
	append hdrStart "$hx $hy moveto\n("
	set str $hdrStart
	append str $header
	append str $hdrEnd
	lappend args -pageheader $str
	if {$content == "full"} {
		set size [$path_ bbox all]
		if {$size == {}} {
			return
		}
		set x [lindex $size 0]
		set y [lindex $size 1]
		set w [expr {[lindex $size 2] - [lindex $size 0]}]
		set h [expr {[lindex $size 3] - [lindex $size 1]}
		]
	} else {
		set x [$path_ canvasx 0]
		set y [$path_ canvasy 0]
		set w [$path_ canvasx [winfo width $path_]]
		set h [$path_ canvasy [winfo height $path_]]
	}
	if {$w>0 && ($h/double($w) > $ph/double($pw))} {
		lappend args -pageheight [append ph i]
	} else {
		lappend args -pagewidth [append pw i]
	}
	lappend args -x $x -y $y -width $w -height $h
	eval $path_ postscript $args
}
MBCanvas public pointerxy {} {
	$self instvar path_
	set rx [winfo rootx $path_]
	set wx [winfo pointerx $path_]
	set ry [winfo rooty $path_]
	set wy [winfo pointery $path_]
	if {($wx == -1) || ($wy == -1)} {
		return {}
	}
	return [$self canvasxy [expr {$wx - $rx}] [expr {$wy - $ry}]]
}
MBCanvas private expandScrReg {newRegion {inc 0}} {
	$self instvar path_
	set region [$path_ cget -scrollregion]
	set oldRegion $region
	set rsz 0
	foreach i {2 3} {
		set newVal [lindex $newRegion $i]
		if {$newVal != {} && $newVal > [lindex $region $i]} {
			set region [lreplace $region $i $i \
					[expr {$newVal + $inc}]]
			set rsz 1
		}
	}
	foreach i {0 1} {
		set newVal [lindex $newRegion $i]
		if {$newVal != {} && $newVal < [lindex $region $i]} {
			set region [lreplace $region $i $i \
					[expr {$newVal - $inc}]]
			set rsz 1
		}
	}
        if $rsz {
		mtrace trcMB "expandScrReg: new $region old:$oldRegion"
                $path_ configure -scrollregion $region
        }
}
MBCanvas public zoom_policy {policy} {
	$self instvar path_
	$self set zoomPolicy_ $policy
	set leftFract 0
	set topFract 0
	set changeSR 1
	switch -exact $policy {
		"fix to view" {
			set changeSR 0
		}
		"fit width" {
			set bbox [$path_ bbox all]
			if {$bbox == {}} { return }
			set width [expr {[lindex $bbox 2] - [lindex $bbox 0]}]
			if {$width > 1} {
				$self fit $width 0
			}
		}
		"fit height" {
			set bbox [$path_ bbox all]
			if {$bbox == {}} { return }
			set height [expr {[lindex $bbox 3] - [lindex $bbox 1]}]
			if {$height > 1} {
				$self fit 0 $height
			}
		}
		"fit all" {
			set bbox [$path_ bbox all]
			if {$bbox == {}} { return }
			set width [expr {[lindex $bbox 2] - [lindex $bbox 0]}]
			set height [expr {[lindex $bbox 3] - [lindex $bbox 1]}]
			$self fit $width $height
		}
		default {
			set topLeft [$self canvasxy 0 0]
			puts "topLeft = $topLeft"
			if [regexp {([0-9]+)%?} $policy {} scale] {
				$self rescale [expr {$scale / 100.0}]
			} else {
				error "invalid zoom policy: $policy"
				return
			}
			set changeSR 0
			$self scrollTopLeft $topLeft
		}
	}
	if $changeSR {
		set bbox [$path_ bbox all]
		if {$bbox == {}} { return }
		$path_ configure -scrollregion $bbox
		$self yview moveto 0
		$self xview moveto 0
	}
}
MBCanvas private scrollTopLeft {topLeft} {
	$self instvar path_
	set sr [$path_ cget -scrollregion]
	set scale [$self getscale]
	set x [expr {[lindex $topLeft 0]*$scale}]
	set y [expr {[lindex $topLeft 1]*$scale}]
	set leftFract [expr {($x - [lindex $sr 0])/([lindex $sr 2] \
			- [lindex $sr 0])}]
	set topFract [expr {($y - [lindex $sr 1])/([lindex $sr 3] \
			- [lindex $sr 1])}]
	$self yview moveto $topFract
	$self xview moveto $leftFract
}
MBCanvas private reconfig {w h} {
	$self instvar path_ zoomPolicy_
	if {$zoomPolicy_ == "fix to view"} {
		set topleft [$self canvasxy 0 0]
		set inset [expr {[$path_ cget -borderwidth] \
				+ [$path_ cget -highlightthickness]}]
		$self resize [expr {$w - 2*$inset}] [expr {$w - 2*$inset}]
		$self scrollTopLeft $topleft
	}
	$self updScrReg 5
	return
}
MBCanvas private updScrReg { {inc 0} } {
	$self instvar path_
	set w [winfo width $path_]
	set h [winfo height $path_]
	set x [$path_ canvasx 0]
	set y [$path_ canvasy 0]
	set bbox [$path_ bbox all]
	set x1 $x
	set x2 [expr {$x + $w}]
	set y1 $y
	set y2 [expr {$y + $h}]
	if {$bbox == {}} {
		$self expandScrReg [list $x1 $y1 $x2 $y2]
		return
	}
	foreach {bx1 by1 bx2 by2} $bbox {
		if {$x1 > $bx1} { set x1 $bx1 }
		if {$y1 > $by1} { set y1 $by1 }
		if {$x2 < $bx2} { set x2 $bx2 }
		if {$y2 < $by2} { set y2 $by2 }
	}
	$self expandScrReg [list $x1 $y1 $x2 $y2]
	return
}
MBCanvas public show_busy {isBusy {prevCursor {}}} {
	$self instvar path_
	if {$isBusy} {
		set oldCursor [$path_ cget -cursor]
		$path_ configure -cursor watch
		return $oldCursor
	} elseif {$prevCursor != {}} {
		$path_ configure -cursor $prevCursor
	}
}
MBCanvas public attach_scrollbar {xscroll yscroll} {
	$path_ configure -xscrollcommand [list $xscroll set] \
			-yscrollcommand [list $yscroll set]
}
MBCanvas public transfer_state_from {canvas} {
	$self enable_tip [$canvas set ownerTip_]
	set zoomPolicy [$canvas set zoomPolicy_]
	if ![regexp  {fix*} $zoomPolicy] {
		$self rescale [$canvas getscale]
	}
	if ![regexp "fit*" $zoomPolicy] {
		$self zoom_policy $zoomPolicy
	} else {
		$self set zoomPolicy_ $zoomPolicy
	}
}
MBCanvas public refreshScrReg {} {
	$self instvar path_
	$self updScrReg 5
}
MBCanvas public pack {args} {
	$self instvar path_
	$self refreshScrReg
	bind $path_ <Enter> "focus $path_"
	bind $path_ <Leave> "focus ."
	eval pack $path_ $args
}
MBCanvas public unpack {} {
	$self resetBindings
	pack forget [$self set path_]
}
WidgetClass transparent_gif
image create photo MBLogo_Icon
MBLogo_Icon put \x47\x49\x46\x38\x39\x61\x78\x0\x16\x0\xF7\x0\x0\x0\x0\x0\x68\x0\x0\x99\x0\x0\xC0\x0\x0\xE1\x0\x0\xFF\x0\x0\x0\x68\x0\x68\x68\x0\x99\x68\x0\xC0\x68\x0\xE1\x68\x0\xFF\x68\x0\x0\x99\x0\x68\x99\x0\x99\x99\x0\xC0\x99\x0\xE1\x99\x0\xFF\x99\x0\x0\xC0\x0\x68\xC0\x0\x99\xC0\x0\xC0\xC0\x0\xE1\xC0\x0\xFF\xC0\x0\x0\xE1\x0\x68\xE1\x0\x99\xE1\x0\xC0\xE1\x0\xE1\xE1\x0\xFF\xE1\x0\x0\xFF\x0\x68\xFF\x0\x99\xFF\x0\xC0\xFF\x0\xE1\xFF\x0\xFF\xFF\x0\x0\x0\x68\x68\x0\x68\x99\x0\x68\xC0\x0\x68\xE1\x0\x68\xFF\x0\x68\x0\x68\x68\x68\x68\x68\x99\x68\x68\xC0\x68\x68\xE1\x68\x68\xFF\x68\x68\x0\x99\x68\x68\x99\x68\x99\x99\x68\xC0\x99\x68\xE1\x99\x68\xFF\x99\x68\x0\xC0\x68\x68\xC0\x68\x99\xC0\x68\xC0\xC0\x68\xE1\xC0\x68\xFF\xC0\x68\x0\xE1\x68\x68\xE1\x68\x99\xE1\x68\xC0\xE1\x68\xE1\xE1\x68\xFF\xE1\x68\x0\xFF\x68\x68\xFF\x68\x99\xFF\x68\xC0\xFF\x68\xE1\xFF\x68\xFF\xFF\x68\x0\x0\x99\x68\x0\x99\x99\x0\x99\xC0\x0\x99\xE1\x0\x99\xFF\x0\x99\x0\x68\x99\x68\x68\x99\x99\x68\x99\xC0\x68\x99\xE1\x68\x99\xFF\x68\x99\x0\x99\x99\x68\x99\x99\x99\x99\x99\xC0\x99\x99\xE1\x99\x99\xFF\x99\x99\x0\xC0\x99\x68\xC0\x99\x99\xC0\x99\xC0\xC0\x99\xE1\xC0\x99\xFF\xC0\x99\x0\xE1\x99\x68\xE1\x99\x99\xE1\x99\xC0\xE1\x99\xE1\xE1\x99\xFF\xE1\x99\x0\xFF\x99\x68\xFF\x99\x99\xFF\x99\xC0\xFF\x99\xE1\xFF\x99\xFF\xFF\x99\x0\x0\xC0\x68\x0\xC0\x99\x0\xC0\xC0\x0\xC0\xE1\x0\xC0\xFF\x0\xC0\x0\x68\xC0\x68\x68\xC0\x99\x68\xC0\xC0\x68\xC0\xE1\x68\xC0\xFF\x68\xC0\x0\x99\xC0\x68\x99\xC0\x99\x99\xC0\xC0\x99\xC0\xE1\x99\xC0\xFF\x99\xC0\x0\xC0\xC0\x68\xC0\xC0\x99\xC0\xC0\xC0\xC0\xC0\xE1\xC0\xC0\xFF\xC0\xC0\x0\xE1\xC0\x68\xE1\xC0\x99\xE1\xC0\xC0\xE1\xC0\xE1\xE1\xC0\xFF\xE1\xC0\x0\xFF\xC0\x68\xFF\xC0\x99\xFF\xC0\xC0\xFF\xC0\xE1\xFF\xC0\xFF\xFF\xC0\x0\x0\xE1\x68\x0\xE1\x99\x0\xE1\xC0\x0\xE1\xE1\x0\xE1\xFF\x0\xE1\x0\x68\xE1\x68\x68\xE1\x99\x68\xE1\xC0\x68\xE1\xE1\x68\xE1\xFF\x68\xE1\x0\x99\xE1\x68\x99\xE1\x99\x99\xE1\xC0\x99\xE1\xE1\x99\xE1\xFF\x99\xE1\x0\xC0\xE1\x68\xC0\xE1\x99\xC0\xE1\xC0\xC0\xE1\xE1\xC0\xE1\xFF\xC0\xE1\x0\xE1\xE1\x68\xE1\xE1\x99\xE1\xE1\xC0\xE1\xE1\xE1\xE1\xE1\xFF\xE1\xE1\x0\xFF\xE1\x68\xFF\xE1\x99\xFF\xE1\xC0\xFF\xE1\xE1\xFF\xE1\xFF\xFF\xE1\x0\x0\xFF\x68\x0\xFF\x99\x0\xFF\xC0\x0\xFF\xE1\x0\xFF\xFF\x0\xFF\x0\x68\xFF\x68\x68\xFF\x99\x68\xFF\xC0\x68\xFF\xE1\x68\xFF\xFF\x68\xFF\x0\x99\xFF\x68\x99\xFF\x99\x99\xFF\xC0\x99\xFF\xE1\x99\xFF\xFF\x99\xFF\x0\xC0\xFF\x68\xC0\xFF\x99\xC0\xFF\xC0\xC0\xFF\xE1\xC0\xFF\xFF\xC0\xFF\x0\xE1\xFF\x68\xE1\xFF\x99\xE1\xFF\xC0\xE1\xFF\xE1\xE1\xFF\xFF\xE1\xFF\x0\xFF\xFF\x68\xFF\xFF\x99\xFF\xFF\xC0\xFF\xFF\xE1\xFF\xFF\xFF\xFF\xFF\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x21\xF9\x4\x1\x0\x0\xD7\x0\x2C\x0\x0\x0\x0\x78\x0\x16\x0\x40\x8\xFF\x0\xAF\x9\x1C\x48\xB0\xA0\xC1\x83\x8\x13\x2A\x5C\xC8\xB0\xA1\xC3\x87\x3\xA1\xB1\x41\x42\xB1\xC2\x11\x82\xD0\xA2\x59\xD3\x78\xAD\xD4\xC4\x7\x2C\x56\x70\x18\x98\xCC\x92\x15\x4B\x73\x8E\x40\x43\xA9\xC7\x92\x8E\x47\xD0\xE4\x58\x92\x39\x27\x91\xC0\x4E\x72\x2E\xC9\x99\x33\x47\x8E\x8E\x59\x79\xD8\x78\x99\xC5\x4A\x8E\x9C\x36\x3B\xC9\x8\x3C\xFA\x52\x20\xCF\x19\x6B\xAE\x91\x4A\x22\xE7\x9\x9B\x27\x88\x4\x96\x7A\x22\x27\x89\x13\xAC\xD7\x58\x21\xB1\xF2\xE4\x89\x95\x32\x7A\x9E\x20\x79\x2\xA5\x6C\x53\x8C\x7A\xE6\x24\x21\x51\xC2\xC1\x1E\x8A\x78\x91\x90\x70\xA0\xC3\x23\x45\x36\xAC\x6\xCE\x71\xA2\x63\xD\x9D\xB1\x1D\xC4\x3E\xE9\x20\x30\x10\x92\x24\x6B\x2D\x5C\x2C\x5\x19\x9\x94\xAF\x89\x1F\x8F\x98\x55\x8A\xA2\x59\x24\x2B\xCA\x94\x22\x81\x44\x5\x45\x12\x4E\x64\x74\x88\x7A\xED\x9\x69\x12\x4F\x2C\x4\x99\xA5\x87\x4\x89\x15\x50\x48\xC8\x58\x53\x1B\xEA\xC0\x40\xB6\x75\x93\x50\xC1\x58\x61\xB2\x89\x14\x2D\x74\x41\x52\xE1\xD1\x41\x89\x6D\x10\xCD\x12\x18\x4C\x97\x2E\x3D\xCE\xAF\x21\xB3\xA4\xCB\x52\x10\x87\x2B\x2F\xA9\xFF\xB4\xE4\x3D\x61\xCC\x4B\x73\xD0\xCB\xD1\x63\x13\xA2\x43\x56\x73\x9E\x7C\x17\x8C\xB7\x2\x6B\x4F\x14\x1F\x54\xA0\x88\xA0\x83\x1C\xBC\x16\xB0\x36\x10\x1B\x73\x74\xD0\x93\x55\x3A\x4\xC2\x86\x15\x41\x74\xC2\x86\x1C\xF\x3E\x8\x5\x19\x48\x14\x28\x90\x1E\x6C\x40\x55\x8A\x13\x50\x4\xB1\xA\x12\x4E\xAC\x5\xE2\x4B\x7A\x20\x21\x43\x10\x8F\x3C\x92\xC8\x13\x4E\xCC\xC0\x4A\x88\x1D\x4C\x77\xD\x45\x1D\x38\xE6\x44\x12\x6A\x21\x11\x23\x45\x1C\xD8\x24\xD6\xA\xC5\xF5\x26\x60\x44\xAC\xCC\x22\xA3\x7B\x48\x26\xA9\xE4\x92\x4C\x62\xE4\x9\x4F\x73\x44\xD3\xE4\x94\x54\x56\xB9\x10\x7E\x14\x95\xC0\x1\x22\x6C\x94\x10\xA0\x41\x97\xF0\x77\xC0\x48\x2\x91\x67\x49\x1E\x65\x74\x64\xC9\x25\x96\xE8\x31\x1F\x43\xA4\x98\xB4\x46\x34\xAC\x20\x92\xDD\x41\x9E\xC8\xC1\xA0\x8A\x79\xCC\x71\x96\x95\x3\xED\xF1\xC4\x6E\x18\xE5\x65\x81\x8C\x12\xE5\x85\x4\x2\x39\xF0\xB7\x68\x71\x37\xB1\xA1\x3\x7A\x41\xE4\xC4\xC1\x4E\x1D\xAC\x42\x60\x8C\xAC\x2C\x58\x46\x50\x5D\xCC\x86\x61\x81\x31\xC9\x11\x23\x34\x5E\x88\xAA\x67\x19\xAB\xB4\xE1\xC4\x1C\x6C\xBC\xFF\x8A\x44\xE\x69\x96\xB8\x27\x2B\x6A\x7D\xC7\x8A\x17\x47\xCC\x12\xDF\xC\x8F\x94\xB8\xD8\x1A\xB3\x94\x35\x43\xAF\x56\xAC\x5\xA9\x40\x61\x52\x94\x4\x19\x2B\x29\x8A\xC4\x3\x64\x40\x52\x9F\x41\xA5\xB4\x61\xC5\x11\xB0\x3A\x91\x43\x10\xB0\xBE\xF4\xA4\xC\xCE\xF1\xC4\x4A\x51\x48\x0\xD1\xD1\x88\x8F\xC8\x45\x2B\x8F\xC1\x2A\x3B\x23\x61\x88\xB4\x2\x4D\x5A\xE9\x26\x12\xA2\x5\x2\xA9\x25\x3\x10\x7A\x75\xD0\xAE\x6E\x1E\x96\x0\xA4\x40\xD0\x90\xA6\xEE\x68\x24\x0\x71\x67\x44\xD6\xE2\x55\x99\xB4\x78\xD5\x25\xDB\x91\xD7\x18\x29\x90\xC6\x1B\x63\x3C\x4B\x22\x8F\x78\x1C\x72\xC6\x32\x72\x9C\x71\x22\xD3\x71\x6C\xE4\xCA\x18\xF\x34\x4B\x8A\x5\xBD\x4C\x72\xCA\x2D\x9F\x4C\x33\xA0\x38\xE7\xAC\x33\x78\x9E\x20\x47\x1A\xB0\xE6\x61\x4\xCD\xB9\x3\x59\x3\xCD\xD0\x35\x9B\x57\xE4\x35\x48\x27\x14\xCD\xD0\xE7\x2E\xBD\x73\x58\x52\x1B\x84\x25\x68\x15\x5C\xD1\x25\x7\x35\xF7\xAC\xD7\xA1\xCC\x76\xD7\xC9\x7C\x6C\xA2\xF4\xE6\x42\xA5\x9C\x19\xC4\x4A\x16\x22\x54\xA\x84\x73\xA0\x44\x60\x17\x49\x37\xB9\x15\x83\xD8\x22\x87\x84\x5\x8F\x44\xFF\x53\xA\x10\x43\xA\x84\xE5\x3\x2B\x3C\xC0\xDA\x4A\x7A\x40\x92\xC7\x77\x6C\xD2\x61\x49\x17\x51\x41\xE3\x49\x27\x7A\x4\x36\x50\x29\x9E\xE8\xD1\x4A\x27\x6D\xE4\xF0\x48\x29\xA5\x2C\x2D\xB9\x1E\x7A\x64\xE5\xD4\x1C\x5D\xB4\xE7\x11\xDE\x61\x91\x5E\x3A\x41\xAC\xB8\x6E\x7A\x47\x81\xD0\x86\x5D\x47\x56\x60\x47\xC7\x13\x40\x13\xD4\xEC\xA2\x23\x44\xD4\x33\x1B\x96\xB0\x41\x47\xA7\xA0\x3D\x30\xAD\x80\x9E\x58\x92\x3\x4A\x47\x34\x9F\x83\x4E\x3F\xE9\xD4\x5\x10\x74\xC8\x41\xB7\x47\x72\xE4\xD0\x85\x51\x72\xCC\xD6\xD3\xA1\x3D\xCD\x0\x44\x50\x56\xC0\x64\x94\x59\x3C\xC9\x51\xC5\x6C\xAD\x3A\x61\x85\xE\x64\x3D\xD1\xF7\x1C\xB3\x2\x61\xEC\xE7\x6B\x3D\xF1\xED\x72\xFE\x9B\xC1\x8D\x9C\x10\x23\xDF\xE1\x5\x1\x17\x61\x1A\x72\x1E\x90\x23\xB\x94\x28\x4B\x5C\xF3\x1D\x1B\xC0\x85\x3A\x3D\x79\x81\xD\xEF\xCB\xD3\x13\xAE\x80\xB9\xAA\x94\xC1\x28\x41\xB0\x49\xCF\x3A\xD4\x29\xF9\x84\xA5\x14\x71\xB9\xA\xAD\xA6\xC2\x3B\x2E\xCC\x20\x59\xCF\xBA\x86\x57\xDE\x72\xA3\x91\xB0\x62\xF\x56\x90\xCB\xAC\x1E\xC1\xA2\x19\x7C\x27\x1A\x6A\x11\xD8\x35\xFF\x4A\x74\xA2\x82\xE0\x2F\x3F\x91\x9B\x8\xB\x2A\x30\x11\x2D\xCD\x2\x39\xF6\x29\x48\x51\xE4\xD3\x93\x4D\x61\x88\x56\x7A\x90\x83\xF9\x80\x10\x4\x2E\x52\xC8\x84\xD7\x18\x4C\xE\xD6\xE0\x89\xD4\xAC\x1\x7F\xAA\xD1\x41\x10\x8B\xB5\x43\xC1\xB4\x48\x5F\x3A\xD2\x8A\xB2\x42\xF4\xAD\x1C\xA8\x60\x31\xAC\x80\x4C\x1\x7F\x34\x9F\x27\xA8\xA0\x77\x45\xD3\x1B\x12\x4\x99\x17\x25\x26\xB\x9\x7B\x80\x6\x41\x30\x4\x15\xB9\x10\xF0\x11\x48\x30\xD5\x2C\xA0\x1\xA2\x2B\xE0\x4F\x3E\xBE\x5A\xCB\x3\x91\x30\x9B\xC7\xBC\x44\x2D\x4F\xC8\x3\x45\xB6\x45\xC9\x89\x91\x6\x9\x2C\x88\x91\x1E\x4A\x30\x16\xD7\x3C\x81\x3\x65\x98\xCB\xA\xD4\x42\x2\xD\x11\x6C\x20\xAE\x59\x81\x15\x82\x53\xC0\x83\x7C\x82\x90\x14\x1B\x24\x72\x10\x40\x26\x81\x0\x41\x88\x64\xE8\x40\x9A\x58\xD1\x81\x37\x25\x22\x7\x3A\x68\xA6\x8C\x10\x91\x3\xE\x74\x20\x99\xDF\x99\x85\x35\x5\x42\xCD\xE\x28\x93\x3\xDF\x49\x4\x7\xAC\x69\xCD\x11\xAC\x86\x20\x3A\xA8\x40\x34\x67\x23\x10\x32\xE4\xA0\x99\x65\x80\xE5\x2C\x92\xF9\x30\x44\xA8\xF3\x9A\xCD\xC4\xD3\xA2\xD4\x9\x1E\x84\x32\x90\x21\x11\x64\x40\x84\x3F\xC9\xE0\x5\x20\x90\x81\xC\x65\x18\xD9\xD4\x16\xCA\xD0\x86\x3A\xF4\xA1\x2\x9\x8\x0\x3B
proc tkerror msg {
        global errorInfo mb
        if {[string match "no more colors*" $msg]} {
                set app [tk appname]
                puts "$app: $msg"
                return
        }
        append errmsg "Error message: "
        append errmsg $msg\n
        set errInf $errorInfo
        if {[winfo exists .masherrdiag] || [winfo exists .mashstacktrace]} {
                puts stderr "$errmsg stack trace: $errorInfo"
                return
        }
	puts stderr "error: $errorInfo"
        set retCode [tk_dialog .masherrdiag Error $errmsg error \
                        0 Exit "Stack Trace" Continue Dump]
        case $retCode {
                0 {abort}
                1 {	set p [new StackTrace]
			$p open $errInf
		}
                2 {puts stderr $errmsg}
        }
        return 1
}
proc bgerror msg {
        tkerror $msg
}
proc abort {} {
        exit -1
}
Class StackTrace
StackTrace instproc open {errmsg} {
        global traceok traceCmd
        $self instvar t_
        set p [toplevel .mashstacktrace]
        set f [frame $p.top]
        set t_ [text $f.t -yscrollcommand "$f.sy set" \
                        -xscrollcommand "$p.sx set"]
        bind $t_ <Button-3> "$t_ get sel.first sel.last"
        set sx [scrollbar $p.sx -orient horiz -command "$t_ xview"]
        set sy [scrollbar $f.sy -orient vert -command "$t_ yview"]
        pack $f -side top -expand true -fill both
        pack $sy -side right -fill y
        pack $sx -side top -fill x
        pack $t_ -side left -expand true -fill both
        set panel [frame $p.b]
        pack $panel -side bottom -fill x
        set abort [button $panel.abort -command "abort" -text "abort"]
        set exitB  [button $panel.exitB -text "exit" \
		    -command "delete [Application instance] ; exit"]
        set cont  [button $panel.continue -command {set traceok ok} \
                        -text continue]
        set sep [label $panel.gap -width 10 -text "" -relief flat]
        set ent [entry $panel.entry -textvar traceCmd -width 40]
        set evl [button $panel.evl -text eval \
                        -command "$self eval_str \$traceCmd"]
        set cls [button $panel.info -text class \
                        -command "$self get_info \$traceCmd"]
        bind $ent <Return> "$evl invoke"
        $t_ insert insert $errmsg
        pack $exitB $abort $cont $sep $ent $evl $cls -side left -fill both
        wm title $p "DebugInfo@[info hostname]"
        tkwait variable traceok
        destroy $p
        return
}
if 0 {
        StackTrace instproc get_next {} {
                $self instvar t_
                set i [$t_ search -forwards -regexp --  "_o[0-9]*"  sel.first]
                puts stderr $i
                set str [$t_ get $i wordend]
                puts stderr $str
        }
}
StackTrace instproc destroy {} {
        $self next
}
StackTrace instproc get_info {str} {
        $self instvar t_
        if {$str==""} {
             set str [$t_ get sel.first sel.last]
        }
        $self eval_str [concat $str info class]
}
StackTrace instproc eval_str {str} {
        $self instvar t_
        $t_ insert 1.0 "eval: $str\n"
        if [catch {eval $str} result] {
                $t_ insert 1.0 "error: $result\n"
        } else {
                $t_ insert 1.0 "result: $result\n"
        }
}
Class MBPresItem
MBPresItem instproc init {coord prop} {
	$self set coord_ $coord
	$self set prop_ $prop
}
Class MBPresItem/page -superclass MBPresItem
MBPresItem/page proc save {file canv item} {
	puts $file {{page {} {}}}
}
MBPresItem/page instproc init {coord prop} {
	$self next $coord $prop
}
MBPresItem/page instproc create {mgr sender pageidv} {
	upvar $pageidv pageid
	set pagemgr [$mgr page_manger]
	set pageid [$pagemgr create_new_page]
	$pagemgr switch_page_later $pageid
}
Class MBPresItem/text -superclass MBPresItem
MBPresItem/text instproc init {coord prop} {
	$self next $coord $prop
}
MBPresItem/text proc save {file canv id} {
	lappend result [$canv type $id]
	lappend result [$canv coords $id]
	set props {}
	lappend props "-text"
	lappend props [$canv itemcget $id -text]
	set font [$canv itemcget $id -font]
	set family [font actual $font -family]
	set size [font actual $font -size]
	if {$family=="Arial"} {
		set family "helvetica"
	}
	set pixelsize [expr {int(($size*[tk scaling])+0.5)*10}]
	lappend props "-font"
	lappend props "-*-$family-bold-r-normal--*-$pixelsize-*-*-*-*-*-*"
	set color [$canv itemcget $id -fill]
	lappend props "-fill"
	lappend props "$color"
	lappend result $props
	puts $file [list $result]
}
MBPresItem/text instproc create {mgr sender pageidv} {
	upvar $pageidv pageid
	$self instvar prop_ coord_
	set index [lsearch -exact $prop_ "-text"]
	puts "text index is $index"
	incr index
	set text [lindex $prop_ $index]
	if {$text=={}} {
		return
	}
	incr index -1
	set props [lreplace $prop_ $index [expr {$index + 1}]]
	set currText [eval $sender -page $pageid create_item text \
			$coord_ $props]
	puts "currText:$currText"
	set canvas [$mgr page_manager current_canvas]
	puts "text: $text"
	for {set i 0} {$i < [string length $text]} {incr i} {
		set char [string index $text $i]
		set textLast [$sender -page $pageid insert $currText $i $char]
	}
	puts "c:$currText l:$textLast"
	$sender -page $pageid create_item group text \
			$currText $textLast
}
Class MBPresItem/line -superclass MBPresItem
MBPresItem/line instproc init {coord prop} {
}
MBPresItem/line proc save {file canv item} {
}
Class MBPres
MBPres instproc init {mgr filename} {
	$self set mgr_ $mgr
	puts "mbpres: $filename"
	$self instvar f_
	catch {file remove $filename}
	set failed [catch {open $filename "r"} f_]
	if {$failed} {
		error "cannot open $filename"
	}
	$self read
	$self set index_ 0
}
MBPres instproc destroy {} {
	close [$self set $f_]
}
MBPres instproc read {} {
	$self instvar lines_ len_ f_
	set lines_ [read $f_]
	set len_ [llength $lines_]
}
MBPres instproc parse_line {index typevar coordvar propvar} {
	$self instvar lines_
	upvar $typevar type $coordvar coord $propvar prop
	set line [lindex $lines_ $index]
	set type [lindex $line 0]
	set coord [lindex $line 1]
	set prop [lindex $line 2]
}
MBPres instproc exe {index pageidv} {
	upvar $pageidv pageid
	$self instvar index_
	set type {}
	set coord {}
	set prop {}
	$self parse_line $index type coord prop
	puts "parse: $type $coord $prop"
	if {$type!={}} {
		set item [new MBPresItem/$type $coord $prop]
	} else {
		return
	}
	$self instvar mgr_
	$item create $mgr_ [$mgr_ sender] pageid
	delete $item
}
MBPres instproc exe_next {pageidv nopage} {
	upvar $pageidv pageid
	$self instvar index_ len_ lines_
	puts "$index_ , $len_"
	if {$index_ <= $len_} {
		if {$nopage && [lindex [lindex $lines_ $index_] 0]=="page"} {
			puts "exe_next returning 2"
			return 2
		}
		$self exe $index_ pageid
		incr index_
		return 1
	} else {
		return 0
	}
}
MBPres instproc load_next_page {} {
	$self instvar mgr_
	set pageid [[$mgr_ page_manager] current_page]
	set ok [$self exe_next pageid 0]
	puts "$ok"
	while {$ok==1} {
		set ok [$self exe_next pageid 1]
	}
}
MBPres instproc load {} {
	$self instvar mgr_
	set pageid [[$mgr_ page_manager] current_page]
	set ok [$self exe_next pageid 0]
	while $ok {
		set ok [$self exe_next pageid 0]
	}
	$self instvar f_
	close $f_
}
MBPres proc save_canvas {canv filename} {
	if [catch {open $filename "a+"} f] {
		error "cannot save to $filename"
	}
	set elements [$canv find withtag all]
	MBPresItem/page save $f $canv {}
	foreach elt $elements {
		set result {}
		set tags [$canv  gettags $elt]
		if {-1 != [lsearch -exact $tags ignore]} {
			continue
		}
		MBPresItem/[$canv type $elt] save $f $canv $elt
        }
	close $f
}
bind Entry <Enter> {
	catch {
		global entryTab
		if $entryTab(%W:focus) {
			focus %W
		}
	}
}
bind Entry <Return> {
    set validateMode [%W cget -validate]
    %W validate
    %W configure -validate $validateMode
}
bind Entry <Escape> {
	focus .
	%W select clear
	%W delete 0 end
	catch {
		global entryTab
		set entryTab(%W:focus) 0
		%W insert 0 $entryTab(%W:value)
	}
}
bind Entry <Control-g> [bind Entry <Escape>]
bind Entry <Control-u> {
    tkEntrySetCursor %W 0
    %W delete insert end
}
proc mk.entry { w action text } {
	puts stderr "Use the new Entry class"
	exit 1
}
Class Entry
Entry instproc init { w value {obj {}} } {
	$self instvar win_
	set win_ $w
	entry $w -relief raised -borderwidth 1 -exportselection 1 \
		-font [$self get_option entryFont] \
                -validate focusout -validatecommand "$self validate %W %P"
	global entryTab
	if {$obj == {}} {
		set entryTab($w:object) $self
	} else {
		set entryTab($w:object) $obj
	}
	set entryTab($w:value) $value
	$w insert 0 $value
}
Entry instproc entry-value { } {
	global entryTab
	$self instvar win_
	$win_ validate
	return $entryTab($win_:value)
}
Entry instproc set-value {v} {
	global entryTab
	$self instvar win_
	$win_ delete 0 end
	$win_ insert 0 $v
	set entryTab($win_:value) $v
}
Entry instproc clear { } {
	global entryTab
	$self instvar win_
	set entryTab($win_:value) 0
	$win_ insert 0 ""
}
Entry instproc validate {entryName newValue} {
    global entryTab
    $self instvar win_
    set validateResult 1
    set oldValue $entryTab($entryName:value)
    if {[catch {set reject [$entryTab($entryName:object) update $newValue]}]} {
        set reject 0
    }
    if {$reject} {
        $win_ delete 0 end
        $win_ insert 0 $oldValue
        bell
        set validateResult 0
    } else {
        set entryTab($entryName:value) $newValue
        set validateResult 1
    }
    return $validateResult
}
set nids 0
proc uniqueID { } {
	global nids
	incr nids
	return $nids
}
proc isCIF fmt {
	if { $fmt == "h261" } {
		return 1
	}
	return 0
}
proc cname_redundant { name cname } {
	set ni [string first @ $name]
	if { $ni < 0 } {
		return 0
	}
	set ci [string first @ $cname]
	if { $ci < 0 } {
		return 0
	}
	if { [string compare \
		[string range $name 0 $ni] \
		[string range $cname 0 $ci]] == 0 } {
		return 1
	}
	return 0
}
set current_icon_mark "FIXME"
proc mk.key w {
	puts stderr "Use the new KeyEditor class"
	exit 1
}
Class KeyEditor
KeyEditor instproc init { w crypt } {
	$self instvar crypt_ entry_ win_
	set crypt_ $crypt
	set win_ $w
	frame $w.key
	checkbutton $w.key.button -text "Encryption Key:" -relief flat \
		-font [$self get_option smallfont] \
		-command "$self toggle" -variable [$self tkvarname encryptOn_]\
		-disabledforeground gray40
	set key [$self get_option sessionKey]
	set entry_ [new Entry $w.key.entry $key $self]
	$self set-key $key
	pack $w.key.button -side left
	pack $w.key.entry -side left -fill x -expand 1
}
KeyEditor instproc disable {} {
	$self instvar win_
	$win_.key.button configure -state disabled
}
KeyEditor instproc enable {} {
	$self instvar win_
	$win_.key.button configure -state normal
}
KeyEditor instproc set-key key {
	$self tkvar encryptOn_
	$self instvar crypt_
	if { $key == "" } {
		$crypt_ crypt_clear
		set encryptOn_ 0
		$self disable
	} elseif { [$crypt_ install-key $key] != "" } {
		$self disable
		set encryptOn_ 0
		$self clear
	} else {
		$self enable
		set encryptOn_ 1
	}
}
KeyEditor instproc toggle {} {
	$self instvar crypt_ entry_
        $self tkvar encryptOn_
	if $encryptOn_ {
		$crypt_ install-key [$entry_ entry-value]
	} else {
		$crypt_ install-key ""
	}
}
KeyEditor instproc update key {
	set key [string trim $key]
	$self set-key $key
	return 0
}
Class TextEntry -superclass Entry
TextEntry instproc init { target w text } {
	$self next $w $text
	$self set target_ $target
}
TextEntry instproc update s {
	$self instvar target_
	if { $s != "" } {
		set s [string trim $s]
	}
	if {$target_ == {}} {
		return 0
	} else {
		return [eval $target_ \"$s"]
	}
}
Class MBMenu -configuration {
	showOwnerTip 1
	showOwnerAsDrawn 1
	followActive 1
}
MBMenu proc make_menu { parent menuList } {
        foreach {menuName label} $menuList {
                set menuBut $parent.$menuName
                set menu $menuBut.menu
                menubutton $menuBut -menu $menu -text $label -underline 0
                pack $menuBut -side left
                menu $menu -tearoff false
        }
}
MBMenu instproc create_new_page {{page_name {}}} {
	$self instvar mbui_
	[[$mbui_ mgr] page_manager] create_new_page
}
MBMenu instproc init {ui fr mgr exitCmd args} {
    $self instvar mbui_ mgr_
    set mbui_ $ui
    set mgr_ $mgr
    set menubar [eval frame $fr.menu $args]
    set logoF [frame $fr.info]
    pack $logoF -side right -anchor e
    set logofont [$self get_option logofont]
    set logoImageL [button $logoF.imgL -image MBLogo_Icon \
		    -highlightthickness 0 -relief flat -command {
	    set p [new StackTrace]
	    global errorInfo
	    $p open $errorInfo
    }]
    pack $logoImageL -side right -fill y -anchor s -expand false
    set menuList { file "File" edit "Edit" view "View" help "Help"}
    MBMenu make_menu $menubar $menuList
    set filemenu $menubar.file.menu
    $filemenu add command -label Save -underline 0 \
		    -command "$self save"
    $filemenu add command -label "Save as PostScript"  -underline 9 \
		-command "$self postscript"
    $filemenu add command -label Load -underline 0 \
		    -command "$self load"
    if { $exitCmd != {} } {
	    $filemenu add command -label Quit -underline 0 \
			    -command "$exitCmd"
    }
    $self instvar readonlyList_
    set editmenu $menubar.edit.menu
    set i 0
    $editmenu add command -label "Erase Last" -underline 0 \
		-command "$self erase_last"
    lappend readonlyList_ [list $editmenu $i]
    incr i
    $editmenu add command -label "Unerase" -underline 0 \
		-command "$self unerase"
    lappend readonlyList_ [list $editmenu $i]
    incr i
    $editmenu add command -label "New Page" -underline 0 \
		-command "$self insert_page"
    lappend readonlyList_ [list $editmenu $i]
    incr i
    $editmenu add command -label "Import..." -underline 0 \
		-command "$self import_ext"
    lappend readonlyList_ [list $editmenu $i]
    set viewmenu $menubar.view.menu
    $self tkvar showSrcList_
    set srcList [$mbui_ set srcList_]
    $viewmenu add checkbutton -label "Members..." -underline 0 \
		-variable [$self tkvarname showSrcList_] \
		-command "$srcList toggle_window \
		\[set [$self tkvarname showSrcList_]\]"
    $srcList add_callback dismiss "set [$self tkvarname showSrcList_] 0"
    $srcList add_callback followAny "set [$self tkvarname follow_active_]"
    $self tkvar follow_active_
    set follow_active_ [$self get_option followActive]
    $srcList set_followAny $follow_active_
    $self tkvar browseTime_
    $viewmenu add checkbutton -label "Past Activity..." -underline 0 \
		    -variable [$self tkvarname browseTime_] \
		    -command "$mbui_ browseTime [$self tkvarname browseTime_]"
    $viewmenu add command -label "Session info..." \
            -underline 8 -command "$self disp-sess-info"
    $viewmenu add checkbutton -label "Follows activity" \
		    -underline 0 \
		    -variable [$self tkvarname follow_active_]
    set pageList [[[$self set mbui_] set pageNavPanel_] set pageList_]
    $viewmenu add cascade -label "Page" \
            -menu [$pageList get_copy $viewmenu] -underline 0
    set tipOptionMenu $viewmenu.tipOptions
    $viewmenu add cascade -label "Tips" \
		    -menu $tipOptionMenu -underline 0
    menu $tipOptionMenu -tearoff 0
    $self tkvar showOwnerTip_
    $tipOptionMenu add checkbutton -label "under cursor" -underline 0 \
		    -variable [$self tkvarname showOwnerTip_] \
		    -command "$self show_owner_tip"
    set showOwnerTip_ [$self get_option showOwnerTip]
    $self tkvar showOwnerAsDrawn_
    $tipOptionMenu add checkbutton -label "when drawn" -underline 0 \
		    -variable [$self tkvarname showOwnerAsDrawn_] \
		    -command "$self show_owner_as_drawn"
    set showOwnerAsDrawn_ [$self get_option showOwnerAsDrawn]
    set optionmenu $viewmenu.option
    $viewmenu add cascade -label "Options" \
            -menu $optionmenu \
            -underline 0
    menu $optionmenu -tearoff 0
    $self tkvar enable_debug_
    set enable_debug_ 0
    set dbgVarName [$self tkvarname enable_debug_]
    set debugDlg [$mbui_ set debug_]
    $optionmenu add checkbutton -label "simulate pkt drop" -underline 0 \
		    -variable $dbgVarName \
		    -command "[$mbui_ set debug_] change_state \
		    \[set $dbgVarName\]"
    $debugDlg add_callback disable_drop "set [$self tkvarname enable_debug_] 0"
    $self tkvar enable_trace_
    set enable_trace_ 0
    $optionmenu add command -label "toggle trace window" -underline 0 \
		    -command "[MTrace set mtrace] toggle_window"
    $optionmenu add checkbutton -label "status bar on top" \
		    -variable [$mbui_ tkvarname statusbarOnTop_] \
		    -command "$mbui_ redraw_statusbar"
    set dbgmenu $viewmenu
    set dumpm $dbgmenu.dumpm
    $dbgmenu add cascade -label "Debug Info" -menu $dumpm -underline 0
    menu $dumpm -tearoff 0
    set sender [[$mbui_ mgr] sender]
    $dumpm add command -label "TimeStamps" -underline 0 \
		    -command "$self dump_ts"
    set pageMgr [[$mbui_ mgr] page_manager]
    $dumpm add command -label "Canvas" -underline 0 \
		    -command "$self dump_canv"
    set helpmenu $menubar.help.menu
    $helpmenu add command -label About -underline 0 \
            -command "$self about"
    pack $menubar -side left -fill y -anchor w -expand true
    return $menubar
}
MBMenu instproc disp-sess-info {} {
        $self instvar mgr_ sessDlg_
	if ![info exists sessDlg_] {
		set sessDlg_ [MBSessionDlg .mbSessDlg -mgr $mgr_ \
				-title "MediaBoard Session Information" \
				-name [[$mgr_ local_src] cname]]
	}
	wm deiconify $sessDlg_
}
MBMenu instproc about {} {
	append msg "MediaBoard \n" \
			"Version [version]\n" \
			"\n" \
			"MASH Group \n" \
			"University of Califonia, Berkeley"
	set msgBox [Dialog transient MessageBox -title "About MediaBoard" \
			-text $msg -type ok]
}
MBMenu instproc followActivePage {} {
	$self tkvar follow_active_
	return $follow_active_
}
MBMenu instproc insert_page {} {
	$self instvar mbui_
	set new_pgid [$self create_new_page]
	set pageMgr [[$mbui_ mgr] page_manager]
	$pageMgr switch_page_later $new_pgid
}
MBMenu instproc import_ext {} {
	$self instvar mbui_
	set toolbar [$mbui_ set toolbar_]
	$toolbar deactivate_tool [$toolbar current_tool]
	[$toolbar tool import] activate [[[$mbui_ mgr] page_manager] current_page]
}
MBMenu instproc tool {toolname} {
	return [[[$self set mbui_] set toolbar_] tool $toolname]
}
MBMenu instproc paste {} {
	$self instvar mbui_
	set c  [[[$mbui_ mgr] page_manager] current_canvas]
	set textTool [$self tool text]
	mtrace trcMB "texttool: $textTool"
	$textTool paste $c [$c canvasxy 1.0 1.0]
}
MBMenu instproc show_owner_tip {} {
	$self tkvar showOwnerTip_
	$self instvar mbui_
	[[[$mbui_ mgr] page_manager] current_canvas] enable_tip $showOwnerTip_
}
MBMenu instproc show_owner_as_drawn {} {
	$self tkvar showOwnerAsDrawn_
	$self instvar mbui_
	$mbui_ enable_tip_as_drawn $showOwnerAsDrawn_
}
MBMenu instproc showOwnerVal {} {
	$self tkvar showOwnerTip_
	return $showOwnerTip_
}
MBMenu instproc unerase {} {
	set ueTool [$self tool unerase]
	$self instvar mbui_
	$ueTool unerase	[[[$mbui_ mgr] page_manager] current_page]
}
MBMenu instproc erase_last {} {
	$self instvar mbui_
	set eTool [$self tool erase]
	$eTool erase_last [[[$mbui_ mgr] page_manager] current_page]
}
MBMenu instproc readonly {on} {
	$self instvar readonlyList_
	if {$on} {
		foreach item $readonlyList_ {
			set widget [lindex $item 0]
			set index [lindex $item 1]
			eval $widget entryconfigure $index -state disabled
		}
	} else {
		foreach item $readonlyList_ {
			set widget [lindex $item 0]
			set index [lindex $item 1]
			eval $widget entryconfigure $index -state normal
		}
	}
}
MBMenu instproc postscript {} {
	$self instvar mbui_
	if {[[[$mbui_ mgr] page_manager] current_page] != {}} {
		[$mbui_ printUI] show
	}
}
MBMenu instproc load {} {
	$self instvar mbpres_ mbui_
	if ![info exists mbpres_] {
		set filename [Dialog transient FileDialog \
				-title "Choose file to load from" \
				-type open]
		set mbpres_ [new MBPres [$mbui_ mgr] $filename]
	}
	$mbpres_ load
}
MBMenu instproc save {} {
	$self instvar mbui_
	set canv [[[$mbui_ mgr] page_manager] current_canvas]
	MBPres save_canvas $canv "pres-out.mb"
}
MBMenu instproc dump_ts {} {
	$self instvar mbui_
	set sender [[$mbui_ mgr] sender]
	if ![catch {$sender dump timestamps} result] {
		if {$result != {}} {
			new DbgInfoWindow "timestamps" $result
		}
	}
}
MBMenu instproc dump_canv {} {
	$self instvar mbui_
	set sender [[$mbui_ mgr] sender]
	if ![catch {$sender dump canvas} result] {
		if {$result != {}} {
			append result [DumpCanvas [$pageMgr \
					current_canvas]]
			new DbgInfoWindow "timestamps" $result
		}
	}
}
WidgetClass MBSessionDlg -superclass Dialog -configspec {
	{ -mgr mgr Mgr "" config_mgr cget_mgr }
	{ -name name Name "" config_name cget_name }
}
MBSessionDlg private build_widget { path } {
	$self set path_ $path
	set f [frame $path.topframe -bd 2 -relief flat]
	pack $f -fill both -expand 1 -side top
	set infoLabel [label $f.ilabel -text "Network Information" -font \
			[$self get_option medfont]]
	pack $infoLabel -fill x -side top
	set ef [frame $path.entryframe -bd 2 -relief sunken]
	$self set_subwidget entryframe $ef
	pack $ef -fill both -expand 1 -side top
	set ft [frame $path.topframe.infoframe -bd 2 -relief sunken]
	label $ft.text -justify left
	$self set_subwidget text $ft.text
	pack $ft.text -side top -anchor w -expand 1 -fill both
	pack $ft -side top -fill both
	set configLabel [label $f.clabel -text "Configurations" -font \
			[$self get_option medfont]]
	pack $configLabel -fill x -side top
	$self instvar nameEntry_
	set nf [frame $ef.nf]
	set ne [entry $nf.name -font [$self get_option smallfont]]
	set nameEntry_ $ne
	set nl [label $nf.label -font [$self get_option smallfont] \
			-text "Name: "]
	bind $ne <Return> "$self update_name \[%W get\]"
	bind $ne <Escape> "$self configure -name \[set [$self tkvarname name_]\]; break"
	bind $ne <FocusOut> "$self update_name \[%W get\]"
	pack $nf -side top -fill x -expand 1 -padx 1 -pady 1
	pack $nl -side left -expand 0
	pack $ne -side left -fill x -anchor w -expand 1 -padx 1
	set bf [frame $path.bframe -bd 1 -relief flat]
	ImageTextButton $bf.ok -underline 0 -text "Ok" \
			-image Icons(check) -orient horizontal \
			-command "$self dismiss"
	pack $bf.ok -expand 0 -pady 2
	pack $bf -fill x -expand 0 -side bottom	-anchor s
}
MBSessionDlg private config_name {option name} {
	$self tkvar name_
	set name_ $name
	$self instvar nameEntry_
	$nameEntry_ del 0 end
	$nameEntry_ insert 0 $name_
}
MBSessionDlg private cget_name {name} {
	$self tkvar name_
	return $name_
}
MBSessionDlg private update_name {name} {
	$self instvar mgr_
	$mgr_ update_name $name
}
MBSessionDlg private config_mgr {opt mgr} {
	if {$mgr == {}} {
		return
	}
	$self instvar mgr_
	set mgr_ $mgr
	$self subwidget text configure -text [$self get_sessionInfo]
	set t [$self subwidget entryframe]
	$self instvar ke_
	if [info exists ke_] {
		delete $ke_
	}
	set ke_ [new KeyEditor $t [[$mgr session] get_agent]]
	pack $t.key -side bottom -fill x -anchor w -padx 1
}
MBSessionDlg private cget_mgr {} {
	return [$self set mgr_]
}
MBSessionDlg private get_sessionInfo {} {
	$self instvar mgr_
	set dn [[$mgr_ session] data-net]
	set cn [[$mgr_ session] ctrl-net]
	append msg      "Session address: "   [$dn addr]  "\n" \
			"Data port: "         [$dn sport] "\n" \
			"Control port: "      [$cn sport] "\n" \
			"Session TTL: "       [$dn ttl]   "\n" \
			"Session interface: " [$dn interface]
	return $msg
}
MBSessionDlg private dismiss { } {
	$self instvar nameEntry_ path_
	if {[$nameEntry_ get] != [$self cget -name]} {
		$self update_name [$nameEntry_ get]
	}
	wm withdraw $path_
	raise $path_
}
package provide "tips" 1.0
array set tip_priv {
    window_delay             500
    y_offset                 5
    x_offset                 20
    currently_tipping        ""
    tips_enabled             1
    tips_initialized         0
}
proc add_tip {window msg} {
    global tip_priv
    if {! $tip_priv(tips_initialized)} {tip_init_tips}
    set tip_priv($window) $msg
    set tags [bindtags $window]
    if {[lsearch -exact $tags TipBindings] == -1} {
	bindtags $window [concat TipBindings [bindtags $window]]
    }
}
proc remove_tip {window} {
    global tip_priv
    if [info exists tip_priv($window)] {
	unset tip_priv($window)
	set tags [bindtags $window]
	if {[set index [lsearch -exact $tags TipBindings]] >= 0} {
	    bindtags $window [lreplace $tags $index $index]
	}
	if {$tip_priv(currently_tipping) == $window} {
	    destroy .tip
	    set tip_priv(currently_tipping) ""
	}
    } else {
	error "No popup tip set for $window"
    }
}
proc enable_tips {bool} {
    global tip_priv
    set tip_priv(tips_enabled) $bool
    if {! $bool && $tip_priv(currently_tipping) != ""} {
	destroy $tip_priv(currently_tipping)
	set tip_priv(currently_tipping) ""
    }
}
proc tip_make_window {window} {
    global tip_priv
    set tip_priv(currently_tipping) $window
    catch {destroy .tip}
    set y [expr [winfo rooty $window] + [winfo height $window] + $tip_priv(y_offset)]
    set x [expr [winfo rootx $window] + $tip_priv(x_offset)]
    toplevel .tip -class Tip
    wm overrideredirect .tip yes
    wm geometry .tip +$x+$y
    pack [message .tip.message -text $tip_priv($window) -bg beige]
}
proc tip_cancel_tip {} {
    global tip_priv
    if {! $tip_priv(tips_enabled)} return
    if {$tip_priv(currently_tipping) != ""} {
	catch {destroy .tip}
	set tip_priv(currently_tipping) ""
    }
    catch {after cancel $tip_priv(after_id)}
}
proc tip_init_tips {} {
    global tip_priv
    option add "*tip.message.background"  "LemonChiffon"                widgetDefault
    option add "*tip.message.foreground"  "Black"                       widgetDefault
    option add "*tip.message.relief"      "raised"                      widgetDefault
    option add "*tip.message.borderWidth" "2"                           widgetDefault
    option add "*tip.message.justify"     "left"                        widgetDefault
    option add "*tip.message.aspect"      "350"                         widgetDefault
    option add "*tip.message.font"        "-*-helvetica-medium-r-normal-*-*-120-*-*-*-*-*-*" widgetDefault
    bind TipBindings <Enter> {
	global tip_priv
	if {! $tip_priv(tips_enabled)} continue
	set tip_priv(currently_tipping) ""
	set tip_priv(after_id) [after $tip_priv(window_delay) tip_make_window %W]
    }
    bind TipBindings <Leave> {
	tip_cancel_tip
    }
    bind TipBindings <Button-1> {
	tip_cancel_tip
    }
    bind TipBindings <space> {
	tip_cancel_tip
    }
    set tip_priv(tips_initialized) 1
}
Class MBTool
WidgetClass ProgressBar -configspec {
	{ -min min Min 0 config_min cget_min }
	{ -max max Max 100 config_max cget_max }
	{ -value val Val 0 config_value cget_value }
	{ -width width Width 200 config_width cget_width }
	{ -height height Height 20 config_height cget_height }
}
ProgressBar private build_widget { path } {
	$self set min_ 0
	$self set max_ 0
	$self set value_ 0
	canvas $path.canvas
	bind $path.canvas <Configure> "$self refresh"
	pack $path.canvas -side top -fill both -expand true
}
ProgressBar private config_min { option value } {
	$self instvar min_ max_
	set min_ $value
	if { $min_ > $max_ } { set max_ $min_ }
	$self do_when_idle "$self refresh"
}
ProgressBar private cget_min { option } {
	return [$self set min_]
}
ProgressBar private config_max { option value } {
	$self instvar min_ max_
	set max_ $value
	if { $min_ > $max_ } { set min_ $max_ }
	$self do_when_idle "$self refresh"
}
ProgressBar private cget_max { option } {
	return [$self set max_]
}
ProgressBar private config_value { option v } {
	$self instvar min_ max_
	if { $v < $min_ } { set v $min_ }
	if { $v > $max_ } { set v $max_ }
	$self set value_ $v
	$self do_when_idle "$self refresh"
}
ProgressBar private cget_value { option } {
	return [$self set value_]
}
ProgressBar instproc config_height { option height } {
	$self subwidget canvas configure -height $height
	$self do_when_idle "$self refresh"
}
ProgressBar instproc cget_height { option } {
	return [$self subwidget canvas cget -height]
}
ProgressBar instproc config_width { option width } {
	$self subwidget canvas configure -width $width
	$self do_when_idle "$self refresh"
}
ProgressBar instproc cget_width { option } {
	return [$self subwidget canvas cget -width]
}
ProgressBar instproc refresh { } {
	$self instvar min_ max_ value_
	set canv [$self subwidget canvas]
	set width  [winfo width $canv]
	set height [winfo height $canv]
	if {""==[$canv find withtag border]} {
		set t [$canv create rectangle 2 2 2 2]
		$canv addtag border withtag $t
	}
	$canv coords border 2 2 [expr $width - 2] [expr $height - 2]
	if {""==[$canv find withtag progress]} {
		set t [$canv create rectangle 2 2 2 2 -fill blue \
				-outline blue]
		$canv addtag progress withtag $t
	}
	if { $max_==$min_ } {
		set w 4
	} else {
		set w [expr 4 + ($width - 8)*($value_ - $min_)/($max_ - $min_)]
	}
	$canv coords progress 4 4 $w [expr $height - 4]
}
WidgetClass ProgressBox -superclass MessageBox -configspec {
	{ -min min Min 0 config_min cget_min }
	{ -max max Max 100 config_max cget_max }
	{ -text text Text {} config_text cget_text }
	{ -value val Val 0 config_value cget_value }
	{ -width width Width 200 config_width cget_width }
	{ -height height Height 20 config_height cget_height }
	{ -type type Type none config_type cget_type }
}
ProgressBox instproc build_widget { path } {
	$self next $path
	canvas $path.progcanv
	pack $path.progcanv -side top -fill both -expand true
}
ProgressBox instproc config_text {args} {
	eval $self next $args
}
ProgressBox instproc config_min { option value } {
	$self set min_ $value
}
ProgressBox instproc cget_min { option } {
	return [$self set min_]
}
ProgressBox instproc config_max { option value } {
	$self set max_ $value
}
ProgressBox instproc cget_max { option } {
	return [$self set max_]
}
ProgressBox instproc config_value { option v } {
	$self set value_ $v
	$self do_when_idle "$self refresh"
}
ProgressBox instproc cget_value { option } {
	return [$self set value_]
}
ProgressBox instproc config_height { option height } {
	$self set height_ $height
	[$self subwidget progcanv] configure -height $height
	$self do_when_idle "$self refresh"
}
ProgressBox instproc cget_height { option } {
	return [$self set height_]
}
ProgressBox instproc config_width { option width } {
	$self set width_ $width
	[$self subwidget progcanv] configure -width $width
	$self do_when_idle "$self refresh"
}
ProgressBox instproc cget_width { option } {
	return [$self set width_]
}
ProgressBox instproc refresh { } {
	$self instvar min_ max_ value_ width_ height_
	if {!( [info exists min_] && [info exists max_] \
			&& [info exists value_] && [info exists width_] \
			&& [info exists height_] ) } {
		return
	}
	set canv [$self subwidget progcanv]
	$canv configure -width $width_ -height $height_
	if {""==[$canv find withtag border]} {
		set t [$canv create rectangle 2 2 2 2]
		$canv addtag border withtag $t
	}
	$canv coords border 2 2 [expr $width_ - 2] [expr $height_ - 2]
	if {""==[$canv find withtag progress]} {
		set t [$canv create rectangle 2 2 2 2 -fill blue \
				-outline blue]
		$canv addtag progress withtag $t
	}
	if { $max_==$min_ } {
		set w 4
	} else {
		set w [expr 4 + ($width_ - 8)*($value_ - $min_)/($max_-$min_)]
	}
	$canv coords progress 4 4 $w [expr $height_ - 4]
}
Class MBImportTool -superclass MBTool -configuration {
	imageOffset {0 0}
}
MBImportTool instproc init {toolbar mgr sender} {
	$self next $toolbar $mgr $sender
        $self instvar filetypes_ fileNames_
	global tcl_platform
	if { $tcl_platform(platform) != "windows" } {
		set filetypes_ {
			{ {Graphics Files}
			{ .GIF .gif .ps .PS .eps .EPS} }
			{ {GIF Files} {.gif .GIF} }
			{ {Postscript Files} {.ps .PS .eps .EPS} }
		}
	} else {
		set filetypes_ {
			{ {GIF Files} {.gif .GIF} }
		}
	}
        set fileNames_ ""
        $self set lastdir_ [pwd]
}
MBImportTool instproc PromptForFile {canvas page_id} {
        $self instvar fileNames_ filetypes_ lastdir_
        set fileNames_ [Dialog transient Dialog/MBImport \
                                -directory "$lastdir_" \
                                -title {Select file to import} \
                                -filetypes $filetypes_]
        if {$fileNames_!=""} {
                set lastdir_ [file dirname [lindex $fileNames_ 0]]
                return 0
        } else {
                return -1
        }
}
MBImportTool instproc CreateFromFile {filename canvas pt1 pt2} {
        global tcl_platform
	$self instvar mgr_
        set type [$self getType $filename]
        set sender [$mgr_ sender]
        if { [string compare $type gif] == 0} {
                set lastImg_ [eval $sender create_item image \
				$pt1 [list $filename]]
        } elseif { ![string compare $type ps] || \
                        ![string compare $type eps] } {
                if { $tcl_platform(platform) != "windows" } {
                        set lastImg_ [eval $sender create_item \
                                        pscript $pt1 $pt2 \
                                        -file $filename]
                } else {
                         Dialog transient MessageBox \
                                         -image Icons(warning) -type ok \
                                         -text "Postscript files are not supported under windows"
			return -1
                }
        } else {
                DbgOut "Unknown format"
                return -1
        }
	$self instvar mgr_ toolbar_
	$toolbar_ add_item [[$mgr_ page_manager] current_page] $lastImg_
        return 1
}
MBImportTool instproc getType { fileName } {
    return [string tolower [lindex [split $fileName "."] end]]
}
MBImportTool instproc restore {} {
        set first_ ""
        set canv_mark_ ""
        set fileNames_ ""
}
MBImportTool instproc defineFirst {canvas pt} {
        $self instvar first_ canv_mark_ fileNames_
        if {$fileNames_==""} {
                return
        }
        set w [$canvas get_win]
        if {[string compare [$self getType $fileNames_] "gif"] == 0} {
 puts "foo"
                $self CreateFromFile $fileNames_ $canvas $pt $pt
 puts "af foo"
                $self restore
                return
        }
	global tcl_platform
	if {$tcl_platform(platform)=="windows"} {
		Dialog transient MessageBox -type ok \
				-text "postscript not supported for windows yet"
		$self restore
		return
	}
        set first_ $pt
        set canv_mark_ [eval $canvas create rect $pt $pt]
        bind $w <B1-Motion> \
		    "$self stretch $canvas \[$canvas canvasxy %x %y\]"
        bind $w <ButtonRelease-1> \
		    "$self end $canvas \[$canvas canvasxy %x %y\]"
}
MBImportTool instproc stretch {canvas pt} {
        $self instvar first_ canv_mark_
        eval $canvas coord $canv_mark_ $first_ $pt
}
MBImportTool instproc end {canvas pt} {
        $self instvar first_ canv_mark_ fileNames_
        $self CreateFromFile [list $fileNames_] $canvas $first_ $pt
        $canvas delete $canv_mark_
        set w [$canvas get_win]
        $self restore
}
MBImportTool instproc activate {page_id args} {
	puts "in $class activate $page_id <$args>"
        $self instvar first_ canv_mark_
        set first_ ""
        set canv_mark_ ""
        $self next page_id
        $self instvar lastImg_ mgr_
	set canv [[$mgr_ page_manager] page2canv $page_id]
        set w [$canv get_win]
        $canv resetBindings
        $canv config -cursor cross
        if {$args=={}} {
                if {-1 == [$self PromptForFile $canv $page_id]} {
                        $self restore
                        return
                }
        }
        $self instvar fileNames_
        set theRest [lrange $fileNames_ 1 end]
        set firstCorner [string trim [$self get_option imageOffset]]
        if {$firstCorner=="none"} {
                set firstCorner [list 0.0 0.0]
        }
        set fileNames_ [lindex $fileNames_ 0]
	if {$theRest != ""} {
		set progbox [ProgressBox .mbimportprogress \
				-text "Importing Files ..." \
				-min 0 -max [expr [llength $theRest] + 1] \
				-value 0 ]
		$progbox center
		update idletasks
	}
	set i 0
	foreach path $theRest {
		set pagename [file rootname [file tail $path]]
		$self instvar toolbar_
		set menu [[$toolbar_ set mbui_] set menu_]
		set pgid [$menu create_new_page $pagename]
		eval [$mgr_ sender] -page $pgid \
			create_item image $firstCorner [list $path]
		incr i
		$progbox configure -text "Importing $path"
		$progbox configure -value $i
		update idletasks
	}
	incr i
        if { ([$self getType $fileNames_]=="gif") && \
                        ("none"!=[string trim \
			[$self get_option imageOffset]])} {
		$self defineFirst $canv $firstCorner
		if {$theRest!={}} {
			$progbox configure -text "Importing $path"
			$progbox configure -value $i
			update idletasks
			destroy $progbox
		}
                $self restore
                return
        }
        bind $w <Button-1> \
                        "$self defineFirst $canv \[$canv canvasxy %x %y\]"
        bind $w <B1-Motion> ""
        bind $w <ButtonRelease-1> ""
}
WidgetClass Dialog/MBImport -superclass Dialog -configspec {
        {-filetypes fileTypes FileTypes "" config_filetypes cget_filetypes }
        {-directory directory Directory "" config_directory cget_directory }
} -default {
	{ *background WidgetDefault }
}
Dialog/MBImport instproc config_filetypes { args } {
        return [eval [$self subwidget filebox] config_filetypes $args]
}
Dialog/MBImport instproc cget_filetypes { args } {
        return [eval [$self subwidget filebox] cget_filetypes $args]
}
Dialog/MBImport instproc config_directory { args } {
        return [eval [$self subwidget filebox] config_directory $args]
}
Dialog/MBImport instproc cget_directory { args } {
        return [eval [$self subwidget filebox] cget_directory $args]
}
Dialog/MBImport instproc build_widget { path } {
	$self next $path
	frame   $path.frame
        set filebox [FileBox $path.filebox -command "$self import; $self ignore_args" -browsecmd "$self ignore_args"]
        set butbox [frame $path.buttonbox]
        button $butbox.imp -underline 0 -text "Import" \
                        -command "$self import; $self ignore_args"
        button $butbox.all -underline 8 -text "Import All" -command \
                        "$self import_all"
        button $butbox.cancel -underline 0 -text "Cancel" \
                        -command "$self cancel"
        bind $path <KeyPress-Escape> "$self cancel"
        pack $butbox.imp $butbox.all $butbox.cancel -side left \
                        -padx 5 -pady 2
        pack $butbox -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
}
Dialog/MBImport instproc import {} {
        set filebox [$self subwidget filebox]
        set file [$filebox cget -filename]
        if { $file=="" } return
        set path [file join [$filebox cget -directory] $file]
        if {![file exists $path]} {
                Dialog transient MessageBox -image Icons(warning) -type ok \
				-text "File \"$path\" does not exist."
                return
        }
	$self tkvar result_
	$self config -result [list $path]
}
proc alphaNumericCmp {str1 str2} {
        if {$str1==$str2} { return 0 }
        if {[ regexp {[a-zA-Z]*0*([0-9]*)\.[a-zA-Z0-9]*} $str1 {} n1 ] && \
                        [ regexp {[a-zA-Z]*0*([0-9]*)\.[a-zA-Z0-9]*} $str2 {} n2]} {
                return [expr {$n1 - $n2}]
        }
}
Dialog/MBImport instproc import_all {} {
        set appPWD [pwd]
        set filebox [$self subwidget filebox]
        set dir [$filebox 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 filter [$filebox current_filter]
        set files [lsort -command alphaNumericCmp [eval glob -nocomplain $filter]]
	if {0==[llength $files]} { return }
        set prevFile ""
        foreach f $files {
                if {$f!=$prevFile} {
                        lappend tmplist $f
                }
                set prevFile $f
        }
        if [info exists tmplist] { puts "after uniquify: $tmplist" }
        foreach f $tmplist {
                lappend paths [file join $dir $f]
        }
        cd $appPWD
        if {$paths==""} {
                return
        }
        $self tkvar result_
        $self config -result $paths
}
Dialog/MBImport instproc cancel { } {
	$self tkvar result_
	$self config -result ""
}
proc StartNetscape {url} {
	set tmp [eval {exec netscape -remote openURL($url) >& /dev/null} ]
	if { $tmp == 0} {
		set err [catch { eval {exec netscape $url &} }]
		if { $err == 0} {
			puts "Could not start netscape."
		}
	}
}
MBTool instproc init {toolbar mgr sender} {
	$self set toolbar_ $toolbar
	$self set sender_ $sender
	$self set mgr_ $mgr
}
MBTool instproc property {tool} {
	$self instvar toolbar_
	return [[$toolbar_ set mbui_] property $tool]
}
MBTool instproc deactivate {} {
}
Class MBSelectTool -superclass MBTool
MBSelectTool instproc init {toolbar mgr sender} {
	$self next $toolbar $mgr $sender
	$self set selectedObj_ {}
}
MBSelectTool instproc activate_move { page_id } {
	$self instvar canv_ page_id_ mgr_
	set page_id_ $page_id
	set canv_ [[$mgr_ page_manager] page2canv $page_id]
	$canv_ resetBindings
	$canv_ setHilit
	$canv_ config -cursor arrow
	set w [$canv_ get_win]
	bind $w <Button-1> "$self start_move \[$canv_ canvasxy %x %y\]"
	bind $w <B1-Motion> "$self move \[$canv_ canvasxy %x %y\]"
	bind $w <ButtonRelease-1> "$self end_move \[$canv_ canvasxy %x %y\]"
}
MBSelectTool instproc activate_copy { page_id } {
	$self instvar canv_ page_id_ mgr_
	set page_id_ $page_id
	set canv_ [[$mgr_ page_manager] page2canv $page_id]
	$canv_ resetBindings
	$canv_ setHilit
	$canv_ config -cursor arrow
	set w [$canv_ get_win]
	bind $w <Button-1> "$self start_copy \[$canv_ canvasxy %x %y\]"
	bind $w <B1-Motion> "$self move \[$canv_ canvasxy %x %y\]"
	bind $w <ButtonRelease-1> "$self end_move \[$canv_ canvasxy %x %y\]"
}
MBSelectTool instproc start_copy {pt} {
	$self instvar selectedObj_ lastpt_ startpt_ sender_ canv_ mgr_ toolbar_
	set nearbyObjs [eval $sender_ nearest $pt 2]
    	set pgId [[$mgr_ page_manager] current_page]
	if { [llength $nearbyObjs] > 0 } {
		set obj [lindex $nearbyObjs 0]
		set selectedObj_ [$sender_ dup_item $obj]
		$toolbar_ add_item $pgId $selectedObj_
		set lastpt_ $pt
		set startpt_ $pt
		$canv_ config -cursor fleur
		$sender_ interactive 1
	}
}
MBSelectTool instproc start_move {pt} {
	$self instvar selectedObj_ lastpt_ startpt_ sender_ canv_
	set nearbyObjs [eval $sender_ nearest $pt 2]
	if { [llength $nearbyObjs] > 0 } {
		set selectedObj_ [lindex $nearbyObjs 0]
		set lastpt_ $pt
		set startpt_ $pt
		$canv_ config -cursor fleur
		$sender_ interactive 1
	}
}
MBSelectTool instproc move {pt} {
	$self instvar selectedObj_ lastpt_ sender_ canv_
	if {$selectedObj_ != {}} {
		set dx [expr {[lindex $pt 0] - [lindex $lastpt_ 0]}]
		set dy [expr {[lindex $pt 1] - [lindex $lastpt_ 1]}]
		$sender_ move $selectedObj_ $dx $dy
		set lastpt_ $pt
		$canv_ hilit
	}
}
MBSelectTool instproc end_move {pt} {
    	$self instvar selectedObj_ lastpt_ startpt_ sender_ canv_ page_id_ \
			toolbar_
	if {$selectedObj_ == {}} {
		return
	} else {
		$canv_ config -cursor arrow
		set dx [expr {[lindex $startpt_ 0] - [lindex $lastpt_ 0]}]
		set dy [expr {[lindex $startpt_ 1] - [lindex $lastpt_ 1]}]
		$sender_ move $selectedObj_ $dx $dy
		$sender_ interactive 0
		set newobj [$sender_ -page $page_id_ move $selectedObj_ \
			    [expr {[lindex $pt 0] - [lindex $startpt_ 0]}] \
			    [expr {[lindex $pt 1] - [lindex $startpt_ 1]}]]
		$toolbar_ replace_item $page_id_ $selectedObj_ $newobj
		set selectedObj_ {}
	}
	$canv_ resetMarker
}
MBSelectTool instproc deactivate {} {
	$self instvar selectedObj_ lastpt_
	if { [info exists selectedObj_] && [info exists lastpt_] } {
		$self end_move $lastpt_
	}
}
Class MBTextTool -superclass MBTool
MBTextTool instproc init {toolbar mgr sender} {
	$self next $toolbar $mgr $sender
	$self set textLast_ {}
	$self set currText_ {}
}
MBTextTool instproc activate { page_id } {
	$self instvar page_id_ canv_ mgr_
	set page_id_ $page_id
	set canv_ [[$mgr_ page_manager] page2canv $page_id]
	$canv_ resetBindings
	$canv_ config -cursor xterm
    	$self set textLast_ {}
	$self set currText_ {}
	set w [$canv_ get_win]
	bind $w <Button-1> "$self new_group $canv_ \[$canv_ canvasxy %x %y\]"
}
MBTextTool instproc new_group {canv pt} {
	$self instvar canv_ currText_ sender_
	if [info exists canv_] {
		$self end_group
	}
	set canv_ $canv
	$self set textLast_ {}
	set currText_ [eval $sender_ create_item text $pt \
		    [$self property text]]
	$canv focus currtext
	$canv icursor currtext 1
	set w [$canv get_win]
	$canv bind currtext <Any-Key>   "$self insert_char %A; break"
	$canv bind currtext <Return>    "$self insert_char \\n"
	$canv bind currtext <Control-h> [list $self insert_char \b]
	$canv bind currtext <Tab>       "$self insert_char \\t; break"
	$canv bind currtext <BackSpace> [$canv bind currtext <Control-h>]
	$canv bind currtext <Delete> [$canv bind currtext <Control-h>]
	$canv bind currtext <Control-v> {}
	$canv bind currtext <Control-y> {}
}
MBTextTool instproc pending {canvWgt} {
	$self instvar canv_ currText_
	if {![info exist canv_]} {
		return 0
	}
	return [expr { $canvWgt==[$canv_ get_win] &&  {} != $currText_ } ]
}
MBTextTool instproc insert_string {str} {
	for {set i 0} {$i < [string length $str]} {incr i} {
		$self insert_char [string index $str $i]
	}
}
MBTextTool instproc paste {canv {pt {}}} {
	$self instvar toolbar_
	set currTool [$toolbar_ current_tool]
	if {$currTool!="text"} {
		$toolbar_ deactivate_tool $currTool
	}
	set canvWgt [$canv get_win]
	set oldcursor [$canv show_busy 1]
	if [catch {selection get} sel] {
		if [catch {selection get -selection CLIPBOARD} sel] {
			$canv show_busy 0 $oldcursor
			return
		}
	}
	if {$sel == {}} {
		$canv show_busy 0 $oldcursor
		return
	}
	set newgroup 0
	$self instvar toolbar_
	if {[$toolbar_ current_tool] != "text" || \
		    ![$self pending $canvWgt]} {
		set newgroup 1
	}
	if {$newgroup} {
		if {$pt == {}} {
			set pt [$canv canvasxy 0.0 0.0]
		}
		$self new_group $canv $pt
	}
	$self insert_string $sel
	if {$newgroup} {
		$self end_group
	}
	if {[$toolbar_ current_tool] != "text"} {
		$canvWgt focus {}
	}
	$canv show_busy 0 $oldcursor
}
MBTextTool instproc insert_char {char} {
	if {$char=={}} { return	}
	$self instvar canv_ currText_ textLast_ sender_
	$canv_ icursor currtext end
	set i [$canv_ index currtext insert]
	set textLast_ [$sender_ insert $currText_ $i $char]
	$canv_ icursor currtext end
}
MBTextTool instproc end_group {} {
	$self instvar canv_ textLast_ currText_ sender_ mgr_ toolbar_
	if {![info exists canv_]} { return }
	set tags [$canv_ gettags currtext]
	if {$tags!={}} {
		set page_id [[$mgr_ page_manager] canv2page $canv_]
		if {$textLast_!={} && $currText_!={} \
				&& $currText_ < $textLast_} {
			set newobj [$sender_ -page $page_id \
				    create_item group text \
				    $currText_ $textLast_]
			$toolbar_ add_item $page_id $newobj
		}
		set currText_ {}
		set textLast_ {}
	}
	$canv_ dtag currtext currtext
}
MBTextTool instproc deactivate {} {
	$self end_group
}
Class MBEraseTool -superclass MBTool
MBEraseTool instproc init {toolbar mgr sender} {
	$self next $toolbar $mgr $sender
}
MBEraseTool instproc activate { page_id } {
	$self instvar mgr_
	set canv [[$mgr_ page_manager] page2canv $page_id]
	$canv resetBindings
	$canv setHilit
	$canv config -cursor pirate
	set w [$canv get_win]
	bind $w <Button-3>  "$self erase_last $page_id"
	bind $w <Button-1>  "$self erase_here \[$canv canvasxy %x %y\]"
	bind $w <B1-Motion> "$self erase_here \[$canv canvasxy %x %y\]"
}
MBEraseTool instproc erase_last {pageid} {
        $self instvar toolbar_
	$toolbar_ deactivate_tool [$toolbar_ current_tool]
	$self instvar trashList_ sender_ mgr_ toolbar_
	set lastItem [$toolbar_ get_item $pageid end]
	if {$lastItem != {}} {
		if ![info exists trashList_($pageid)] {
			set trashList_($pageid) {}
		}
		set trashList_($pageid) \
				[linsert $trashList_($pageid) 0 $lastItem]
		$sender_ delete_item $lastItem
		$toolbar_ replace_item $pageid $lastItem {}
	}
	[[$mgr_ page_manager] page2canv $pageid] unhilit
}
MBEraseTool instproc unerase { pageid } {
	$self instvar trashList_ sender_ toolbar_
	if {![info exists trashList_($pageid)] \
			|| $trashList_($pageid) == {}} {
		return
	}
	set obj [lindex $trashList_($pageid) 0]
	set trashList_($pageid) [lrange $trashList_($pageid) 1 end]
	if [catch {$sender_ dup_item $obj} id] {
		puts stderr "unerase failed!"
	} else {
		$toolbar_ add_item $pageid $id
	}
}
MBEraseTool instproc erase_here {pt} {
	$self instvar trashList_ sender_ mgr_ toolbar_
	set killObjs [eval $sender_ nearest $pt 2]
	set pageid [[$mgr_ page_manager] current_page]
	foreach killObj $killObjs {
		if ![info exists trashList_($pageid)] {
			set trashList_($pageid) {}
		}
		set trashList_($pageid) \
				[linsert $trashList_($pageid) 0 $killObj]
		$sender_ delete_item $killObj
		$toolbar_ replace_item $pageid $killObj {}
		[[$mgr_ page_manager] page2canv $pageid] unhilit
	}
}
Class MBShapeTool -superclass MBTool
MBShapeTool instproc init {toolbar mgr sender} {
	$self next $toolbar $mgr $sender
	$self set fakeObj_ {}
}
MBShapeTool instproc activate_shape { type page_id } {
	$self instvar type_ canv_ page_id_ mgr_
	set page_id_ $page_id
	set canv_ [[$mgr_ page_manager] page2canv $page_id]
	$canv_ resetBindings
	$canv_ config -cursor tcross
	set type_ $type
	set w [$canv_ get_win]
	bind $w <Button-1> "$self begin %x %y"
	bind $w <B1-Motion> \
		    "$self motion \[$w canvasx %x\] \[$w canvasy %y\]"
	bind $w <ButtonRelease-1> "$self end %x %y"
}
MBShapeTool instproc begin {rootx rooty} {
	$self instvar fakestartpt_ startpt_ fakeObj_ canv_ type_
	set startpt_ [$canv_ canvasxy $rootx $rooty]
	set x [$canv_ canvasx $rootx]
	set y [$canv_ canvasy $rooty]
	set fakestartpt_ [list $x $y]
	set fakeObj_ [eval $canv_ create $type_ $x $y $x $y \
		    [$self property $type_]]
}
MBShapeTool instproc motion {x y} {
	$self instvar fakestartpt_ fakeObj_ canv_
	if {$fakeObj_ == {}} { return }
	$canv_ config -cursor cross
	eval $canv_ coords $fakeObj_ $fakestartpt_ $x $y
}
MBShapeTool instproc end {rootX rootY} {
	$self instvar startpt_ fakeObj_ sender_ canv_ type_ page_id_ toolbar_
	if {$fakeObj_ == {}} { return }
	$canv_ delete $fakeObj_
	set endpt [$canv_ canvasxy $rootX $rootY]
	set newobj [eval $sender_ -page $page_id_ \
		    create_item $type_ $startpt_ \
		    $endpt [$self property $type_]]
	$toolbar_ add_item $page_id_ $newobj
	set startpt_ {}
	set fakeObj_ {}
	$canv_ config -cursor tcross
}
MBShapeTool instproc deactivate {} {
	mtrace trcExcessive "$class deactivate"
	$self instvar canv_
	set w [$canv_ get_win]
	set rx [winfo rootx $w]
	set wx [winfo pointerx $w]
	set ry [winfo rooty $w]
	set wy [winfo pointery $w]
	$self end [expr {$wx - $rx}] [expr {$wy - $ry}]
}
Class MBFHTool -superclass MBTool
MBFHTool instproc init {toolbar mgr sender} {
	$self next $toolbar $mgr $sender
}
MBFHTool instproc activate { page_id } {
	$self instvar canv_ page_id_ mgr_
	set page_id_ $page_id
	set canv_ [[$mgr_ page_manager] page2canv $page_id]
	$canv_ config -cursor pencil
	$canv_ resetBindings
	set w [$canv_ get_win]
	$self set firstpt_ {}
	$self set start_ {}
	bind $w <Button-1>  "$self begin \[$canv_ canvasxy %x %y\]"
	bind $w <B1-Motion> "$self motion %x %y"
	bind $w <ButtonRelease-1> "$self end"
}
MBFHTool instproc begin {pt} {
	$self instvar start_ last_ prop_ firstpt_ sender_
	set firstpt_ $pt
	set prop_ [$self property plainline]
	set start_ [eval $sender_ create_item line $pt $pt $prop_]
	set last_ $start_
}
MBFHTool instproc motion {x y} {
	$self instvar start_ last_ prop_ firstpt_ sender_ canv_
	if {$firstpt_ == {}} return
	set pt [$canv_ canvasxy $x $y]
	set last_ [eval $sender_ create_item line $firstpt_ $pt $prop_]
	set firstpt_ $pt
}
MBFHTool instproc end {} {
	$self instvar start_ last_ firstpt_ sender_ page_id_ toolbar_
	if {$start_ == {}} return
	set newObj [eval $sender_ -page $page_id_ \
		    create_item group mline $start_ $last_]
	$toolbar_ add_item $page_id_ $newObj
	set start_ {}
	set last_ {}
	set firstpt_ {}
}
MBFHTool instproc deactivate {} {
	$self end
}
Class MBScanTool -superclass MBTool
MBScanTool instproc init {toolbar mgr sender} {
	$self next $toolbar $mgr $sender
}
MBScanTool instproc activate { page_id } {
	$self instvar mgr_
	set canv [[$mgr_ page_manager] page2canv $page_id]
	$canv resetBindings
	$canv setHilit
	set w [$canv get_win]
	bind $w <Button-1> "$self start_scan $w %x %y"
	bind $w <B1-Motion> "$self scan_to $w %x %y"
	bind $w <ButtonRelease-1> "$self end_scan"
}
MBScanTool instproc start_scan { canvwgt x y } {
	$canvwgt scan mark $x $y
}
MBScanTool instproc scan_to { canvwgt x y } {
	$canvwgt scan dragto $x $y
	$canvwgt scan mark $x $y
}
MBScanTool instproc end_scan { } {
}
Class MBWhoTool -superclass MBTool
MBWhoTool instproc init {toolbar mgr sender} {
	$self next $toolbar $mgr $sender
	$self set canv_ {}
	$self set font_ [$self get_option smallfont]
}
MBWhoTool instproc activate { page_id } {
	$self instvar canv_ mgr_
	set canv_ [[$mgr_ page_manager] page2canv $page_id]
	set w [$canv_ get_win]
	bind $w <B1-Motion> "$self show_owner %x %y"
}
MBWhoTool instproc show_owner { x y } {
	$self instvar canv_ label_ font_ labelw_
	set px [$canv_ canvasx $x]
	set py [$canv_ canvasy $y]
	set tag [$canv_ find closest $px $py]
	set source [$canv_ owner $tag]
	if {$source == {}} {
		return
	}
	set cname [$source cname]
	$canv_ hilit $tag
	if {![info exists label_]} {
		set label_ [label .l -text $cname -font $font_ -bg beige]
		set labelw_ [$canv_ create window $px $py -window $label_]
	} else {
		$label_ configure -text $cname
		$canv_ coord $labelw_ $px $py
	}
	$canv_ raise $labelw_
}
Class MBToolbar -superclass MBWidget
MBToolbar instproc init {ui fr mgr sender ops} {
	$self instvar mbui_ mgr_
	set mbui_ $ui
	set mgr_ $mgr
	$self set currTool_ {}
	$self set lastTool_ {}
	set p [eval frame $fr.toolbar $ops]
	$self set path_ $p
	$self instvar tools_
	set tools_(freehand) [new MBFHTool $self $mgr $sender]
	set tools_(import)   [new MBImportTool $self $mgr $sender]
	set tools_(text)     [new MBTextTool $self $mgr $sender]
	set tools_(line)     [new MBShapeTool $self $mgr $sender]
	set tools_(rectangle) $tools_(line)
	set tools_(oval)     $tools_(line)
	set tools_(copy)     [new MBSelectTool $self $mgr $sender]
	set tools_(move)     $tools_(copy)
	set tools_(erase)    [new MBEraseTool $self $mgr $sender]
	set tools_(unerase)  $tools_(erase)
	$self tkvar currTool_
	set currToolVarName [$self tkvarname currTool_]
	set smallfont_ [$self get_option smallfont]
	button $p.sep -text "" -bitmap "sep" -height 4 -relief flat -state disabled
	set pageMgr [$mgr page_manager]
	button $p.unerase -bitmap unerase -command \
			"$tools_(unerase) unerase \[$pageMgr current_page\]" \
			-justify center
	$self add_tip $p.unerase "Unerase Object"
	radiobutton $p.erase -bitmap erase -command \
			"$tools_(erase) activate \[$pageMgr current_page\]" \
			-variable $currToolVarName \
			-value erase -indicatoron false
	$self add_tip $p.erase "Erase"
	radiobutton $p.copy -bitmap copy -command \
			"$tools_(copy) activate_copy \[$pageMgr current_page\]" \
			-variable $currToolVarName -value copy \
			-indicatoron false
	$self add_tip $p.copy "Copy"
	radiobutton $p.move -bitmap move -command \
			"$tools_(move) activate_move \[$pageMgr current_page\]" \
			-variable $currToolVarName -value move \
			-indicatoron false
	$self add_tip $p.move "Move"
	radiobutton $p.freehand -bitmap freehand -command \
			"$tools_(freehand) activate \[$pageMgr current_page\]" \
			-variable $currToolVarName -value freehand \
			-indicatoron false
	$self add_tip $p.freehand "Freehand Sketch"
	radiobutton $p.line -bitmap line -command \
			"$tools_(line) activate_shape line \[$pageMgr current_page\]" \
			-variable $currToolVarName -value line \
			-indicatoron false
	$self add_tip $p.line "Straight Line"
	radiobutton $p.oval -bitmap oval -command  \
			"$tools_(oval) activate_shape oval \[$pageMgr current_page\]" \
			-variable $currToolVarName -value oval \
			-indicatoron false
	$self add_tip $p.oval "Oval"
	radiobutton $p.rectangle -bitmap rectangle -command  \
			"$tools_(rectangle) activate_shape rectangle \
			 \[$pageMgr current_page\]" \
			-variable $currToolVarName -value rectangle \
			-indicatoron false
	$self add_tip $p.rectangle "Rectangle"
	radiobutton $p.text -bitmap text -command  \
			"$tools_(text) activate  \[$pageMgr current_page\]" \
			-variable $currToolVarName -value text \
			-indicatoron false
	$self add_tip $p.text "Text"
	set buttonList {unerase erase copy move sep \
			oval rectangle line text freehand}
	set omitTools [string trim [$self get_option omitTools]]
	foreach elt $buttonList {
		if {-1==[lsearch -exact $omitTools $elt]} {
			pack $p.$elt -side bottom -pady 1 -padx 1 -ipadx 0 -ipady 0
		}
	}
}
MBToolbar instproc pack {args} {
	eval $self next $args
	$self select_tool [$self current_tool]
}
MBToolbar instproc unpack {} {
	$self deactivate_tool [$self current_tool]
	$self instvar mgr_
	[[$mgr_ page_manager] current_canvas] resetBindings
	$self next
}
MBToolbar instproc add_tip {args} {
	return [eval add_tip $args]
}
MBToolbar instproc current_tool {} {
	$self tkvar currTool_
	return $currTool_
}
MBToolbar instproc select_tool {toolname} {
	$self instvar path_
	if {$toolname != {}} {
		$path_.$toolname invoke
	}
}
MBToolbar instproc trace_tool {cmd} {
	$self instvar tool_change_callbacks_ traced_
	$self tkvar currTool_
	if ![info exists traced_] {
		trace variable currTool_ w \
				"$self tool_changed"
		set traced_ 1
	}
	lappend tool_change_callbacks_ $cmd
}
MBToolbar instproc deactivate_tool {{toolname {}}} {
	$self instvar path_ lastTool_ tools_
	if {$toolname == {}} {
		set toolname $lastTool_
	}
	if {$toolname != {}} {
		$tools_($toolname) deactivate
	}
}
MBToolbar instproc tool {toolname} {
	$self instvar tools_
	if [info exists tools_($toolname)] {
		return $tools_($toolname)
	}
}
MBToolbar instproc tool_changed {args} {
	$self tkvar currTool_
	$self instvar lastTool_
	$self deactivate_tool
	set lastTool_ $currTool_
	$self instvar tool_change_callbacks_
	foreach cmd $tool_change_callbacks_ {
		eval $cmd $currTool_
	}
}
MBToolbar instproc destroy {} {
	trace vdelete [$self tkvarname currTool_] w "$self tool_changed"
	$self instvar tools_
	delete $tools_(freehand)
	delete $tools_(import)
	delete $tools_(text)
	delete $tools_(line)
	delete $tools_(copy)
	delete $tools_(erase)
	delete $tools_(none)
}
MBToolbar instproc add_item {pageId id} {
	$self instvar arItems_
	lappend arItems_($pageId) $id
	mtrace trcVerbose "adding $id to arItems_($pageId), new: $arItems_($pageId)"
}
MBToolbar instproc replace_item {pageId oldId newId} {
	$self instvar arItems_
	set arItems_($pageId) [lsubst $arItems_($pageId) $oldId $newId]
}
MBToolbar instproc get_item {pageId index} {
	$self instvar arItems_
	if [info exists arItems_($pageId)] {
		mtrace trcVerbose "get_item $pageId $index: returning  [lindex $arItems_($pageId) $index]"
		return [lindex $arItems_($pageId) $index]
	} else {
		mtrace trcVerbose "cannot find arItems($pageId), returning null"
		return {}
	}
}
image create photo VcrIcons(play)
VcrIcons(play) put \x47\x49\x46\x38\x39\x61\x14\x0\x14\x0\xF7\x0\x0\xD8\xD8\xD8\xF8\xFC\xF8\x39\xF8\x31\x0\x0\x0\x80\x80\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xE1\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xE1\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xC\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xE1\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xC\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x23\xE1\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x23\xE1\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x25\xE1\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xC\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x2A\xE1\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xC\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xC\x0\x0\x0\x8F\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xC\x0\x0\x0\x62\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xC\x0\x0\x0\x23\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xC\x0\x0\x0\x25\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xC\x0\x0\x0\x25\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xC\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xC\x0\x0\x0\x23\x81\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xC\x0\x0\x0\x25\x81\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x11\x0\x0\x0\x25\x81\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x11\x0\x0\x0\x25\x81\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x11\x0\x0\x0\x37\x81\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xC\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x11\x0\x0\x0\xA6\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xC\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x11\x0\x0\x0\x92\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x16\x0\x0\x0\x93\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x16\x0\x0\x0\xCD\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xC\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x16\x0\x0\x0\x45\xE1\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xA7\xA7\xA7\x0\x2F\x0\x4F\x0\x0\x11\xA9\x0\xF8\x23\x0\x0\xB8\x0\x9E\x0\xAC\xAC\xAC\x0\xAD\xAD\xAD\x0\xAE\xAE\xAE\x0\xAF\xAF\xAF\x0\xB0\xB0\xB0\x0\xB1\xB1\xB1\x0\xB3\xB3\xB3\x0\xB4\xB4\xB4\x0\xB5\xB5\xB5\x0\xB6\xB6\xB6\x0\xB7\xB7\xB7\x0\xB8\xB8\xB8\x0\xB9\xB9\xB9\x0\xBA\xBA\xBA\x0\xBB\xBB\xBB\x0\xBC\xBC\xBC\x0\xBD\xBD\xBD\x0\xBE\xBE\xBE\x0\xC0\xC0\xC0\x0\xC1\xC1\xC1\x0\xC2\xC2\xC2\x0\xC3\xC3\xC3\x0\xC4\xC4\xC4\x0\xC5\xC5\xC5\x0\xC6\xC6\xC6\x0\xC7\xC7\xC7\x0\xC8\xC8\xC8\x0\xC9\xC9\xC9\x0\xCA\xCA\xCA\x0\xCC\xCC\xCC\x0\xCD\xCD\xCD\x0\xCE\xCE\xCE\x0\x21\xF9\x4\x1\x0\x0\x1\x0\x2C\x0\x0\x0\x0\x14\x0\x14\x0\x40\x8\x5D\x0\x3\x8\x1C\x48\xB0\xA0\xC1\x81\x2\x12\x2A\x5C\x98\xD0\xD0\x41\x2\x10\x23\x12\x38\x68\x70\x21\x45\x8A\xC\x5\x18\x9A\x66\x48\x22\xC4\x8B\x20\x2B\x66\x14\x10\x32\xC0\x48\x85\x1B\x3B\x4E\x24\xD8\x90\xA3\xC7\x95\x25\x63\xCA\xC4\x48\x72\xA6\xC0\x8C\x32\x4F\x26\x4\xA9\x13\xE5\x47\x96\x23\x39\x4E\x93\x58\x70\xA1\xD0\x97\x7\xA7\x79\x19\xEA\x31\x64\x53\x9B\x32\x3\x2\x0\x3B
image create photo VcrIcons(reverse)
VcrIcons(reverse) put \x47\x49\x46\x38\x39\x61\x14\x0\x14\x0\xF7\x0\x0\xD8\xD8\xD8\xF8\xFC\xF8\x39\xF8\x31\x0\x0\x0\x80\x80\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xE1\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xE1\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xC\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xE1\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xC\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x23\xE1\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x23\xE1\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x25\xE1\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xC\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x2A\xE1\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xC\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xC\x0\x0\x0\x8F\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xC\x0\x0\x0\x62\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xC\x0\x0\x0\x23\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xC\x0\x0\x0\x25\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xC\x0\x0\x0\x25\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xC\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xC\x0\x0\x0\x23\x81\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xC\x0\x0\x0\x25\x81\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x11\x0\x0\x0\x25\x81\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x11\x0\x0\x0\x25\x81\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x11\x0\x0\x0\x37\x81\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xC\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x11\x0\x0\x0\xA6\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xC\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x11\x0\x0\x0\x92\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x16\x0\x0\x0\x93\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x16\x0\x0\x0\xCD\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xC\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x16\x0\x0\x0\x45\xE1\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xA7\xA7\xA7\x0\x41\x0\x4F\x0\x0\x11\xA9\x0\xC0\x0\x9E\x0\xC0\x0\x9E\x0\xAC\xAC\xAC\x0\xAD\xAD\xAD\x0\xAE\xAE\xAE\x0\xAF\xAF\xAF\x0\xB0\xB0\xB0\x0\xB1\xB1\xB1\x0\xB3\xB3\xB3\x0\xB4\xB4\xB4\x0\xB5\xB5\xB5\x0\xB6\xB6\xB6\x0\xB7\xB7\xB7\x0\xB8\xB8\xB8\x0\xB9\xB9\xB9\x0\xBA\xBA\xBA\x0\xBB\xBB\xBB\x0\xBC\xBC\xBC\x0\xBD\xBD\xBD\x0\xBE\xBE\xBE\x0\xC0\xC0\xC0\x0\xC1\xC1\xC1\x0\xC2\xC2\xC2\x0\xC3\xC3\xC3\x0\xC4\xC4\xC4\x0\xC5\xC5\xC5\x0\xC6\xC6\xC6\x0\xC7\xC7\xC7\x0\xC8\xC8\xC8\x0\xC9\xC9\xC9\x0\xCA\xCA\xCA\x0\xCC\xCC\xCC\x0\xCD\xCD\xCD\x0\xCE\xCE\xCE\x0\x21\xF9\x4\x1\x0\x0\x1\x0\x2C\x0\x0\x0\x0\x14\x0\x14\x0\x40\x8\x7B\x0\x3\x8\x1C\x48\xB0\xA0\xC1\x81\x2\x12\x2A\x5C\x28\x0\x1A\x1\x2\x7\xB\xC2\x43\x87\xEE\xA1\xC5\x88\x5\x17\x22\x83\x58\x90\x5C\x45\x8B\xC\x5\x18\x7A\x88\xB1\x64\xC9\x90\x9\x1D\x72\x14\x8\xE0\x21\x4A\x85\x23\x57\x4A\xA4\x68\x91\x40\xC2\x8D\x32\x4D\x6\x0\x80\xE\x1C\x0\x9D\x40\x4F\x8A\x4\xA7\x33\x24\x28\x2\xD8\xE\xBE\x4C\x78\x54\x26\xBF\xA5\xA\x71\x12\x4\x80\xD\x24\xCA\x98\x6\xC1\x91\x23\x57\x53\x23\x49\x8C\x5B\xB9\x3E\x84\x86\x15\x28\x0\x8F\x55\xC9\x5\x8D\x18\x10\x0\x3B
image create photo VcrIcons(pause)
VcrIcons(pause) put \x47\x49\x46\x38\x39\x61\x14\x0\x14\x0\xC2\x0\x0\xD8\xD8\xD8\xF8\xFC\xF8\xB8\xBC\xB8\x0\x0\x0\x80\x80\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x21\xF9\x4\x1\x0\x0\x0\x0\x2C\x0\x0\x0\x0\x14\x0\x14\x0\x0\x3\x49\x8\xBA\xDC\xFE\xF0\x85\x19\x16\xAD\x30\x88\x3D\x94\xE6\xD9\x26\xC\x4\xF1\x8D\xA5\x73\x92\xA6\xC8\xAA\x6E\xB9\xA6\xCD\xDC\x72\x34\x63\xDB\x30\x7E\xA3\x84\x1E\x90\x57\x8B\xFD\x5E\x45\x1F\x51\x67\x5C\x5A\x9A\xC6\xC7\x60\xFA\xA2\x22\x1D\xA5\xAC\x22\x9B\x6B\x70\x83\x80\x6F\x64\x4C\x2E\x3\x12\x0\x3B
image create photo VcrIcons(stop)
VcrIcons(stop) put \x47\x49\x46\x38\x39\x61\x10\x0\x14\x0\xC2\x0\x0\xD8\xD8\xD8\x0\x0\x0\xB8\xBC\xB8\x50\x54\x50\xF8\xFC\xF8\x80\x80\x80\x0\x0\x0\x0\x0\x0\x21\xF9\x4\x1\x0\x0\x0\x0\x2C\x0\x0\x0\x0\x10\x0\x14\x0\x0\x3\x3C\x8\xBA\xDC\xFE\x30\xB2\x40\xAB\xD\x62\x8E\xCD\x3B\xD1\x5D\x48\x14\x85\x12\x84\x22\x69\xA2\x9E\xA\x9C\xEC\x36\x96\x6F\x2C\xBB\x70\x3C\xAF\xF6\x5E\xF7\x38\xDB\xC0\x27\x20\x18\x8F\x48\x9F\x82\xC4\x6C\x32\x19\xCE\x28\x4D\x42\xAD\x5A\x1\x9\x0\x3B
image create photo VcrIcons(sstop)
VcrIcons(sstop) put \x47\x49\x46\x38\x39\x61\x14\x0\x10\x0\x80\x0\x0\x0\x0\x0\xBF\xBF\xBF\x21\xF9\x4\x1\x0\x0\x1\x0\x2C\x0\x0\x0\x0\x14\x0\x10\x0\x0\x2\x1C\x8C\x8F\xA9\xCB\xED\xF\x17\x98\x94\xBE\x8A\x2F\xB6\x6E\xF3\xE6\x4D\x9A\x37\x6E\x65\xD6\x85\xD1\xCA\xB6\x4C\x1\x0\x3B
image create photo VcrIcons(splay)
VcrIcons(splay) put \x47\x49\x46\x38\x39\x61\x14\x0\x10\x0\x80\x0\x0\x0\x0\x0\xBF\xBF\xBF\x21\xF9\x4\x1\x0\x0\x1\x0\x2C\x0\x0\x0\x0\x14\x0\x10\x0\x0\x2\x1D\x8C\x8F\xA9\xCB\xED\xF\x17\x88\xA\x58\x7A\xAC\xC6\xBA\xC7\xE\x3E\x60\xD8\x8C\x97\x48\x42\x1E\x37\x61\xEE\x8B\x14\x0\x3B
image create photo VcrIcons(record)
VcrIcons(record) put \x47\x49\x46\x38\x39\x61\x10\x0\x14\x0\xC2\x0\x0\xD8\xD8\xD8\x0\x0\x0\xB8\xBC\xB8\xF8\x14\x40\xF8\xFC\xF8\x80\x80\x80\x0\x0\x0\x0\x0\x0\x21\xF9\x4\x1\x0\x0\x0\x0\x2C\x0\x0\x0\x0\x10\x0\x14\x0\x0\x3\x3C\x8\xBA\xDC\xFE\x30\xB2\x40\xAB\xD\x62\x8E\xCD\x3B\xD1\x5D\x48\x14\x85\x12\x84\x22\x69\xA2\x9E\xA\x9C\xEC\x36\x96\x6F\x2C\xBB\x70\x3C\xAF\xF6\x5E\xF7\x38\xDB\xC0\x27\x20\x18\x8F\x48\x9F\x82\xC4\x6C\x32\x19\xCE\x28\x4D\x42\xAD\x5A\x1\x9\x0\x3B
image create photo VcrIcons(redbullet)
VcrIcons(redbullet) put \x47\x49\x46\x38\x39\x61\xA\x0\xA\x0\xC2\x0\x0\xD8\xD8\xD8\xF8\x60\x40\xF8\x0\x0\xF8\xA4\x0\xB0\x20\x20\x0\x0\x0\x0\x0\x0\x0\x0\x0\x21\xF9\x4\x1\x0\x0\x0\x0\x2C\x0\x0\x0\x0\xA\x0\xA\x0\x0\x3\x1A\x8\xBA\xDC\xBE\x21\x8\x17\x46\x9C\xD0\x5E\xB2\xC4\x15\x2\xA7\x80\x24\x21\x8E\xA1\xE9\x98\xE7\xB3\x24\x0\x3B
image create photo VcrIcons(greenbullet)
VcrIcons(greenbullet) put \x47\x49\x46\x38\x39\x61\xA\x0\xA\x0\xA2\x0\x0\x0\x0\x0\xFF\xFF\xFF\x28\x88\x50\x0\xFC\x0\x30\xCC\x30\x98\xF8\x98\xFF\xFF\xFF\x0\x0\x0\x21\xF9\x4\x1\x0\x0\x6\x0\x2C\x0\x0\x0\x0\xA\x0\xA\x0\x0\x3\x1A\x68\xBA\xDC\xBE\x23\xBA\x51\x22\x61\x34\xE\x22\x16\xB1\x4\xE7\x85\xA1\xD0\x8D\xE6\xC9\xA4\x8F\x93\x0\x0\x3B
image create photo VcrIcons(browse_small)
VcrIcons(browse_small) put \x47\x49\x46\x38\x39\x61\xA\x0\xA\x0\xC2\x0\x0\xD8\xD8\xD8\x78\x7C\x78\x0\xFC\xF8\xF8\xFC\xF8\x0\x0\x0\x0\x7C\x78\x0\x0\xF8\x0\x0\x0\x21\xF9\x4\x1\x0\x0\x0\x0\x2C\x0\x0\x0\x0\xA\x0\xA\x0\x0\x3\x20\x8\x10\xAC\xBE\x62\x8\xF2\x42\x8C\x85\xAA\x20\x65\x76\x96\xF7\x39\x44\x61\x12\x1A\x89\xA\x46\xFA\x0\xAC\xFB\xB0\x6F\x9D\x0\x0\x3B
Class MBTimeBrowser -superclass MBWidget
MBTimeBrowser set defaultNumSteps_ 100
MBTimeBrowser set defaultFrameTime_ 1
MBTimeBrowser set defaultRefreshTime_ 500
MBTimeBrowser instproc init {parent browseVarName} {
	$self instvar path_ slider_ stepSlider_ stepLabel_ timeLabel_ \
			pauseBut_ playBut_ sliderRange_ afterId_ revBut_
	$self set browseVarName_ $browseVarName
	set afterId_ 0
	set path_ [frame $parent.ts -relief raised -bd 2]
	set stepSlider_ [scale $path_.stepS -orient horizontal \
			-from 1000 -to 10 -width 10 \
			-showvalue 0 -command "$self update_steps"]
	$stepSlider_ set [MBTimeBrowser set defaultNumSteps_]
	set sliderRange_ [MBTimeBrowser set defaultNumSteps_]
	pack $stepSlider_ -side left -anchor s -pady 2
	set sliderRange_ 10000
	set slider_ [scale $path_.slider -orient horizontal -label Time \
			-from 0 -to $sliderRange_ -resolution 0.05 \
			-showvalue false -command "$self update_label"]
        bind $slider_ <Button-1> "$self wait"
        bind $slider_ <Button-2> "$self wait"
	bind $slider_ <ButtonRelease-1> "$self move2time"
	bind $slider_ <ButtonRelease-2> "$self move2time"
        pack $slider_ -side left -fill x -expand 1
	set timeLabel_ [label $path_.timeL -relief sunken]
	set pauseBut_ [button $path_.pauseB -image VcrIcons(pause) \
			-command "$self pause"]
	set playBut_ [button $path_.playB -image VcrIcons(play) \
			-command "$self play"]
	set revBut_ [button $path_.revB -image VcrIcons(reverse) \
			-command "$self reverse"]
	set stopBut_ [button $path_.stopB -image VcrIcons(stop) \
			-command "$self stop"]
	pack $pauseBut_ $revBut_ $playBut_ $stopBut_ \
			-side left -fill x -anchor s -padx 2 -pady 4
	$self set frameTime_ [MBTimeBrowser set defaultFrameTime_]
	$self set refreshTime_ [MBTimeBrowser set defaultRefreshTime_]
	$self set running_ 0
	$self set shouldResume_ 0
}
MBTimeBrowser instproc format_time {time {prefix {}}} {
	set result [clock format [expr {int($time)}] -format "%%s %I:%M:%S.%%d %p"]
	set frac [expr {int(($time - int($time))*10)}]
	return [format $result $prefix $frac]
}
MBTimeBrowser instproc min_time {time} {
	$self set mintime_ $time
}
MBTimeBrowser instproc max_time {time} {
	$self set maxtime_ $time
}
MBTimeBrowser instproc update_callBack {cmd} {
	$self set updateCallBack_ $cmd
}
MBTimeBrowser instproc stop_callBack {cmd} {
	$self set stopCallBack_ $cmd
}
MBTimeBrowser instproc update_slider {time} {
	$self instvar mintime_ maxtime_ slider_ sliderRange_
	set x [expr {($time - $mintime_)*$sliderRange_/($maxtime_-$mintime_)}]
	$slider_ set $x
	$self update_label $x
}
MBTimeBrowser instproc update_steps {step} {
 puts "update_steps $step"
	$self instvar stepSlider_ mintime_ maxtime_ frameTime_ \
			currTime_ slider_
	set dir [expr {($frameTime_ < 0) ? -1 : 1}]
	if {[info exists mintime_] && [info exists maxtime_]} {
		set frameTime [expr {($maxtime_ - $mintime_)/$step}]
		$stepSlider_ configure -label \
				[format "Step: %.2g s" $frameTime]
		set frameTime_ [expr {($frameTime_<0) ? -1*$frameTime : $frameTime}]
		puts "frametime_ set to $frameTime_, step to $step"
	}
}
MBTimeBrowser instproc goto {time} {
	$self instvar maxtime_ mintime_
	$self instvar mintime_ maxtime_ slider_ currTime_
	$self set currTime_ $time
	$self update_slider $time
}
MBTimeBrowser instproc set_time {newtime} {
	$self instvar updateCallBack_
	$self set currTime_ $newtime
	eval $updateCallBack_ $newtime
}
MBTimeBrowser instproc update_label {x} {
	$self instvar slider_ mintime_ maxtime_ sliderRange_
	set newtime [expr {$mintime_+($x/$sliderRange_)*($maxtime_-$mintime_)}]
	$slider_ configure -label \
			[$self format_time $newtime "Displayed Time:"]
}
MBTimeBrowser instproc move2time {} {
	$self instvar slider_ mintime_ maxtime_ shouldResume_ sliderRange_
	set x [$slider_ get]
	set newtime [expr {$mintime_ + ($x/$sliderRange_)*($maxtime_-$mintime_)}]
	$self set_time $newtime
	if $shouldResume_ {
                $self nextFrame
        }
}
MBTimeBrowser instproc nextFrame {} {
	$self instvar currTime_ frameTime_ refreshTime_ running_ afterId_ \
			mintime_ maxtime_
	if {!$running_} {
		return
	}
	set newTime [expr {$currTime_ + $frameTime_}]
	if {$newTime > $maxtime_ || $newTime < $mintime_} {
 puts "stop running: min:$mintime_ max:$maxtime_ new:$newTime"
		$self set running_ 0
	}
	$self update_slider $newTime
	$self set_time $newTime
	if {$running_} {
		set afterId_ [after $refreshTime_ "$self nextFrame"]
	}
}
MBTimeBrowser instproc play {} {
	$self instvar frameTime_ currTime_ mintime_
	$self set running_ 1
	if {$frameTime_ < 0} {
		set frameTime_ [expr {$frameTime_ * -1}]
	}
	if {$currTime_ < $mintime_} {
		set currTime_ $mintime_
	}
	$self nextFrame
}
MBTimeBrowser instproc reverse {} {
	$self set running_ 1
	$self instvar frameTime_ currTime_ maxtime_
	if {$frameTime_ > 0} {
		set frameTime_ [expr {$frameTime_ * -1}]
	}
	if {$currTime_ > $maxtime_} {
		set currTime_ $maxtime_
	}
	$self nextFrame
}
MBTimeBrowser instproc pause {} {
	$self set running_ 0
}
MBTimeBrowser instproc wait {} {
	set shouldResume_ [$self set running_]
	$self set running_ 0
}
MBTimeBrowser instproc stop {} {
	$self set running_ 0
	eval [$self set stopCallBack_]
}
Class MBUI -superclass Observer -configuration {
        canvWidth 500
        canvHeight 430
	showLocalOwnerTip 0
        drop 0
	psOrient portrait
	psColorMode gray
	psContent full
	statusbarOnTop 1
}
MBUI instproc init {path mgr sender vis exitCmd} {
        $self instvar idleHandler_  mgr_ vis_ printUI_ srcList_
        set idleHandler_ {}
        set mgr_ $mgr
        set vis_ $vis
        set srcList_ [new SrcList]
	$srcList_ add_callback track "$self track"
	$self set tipsAsDrawn_ 1
	$self instvar mainframe_ tframe_ canvframe_ \
			canvframetext_ canvframebut_ bframe_ mframe_ menu_
        set mainframe_ $path
        set tframe_ [frame $mainframe_.tf -borderwidth 0 -relief raised]
        set canvframe_ [frame $tframe_.cf -borderwidth 2 -relief ridge]
        set canvframetext_ [label $canvframe_.l \
                        -text "\nWaiting for network specs.\n" ]
        set canvframebut_ [button $canvframe_.b \
                        -text "Create new page" -state disabled \
			-command "\[$self set menu_\] insert_page" ]
        if $vis_ {
                pack $canvframe_ -side left -fill both \
                                -expand true -padx 1 -pady 1
                pack $canvframetext_ -side top -anchor c \
                                -fill both -expand true
                pack $canvframebut_ -side top -anchor c \
                                -fill x -expand true -anchor s -pady 3 -padx 3
        }
        $self set bframe_ [frame $mainframe_.bf \
                        -borderwidth 0 -relief raised -height 22p]
        $self set mframe_ [frame $mainframe_.mf \
                        -borderwidth 1 -relief raised ]
        if $vis_ {
                pack $mframe_ -side top -fill x -expand false -anchor n
                pack propagate $bframe_ FALSE
        }
	$self instvar props_ toolbar_
        set props_ [new MBProps]
	$props_ draw_panel $bframe_
        $self draw_navPanel $bframe_
	$self tkvar statusbarOnTop_
	set statusbarOnTop_ [$self get_option statusbarOnTop]
	$self instvar debug_
	set debug_ [new MBDebugDlg $mgr_ $vis_]
	$mgr_ attach_debug $debug_
	set drop [$self get_option drop]
	$debug_ change_state $drop
        set menu_ [new MBMenu $self $mframe_ $mgr_ $exitCmd]
        set toolbar_ [new MBToolbar $self $tframe_ $mgr $sender ""]
	$toolbar_ trace_tool "$self tool_changed"
        if $vis_ {
                pack $tframe_ -side top -fill both -expand true -anchor nw
        }
        set geom [$self get_option geometry]
        if {$vis} {
                wm geometry . $geom
		global mash
		if { ![info exists mash(environ)] || $mash(environ)!="mplug"} {
			wm iconify .
			wm deiconify .
		}
        } else {
		global mash
		if { ![info exists mash(environ)] || $mash(environ)!="mplug"} {
			wm iconify .
			wm title . [lindex [split [info hostname] .] 0]
		}
        }
	set orient [$self get_option psOrient]
	set color [$self get_option psColorMode]
	set content [$self get_option psContent]
	set printUI_ [MBUI_Print .mbuiprint -colorMode $color \
			-orient $orient -content $content \
			-pageMgr [$mgr_ page_manager]]
	$printUI_ hide
	$self set browsePage_ {}
	[$mgr_ page_manager] attach_observer $self
        global mb
        set pswin [new MBPSProcessor .mbps]
        DbgOut [concat "Window ID for MBPSProcessor: " [winfo id .mbps]]
        set mb(gsinterp) [new MBPSInterp $pswin]
}
MBUI instproc reset { session } {
	set prefix [$self get_option iconPrefix]
        set hostname [lindex [split [info hostname] .] 0]
        append prefix "@" $hostname ":"
        set conf [$self get_option conferenceName]
	if {$conf=={}} {
		set conf [[$session data-net] addr]
		append conf /
		append conf [[$session data-net] sport]
	}
	$self window_title $prefix $conf
        $self activate
}
MBUI instproc destroy {} {
}
MBUI instproc mgr {} {
	return [$self set mgr_]
}
MBUI instproc printUI {} { return [$self set printUI_] }
MBUI instproc window_title { prefix name } {
	$self instvar name_ prefix_
	set name_ $name
	set prefix_ $prefix
	wm iconname . "$prefix_$name_"
	wm title . "$prefix_$name_"
}
MBUI instproc activate {} {
	$self instvar canvframebut_ canvframetext_
	if [winfo exists $canvframebut_] {
		$canvframebut_ configure -state normal
	}
	if [winfo exists $canvframetext_] {
		$canvframetext_ configure \
				-text "\nPlease wait for data to arrive from the network\n or \nclick on the button below to create a new page.\n        "
	}
}
MBUI instproc redraw_statusbar {} {
	$self tkvar statusbarOnTop_
	$self instvar bframe_ tframe_
	if {$statusbarOnTop_} {
		pack $bframe_ -before $tframe_ \
				-side top -fill x -expand false -anchor s
	} else {
		pack $bframe_ -before $tframe_ \
				-side bottom -fill x -expand false -anchor s
	}
}
MBUI instproc pack_panels {} {
	$self instvar canvframetext_ canvframebut_ toolbar_ canvframe_ vis_ \
			mgr_
        destroy $canvframetext_
        destroy $canvframebut_
	$self redraw_statusbar
	if $vis_ {
		$self show_toolbar 1
	}
}
MBUI instproc activity {src {page_id {}} {canv {}} {id {}}} {
	$self instvar idleHandler_ srcList_ menu_ tipsAsDrawn_ \
			browsePage_ mgr_
	if {$src != {}} {
		$srcList_ hilit $src
		if {$idleHandler_=={}} {
			set idleHandler_ [after idle $self refresh]
		}
	}
	if { ($canv != {}) && $tipsAsDrawn_ && $id!=0} {
		$canv show_owner $id 0
	}
        if { ($page_id != {}) && [$menu_ followActivePage] == 1 \
			&& $browsePage_ == {}} {
		[$mgr_ page_manager] switch_page_later $page_id
	}
}
MBUI instproc notify_currPage {src page_id} {
	$self instvar mgr_
	mtrace trcVerbose "notify currpage $page_id"
	set pageMgr [$mgr_ page_manager]
	if {[$pageMgr current_page] != $page_id} {
		$pageMgr switch_page_later $page_id
	}
}
MBUI instproc refresh {} {
        $self instvar idleHandler_ mgr_
	set pagemgr [$mgr_ page_manager]
	if {[$pagemgr current_page] != {}} {
		[$pagemgr current_canvas] refreshScrReg
	}
        set idleHandler_ {}
}
MBUI instproc create_canvas {page_id} {
        $self instvar vis_ mgr_
	set pageMgr [$mgr_ page_manager]
        if [$pageMgr has_page $page_id] {
                mtrace trcVerbose "returning old value: $pageMgr page2canv $page_id]"
                return [$pageMgr page2canv $page_id]
        }
        $self instvar canvframe_
        set fr $canvframe_
        if ![winfo exists $fr.xs] {
                scrollbar $fr.xs -orient horizontal -width 12
                scrollbar $fr.ys -orient vertical -width 12
        }
        set size [list 0 0]
	if { [$self get_option geometry] != "" } {
		set g [split [$self get_option geometry] x]
		set canvWidth [expr [lindex $g 0] - 60]
		set canvHeight [expr [lindex $g 1] - 90]
	} else {
		set canvWidth [$self get_option canvWidth]
		set canvHeight [$self get_option canvHeight]
	}
        set size [list [lappend size $canvWidth $canvHeight]]
        set c [new MBCanvas]
	$c create_canvas $canvframe_ \
		    "-scrollregion $size -width $canvWidth \
		    -height $canvHeight -background white \
		    -takefocus 1"
	$c setsize $canvWidth $canvHeight
	if {[$self get_option showLocalOwnerTip]==0} {
		$c omitShowOwner [$mgr_ local_src]
	}
	$pageMgr add_page $page_id $c
        if {[$pageMgr current_page]=={}} {
		after idle "$self pack_first_canvas $c"
        }
        mtrace trcVerbose "created new page: $page_id"
	set w [$c get_win]
	$self instvar toolbar_
	set textTool [$toolbar_ tool text]
	bind $w <Shift-Button-1> \
		    "$textTool paste $c \[$c canvasxy %x %y\]; break"
	bind $w <Button-2> [bind $w <Shift-Button-1>]
	bind $w <Control-v> "$textTool paste $c \[$c pointerxy\]; break"
	bind $w <Control-y> [bind $w <Control-v>]
	bind $w <Shift-Insert> [bind $w <Control-v>]
	bind $w <Button-3> "[$toolbar_ tool erase] erase_last \[$pageMgr current_page\]"
	bind $w <Tab> "break"
        return $c
}
MBUI instproc pack_first_canvas {c} {
	$self instvar vis_ canvframe_ mgr_ menu_
	set pageMgr [$mgr_ page_manager]
	if {[$pageMgr current_page]!={}} {
		return
	}
	$c configure -xscrollcommand [list $canvframe_.xs set] \
			-yscrollcommand [list $canvframe_.ys set]
	$pageMgr switch_page_later [$pageMgr canv2page $c]
	if {$vis_} {
		after idle "$self pack_panels"
	}
	pack $canvframe_.xs -side bottom -fill x -expand false \
			-anchor n \
			-padx 1 -pady 1
	pack $canvframe_.ys -side left -fill y -expand false \
			-anchor w \
			-pady 1 -padx 1
	$canvframe_.xs configure -command \
			"\[$pageMgr current_canvas\] xview"
	$canvframe_.ys configure -command \
			"\[$pageMgr current_canvas\] yview"
}
MBUI instproc draw_navPanel {fr args} {
	$self instvar mgr_ pageNavPanel_ canvframe_
	if [$self set vis_ ] {
		set pageNavPanel_ [new MBPageNavPanel $fr [$mgr_ page_manager]]
		$pageNavPanel_ build_widgets {pagelist next prev zoom}
		$pageNavPanel_ pack -side right -fill y -anchor se -padx 2
		bind $canvframe_ <Configure> "update idletasks; $pageNavPanel_ update_zoomscale"
	}
        return [$pageNavPanel_ set path_]
}
MBUI instproc property {tool} {
	return [[$self set props_] property $tool]
}
MBUI instproc tool_changed {newtool} {
	eval [$self set props_] refresh_panel $newtool
}
MBUI instproc switch_page {page_id} {
	$self instvar toolbar_ menu_
	if {[$toolbar_ current_tool] == {}} {
		$toolbar_ select_tool freehand
	} else {
		$toolbar_ select_tool [$toolbar_ current_tool]
	}
	$menu_ tkvar browseTime_
	if {$browseTime_ == 1}  {
		set browseTime_ 0
		$self browseTime browseTime_
		set browseTime_ 1
		$self browseTime browseTime_
	}
}
MBUI instproc enable_tip_as_drawn {tipping} {
	$self set tipsAsDrawn_ $tipping
}
Class MBProps
MBProps instproc init_fonts {} {
	set o [$self options]
if 1 {
	$o add_default font1 \
			-*-helvetica-bold-r-normal--*-120-75-75-*-*-*-*
	$o add_default font2 \
			-*-helvetica-bold-r-normal--*-140-75-75-*-*-*-*
	$o add_default font3 \
			-*-helvetica-bold-r-normal--*-180-75-75-*-*-*-*
	$o add_default font4 \
			-*-helvetica-bold-r-normal--*-240-75-75-*-*-*-*
	$o add_default font5 \
			-*-times-bold-r-normal--*-120-75-75-*-*-*-*
	$o add_default font6 \
			-*-times-bold-r-normal--*-140-75-75-*-*-*-*
	$o add_default font7 \
			-*-times-bold-r-normal--*-180-75-75-*-*-*-*
	$o add_default font8 \
			-*-times-bold-r-normal--*-240-75-75-*-*-*-*
	$o add_default font9 \
			-*-helvetica-bold-r-normal--*-360-*-*-*-*-*-*
	$o add_default font10 \
			-*-helvetica-bold-r-normal--*-480-*-*-*-*-*-*
	return
}
	$self add_default font1 {helvetica -12 bold}
	$self add_default font2 {helvetica -14 bold}
	$self add_default font3 [$o get_option helv18b]
	$self add_default font4 [$o get_option helv24b]
	$self add_default font5 [$o get_option times12b]
	$self add_default font6 [$o get_option times14b]
	$self add_default font7 [$o get_option times18b]
	$self add_default font8 [$o get_option times24b]
}
MBProps instproc init {} {
	$self tkvar props_
	$self init_fonts
        set props_(line) {-fill color -arrow arrow -width width}
        set props_(freehand) {-fill color -width width}
        set props_(plainline) $props_(freehand)
        set props_(rectangle) {-fill fill -outline outline -width width}
        set props_(oval) $props_(rectangle)
        set props_(text) {-fill color -font font}
        set props_(move) {}
	set props_(copy) {}
        set props_(erase) {}
        set props_(all)  {fill arrow outline color width font}
        set props_(all,fill)  \
                        {colors 2 "custom" "" "none" "" White White \
			Black Black Red Red \
                        Orange Orange Yellow Yellow Green Green Blue Blue \
                        Magenta Magenta Violet Violet}
        set props_(all,outline) \
                        {colors 2 "custom" "" Black Black Red Red \
                        Orange Orange Yellow Yellow \
                        Green Green Blue Blue Magenta Magenta Violet Violet}
        set props_(all,color) \
                        {colors 2 "custom" "" Black Black Red Red \
                        Orange Orange Yellow Yellow \
                        Green Green Blue Blue Magenta Magenta Violet Violet}
        set props_(all,arrow) \
                        {text 1 "at the end" last "both ends" \
                        both "beginning" first "none" none}
        set props_(all,font) {font 1}
        set i 1
        while {""!=[set font [$self get_option font$i]]} {
                lappend props_(all,font) font$i
                lappend props_(all,font) $font
                incr i
        }
        set props_(all,width)  \
                        {text 2 1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 9 9 10 10}
}
MBProps instproc refresh_panel {currentset} {
	$self instvar panel_
	$self tkvar props_
	if [info exists props_($currentset)] {
		set currProps $props_($currentset)
	} else {
		set currProps {}
	}
	if {[llength $currProps] == 0} {
		pack forget $panel_
		return
	}
	if ![winfo ismapped $panel_] {
		pack $panel_ -side left -expand FALSE -fill both
	}
	foreach elt $props_(all) {
		if {-1 == [lsearch -exact $currProps $elt]} {
			pack forget $panel_.$elt
		} else {
			pack $panel_.$elt -side left -padx 1 -pady 1
		}
	}
}
MBProps instproc property {prop_set} {
	$self tkvar props_
	set prop_list $props_($prop_set)
	set newprop ""
	foreach {param property} $prop_list {
		if {$props_($property)!=""} {
			append newprop " $param "
			append newprop [list $props_($property)]
		}
	}
	return $newprop
}
MBProps instproc draw_panel {fr args} {
	$self tkvar props_
	$self instvar panel_ vis_
        set font [[Application instance] resource medfont]
	set panel_ [eval frame $fr.op1 $args]
	set propsName [$self tkvarname props_]
	foreach elt $props_(all) {
		frame $panel_.$elt
		set str "$elt:"
		set label [string toupper \
				[string index $str 0]][string range $str 1 end]
		label $panel_.$elt.label -text $label -font $font
		new MBOptionMenu $panel_.$elt.menu \
				[set propsName]($elt) \
				[set propsName]($elt,currLabel) \
				$props_(all,$elt)
		pack $panel_.$elt.label -side left -expand FALSE
		pack $panel_.$elt.menu -side left -expand FALSE
	}
	$self refresh_panel freehand
}
MBUI instproc show_timepanel {on} {
	$self instvar timepanel_ mainframe_
	$self readonly $on
	if ![info exists timepanel_] {
		$self instvar menu_
		set timepanel_ [new MBTimeBrowser $mainframe_ \
				[$menu_ tkvarname browseTime_]]
		$timepanel_ update_callBack "$self set_time"
		$timepanel_ stop_callBack "$self stopBrowseTime"
	}
	if {$on} {
		$timepanel_ pack -side bottom -fill x -expand 0
	} else {
		$timepanel_ unpack
	}
}
MBUI instproc show_toolbar {on} {
	$self instvar toolbar_ canvframe_
	if {$on} {
		$toolbar_ pack -before $canvframe_ \
				-side right -expand false -anchor e
	} else {
		$toolbar_ unpack
	}
}
MBUI instproc readonly {on} {
	$self show_toolbar [expr {$on ? 0 : 1}]
	[$self set menu_] readonly $on
}
MBUI instproc browseTime {varname} {
	upvar $varname browseOnVar
	$self instvar browsePage_ mgr_
	mtrace trcVerbose "$class browseTime $browseOnVar"
	set pageMgr [$mgr_ page_manager]
	if {$browseOnVar} {
		$self instvar timepanel_
		set curr_page [$pageMgr current_page]
		set range [$mgr_ time_range $curr_page]
		set retry 0
		while {($range  == {}) && ($retry < 10)} {
			update
			incr retry
			set range [$mgr_ time_range $curr_page]
		}
		if {$range == {}} {
			set browseOnVar 0
			Dialog transient MessageBox -title "Empty Page" \
					-text "This page is currently empty. Reverting to normal mode." -type ok
		}
	}
	$self show_timepanel $browseOnVar
	if {$browseOnVar} {
		set mintime [lindex $range 0]
		set maxtime [lindex $range 1]
		$timepanel_ min_time [expr {$mintime - 1}]
		$timepanel_ max_time [expr {$maxtime + 1}]
		$timepanel_ goto [expr {$maxtime + 1}]
		set browsePage_ [$pageMgr current_page]
		$self set_time $maxtime
	} else {
		if {$browsePage_ != {}} {
			$mgr_ release_time $browsePage_
		}
		set browsePage_ {}
	}
}
MBUI instproc stopBrowseTime {} {
	$self instvar menu_
	$menu_ tkvar browseTime_
	set browseTime_ 0
	$self browseTime browseTime_
}
MBUI instproc set_time {newtime} {
	$self instvar mgr_ browsePage_
	$mgr_ warp_time $browsePage_ $newtime
}
MBUI instproc track {src trackIt} {
	$self instvar srcToTrack_ mgr_
	if {$trackIt} {
		set srcToTrack_ $src
	} else {
		set srcToTrack_ {}
	}
	$mgr_ track $src $trackIt
}
MBUI instproc source_list { } {
	return [$self set srcList_]
}
Class GPSinterp
GPSinterp instproc fork {} {
	$self instvar path_ pswin_ pipe_
	set windowID [winfo id $path_]
	set pixmapID [$pswin_ pixmap-id]
	global env
	set env(GHOSTVIEW) "[expr $windowID] [expr $pixmapID]"
        puts stderr "\$GHOSTVIEW = $env(GHOSTVIEW)"
	$self setup-property
        set failed [catch {
                set pipe_ [open "|gs -dQUIET -dNOPAUSE -dSAFER -dNOPLATFONTS -" w]
        }]
        if !{$failed} { fconfigure $pipe_ -blocking false }
}
GPSinterp instproc init pswin {
	$self instvar orient_ pswin_ path_
	set orient_ 0
	set pswin_ $pswin
	set path_ [$pswin_ path]
}
GPSinterp instproc kill {} {
    $self instvar pipe_
    if [info exists pipe_] {
        set pid [pid $pipe_]
        $self dump "quit\n"
        catch {flush $pipe_}
        foreach p $pid {
            exec kill $p
        }
        catch "close $pipe_"
        unset pipe_
    }
}
GPSinterp instproc destroy {} {
    $self instvar pswin_ pipe_
    $pswin_ release
    delete $pswin_
    $self kill
}
GPSinterp instproc dump msg {
    $self instvar pipe_
    puts $pipe_ $msg
}
GPSinterp instproc render-file f {
	$self instvar pipe_ first_ pswin_ mwin_
        if ![info exists pipe_] {
                return
        }
	$pswin_ start
	$self dump [concat \
{userdict /$brkpage {} put
userdict /_$mash$save save put
userdict /_$realshowpage /showpage load put
userdict /showpage { stop } bind put } \
($f) (r) file cvx stopped pop \
{_$realshowpage grestoreall clear cleardictstack _$mash$save restore}]
	flush $pipe_
        puts stderr "executing render-file $f"
}
GPSinterp instproc width {} {
	$self instvar path_
	return [winfo width $path_]
}
GPSinterp instproc height {} {
	$self instvar path_
	return [winfo height $path_]
}
GPSinterp instproc set-orientation o {
}
GPSinterp instproc setup-property {} {
	$self instvar orient_ pswin_
        $self instvar bbox_
        if { [info exists bbox_] && "$bbox_"!="" } {
            set w [expr [lindex $bbox_ 2] - [lindex $bbox_ 0]]
            set h [expr [lindex $bbox_ 3] - [lindex $bbox_ 1]]
            set xdpi [expr int(72*[$self width]/$w)]
            set ydpi [expr int(72*[$self height]/$h)]
        } else {
            if $orient_ {
		set w [$self height]
		set h [$self width]
            } else {
		set w [$self width]
		set h [$self height]
            }
            set scaledWidth [expr int(8.5 * 72 + 0.5)]
            set scaledHeight [expr int(11 * 72 + 0.5)]
            set xdpi [expr int($w / 8.5 - 0.5)]
            set ydpi [expr int($h / 11 - 0.5 )]
        }
        if { [info exists bbox_] && "$bbox_"!="" } {
            set s "0 $orient_ $bbox_ $xdpi $ydpi"
        } else {
            set s "0 $orient_ 0 0 $scaledWidth $scaledHeight $xdpi $ydpi"
        }
        puts $s
	$pswin_ set-atom GHOSTVIEW $s
}
PostscriptWindow instproc recv-page w {
	$self damage
	$self instvar mwin_ path_
	set mwin_ $w
	[winfo parent $path_] configure -cursor ""
}
PostscriptWindow instproc init path {
	$self next $path
	$self instvar path_
	set path_ $path
}
PostscriptWindow instproc path {} {
        $self instvar path_
        return $path_
}
PostscriptWindow instproc resize {} {
	$self instvar path_
	puts stderr "resize [winfo width $path_] [winfo height $path_]"
}
PostscriptWindow instproc start {} {
	$self instvar path_
	$self release
	puts [[winfo parent $path_] cget -cursor]
	[winfo parent $path_] configure -cursor watch
}
PostscriptWindow instproc release {} {
	$self instvar mwin_
	if [info exists mwin_] {
                puts stderr "calling next-page"
		$self next-page $mwin_
		unset mwin_
	}
}
Class MBPSInterp -superclass GPSinterp
MBPSInterp instproc init pswin {
    $self instvar orient_ pswin_ path_ width_ height_
    $self next $pswin
    set width_ 0
    set height_ 0
    $pswin_ Init $self
}
MBPSInterp instproc get_pixmap {args} {
    $self instvar pswin_
    return [eval $pswin_ get_pixmap $args]
}
MBPSInterp instproc pixmap-id {} {
     $self instvar pswin_
     return [expr [$pswin_ pixmap-id]]
}
MBPSInterp instproc width {} {
    $self instvar width_
    return $width_
}
MBPSInterp instproc height {} {
    $self instvar height_
    return $height_
}
MBPSInterp instproc set-bbox {bbox} {
    $self instvar bbox_
    set bbox_ $bbox
}
MBPSInterp instproc resize {width height} {
    $self instvar path_ width_ height_ pipe_
    if {$width_!=$width || $height_!=$height} {
        $self kill
        set width_ $width
        set height_ $height
    }
    $self fork
}
MBPSProcessor superclass PostscriptWindow
MBPSProcessor instproc Init {interp} {
    $self instvar busy_ waiting_ curr_file_ curr_pm_ busy_ gs_
    set gs_ $interp
    set busy_ 0
    set waiting_ ""
}
MBPSProcessor instproc pixmap-id {} {
    $self instvar pixmap_id_
    DbgOut "returning tcl bitmap"
    return $pixmap_id_
}
DSC_Parser instproc get_bbox {file} {
    seek $file 0 start
    set contents [read $file 4096]
    set found [regexp "%%BoundingBox: (\[(\]atend\[)\]|\[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]*)" $contents dummy bbox]
    if {$found == 0} {
        DbgOut "Cannot find bounding box"
        return ""
    }
    if {[string compare "(atend)" $bbox] == 0} {
        seek $file "-4096" end
        set contents [read $file 4096]
        set found [regexp "%%BoundingBox: (\[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]*)" $contents dummy bbox]
        if {$found == 0} {
            DbgOut "Cannot find bbox at end"
            return ""
        }
    }
    DbgOut "bbox of ps: $bbox"
    seek $file 0 start
    return $bbox
}
MBPSProcessor instproc get_next_req { } {
    $self instvar waiting_ file_ pixmap_id_ pmSize_ busy_ gs_
    if {$busy_ == 1} {
        return
    }
    if {[llength $waiting_] <= 0} {
        return
    }
    set currPS [lindex $waiting_ 0]
    set waiting_ [lrange $waiting_ 1 end]
    set busy_ 1
    set file_ [lindex $currPS 0]
    set pixmap_id_ [lindex $currPS 1]
    $self set_pixmap $pixmap_id_
    set pmSize_ [lrange $currPS 2 3]
    set psFile [open $file_ r]
    set psp [new DSC_Parser]
    $psp set-file $psFile
    set bbox [$psp get_bbox $psFile]
    $gs_ set-bbox $bbox
    eval $gs_ resize $pmSize_
    set npage [$psp set npage_]
    set tmpFile /tmp/mbps.[pid].ps
    set f [open $tmpFile w]
    $psp dump 1 $f
    close $f
    DbgOut "calling render-file $tmpFile"
    $gs_ render-file $tmpFile
}
MBPSProcessor instproc get_pixmap {pixmap_id width height filename } {
    $self instvar waiting_ file_ pixmap_id_ busy_
    lappend waiting_ [list $filename $pixmap_id $width $height]
    DbgOut "busy=$busy_, \$waiting_=$waiting_"
    $self get_next_req
    return $pixmap_id
}
MBPSProcessor instproc recv-page w {
    $self instvar mwin_ path_ busy_ pixmap_id_ pmSize_
    [winfo parent $path_] configure -cursor ""
    DbgOut "\n\n ------- recv-page called --------- "
    set busy_ 0
    $self get_next_req
}
MBPSProcessor instproc recv-done w {
    DbgOut "\n\n ------- recv-done called --------- \n\n"
}
MBPSProcessor instproc destroy {} {
    DbgOut "in MBPSInterp instproc destroy"
    $self next
}
MB_Manager public attach_page_manager {page_mgr} {
	$self set page_manager_ $page_mgr
}
MB_Manager public page_manager {} {
	return [$self set page_manager_]
}
MB_Manager public attach_sender {sender} {
	$self set sender_ $sender
}
MB_Manager public sender {} {
	return [$self set sender_]
}
MB_Manager public destory {} {
	delete $page_manager_
}
MB_Manager public debug {} {
	return [$self set debug_]
}
MB_Manager public update_name {name} {
	set local_src [$self local_src]
	if {$local_src!={}} {
		$local_src cname $name
	}
}
Class MBPageMgr -superclass Observable
MBPageMgr public init {mbMgr} {
        $self set idleHandler_ {}
        $self set nextPage_ {}
	$self set currPage_ {}
	$self set mgr_ $mbMgr
}
MBPageMgr public destroy {} {
	$self instvar arPage2Canv_
	foreach page_id [array names arPage2Canv_] {
		mtrace trcMB "deleting canvas for page: $page_id"
		delete $arPage2Canv_($page_id)
	}
}
MBPageMgr public switch_page_later {page_id} {
        $self instvar idleHandler_ nextPage_
        if {[string compare $nextPage_ $page_id]} {
                after cancel $idleHandler_
                set idleHandler_ [after idle $self switch_page $page_id]
                set nextPage_ $page_id
        }
}
MBPageMgr public create_new_page {{page_name {}}} {
	$self instvar mgr_
        if {$page_name=={}} {
                set page_name "Page "
                append page_name [$self nextPageNumber]
        } else {
                set page_name [lindex $args 0]
        }
        set page_id [[$mgr_ sender] create_page $page_name]
        return $page_id
}
MBPageMgr public add_page {page_id canvas} {
	$self instvar arCanv2Page_ arPage2Canv_
	if [info exists arCanv2Page_($canvas)] {
		error "MBPageMgr add_page called with already created page"
	}
	set arCanv2Page_($canvas) $page_id
	set arPage2Canv_($page_id) $canvas
	$self notify_observers add_page $page_id
}
MBPageMgr public current_page {} {
	return [$self set currPage_]
}
MBPageMgr public current_canvas {} {
	$self instvar currPage_
	if {$currPage_!={}} {
		return [$self page2canv $currPage_]
	} else {
		return {}
	}
}
MBPageMgr public pagelist {} {
	$self instvar arPage2Canv_
	return [array names arPage2Canv_]
	return
}
MBPageMgr public has_page {page_id} {
	$self instvar arPage2Canv_
	return [info exists arPage2Canv_($page_id)]
}
MBPageMgr public page2canv {page_id} {
	$self instvar arPage2Canv_
	if ![info exists arPage2Canv_($page_id)] {
		error "cannot find $page_id"
	}
	return $arPage2Canv_($page_id)
}
MBPageMgr public canv2page {canvas} {
	$self instvar arCanv2Page_
	if ![info exists arCanv2Page_($canvas)] {
		error "cannot find $canvas"
	}
	return $arCanv2Page_($canvas)
}
MBPageMgr private switch_page {page_id} {
	$self instvar currPage_ nextPage_ sender_
        $self instvar menubutton_ mgr_
        if {$page_id==$currPage_} {
                mtrace trcVerbose "same page, do nothing"
                return
        }
        mtrace trcVerbose "switching to $page_id"
	puts "before update idletasks 1"
        update idletasks
	puts "after update idletasks 1"
	if {$currPage_ != {}} {
		set old_canv [$self page2canv $currPage_]
		$old_canv unpack
	}
	set new_canv [$self page2canv $page_id]
	$new_canv pack -side left -fill both -expand true -anchor nw
	if {$currPage_ != {}} {
		$new_canv transfer_state_from $old_canv
	}
        set currPage_ $page_id
        set nextPage_ $page_id
	[$mgr_ sender] switch_page $currPage_
	$self notify_observers switch_page $currPage_
}
MBPageMgr public nextPageNumber {} {
        $self instvar arCanv2Page_ mgr_
        set part [$mgr_ local_srcid]
	set pages [array names arCanv2Page_]
        mtrace trcVerbose "pages:$pages, part=$part"
        set max 0
        foreach id $pages {
                if {[string first $part $id]>=0} {
                        mtrace trcExcessive \
					[concat "match $id, split returns <" \
                                        [split $id :] ">"]
                        set n "0x"
                        append n [lindex [split $id :] 1]
                        if {$n > $max} {
                                set max $n
                        }
                }
        }
        return [expr $max + 1]
}
MBPageMgr public page_label {page_id} {
        set wrk [split $page_id :]
        set srcid [lindex $wrk 0]
        set h "0x"
        append h [lindex $wrk 1]
	if {$h == "0x"} {
		return "(null)"
	}
        set pagenum [format "%d" $h]
        set wrk [split $srcid _]
        set addr [lindex $wrk 0]
        set uid [lindex $wrk 1]
        set agent [[[$self set mgr_] session] get_agent]
        set src [$agent get_source $addr $uid]
	$self instvar mgr_
        if {$src=={}} {
                set addr [format %u "0x$addr"]
                set uid [format %u "0x$uid"]
                set addr [$mgr_ intoa $addr]
                return [append nothing $uid "@" $addr ":Page " $pagenum]
        }
        return [append nothing [$src cname] ": " $pagenum]
}
MBPageMgr proc sort_pages {pagelist} {
	proc mbPageIdCompare {p1 p2} {
		puts "compare $p1 $p2"
		set t [split $p1 :]
		set h1 [lindex $t 0]
		set n1 [lindex $t 1]
		set t [split $p2 :]
		set h2 [lindex $t 0]
		set n2 [lindex $t 1]
		set r [string compare $h1 $h2]
		if {$r == 0} {
			return [expr {$n1 - $n2}]
		}
		puts "return $r"
		return $r
	}
	return [lsort -command mbPageIdCompare $pagelist]
}
Class FontInitializer
FontInitializer public init {options} {
	$options add_default foundry adobe
	set foundry [$options get_option foundry]
        set b b
	set o o
        foreach i {8 10 12 14 18 24 36 48} {
                $options add_default helv$i    [$self search_font $foundry helvetica medium $i r]
                $options add_default helv$i$b  [$self search_font $foundry helvetica bold $i r]
		$options add_default helv$i$o  [$self search_font $foundry helvetica bold $i o]
                $options add_default times$i   [$self search_font $foundry times     medium $i r]
                $options add_default times$i$b [$self search_font $foundry times     bold $i r]
                $options add_default times$i$o [$self search_font $foundry times     bold $i o]
		$options add_default courier$i [$self search_font $foundry courier medium $i r]
        }
        $options add_default tinyfont [$self get_option helv8]
	$options add_default smallfont [$self get_option helv10b]
	$options add_default medfont [$self get_option helv12b]
	$options add_default helpFont [$self get_option times14]
	$options add_default entryFont [$self get_option helv10]
        $options add_default logofont [$self get_option times12o]
}
FontInitializer public 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
		}
	}
	puts stderr "can't find $weight $fname font (using fixed)"
	if ![havefont fixed] {
		puts stderr "can't find fixed font"
		exit 1
	}
	return fixed
}
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 {
		set a [Application instance]
		if [catch {$a reset $ab srm $self}] {
			$a 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 Timer
Class Timer/Periodic -superclass Timer
Class Timer/Adaptive -superclass Timer
Class Timer/Adaptive/ConstBW -superclass Timer/Adaptive
Timer public init {} {
	$self next
	$self randomize 0
	$self set randwt_ 1.0
}
Timer public destroy {} {
	$self cancel
	$self next
}
Timer public randomize { {yesno 1} {randwt {}} } {
	if { $randwt!={} } {
		$self set randwt_ $randwt
	}
	if {$yesno=="yes"} {set yesno 1} elseif {$yesno=="no"} {set yesno 0}
	$self set randomize_ $yesno
}
Timer private sched { t } {
	$self msched $t
}
Timer public msched { t } {
	$self instvar id_ randomize_ randwt_
	if [info exists id_] {
		puts stderr "warning: $self ([$self info class]):\
				overlapping timers"
	}
	if $randomize_ {
		set r [expr [random]/double(0x7fffffff)-0.5]
		set t [expr $t+$t*$r*$randwt_]
	}
	set t [expr int($t+0.5)]
	set id_ [after $t "$self do_timeout"]
}
Timer private do_timeout {} {
	$self instvar id_
	if ![info exists id_] {
		puts stderr "warning: $self ($class) no timer id_"
	} else {
		unset id_
	}
	$self timeout
}
Timer public is_sched { } {
	$self instvar id_
	return [info exists id_]
}
Timer public cancel {} {
	$self instvar id_
	if [info exists id_] {
		after cancel $id_
		unset id_
	}
}
Timer/Periodic public init { {period 5000} } {
	$self next
	$self set period_ $period
}
Timer/Periodic public start { {period {}} } {
	$self instvar period_
	if { $period!={} } { set period_ $period }
	if [$self is_sched] { $self cancel }
	$self msched $period_
}
Timer/Periodic instproc do_timeout {} {
	$self instvar period_
	$self next
	if { [info commands $self]=="" } return
	$self msched $period_
}
Timer/Adaptive public init { {interval 5000} } {
	$self next
	$self set interval_ $interval
}
Timer/Adaptive public start {} {
	$self instvar interval_
	if [$self is_sched] { $self cancel }
	set interval_ [$self adapt $interval_]
	$self msched [expr int($interval_+0.5)]
}
Timer/Adaptive public do_timeout {} {
	$self next
	if { [info commands $self]=="" } return
	$self instvar interval_
	set interval_ [$self adapt $interval_]
	$self msched [expr int($interval_+0.5)]
}
Timer/Adaptive private adapt {interval} {
	return $interval
}
Timer/Adaptive/ConstBW public init { bw {thresh {}} {size_gain {}} } {
	$self instvar size_gain_ avgsize_ nsrcs_ bw_ thresh_ interval_
	if { $size_gain!={} } {
		set size_gain_ $size_gain
	} else {
		set size_gain_ 0.125
	}
	set avgsize_ 28
	set nsrcs_ 0
	set bw_ $bw
	if { $thresh=={} } {
		set thresh_ 500
	} else {
		set thresh_ $thresh
	}
	$self next $thresh_
}
Timer/Adaptive/ConstBW public threshold { {thresh {}} } {
    $self instvar thresh_
    if {$thresh=={}} {
	return $thresh_
    } else {
	set thresh_ $thresh
    }
}
Timer/Adaptive/ConstBW public bandwidth { {bw {}} } {
    $self instvar bw_
    if {$bw=={}} {
	return $bw_
    } else {
	set bw_ $bw
    }
}
Timer/Adaptive/ConstBW public sample_size { size } {
	$self instvar avgsize_ size_gain_
	set avgsize_ [expr $avgsize_ + $size_gain_ * ($size + 28 - $avgsize_)]
}
Timer/Adaptive/ConstBW public update_nsrcs { nsrcs } {
	$self set nsrcs_ $nsrcs
}
Timer/Adaptive/ConstBW public nsrcs { nsrcs } {
	return [$self set nsrcs_]
}
Timer/Adaptive/ConstBW public incr_nsrcs { {incr 1} } {
        $self instvar nsrcs_
        incr nsrcs_ $incr
}
Timer/Adaptive/ConstBW private adapt {interval} {
	$self instvar avgsize_ bw_ nsrcs_ thresh_
	set t [expr 1000 * ($nsrcs_ * $avgsize_ * 8) / $bw_]
	if { $t < $thresh_ } {
		return $thresh_
	} else {
		return $t
	}
}
AnnounceListenManager public init { spec {mtu 1500} } {
	$self next $mtu
	$self instvar data_ snet_ rnet_
	set data_ ""
	set snet_ ""
	set rnet_ ""
	if [regexp {^[0-9]*$} $spec] {
		set rnet_ [new Network]
		$rnet_ open $spec
	} else {
		set ab [new AddressBlock/Simple $spec]
		set addr  [$ab addr]
		set sport [$ab sport]
		set rport [$ab rport]
		set ttl   [$ab ttl]
		delete $ab
		set snet_ [new Network]
		if [in_multicast $addr] {
			$snet_ open $addr $sport $rport $ttl
			set rnet_ $snet_
		} else {
			if { $rport != 0 } {
				set rnet_ [new Network]
				$rnet_ open $rport
			}
			$snet_ open $addr $sport 0 1
		}
	}
	if { $snet_ != "" } {
		$snet_ loopback 1
		$self send_network $snet_
	}
	if { $rnet_ != "" } {
		$self recv_network $rnet_
	}
}
AnnounceListenManager public destroy {} {
	$self instvar snet_ rnet_ timers_
	if { $rnet_==$snet_ } {
		delete $snet_
	} else {
		if { $snet_ != "" } {
			delete $snet_
		}
		if { $rnet_ != "" } {
			delete $rnet_
		}
	}
	if [info exists timers_] {
		foreach t [array names timers_] {
			delete $timers_($t)
		}
	}
	$self next
}
AnnounceListenManager public timer {args} {
	$self instvar timers_
	if {[llength $args]==1} {
		set d __default_timer__
		set t [lindex $args 0]
		if {$t!={}} { $t proc timeout { } "$self send_announcement" }
	} else {
		set d [lindex $args 0]
		set t [lindex $args 1]
		if {$t!={}} { $t proc timeout { } \
				[list $self send_announcement $d] }
	}
	if [info exists timers_($d)] {
		set sched [$timers_($d) is_sched]
		delete $timers_($d)
	} else {
		set sched 0
	}
	if {$t!={}} {
		set timers_($d) $t
		if $sched {
			$t start
		}
	} else {
		catch {unset timers_($d)}
	}
	return $t
}
AnnounceListenManager public get_timer {args} {
	$self instvar timers_
	if {[llength $args]==0} {
		set d __default_timer__
	} else {
		set d [lindex $args 0]
	}
	if [info exists timers_($d)] { return $timers_($d) } else { return "" }
}
AnnounceListenManager public start {args} {
	if { [llength $args]==0 } {
		set t [$self get_timer]
	} else {
		set d [lindex $args 0]
		set t [$self get_timer $d]
	}
	if { $t=={} } {
		set t [new Timer/Periodic]
		$t randomize 1
		if [info exists d] { $self timer $d $t } else { $self timer $t}
	}
	if [info exists d] {$self send_announcement $d} \
			else {$self send_announcement}
	$t start
}
AnnounceListenManager public stop {args} {
	$self instvar timers_
	if {[llength $args]==0} {
		foreach d [array names timers_] {
			$timers_($d) cancel
		}
	} else {
		set d [lindex $args 0]
		$timers_($d) cancel
	}
}
AnnounceListenManager public recv_announcement { addr port data len } {
	puts "ALM::recv_announcement $addr/$port \[$len\]: $data"
}
AnnounceListenManager public send_announcement {args} {
	$self instvar data_
	if {[llength $args]==0} {
		if { $data_!={} } { $self announce $data_ }
	} else {
		$self announce [lindex $args 0]
	}
}
AnnounceListenManager public set_announcement { data } {
	$self set data_ $data
}
AnnounceListenManager public get_announcement { } {
	return [$self set data_]
}
AnnounceListenManager public ttl {num} {
	$self instvar snet_
	$snet_ ttl $num
}
Class AnnounceListenManager/AS -superclass AnnounceListenManager
AnnounceListenManager/AS instproc init { netspec bw atype } {
	random 0
	$self next $netspec 1024
	$self instvar atype_
	set atype_ $atype
	$self instvar agentbytype_
	set agentbytype_(srv) ""
	set agentbytype_(client) ""
	set agentbytype_(hm) ""
	set t [new Timer/Adaptive/ConstBW $bw 3000]
	$t randomize
        $self timer $t
	set o [$self options]
	$o add_default startupWait 60
	$self instvar aliveid_
	set aliveid_ [after [expr [$self get_option startupWait]*1000] "$self check_alive 1"]
}
AnnounceListenManager/AS proc version {} {
	return 2.0
}
AnnounceListenManager/AS public send_announcement {} {
	$self instvar atype_
	set o "ASCP v[$class version]"
	set n $atype_
	set o $o\n$n
	set n [$self agent_instance]
	set o $o\n$n
	set n [$self service_name]
	set o $o\n$n
	set n [$self service_location]
	set o $o\n$n
	set n [$self service_instance]
	set o $o\n$n
	set n [$self ssg_port]
	set o $o\n$n
	set n [$self agent_data]
	set o $o\n$n
	$self announce $o
	$self check_alive 0
}
AnnounceListenManager/AS instproc announce_death {} {
	$self instvar id1_ id2_ atype_
	set o "ASCP v[AnnounceListenManager/AS version]"
	set n $atype_
	set o $o\n$n
	set n [$self agent_instance]
	set o $o\n$n
	set n bye
	set o $o\n$n
	set n -
	set o $o\n$n
	set n -
	set o $o\n$n
	set n -
	set o $o\n$n
	$self announce $o
}
AnnounceListenManager/AS public agent_instance {} {
	return "[pid]@[lookup_host_name [localaddr]]"
}
AnnounceListenManager/AS public agent_data {} {
	return ""
}
AnnounceListenManager/AS public ssg_port {} {
	return "-"
}
AnnounceListenManager/AS instproc service_location {} {
	return "-"
}
AnnounceListenManager/AS instproc destroy {} {
	$self instvar aliveid_
	after cancel $aliveid_
	$self next
}
AnnounceListenManager/AS instproc recv_announcement { addr port data size } {
	$self instvar lastann_ sdp_ agentbytype_ agenttab_ atype_
        set t [$self get_timer]
	$t sample_size $size
	set o [split $data \n]
	if { [lindex $o 0] != "ASCP v[$class version]" } {
		set msg "$self ($class): received non-ASCP v[$class version] announcement from $addr."
		if { $atype_ == "hm" } {
			$self instvar agent_
			$agent_ log $msg
		} else {
			puts stderr $msg
		}
 		return
	}
	set atype [lindex $o 1]
	set aspec [lindex $o 2]
	set srv_name [lindex $o 3]
	set srv_loc [lindex $o 4]
	set srv_inst [lindex $o 5]
	set ssg_port [lindex $o 6]
	set ad [join [lrange $o 7 end] \n]
	if { $srv_name == "DEATH" } {
		set msg "Received death packet from $aspec at $addr - exiting."
		if { $srv_loc == $atype_ } {
			if { $atype_ == "hm" } {
				$self instvar agent_
				$agent_ log $msg
			} else {
				puts stderr $msg
			}
			$self announce_death
			exit 0
		}
		$self recv_msg $atype $aspec $addr DEATH $srv_loc \
			$srv_inst $ssg_port "$ad"
		return
	}
	if { $srv_name == "bye" } {
		$self delete_agent $aspec
		return
	}
	if ![info exists agenttab_($aspec)] {
		$self instvar avgdelta_
		$self register $atype $aspec $addr $srv_name $srv_inst "$ad"
	        $t incr_nsrcs
		set timeout [$self get_option startupWait]
		set avgdelta_($aspec) [expr $timeout / 8]
		lappend agentbytype_($atype) $aspec
	} else {
		set now [gettimeofday]
		set delta [expr $now - $lastann_($aspec,abs)]
		$self instvar avgdelta_
		set avgdelta_($aspec) \
				[expr 0.875*$avgdelta_($aspec)+0.125*$delta]
	}
	set agenttab_($aspec) "$addr {$ad} $atype $srv_name $srv_inst"
	set lastann_($aspec,abs) [gettimeofday]
	set lastann_($aspec,ascii) [gettimeofday ascii]
	$self recv_msg $atype $aspec $addr $srv_name $srv_loc $srv_inst \
			$ssg_port "$ad"
}
AnnounceListenManager/AS instproc advance_timers { delta } {
	$self instvar lastann_ agenttab_ avgdelta_
	set aspecs [array names agenttab_]
	foreach aspec $aspecs {
		set lastann_($aspec,abs) [expr $lastann_($aspec,abs)+$delta]
	}
}
AnnounceListenManager/AS instproc check_alive { timer } {
	$self instvar lastann_ agenttab_ avgdelta_
	set now [gettimeofday]
	set aspecs [array names agenttab_]
	foreach aspec $aspecs {
		set lastann $lastann_($aspec,abs)
		set avgdelta $avgdelta_($aspec)
		set delta [expr $now - $lastann]
		if { $delta > 8 * $avgdelta } {
			$self delete_agent $aspec
		}
	}
	$self instvar aliveid_
	if { $timer } {
		set t [expr [$self get_option startupWait]*1000]
		set aliveid_ [after $t "$self check_alive 1"]
	}
}
AnnounceListenManager/AS instproc delete_agent { aspec } {
 	$self instvar agentbytype_ agenttab_ lastann_ avgdelta_
	if ![info exists agenttab_($aspec)] {
		return
	}
	set a $agenttab_($aspec)
	set addr [lindex $a 0]
	set ad [lindex $a 1]
	set atype [lindex $a 2]
	set srv_name [lindex $a 3]
	set srv_inst [lindex $a 4]
	unset agenttab_($aspec)
	unset lastann_($aspec,abs)
	unset lastann_($aspec,ascii)
	unset avgdelta_($aspec)
	set t $agentbytype_($atype)
	set i [lsearch -exact $t $aspec]
	set agentbytype_($atype) [lreplace $t $i $i]
	[$self get_timer] incr_nsrcs -1
	$self unregister $atype $aspec $addr $srv_name $srv_inst "$ad"
}
AnnounceListenManager/AS instproc agenttab aspec {
	$self instvar agenttab_
	if [info exists agenttab_($aspec)] {
		return $agenttab_($aspec)
	}
	return ""
}
Class AnnounceListenManager/AS/Client -superclass AnnounceListenManager/AS
AnnounceListenManager/AS/Client public init { spec bw srv_loc } {
	$self next $spec $bw client
	$self instvar srv_inst_ srv_loc_
	set srv_loc_ $srv_loc
}
AnnounceListenManager/AS/Client public service_location { } {
	$self instvar srv_loc_
	return $srv_loc_
}
AnnounceListenManager/AS/Client private recv_msg { atype aspec addr srv_name \
	        srv_loc srv_inst ssg_port msg } {
}
Class RTP
Class RTP/Video -superclass RTP
Class RTP/Audio -superclass RTP
RTP private init {} {
	eval $self next
	$self instvar rtp_ptoa_
	set rtp_ptoa_(-1) ""
}
RTP/Audio set default_ptoa_(0) pcm
RTP/Audio set default_ptoa_(1) celp
RTP/Audio set default_ptoa_(2) g721
RTP/Audio set default_ptoa_(3) gsm
RTP/Audio set default_ptoa_(5) dvi
RTP/Audio set default_ptoa_(6) dvi
RTP/Audio set default_ptoa_(7) lpc
RTP/Audio set default_ptoa_(8) pcma
RTP/Audio set default_ptoa_(9) g722
RTP/Audio set default_ptoa_(10) lin16
RTP/Audio set default_ptoa_(11) lin16
RTP/Audio set default_ptoa_(14) mpa
RTP/Audio set default_ptoa_(15) g728
RTP/Video set default_ptoa_(21) pvh
RTP/Video set default_ptoa_(25) cellb
RTP/Video set default_ptoa_(26) jpeg
RTP/Video set default_ptoa_(27) cuseeme
RTP/Video set default_ptoa_(28) nv
RTP/Video set default_ptoa_(29) picw
RTP/Video set default_ptoa_(30) cpv
RTP/Video set default_ptoa_(31) h261
RTP/Video set default_ptoa_(32) mpeg
RTP/Video set default_ptoa_(33) mpegs
RTP/Video set default_ptoa_(42) h263+
RTP/Video set default_ptoa_(34) h263
RTP/Audio set default_ptoa_(126) mp3
RTP/Video set default_ptoa_(127) h261v1
RTP/Video set default_ptoa_(50) sc
RTP/Audio public init args {
	$self next
	$class instvar default_ptoa_
	$self instvar rtp_ptoa_ rtp_atop_
	foreach p [array names default_ptoa_] {
		$self add_mapping $p $default_ptoa_($p)
	}
	foreach mapping [$self get_option rtpMap] {
		set l [split $mapping :]
		set pt [lindex $l 0]
		set fmt [lindex $l 1]
		$self add_mapping $pt $fmt
	}
}
RTP/Video public init args {
	$self next
	$class instvar default_ptoa_
	$self instvar rtp_ptoa_ rtp_atop_
        set rtp_ptoa_(-1) ""
	foreach p [array names default_ptoa_] {
		set rtp_ptoa_($p) $default_ptoa_($p)
		set rtp_atop_($default_ptoa_($p)) $p
	}
	foreach mapping [$self get_option rtpMap] {
		set l [split $mapping :]
		set pt [lindex $l 0]
		set fmt [lindex $l 1]
		$self add_mapping $pt $fmt
	}
	$self instvar classmap_
	set classmap_(pvh) PVH
	set classmap_(h261) H261
	set classmap_(h261v1) H261v1
	set classmap_(nv) NV
	set classmap_(cellb) CellB
	set classmap_(jpeg) JPEG
        set classmap_(h263+) H263+
        set classmap_(h263) H263
	set classmap_(sc) SC
}
RTP/Video public classmap type {
	$self instvar classmap_
	if [info exists classmap_($type)] {
		return $classmap_($type)
	}
	return "Null"
}
RTP public add_mapping {pt fmt} {
	$self instvar rtp_ptoa_ rtp_atop_
	set rtp_ptoa_($pt) $fmt
	set rtp_atop_($fmt) $pt
}
RTP public rtp_type pt {
	$self instvar rtp_ptoa_
	if [info exists rtp_ptoa_($pt)] {
		return $rtp_ptoa_($pt)
	} elseif { $pt < 0 }  {
		return ""
	} else {
		return fmt-$pt
	}
}
RTP public rtp_fmt_number fmt {
	$self instvar rtp_atop_
	if [info exists rtp_atop_($fmt)] {
		return $rtp_atop_($fmt)
	} else {
		return -1
	}
}
RTP public rtp_format src {
	$self instvar rtp_ptoa_
	return [$self rtp_type [$src format]]
}
RTP instproc cname_redundant { name cname } {
	set ni [string first @ $name]
	if { $ni < 0 } {
		return 0
	}
	set ci [string first @ $cname]
	if { $ci < 0 } {
		return 0
	}
	if { [string compare \
		[string range $name 0 $ni] \
		[string range $cname 0 $ci]] == 0 } {
		return 1
	}
	return 0
}
RTP public rtp_representation src {
	set fmt [$self rtp_format $src]
	set name [$src sdes name]
	set cname [$src sdes cname]
	set addr [$src addr]
	if { $name == "" } {
		if { $cname == "" } {
			set srcname $addr
			set srcinfo $addr/$fmt
		} else {
			set srcname $cname
			set srcinfo $addr/$fmt
		}
	} elseif [$self cname_redundant $name $cname] {
		set srcname $name
		set srcinfo $addr/$fmt
	} else {
		set srcname $name
		set srcinfo $cname/$fmt
	}
	return "{$srcname} {$srcinfo}"
}
Class SDPParser
Class SDPMedia
Class SDPTime
Class SDPMessage
SDPParser instproc init { {ordered_syntax 1} } {
	$self next
	$self instvar nextsym_ ordered_syntax_ parse_error_
	set nextsym_(start) "v"
	set nextsym_(v) "o"
	set nextsym_(o) "s"
	set nextsym_(s) "i u e p c b t"
	set nextsym_(i) "u e p c b t"
	set nextsym_(u) "e p c b t"
	set nextsym_(e) "e p c b t"
	set nextsym_(p) "e p c b t"
	set nextsym_(c) "b t "
	set nextsym_(b) "t"
	set nextsym_(t) "t r z k a m"
	set nextsym_(r) "t z k a m"
	set nextsym_(z) "k a m"
	set nextsym_(k) "a m"
	set nextsym_(a) "a m"
	set nextsym_(m) "m i:m c:m b:m k:m a:m v"
	set nextsym_(i:m) "m c:m b:m k:m a:m v"
	set nextsym_(c:m) "m b:m k:m a:m v"
	set nextsym_(b:m) "m k:m a:m v"
	set nextsym_(k:m) "m a:m v"
	set nextsym_(a:m) "m a:m v"
	set ordered_syntax_ $ordered_syntax
	set parse_error_ ""
}
SDPParser instproc check_syntax { last cur media } {
	$self instvar nextsym_
	if ![info exists nextsym_($last)] {
		return ""
	}
	foreach s $nextsym_($last) {
		set t [split $s :]
		if { [lindex $t 0] == $cur } {
			return $s
		}
	}
	return ""
}
SDPParser instproc parse { announcement } {
	$self instvar parse_error_ ordered_syntax_
	set media ""
	set allmsgs ""
	set lasttag "start"
	set lines [split $announcement "\n"]
	set parse_error_ ""
	set lnum 0
	foreach line $lines {
		incr lnum
		set line [string trimright $line]
		if { $line=={} } continue
		set sline [split $line =]
		set tag [lindex $sline 0]
		set value [join [lrange $sline 1 end]]
		set ret [$self check_syntax $lasttag $tag $media]
		if { $ret == "" && $ordered_syntax_==1 } {
			set parse_error_ "$class: syntax error between\
					$lasttag and $tag in line $lnum."
			foreach m $allmsgs {
				delete $m
			}
			return ""
		}
		set lasttag $ret
		switch $tag {
		v {
			set media ""
			set msg [new SDPMessage]
			lappend allmsgs $msg
			$msg set version_ $value
		}
		o {
			if {![info exists msg]} {
				set media ""
				set msg [new SDPMessage]
				lappend allmsgs $msg
				$msg set version_ 0
				set tmp [$msg set msgtext_]
				lappend tmp "v=0"
				$msg set msgtext_ $tmp
			}
			$msg set creator_ [lindex $value 0]
			$msg set createtime_ [lindex $value 1]
			$msg set modtime_  [lindex $value 2]
			$msg set nettype_ [lindex $value 3]
			$msg set addrtype_ [lindex $value 3]
			$msg set createaddr_ [lindex $value 5]
		}
		s {
			$msg set session_name_ $value
		}
		i {
			if { $media != "" } {
				$media set session_info_ $value
			} else {
				$msg set session_info_ $value
			}
		}
		p {
			set tmp ""
			catch { set tmp [$msg set phonelist_] }
			lappend tmp $value
			$msg set phonelist_ $tmp
		}
		e {
			set tmp ""
			catch { set tmp [$msg set emaillist_] }
			lappend tmp $value
			$msg set emaillist_ $tmp
		}
		u {
			$msg set uri_ $value
		}
		c {
			if { $media != "" } {
				$media set nettype_ [lindex $value 0]
				$media set addrtype_ [lindex $value 1]
				$media set caddr_ [lindex $value 2]
			} else {
				$msg set nettype_ [lindex $value 0]
				$msg set addrtype_ [lindex $value 1]
				$msg set caddr_ [lindex $value 2]
			}
		}
		b {
			set bwspec [split $value :]
			if { $media != "" } {
				$media set bwmod_ [lindex $bwspec 0]
				$media set bwval_ [lindex $bwspec 1]
			} else {
				$msg set bwmod_ [lindex $bwspec 0]
				$msg set bwval_ [lindex $bwspec 1]
			}
		}
		t {
			set tdes [new SDPTime]
			$tdes set fields_(t) $value
			$tdes set starttime_ [lindex $value 0]
			$tdes set endtime_ [lindex $value 1]
			set tmp [$msg set alltimedes_]
			lappend tmp $tdes
			$msg set alltimedes_ $tmp
		}
		r {
			$tdes set fields_(r) $value
			$tdes set repeat_interval_ [lindex $value 0]
			$tdes set active_duration_ [lindex $value 1]
			$tdes set offlist_ [lrange $value 2 end]
		}
		z {
			set nval [llength $value]
			if [expr 2 * ($nval / 2) != $nval] {
				foreach m $allmsgs {
					delete $m
				}
				return ""
			}
			$self instvar zoneinfo_
			for { set n 0 } { $n < $nval } { incr n } {
				set adjtime [lindex $value $n]
				incr n
				set offset [lindex $value $n]
				lappend zoneinfo_ "$adjtime $offset"
			}
		}
		k {
			set tmp [split $value :]
			if { $media != "" } {
				$media set crypt_method_ [lindex $tmp 0]
				$media set crypt_key_ [lindex $tmp 1]
			} else {
				$msg set crypt_method_ [lindex $tmp 0]
				$msg set crypt_key_ [lindex $tmp 1]
			}
		}
		a {
			set attribute [split $value ":"]
			set attname [lindex $attribute 0]
			set attval [join [lrange $attribute 1 end] ":"]
			if { $media != "" } {
				set target $media
			} else {
				set target $msg
			}
			if [catch {$target set attributes_($attname)}] {
				$target set attributes_($attname) {}
			}
			$target set attributes_($attname) \
			    [concat [$target set attributes_($attname)] \
				 [list $attval]]
		}
		m {
			set media [new SDPMedia $msg]
			set mt [lindex $value 0]
			$media set mediatype_ $mt
			$media set port_  [lindex $value 1]
			$media set proto_ [lindex $value 2]
			$media set fmt_ [lrange $value 3 end]
			set tmp ""
			catch { set tmp [$msg set media_array_($mt)] }
			lappend tmp $media
			$msg set media_array_($mt) $media
			set tmp [$msg set allmedia_]
			lappend tmp $media
			$msg set allmedia_ $tmp
		}
		default {
			set parse_error_ "$class: error unknown modifier $tag."
			foreach m $allmsgs {
				delete $m
			}
			return ""
		}
		}
		set tmp [$msg set msgtext_]
		lappend tmp $line
		$msg set msgtext_ $tmp
		if { $media != "" && [regexp {[icbka]} $tag] } {
			$media set fields_($tag) $value
		} else {
			$msg set fields_($tag) $value
		}
	}
	foreach msg $allmsgs {
		set tmp [$msg set msgtext_]
		set tmp [join $tmp \n]
		append tmp \n
		$msg set msgtext_ $tmp
	}
	return $allmsgs
}
SDPParser instproc parse_error { } {
	return [$self set parse_error_]
}
SDPMessage instproc init {} {
	$self next
	$self instvar allmedia_ alltimedes_ msgtext_
	set allmedia_ ""
	set alltimedes_ ""
	set msgtext_ ""
}
SDPMessage instproc destroy {} {
	$self instvar allmedia_ alltimedes_
	foreach m $allmedia_ {
		delete $m
	}
	foreach t $alltimedes_ {
		delete $t
	}
	$self next
}
SDPMessage instproc media { media_type } {
	$self instvar media_array_
	if [info exists media_array_($media_type)] {
		return $media_array_($media_type)
	} else {
		return ""
	}
}
SDPMessage instproc have_field { field } {
	$self instvar fields_
	return [info exists fields_($field)]
}
SDPMessage instproc field_value { field } {
	$self instvar fields_
	if [info exists fields_($field)] {
		return $fields_($field)
	} else {
		return ""
	}
}
SDPMessage instproc attributes {} {
	$self instvar attributes_
	if [info exists attributes_] {
		return [array names attributes_]
	} else {
		return ""
	}
}
SDPMessage instproc have_attr { name } {
	$self instvar attributes_
	return [info exists attributes_($name)]
}
SDPMessage instproc attr_value { name } {
    $self instvar attributes_
    if [info exists attributes_($name)] {
	    return $attributes_($name)
    } else {
	    return ""
    }
}
SDPMessage instproc obj2str {} {
	$self instvar attributes_ alltimedes_ allmedia_
	set o "v=[$self field_value v]"
	foreach f { o s i u } {
		if [$self have_field $f] {
			set n "$f=[$self field_value $f]"
			set o $o\n$n
		}
	}
	$self instvar phonelist_ emaillist_
	if [info exists phonelist_] {
		foreach e $phonelist_ {
			set n "p=$e"
			set o $o\n$n
		}
	}
	if [info exists emaillist_] {
		foreach e $emaillist_ {
			set n "e=$e"
			set o $o\n$n
		}
	}
	foreach f { c b } {
		if [$self have_field $f] {
			set n "$f=[$self field_value $f]"
			set o $o\n$n
		}
	}
	foreach t $alltimedes_ {
		set n [$t obj2str]
		set o $o\n$n
	}
	foreach f { z k } {
		if [$self have_field $f] {
			set n "$f=[$self field_value $f]"
			set o $o\n$n
		}
	}
	foreach a [$self attributes] {
		if { $attributes_($a) == "" } {
			set n "a=$a"
		} else {
			set n "a=$a:$attributes_($a)"
		}
		set o $o\n$n
	}
	foreach m $allmedia_ {
		set n [$m obj2str]
		set o $o\n$n
	}
	return $o
}
SDPMessage public unique_key {} {
    if ![$self have_field o] {
	$self warn "in SDPMessage::unique_key without o= field"
	return ""
    }
    set l [split [$self field_value o]]
    set l [lreplace $l 2 2]
    set key [join $l :]
    return $key
}
SDPMessage instproc htmlify_media { } {
    set html {}
    foreach media [$self set allmedia_] {
	append html [$media create_dynamic_html \
		[DynamicHTMLifier set html_(media)]]
    }
    return $html
}
SDPMessage instproc htmlify_times { {single_line 0} } {
    set html {}
    if $single_line { set t time1 } else { set t time }
    foreach time [$self set alltimedes_] {
	set repeat [string tolower [$time readable_repeat]]
	if { [$time set starttime_] != 0 } {
	    append html [$time create_dynamic_html \
			    [DynamicHTMLifier set html_(${t}_$repeat)]]
	} else {
	    append html "Unbounded session"
	}
    }
    return $html
}
SDPMessage instproc htmlify_url { } {
    $self instvar uri_
    if [info exists uri_] {
	return "<a href=\"$uri_\">$uri_</a>"
    } else {
	return ""
    }
}
SDPMessage instproc htmlify_list { varname } {
    set list {}
    foreach elt [$self get $varname] {
	if { $list!={} } {
	    append list ", $elt"
	} else {
	    append list $elt
	}
    }
    return $list
}
SDPMessage instproc get { varname } {
    $self instvar $varname
    if [info exists $varname] {
	return [set $varname]
    } else {
	return ""
    }
}
SDPMedia instproc htmlify_mediatype { } {
    return "[$self set mediatype_]"
}
SDPMedia instproc get { varname } {
    $self instvar $varname
    if [info exists $varname] {
	return [set $varname]
    } elseif { $varname == "spec_" } {
	    set caddr [split [$self get caddr_] /]
	    set port [$self get port_]
	    set spec [lindex $caddr 0]/$port
	    set ttl [lindex $caddr 1]
	    if { $ttl != {} } { append spec /$ttl }
	    return $spec
    } else {
	return ""
    }
}
SDPMedia instproc init {{msg ""}} {
	$self next
	if {$msg == ""} { return }
	$self instvar attributes_ fields_
	set alist [$msg attributes]
	foreach a $alist {
		set attributes_($a) [$msg set attributes_($a)]
	}
	set vlist [$msg info vars]
	foreach f { session_info_ nettype_ addrtype_ caddr_ bwmod_ bwval_
		crypt_method_ crypt_key_ } {
		if { [lsearch -exact $vlist $f] >= 0 } {
			$self set $f [$msg set $f]
		}
	}
	foreach f { i c b k a } {
		if [$msg have_field $f] {
			set fields_($f) [$msg field_value $f]
		}
	}
}
SDPMedia instproc have_field { field } {
	$self instvar fields_
	return [info exists fields_($field)]
}
SDPMedia instproc field_value { field } {
	$self instvar fields_
	if [info exists fields_($field)] {
		return $fields_($field)
	} else {
		return ""
	}
}
SDPMedia instproc have_attr { name } {
	$self instvar attributes_
	return [info exists attributes_($name)]
}
SDPMedia instproc attr_value { name } {
    $self instvar attributes_
    if [info exists attributes_($name)] {
	    return $attributes_($name)
    } else {
	    return ""
    }
}
SDPMedia instproc attributes {} {
	$self instvar attributes_
	if [info exists attributes_] {
		return [array names attributes_]
	} else {
		return ""
	}
}
SDPMedia instproc obj2str {} {
	$self instvar attributes_
	set o "m=[$self field_value m]"
	foreach f { i c b k } {
		if [$self have_field $f] {
			set n "$f=[$self field_value $f]"
			set o $o\n$n
		}
	}
	foreach a [array names attributes_] {
		if { $attributes_($a) == "" } {
			set n "a=$a"
		} else {
			set n "a=$a:$attributes_($a)"
		}
		set o $o\n$n
	}
	return $o
}
SDPTime instproc have_field { field } {
	$self instvar fields_
	return [info exists fields_($field)]
}
SDPTime instproc field_value { field } {
	$self instvar fields_
	if [info exists fields_($field)] {
		return $fields_($field)
	} else {
		return ""
	}
}
SDPTime instproc obj2str {} {
	set o "t=[$self field_value t]"
	if [$self have_field r] {
		set n "r=[$self field_value r]"
		set o $o\n$n
	}
	return $o
}
SDPTime public get { varname } {
    $self instvar $varname
    if [info exists $varname] {
	return [set $varname]
    } else {
	return ""
    }
}
SDPTime public sec_until_current { time_type } {
    set sdp_time [ntp_to_unix [$self get $time_type]]
    set current [clock seconds]
    return [expr $sdp_time - $current]
}
SDPTime public current_in_interval { start end } {
    set current [unix_to_ntp [clock seconds]]
    if { [expr $start == 0 && $end == 0] } {
	return 1
    } elseif { $start == 0 } {
	return [expr $end > $current]
    } elseif { $end == 0 } {
	return [expr $start <= $current]
    } else {
	return [expr $start <= $current && $end > $current]
    }
}
SDPTime public readable_time { time_type } {
    set sec [ntp_to_unix [$self get $time_type]]
    if { $sec == 0 } {
	return *unbounded*
    } else {
	return [clock format $sec -format {%H:%M}]
    }
}
SDPTime public readable_duration { } {
    set duration [$self get active_duration_]
    set hours [expr $duration / 3600]
    if { $hours < 24 } {
	return "$hours hour(s)"
    }
    set days [expr $hours / 24]
    if { $days < 7 } {
	return "$days day(s)"
    }
    set weeks [expr $days / 7]
    return "$weeks week(s)"
}
SDPTime public readable_date { time_type {numonly 0} } {
    set sec [ntp_to_unix [$self get $time_type]]
    if { $sec == 0 } {
	return *unbounded*
    } elseif $numonly {
	return [clock format $sec -format {%m/%d/%y}]
    } else {
	return [clock format $sec -format {%B %d, %Y}]
    }
}
SDPTime public readable_day { time_type } {
    set sec [ntp_to_unix [$self get $time_type]]
    if { $sec == 0 } {
	return *unbounded*
    } else {
	return [clock format $sec -format {%a}]
    }
}
SDPTime public readable_day_full { time_type } {
    set sec [ntp_to_unix [$self get $time_type]]
    if { $sec == 0 } {
	return *unbounded*
    } else {
	return [clock format $sec -format {%A}]
    }
}
SDPTime public readable_zone { time_type } {
    set sec [ntp_to_unix [$self get $time_type]]
    return [clock format $sec -format {%Z}]
}
SDPTime public readable_repeat { } {
    set interval [$self get repeat_interval_]
    if { $interval == 86400 } {
	return Daily
    } elseif { $interval == 604800 } {
	return Weekly
    } else {
	return None
    }
}
Class MeGa
MeGa instproc init args {
	eval $self next $args
	$self set sdp_ [new SDPParser]
}
MeGa instproc destroy {} {
	$self instvar sdp_
	delete $sdp_
	$self next
}
MeGa proc ctrlchan { media spec } {
	set tmp [split $spec /]
	set addr [lindex $tmp 0]
	if ![in_multicast $addr] {
		return $spec
	}
	set port [lindex $tmp 1]
	switch $media {
	video {
		incr port 2
	}
	audio {
		incr port 4
	}
	mb {
		incr port 6
	}
	sdp {
		incr port 8
	}
	hm {
		incr port 10
	}
	}
	set ttl [lindex $tmp 2]
	return $addr/$port/$ttl
}
Class AnnounceListenManager/AS/Client/MeGa \
		-superclass { AnnounceListenManager/AS/Client MeGa }
Class AnnounceListenManager/AS/Client/MeGa/Audio \
	-superclass { AnnounceListenManager/AS/Client/MeGa RTP/Audio }
Class AnnounceListenManager/AS/Client/MeGa/Video \
	-superclass { AnnounceListenManager/AS/Client/MeGa RTP/Video }
AnnounceListenManager/AS/Client/MeGa instproc init { agent spec bw toolname media sname sspec rportspec ofmt srv_loc } {
	set spec [MeGa ctrlchan $media $spec]
	$self next $spec $bw $srv_loc
	$self instvar agent_ toolname_ sname_ sspec_ media_ rportspec_ ofmt_
	set toolname_ $toolname
	set media_ $media
	set sname_ $sname
	set sspec_ $sspec
	set rportspec_ $rportspec
	set ofmt_ $ofmt
	set agent_ $agent
	$self instvar srv_inst_
	[$self get_timer] threshold 15000
	set srv_inst_ [$self service_instance]
}
AnnounceListenManager/AS/Client/MeGa instproc reset_spec {sspec} {
    $self instvar sspec_ srv_inst_ index_
    set sspec_ $sspec
    set rand [random]
    set index_ $rand
    set srv_inst_ [$self service_instance]
}
AnnounceListenManager/AS/Client/MeGa instproc recv_msg { atype aspec addr srv_name srv_loc srv_inst ssg_port msg } {
	if { $atype != "srv" } {
		return
	}
	$self instvar agent_ srv_inst_
	if { $srv_inst_ != $srv_inst } {
		return
	}
	$self instvar sdp_
	set msg [$sdp_ parse $msg]
	if { $msg == "" } {
		return
	}
	if [$agent_ have_network] {
		set addr [$agent_ session-addr]
		set sport [$agent_ session-sport]
		set rport [$agent_ session-rport]
		set ttl [$agent_ session-ttl]
		set curspec $addr/$sport:$rport/$ttl
	} else {
		set curspec ""
		set ttl -1
	}
	set media [$msg set allmedia_]
	$self instvar media_ rportspec_
	foreach mrec [$msg set allmedia_] {
		if [$mrec have_attr global] {
			continue
		}
		set tmp [split [$mrec set caddr_] /]
		set laddr [lindex $tmp 0]
		set lttl [lindex $tmp 1]
		set pspec [split [$mrec set port_] :]
		set sport [lindex $pspec 0]
		set rport [lindex $pspec 1]
		set myrport [lindex [split $rportspec_ :] 0]
		if { ([in_multicast $laddr] && $myrport == 0) || \
		     ($laddr == [localaddr] && $sport == $myrport) } {
	     		if { ![in_multicast $laddr] } {
				set laddr [$msg set createaddr_]
			}
	     		set newspec $laddr/$rport:$sport/$lttl
			if { $newspec != $curspec } {
				set fmt [$mrec set fmt_]
				set fmt [$self format_name $fmt]
				if { $fmt == "" } {
					set fmt null
				}
				$agent_ reset_spec \
						$laddr/$rport:$sport/$fmt/$lttl
				$self send_announcement
			}
			delete $msg
	     		return
		}
	}
	delete $msg
}
AnnounceListenManager/AS/Client/MeGa private format_name { fmt } {
	return ""
}
AnnounceListenManager/AS/Client/MeGa/Audio private format_name { fmt } {
	return [$self rtp_type $fmt]
}
AnnounceListenManager/AS/Client/MeGa/Video private format_name { fmt } {
	return [$self rtp_type $fmt]
}
AnnounceListenManager/AS/Client/MeGa instproc register { atype aspec addr srv_name srv_inst msg } {
}
AnnounceListenManager/AS/Client/MeGa instproc unregister { atype aspec addr srv_name srv_inst msg } {
}
AnnounceListenManager/AS/Client/MeGa public agent_data {} {
	$self instvar id1_ id2_ agent_ media_ agent_ sname_ sspec_ \
		toolname_ rportspec_ ofmt_
	set o "v=0"
	set n "o=client [pid] 0 IN IP4 [localaddr]"
	set o $o\n$n
	set n "s=$sname_"
	set o $o\n$n
	set n "c=IN IP4 $sspec_"
	set o $o\n$n
	if { $media_ == "video" } {
		set n "b=AS:[$agent_ set sessionbw_]"
		puts "!!SESSIONBW $n"
		set o $o\n$n
		set n "t=0 0"
		set o $o\n$n
		if { [$self get_option localScubaScope] != "" } {
			set n "a=localscuba"
			set o $o\n$n
		}
	} else  {
		set n "t=0 0"
		set o $o\n$n
	}
	set n "a=tool:$toolname_"
	set o $o\n$n
	set fmt [$self format_num $ofmt_]
	set rportspec [split $rportspec_ :]
	set rport [lindex $rportspec 0]
	set n "m=$media_ $rport RTP/AVP $fmt"
	set o $o\n$n
	if [$agent_ have_network] {
		set addr [$agent_ session-addr]
		set sport [$agent_ session-sport]
		set rport [$agent_ session-rport]
		set ttl [$agent_ session-ttl]
		set n "c=IN IP4 $addr/$sport:$rport/$ttl"
	} else {
		set n "c=IN IP4 none"
	}
	set o $o\n$n
	return $o
}
AnnounceListenManager/AS/Client/MeGa private format_num { fmt } {
	return -1
}
AnnounceListenManager/AS/Client/MeGa/Video private format_num { fmt } {
	return [$self rtp_fmt_number $fmt]
}
AnnounceListenManager/AS/Client/MeGa/Audio private format_num { fmt } {
	return [$self rtp_fmt_number $fmt]
}
AnnounceListenManager/AS/Client/MeGa instproc service_name {} {
	return MeGa
}
AnnounceListenManager/AS/Client/MeGa instproc service_instance {} {
	$self instvar sname_ rportspec_ media_ index_
	set o $sname_:$media_
	set rportspec [split $rportspec_ :]
	set rport [lindex $rportspec 0]
	if { $rport != 0 } {
		set o $o:[localaddr]/$rport
	    if {[info exists index_]} {
		set o $o:$index_
	    }
	}
	return $o
}
AnnounceListenManager/AS/Client/MeGa instproc agent_instance {} {
    $self instvar index_
    if {[info exists index_]} {
	return "[pid]@[lookup_host_name [localaddr]]:$index_"
    } else {
	return "[pid]@[lookup_host_name [localaddr]]"
    }
}
AnnounceListenManager/AS/Client/MeGa instproc ssg_port {} {
	$self instvar rportspec_
	set rportspec [split $rportspec_ :]
	set rport [lindex $rportspec 0]
	if { $rport != 0 } {
		return [lindex $rportspec 1]
	} else {
		return "-"
	}
}
Class MBNet -configuration {
	megaMbFormat null
	megaRecvMbPort 0
	mbSessionBW 20
	megaMbCtrl 224.4.5.24/50000/31
	megaMbCtrlBW 20000
	mbServiceLocation urn:mbgw
	delayParams default
        mbSessionSpec "224.2.55.66/8000"
}
MBNet instproc init { ui mbMgr } {
        global mb
	set srcList [$ui set srcList_]
	set pageList [[$ui set pageNavPanel_] set pageList_]
        $mbMgr proc new_source { src } "$srcList register \$src"
        $mbMgr proc cname_update { src newname }  \
		    "$srcList update_src_info \$src \$newname ; \
		     $pageList update_src_info \$src \$newname"
        set luid [$self get_option uid]
	if { $luid != "" } {
		set luid [format %x $luid]
	}
	$self instvar mbAgent_ addr_
        set mbAgent_ [new SRMAgent $luid]
 	if { [$self get_option megaMbSession] != "" } {
		$self start_mega
		set prefix [$self get_option iconPrefix]
		set hostname [lindex [split [info hostname] .] 0]
		append prefix "@" $hostname ":"
		set conf "Contacting MeGa..."
		$ui window_title $prefix $conf
	} else {
		set addr_ [$self get_option mbSessionSpec]
	}
	$self instvar session_
        set session_ [$mbAgent_ create-session $mbMgr $mbMgr]
        $mbMgr attach_session $session_
	set params [$self get_option delayParams]
	if {"$params"!="default"} {
		eval $session_ delay-params $params
	}
	$mbMgr attach_ui $ui
}
MBNet public start_mega { } {
	$self instvar al_ mbAgent_ addr_
	if [info exists al_] { delete $al_ }
 	if { [$self get_option megaMbSession] != "" } {
		set sname [$self get_option megaMbSession]
		set sspec [$self get_option mbSessionSpec]
		set rportspec [$self get_option megaRecvMbPort]
		set ofmt [$self get_option megaMbFormat]
		set sbw [$self get_option mbSessionBW]
		set bw [expr 0.02*$sbw*1000]
		set megaspec [$self get_option megaMbCtrl]
		set loc [$self get_option mbServiceLocation]
		set al_ [new AnnounceListenManager/AS/Client/MeGa \
				$mbAgent_ $megaspec $bw mb mb \
				$sname $sspec $rportspec $ofmt $loc]
		$al_ start
		set addr_ ""
	}
}
MBNet public reset_mega {} {
	$self instvar al_
	if ![info exists al_] {
		$self start_mega
	} else {
		$al_ reset_spec [$self get_option mbSessionSpec]
	}
}
MBNet instproc adjust_spec {} {
	$self instvar mbAgent_ addr_
	if { $addr_ != "" } {
		set comps [split $addr_ /]
		if {[llength $comps] > 2} {
			$self add_default defaultTTL [lindex $comps 2]
		}
 		$mbAgent_ reset_spec [lindex $comps 0]/[lindex $comps 1]
	}
}
MBNet instproc session { } {
	$self instvar session_
	return $session_
}
MBNet instproc mbAgent { } {
	$self instvar mbAgent_
	return $mbAgent_
}
Class MBApp -superclass RTPApplication
MBApp public init { widgetPath argv } {
	$self instvar mbui_
        $self next mb
	set o [$self options]
	$self init_args $o
        $self init_resources $o
        $self init_fonts $o
	$o load_preferences "mb"
	set argv [$o parse_args $argv]
        MTrace init {trcMB}
	$self check_rtp_sdes
        $self init_variables
        $self init_UI $widgetPath
	$self instvar mgr_
	set mbnet [new MBNet $mbui_ $mgr_]
	$self instvar session_ mbAgent_
	set session_ [$mbnet session]
	set mbAgent_ [$mbnet mbAgent]
	$mbnet adjust_spec
        set logf [$o get_option playScript]
        if {"none" != $logf} {
                global mb
                set isRT [$config get_option rtPlay]
                set player [new Tcl_Player $logf [$self set sender_] $isRT]
                after 15000 $player start
        }
	$self init_local
}
MBApp public destroy {} {
        $self instvar mbAgent_ mbui_ mgr_
        global mb
	delete $mbAgent_
	delete $mbui_
	delete $mb(gsinterp)
	delete $mgr_
}
MBApp public exit {} {
	delete $self
	exit
}
MBApp instproc init_args {o} {
	$o register_option -u    uid
	$o register_option -dbg  debug
	$o register_option -sa   mbSessionSpec
	$o register_option -ui   showUI
	$o register_option -drop drop
	$o register_option -play playScript
	$o register_option -rt   rtPlay
	$o register_option -rec  record
	$o register_option -tr   trace
	$o register_option -dp   delayParams
	$o register_option -follow followActive
	$o register_option -C conferenceName
	$o register_option -K sessionKey
	$o register_boolean_option -recvonly recvOnly
	$o register_option -geometry geometry
	$o register_option -rport megaRecvMbPort
	$o register_option -ofmt megaMbFormat
	$o register_option -usemega megaMbSession
	$o register_option -megactrl megaMbCtrl
	$o register_option -sspec mbSessionSpec
	$o register_option -maxsbw maxMbSessionBW
	$o register_option -sbw mbSessionBW
	$o register_option -sloc mbServiceLocation
}
MBApp instproc ui_init_default { } {
	option add *Button*HighlightThickness 1 19
	option add *Button*BorderWidth 1 19
	option add *Scrollbar*HighlightThickness 1 19
	option add *Scrollbar*BorderWidth 1 19
	set scrollbar [scrollbar .___scrollbar___]
	set scrollbarWidth [$scrollbar cget -width]
	set scrollbarWidth [expr {($scrollbarWidth * 2)/3}]
	destroy $scrollbar
	option add *Scrollbar*Width $scrollbarWidth 19
	option add *Entry*HighlightThickness 1 19
	option add *Entry*BorderWidth 2 19
	option add *Entry*Background White 19
	option add *Menubutton*HighlightThickness 1 19
	option add *Menubutton*BorderWidth 1 19
}
MBApp instproc init_variables {} {
        global mb
        $self ui_init_default
        catch {unset mb}
	$self instvar sender_
        if {[$self get_option record]==1} {
                set sender_ [new Tcl_Recorder MB_Sender]
        } else {
                set sender_ [new MB_Sender]
        }
	$self instvar mgr_
	set mgr_ [new MB_Manager]
	set pageMgr [new MBPageMgr $mgr_]
	$mgr_ attach_page_manager $pageMgr
	$mgr_ attach_sender $sender_
}
MBApp instproc reset { ab } {
	$self instvar mbAgent_ mbui_ mgr_ session_
	set nm [$mbAgent_ set network_]
	$nm loopback 1
	$self instvar have_network_
	if {![info exists have_network_] || $have_network_ == 0} {
		$session_ start_timers
		[$self set sender_] attach $mgr_
		set have_network_ 1
	}
	$mbui_ reset $session_
}
MBApp instproc init_UI { widgetPath } {
        $self instvar mgr_ sender_
	frame $widgetPath
        $self set mbui_ [ new MBUI $widgetPath $mgr_ $sender_ [$self get_option showUI] "$self exit" ]
	pack $widgetPath -expand 1 -fill both
}
if { $tcl_version < 8 } {
	MBApp instproc search_font { foundry style weight points attr} {
		global font tcl_version
		$self instvar name_
		foreach f $font($points) {
                set fname -$foundry-$style-$weight-$attr-$f
			if [havefont $fname] {
				return $fname
			}
		}
		puts stderr "Mb: can't find $weight $fname font (using fixed)"
		if ![havefont fixed] {
			puts stderr "Mb: can't find fixed font"
			exit 1
		}
		return fixed
	}
}
MBApp instproc init_fonts {o} {
	new FontInitializer $o
        $o add_option smallfont [$o get_option helv10]
        $o add_option medfont [$o get_option helv12]
        $o add_option helpFont [$o get_option times12]
}
MBApp instproc init_resources {o} {
        global env
        $self instvar class_
        option add *Radiobutton.relief flat startupFile
        $o add_default debug 1
        $o add_default playScript none
        $o add_default rtPlay 0
        $o add_default record 0
        $o add_default iconPrefix MediaBoard
        $o add_default showUI 1
        $o add_default trace none
	$o add_default defaultTTL 31
}
new MBApp .[pid] $argv
