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

#
# Copyright (c) 1993-1996 The Regents of the University of California.
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. All advertising materials mentioning features or use of this software
#    must display the following acknowledgement:
#	This product includes software developed by the University of
#	California, Berkeley and the Network Research Group at
#	Lawrence Berkeley Laboratory.
# 4. Neither the name of the University nor of the Laboratory may be used
#    to endorse or promote products derived from this software without
#    specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#
# @(#) $Header: /usr/src/mash/repository/mash/mash-1/head.tcl,v 1.3 1997/08/15 07:23:36 mccanne Exp $ (LBL)
#
proc havefont { f } { return 1 }
Import enable
Class Log
Log proc name s {
	Log set name_ $s
}
Log proc warn s {
	Log instvar name_
	puts stderr "$name_: $s"
}
Log proc fatal s {
	Log warn $s
	exit 1
}
Class Application
Application public init name {
	$self next
	$self instvar name_ class_
	set name_ $name
	$self add_option appname $name
	Log set name_ $name
	set class_ [string toupper [string index $name_ 0]][string \
		range $name_ 1 end]
	catch "tk appname $name"
	Application set instance_ $self
}
Application proc instance {} {
	return [Application set instance_]
}
Application proc name {} {
	return [[Application instance] set name_]
}
Application proc class {} {
	return [[Application instance] set class_]
}
Application proc toplevel w {
	Application instvar visual_ colormap_
	if [info exists visual_] {
		toplevel $w -class [Application class] \
			-visual $visual_ -colormap $colormap_
	} else {
		toplevel $w -class [Application class]
	}
}
global font
set font(helvetica10) {
	normal--*-100-75-75-*-*-*-*
	normal--10-*-*-*-*-*-*-*
	normal--11-*-*-*-*-*-*-*
	normal--*-100-*-*-*-*-*-*
	normal--*-*-*-*-*-*-*-*
}
set font(helvetica12) {
	normal--*-120-75-75-*-*-*-*
	normal--12-*-*-*-*-*-*-*
	normal--14-*-*-*-*-*-*-*
	normal--*-120-*-*-*-*-*-*
	normal--*-*-*-*-*-*-*-*
}
set font(helvetica14) {
	normal--*-140-75-75-*-*-*-*
	normal--14-*-*-*-*-*-*-*
	normal--*-140-*-*-*-*-*-*
	normal--*-*-*-*-*-*-*-*
}
set font(times14) {
	normal--*-140-75-75-*-*-*-*
	normal--14-*-*-*-*-*-*-*
	normal--*-140-*-*-*-*-*-*
	normal--*-*-*-*-*-*-*-*
}
Application instproc search_font { foundry style weight points slant } {
	global font tcl_version tcl_platform
 	if {$tcl_version >= 8} {
 		if {$slant == "r"} {
 			set slant ""
 		} elseif {$slant == "o"} {
 			set slant "italic"
 		}
		if {$weight == "medium"} {
			set weight ""
		}
 		return "$style -$points $weight $slant"
 	}
	foreach f $font($style$points) {
		set fname -$foundry-$style-$weight-$slant-$f
		if [havefont $fname] {
			return $fname
		}
	}
	$self instvar name_
	puts stderr "$name_: can't find $weight $fname font (using fixed)"
	if ![havefont fixed] {
		puts stderr "$name_: can't find fixed font"
		exit 1
	}
	return fixed
}
Application public init_local {} {
	$self instvar name_
	set f ~/.$name_.tcl
	if [file exists $f] {
		uplevel #0 "source $f"
	}
	set script [$self resource startupScript]
	if { $script != "" } {
		uplevel #0 "source $script"
	}
}
Application instproc user_hook {} {
}
Object instproc options {} {
	$self instvar options_
	if ![info exists options_] {
		Object instvar options_
		if ![info exists options_] {
			set options_ [new Configuration]
			global tcl_platform
			if {"$tcl_platform(platform)"=="windows"} {
				$options_ add_default \
					background SystemButtonFace
				$options_ add_default \
					infoHighlightColor SystemHighlightText
			}
		}
	}
	$options_ add_default appname mash
	return $options_
}
Object instproc optionsFrom o {
	$self set options_ $o
}
Class instproc configuration a {
 	$self instvar options_
	if ![info exists options_] {
		set options_ [new Configuration]
	}
	foreach { option value } $a {
		$options_ add_default $option $value
	}
}
Object instproc get_option r {
	set v [[$self options] get_option $r]
	if { $v != "" } {
		return $v
	}
	set cl [$self info class]
	foreach cl "$cl [$cl info heritage]" {
		$cl instvar options_
		if [info exists options_] {
			set v [$options_ get_option $r]
			if { $v != "" } {
				return $v
			}
		}
	}
	return ""
}
Object instproc resource r {
	return [$self get_option $r]
}
Object instproc add_option { r v } {
	return [[$self options] add_option $r $v]
}
Object instproc add_default { r v } {
	return [[$self options] add_default $r $v]
}
Object instproc yesno r {
	set v [$self get_option $r]
	if [string match \[0-9\]* $v] {
		return $v
	}
	if [string match \[tT\]* $v] {
		return 1
	}
	return 0
}
Object instproc debug s {
	if [$self yesno debug] {
		Log warn $s
	}
}
Object instproc warn s {
	Log warn $s
}
Object instproc fatal s {
	Log fatal $s
}
Class Configuration
Configuration public get_option r {
	$self instvar table_ default_
	if [info exists table_($r)] {
		return $table_($r)
	}
	if [info exists default_($r)] {
		return $default_($r)
	}
	return ""
}
Configuration public add_option { r v } {
	$self instvar table_
	set table_($r) $v
}
Configuration public add_default { r v } {
	$self set default_($r) $v
}
Configuration public register_option  { flag option args } {
	$self instvar arg_option_ usage_
	set arg_option_($flag) $option
	set usage_($flag) $args
}
Configuration public register_boolean_option  { flag option args } {
	$self instvar arg_bool_ arg_bool_val_
	set arg_bool_($flag) $option
	if { $args == "" } {
		set args 1
	}
	set arg_bool_val_($flag) $args
}
Configuration public register_list_option {flag option args} {
	$self instvar arg_list_option_
	set arg_list_option_($flag) $option
	set usage_($flag) $args
}
Configuration private is_arg argv {
	if { $argv != "" } {
		return [string match -* [lindex $argv 0]]
	}
	return 0
}
Configuration instproc parse_args argv {
	$self instvar arg_resource_ bool_resource_ 
	$self instvar arg_option_ arg_bool_ arg_bool_val_ arg_list_option_
	if { [info exists arg_resource_] || [info exists bool_resource_] } {
		puts stderr "your application class needs to be fixed"
		exit 1
	}
	while 1 {
		if ![$self is_arg $argv] {
			break
		}
		set arg [lindex $argv 0]
		set argv [lrange $argv 1 end]
		set val [lindex $argv 0]
		if { $arg == "-help" } {
			$self usage
			exit
		}
		if { $arg == "-X" } {
			set L [split $val =]
			if { [llength $L] != 2 } {
				puts stderr "malformed -X argument"
				exit 1
			}
			$self add_option [lindex $L 0] [lindex $L 1]
			set argv [lrange $argv 1 end]
			continue
		}
		if [info exists arg_option_($arg)] {
			$self add_option $arg_option_($arg) $val
			set argv [lrange $argv 1 end]
			continue
		}
		if [info exists arg_bool_($arg)] {
			$self add_option $arg_bool_($arg) $arg_bool_val_($arg)
			continue
		}
		if [info exists arg_list_option_($arg)] {
			set o $arg_list_option_($arg)
			set l [$self get_option $o]
			lappend l $val
			$self add_option $o $l
			set argv [lrange $argv 1 end]
			continue
		}
		$self usage
		$self fatal "unknown command option: $arg"
	}
	return $argv
}
Configuration public usage {} {
	set display_args_on_single_line 0
	if { $display_args_on_single_line } {
		puts "usage: [Application name] [join [$self arg_info]]"
	} else {
		puts "usage: [Application name]" 
		foreach arg [$self arg_info] {
			puts $arg
		}
	}
}
Configuration private arg_info {} {
	$self instvar arg_option_ arg_bool_ usage_
	foreach arg [array names arg_option_] {
		set r $arg_option_($arg)
		set d [$self get_option $r]
		if { $d != "" || $usage_($arg) != "required"} {
			lappend opt "\[$arg $r ($d)\]"
		} else {
			lappend req "$arg $r"
		}
	}
	foreach arg [array names arg_bool_] {
		set r $arg_bool_($arg)
		set d [$self get_option $r]
		if { $d != "" } {
		        lappend opt "\[$arg ($d)\]"
		} else {
			lappend opt "\[$arg\]"
		}
	}
	if [info exists opt] {
		if [info exists req] {
			return [concat $opt $req]
		} else {
			return $opt
		}
	} else {
		if [info exists req] {
			return $req
		} else {
			return ""
		}
	}
}
Configuration public load_preferences suffixList {
	set mash [glob ~]/.mash
	if [file isdirectory $mash] {
		$self load_file $mash/prefs
		foreach suffix $suffixList {
			$self load_file $mash/prefs-$suffix
		}
	}
}
Configuration private load_file fname {
	if ![file readable $fname] {
		return
	}
	set f [open $fname r]
	set count 0
	while 1 {
		incr count
		if [eof $f] {
			close $f
			return
		}
		set line [string trim [gets $f]]
		if { $line == {} || [string index $line 0]=="#" } {
			continue
		}
		set colon [string first ":" $line]
		if { $colon==-1 } {
			puts stderr "Invalid line $count in $fname:\
					Must be of the form \"key: value\""
			continue
		}
		set option [string trim [string range $line 0 [expr $colon-1]]]
		set value [string trim [string range $line \
				[expr $colon+1] end]]
		$self add_option $option $value
	}
}
Object instproc has_method { method } {
	if { [$self info procs $method]!="" } {
		return 1
	}
	return [[$self info class] has_method $method]
}
Class instproc has_method { method } {
	if { [$self info instprocs $method]!="" } {
		return 1
	}
	foreach cl [$self info heritage] {
		if { [$cl info instprocs $method]!="" } {
			return 1
		}
	}
	return 0
}
proc version {} {
	global mash
	return $mash(version)
}
proc local_fqdn {} {
	set host ""
	catch {set host [lookup_host_name [localaddr]]}
	if { [string first . $host] < 0 } {
		return ""
	}
	return $host
}
proc email_heuristic {} {
	set user [user_heuristic]
	set addr [local_fqdn]
	if { $addr == "" } {
		return ""
	}
	return $user@$addr
}
proc user_heuristic {} {
	global env
	if [info exists env(USER)] {
		set user $env(USER)
	} elseif [info exists env(LOGNAME)] {
		set user $env(LOGNAME)
	} else {
		catch {set env(USER) [getusername]}
		if [info exists env(USER)] {
			return $env(USER)
		}
		return "UNKNOWN"
	}
}
proc format_fps f {
	set fps $f
	if { $fps < .1 } {
		set fps "0 f/s"
	} elseif { $fps < 10 } {
		set fps [format "%.1f f/s" $fps]
	} else {
		set fps [format "%2.0f f/s" $fps]
	}
	return $fps
}
proc format_bps b {
	set bps $b
	if { $bps < 1 } {
		set bps "0 bps"
	} elseif { $bps < 1000 } {
		set bps [format "%3.0f bps" $bps]
	} elseif { $bps < 1000000 } {
		set bps [format "%3.1f kb/s" [expr $bps / 1000.]]
	} else {
		set bps [format "%.2f Mb/s" [expr $bps / 1000000.]]
	}
	return $bps
}
proc gettime {sec} {
    clock format $sec
}
proc sdr_gettimeofday {} {
    clock seconds
}
proc gettimenow {} {
    gettime [clock seconds]
}
proc getreadabletime {} {
    return [clock format [clock seconds] -format {%H:%M, %d/%m/%y}]
}
proc unix_to_ntp {unixtime} {
    set oddoffset 2208988800
    if {$unixtime==0} {return 0}
    return [format %u [expr $unixtime + $oddoffset]]
}
proc ntp_to_unix {ntptime} {
    set oddoffset 2208988800
    if {($ntptime==0)||($ntptime==1)} {return $ntptime}
    return [format %u [expr $ntptime - $oddoffset]]
}
proc duration_readable {secs {option terse}} {
	set ret ""
	set r [expr round($secs)]
	set h [expr $r / 3600]
	set r [expr $r % 3600]
	set m [expr $r / 60]
	set s [expr $r % 60]
	if {$option == "verbose"} then {
		if {$h} {
			set ret "$ret $h\h"
		} 
		if {$m} {
			set ret "$ret $m\m"
		} 
		if {$s} {
			set ret "$ret and $s\s"
		} 
	} else {
		set ret "$h:$m:$s"
	}
		return $ret
}
Class RTPApplication -superclass Application
RTPApplication public init name {
	$self next $name
}
RTPApplication public run_resource_dialog { name email } {
	set font [$self get_option medfont]
	set w .form
	global V
	frame $w
	frame $w.msg -relief ridge
	label $w.msg.label -font $font -wraplength 4i \
		-justify left -text \
"Please specify values for the following resources. \
These strings will identify you by name and by email address \
in any RTP-based conference.  Please use your real name and \
affiliation instead of a ``handle'', e.g., ``Jane Doe (ACME Research)''. \
The values you enter will be saved in ~/.mash/prefs so you will \
not have to re-enter them." -relief ridge
	pack $w.msg.label -padx 6 -pady 6
	pack $w.msg -side top
	foreach i {name email} {
		frame $w.$i -bd 2
		entry $w.$i.entry -relief sunken
		label $w.$i.label -width 10 -anchor e
		pack $w.$i.label -side left
		pack $w.$i.entry -side left -fill x -expand 1 -padx 8
	}
	$w.name.label config -text rtpName:
	$w.email.label config -text rtpEmail:
	pack $w.msg -pady 10
	pack $w.name $w.email -side top -fill x
	$w.$i.entry insert 0 [email_heuristic]
	frame $w.buttons
	button $w.buttons.accept -text Accept -command "set dialogDone 1"
	button $w.buttons.dismiss -text Quit -command "set dialogDone -1"
	pack $w.buttons.accept $w.buttons.dismiss \
		-side left -expand 1 -padx 20 -pady 10
	pack $w.buttons
	pack $w -padx 10
	global dialogDone
	while { 1 } {
		set dialogDone 0
		focus $w.name.entry
		tkwait variable dialogDone
		if { $dialogDone < 0 } {
			exit 0
		}
		set name [string trim [$w.name.entry get]]
		if { [string length $name] <= 3 } {
			new ErrorWindow "please enter a reasonable name"
			continue
		}
		set email [string trim [$w.email.entry get]]
		if { [string first . $email] < 0 || \
			[string first @ $email] < 0 } {
			new ErrorWindow "email address should have form user@host.domain"
			continue
		}
		break
	}
	set mash [glob ~]/.mash
	if ![file exists $mash] {
		file mkdir $mash
	}
	set f [open $mash/prefs a+ 0644]
	puts $f "rtpName: $name"
	puts $f "rtpEmail: $email"
	close $f
	pack forget $w
	destroy $w
}
RTPApplication public check_rtp_sdes {} {
	set name [$self get_option rtpName]
	if { $name == "" } {
		set name [$self get_option sessionName]
		option add *rtpName $name startupFile
	}
	set email [$self get_option rtpEmail]
	if { $name == "" || $email == "" } {
		$self run_resource_dialog $name $email
	}
}
RTPApplication private check_hostspec { argv megaSession } {
	if { $argv == "" } {
		if { $megaSession == "" } {
			$self fatal "destination address required"
		}
	} elseif { [llength $argv] > 1 } {
		set extra [lindex $argv 1]
		$self fatal "extra arguments (starting with $extra)"
	}
	return $argv
}
set MTrace(trcNone)      {0x00000000 {none}}
set MTrace(trcNet)       {0x00000001 {Network}}
set MTrace(trcSRM)       {0x00000002 {SRM}}
set MTrace(trcArchive)   {0x00000004 {Archive}}
set MTrace(trcMB)        {0x00000008 {Mediaboard}}
set MTrace(trcFCA)       {0x00000010 {Floor control}}
set MTrace(trcLTS)       {0x00000020 {Logical Time System}}
set MTrace(trcTGMB)      {0x00000040 {TopGun MediaBoard}}
set MTrace(trcCB)        {0x00000080 {Coordination Bus}}
set MTrace(trcVerbose)   {0x20000000 {Verbose}}
set MTrace(trcExcessive) {0x40000000 {Excessive}}
set MTrace(trcTmp)       {0x80000000 {Temp}}
set MTrace(trcAll)       {0xFFFFFFFF {All}}
if { [Class info instances MTrace]=="" } {
    proc MTrace { args } {
	    return MTrace
    }
}
MTrace proc init { flags } {
	global MTrace
	MTrace instvar mtrace
	set mtrace [new MTrace]
	$mtrace create_window
	foreach flag $flags {
		if { [info exists MTrace($flag)] } {
			set bits [lindex $MTrace($flag) 0]
			set msg  [lindex $MTrace($flag) 1]
			$mtrace tkvar flag_$flag
			set flag_$flag 1
			$mtrace set_flag $bits
		}
	}
	return $mtrace
}
MTrace instproc create_window { } {
	global mash
	if { $mash(environ) == "smash" } return
	$self instvar path_
	global MTrace
	set count 0
	while { [winfo exists ".mtrace_$count"] } { incr count }
	set path_ ".mtrace_$count"
	toplevel $path_
	wm title $path_ "MASH Trace"
	wm withdraw $path_
	set main [frame $path_.main -bd 1 -relief sunken]
	pack $main -side top -fill both -expand 1 -padx 5 -pady 3
	foreach flag [array names MTrace] {
		$self tkvar flag_$flag
		set flag_$flag 0
		checkbutton $main.$flag -text [lindex $MTrace($flag) 1] \
				-variable [$self tkvarname flag_$flag] \
				-command "$self toggle_flag $flag" \
				-bd 1 -pady 0 -anchor w
		pack $main.$flag -pady 0 -padx 5 -fill x -expand 1
	}
	button $path_.button -text "Dismiss" -command "$self toggle_window" \
			-pady 0
	pack $path_.button -anchor e -padx 5 -pady 2
	return $path_
}
MTrace instproc toggle_window { } {
	global mash
	if { $mash(environ) == "smash" } return
	$self instvar path_
	if { [winfo ismapped $path_] } {
		wm withdraw $path_
	} else {
		wm deiconify $path_
	}
}
MTrace instproc toggle_flag { flag } {
	global MTrace
	$self tkvar flag_$flag
	if { [set flag_$flag] } {
		$self set_flag [lindex $MTrace($flag) 0]
	} else {
		$self reset_flag [lindex $MTrace($flag) 0]
	}
}
proc mtrace { flags args } {
        global MTrace
	set bits 0
	foreach flag [split $flags "|"] {
		set bits [expr $bits | [lindex $MTrace($flag) 0]]
	}
	MTrace instvar mtrace
	if [info exists mtrace] {
		$mtrace trace $bits $args
	}
}
Class 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 ctrl-port p {
	return [expr [$self data-port $p] + 1]
}
AddressBlock instproc addr {{k 0}} {
	return [$self set addr_($k)]
}
AddressBlock instproc sport {{k 0}} {
	return [$self set sport_($k)]
}
AddressBlock instproc rport {{k 0}} {
	return [$self set rport_($k)]
}
AddressBlock instproc ttl {{k 0}} {
	return [$self set ttl_($k)]
}
AddressBlock instproc nchan {} {
	return [$self set nchan_]
}
AddressBlock instproc parse s {
	set dst [split $s /]
	set n [llength $dst]
	if { $n < 2 } {
		return "must specify both address and port in the form addr/port"
	}
	set addr [lindex $dst 0]
	set ports [split [lindex $dst 1] :]
	set sport [lindex $ports 0]
	if { [llength $ports] == 1 } {
		set rport $sport
	} else {
		set rport [lindex $ports 1]
	}
	set firstchar [string index $addr 0]
	if [string match \[a-zA-Z\] $firstchar] {
		set s [gethostbyname $addr]
		if { $s == "" } {
			return "cannot lookup host name: $addr"
		}
		set addr $s
	}
	foreach port "$sport $rport" {
		if { ![string match \[0-9\]* $port] || $port >= 65536 } {
			$self fatal "illegal port '$port'"
		}
	}
	set ttl [$self get_option defaultTTL]
	set cnt 1
	if { $n >= 3 } {
		set fmt [lindex $dst 2]
		if { $n >= 4 } {
			set ttl [lindex $dst 3]
			if { $n > 4 } {
				set cnt [lindex $dst 4]
				if { ![string match \[0-9\]* $cnt] ||
				     $cnt >= 20 } {
					return "$dst: bad layered addr count"
					exit 1
				}
				if { $n > 5 } {
					return "$dst: malformed address"
				}
			}
		}
	}
	if { $ttl < 0 || $ttl > 255 } {
		return "$dst: invalid ttl ($ttl)"
	}
	set oct [split $addr .]
	set base [lindex $oct 0].[lindex $oct 1].[lindex $oct 2]
	set off [lindex $oct 3]
	$self instvar addr_ sport_ rport_ ttl_ nchan_
	set i 0
	while { $i < $cnt } {
		set sp [$self data-port $sport]
		set rp [$self data-port $rport]
		set addr_($nchan_) $base.$off
		set sport_($nchan_) $sp
		set rport_($nchan_) $rp
		set ttl_($nchan_) $ttl
		if [in_multicast $addr] {
			incr off
		}
		incr sport 2
		incr rport 2
		incr i
		incr nchan_
	}
	if { [info exists fmt] && $fmt != "" && $fmt != "1" } {
		$self add_option videoFormat $fmt
		$self add_option audioFormat $fmt
	}	
	if [info exists confid] {
		$self add_option confid $confid
	}	
	if [info exists ttl] {
		$self add_option defaultTTL $ttl
	}
	$self bandwidth_heuristic
}
AddressBlock instproc bandwidth_heuristic {} {
	$self instvar nchan_ addr_ ttl_ maxbw_
	set i 0
	while { $i < $nchan_ } {
		set maxbw [$self get_option maxbw]
		if { $maxbw <= 0 } {
			set ttl $ttl_($i)
			if { $ttl <= 16 || ![in_multicast $addr_($i)] } {
				set maxbw 3072000
			} elseif { $ttl <= 64 } {
				set maxbw 1024000
			} elseif  { $ttl <= 128 } {
				set maxbw 128000
			} elseif { $ttl <= 192 } {
				set maxbw 53000
			} else {
				set maxbw 32000
			}
		}
		set maxbw_($i) $maxbw
		incr i
	}
}
AddressBlock/Simple instproc data-port p {
	return $p
}
AddressBlock/RTP instproc data-port p {
	return [expr $p &~ 1]
}
set rlm_param(alpha) 4
set rlm_param(alpha) 2
set rlm_param(beta) 0.75
set rlm_param(init-tj) 1.5
set rlm_param(init-tj) 10
set rlm_param(init-tj) 5
set rlm_param(init-td) 5
set rlm_param(init-td-var) 2
set rlm_param(max) 600
set rlm_param(max) 60
set rlm_param(g1) 0.25
set rlm_param(g2) 0.25
Class MMG
MMG instproc init { levels } {
	$self next
	$self instvar debug_ env_ maxlevel_
	set debug_ 0
	set env_ [lindex [split [$self info class] /] 1]
	set maxlevel_ $levels
	global rlm_debug_flag
	if [info exists rlm_debug_flag] {
		set debug_ $rlm_debug_flag
	}
	$self instvar TD TDVAR state_ subscription_
	global rlm_param
	set TD $rlm_param(init-td)
	set TDVAR $rlm_param(init-td-var)
	set state_ /S
	$self instvar layer_ layers_
	set i 1
	while { $i <= $maxlevel_ } {
		set layer_($i) [$self create-layer [expr $i - 1]]
		lappend layers_ $layer_($i)
		incr i
	}
	set subscription_ 0
	$self add-layer
	set state_ /S
	$self set_TJ_timer
}
MMG instproc set-state s {
	$self instvar state_
	set old $state_
	set state_ $s
	$self debug "FSM: $old -> $s"
}
MMG instproc drop-layer {} {
	$self dumpLevel
	$self instvar subscription_ layer_
	set n $subscription_
	if { $n > 0 } {
		$self debug "DRP-LAYER $n"
		$layer_($n) leave-group 
		incr n -1
		set subscription_ $n
	}
	$self dumpLevel
}
MMG instproc add-layer {} {
	$self dumpLevel
	$self instvar maxlevel_ subscription_ layer_
	set n $subscription_
	if { $n < $maxlevel_ } {
		$self debug "ADD-LAYER"
		incr n
		set subscription_ $n
		$layer_($n) join-group
	}
	$self dumpLevel
}
MMG instproc current_layer_getting_packets {} {
	$self instvar subscription_ layer_ TD
	set n $subscription_
	if { $n == 0 } {
		return 0
	}
	set l $layer_($subscription_)
	$self debug "npkts [$l npkts]"
	if [$l getting-pkts] {
		return 1
	}
	set delta [expr [$self now] - [$l last-add]]
	if { $delta > $TD } {
		set TD [expr 1.2 * $delta]
	}
	return 0
}
MMG instproc mmg_loss {} {
	$self instvar layers_
	set loss 0
	foreach l $layers_ {
		incr loss [$l nlost]
	}
	return $loss
}
MMG instproc mmg_pkts {} {
	$self instvar layers_
	set npkts 0
	foreach l $layers_ {
		incr npkts [$l npkts]
	}
	return $npkts
}
MMG instproc check-equilibrium {} {
	global rlm_param
	$self instvar subscription_ maxlevel_ layer_
	set n [expr $subscription_ + 1]
	if { $n >= $maxlevel_ || [$layer_($n) timer] >= $rlm_param(max) } {
		set eq 1
	} else {
		set eq 0
	}
	$self debug "EQ $eq"
}
MMG instproc backoff-one { n alpha } {
	$self debug "BACKOFF $n by $alpha"
	$self instvar layer_
	$layer_($n) backoff $alpha
}
MMG instproc backoff n {
	$self debug "BACKOFF $n"
	global rlm_param
	$self instvar maxlevel_ layer_
	set alpha $rlm_param(alpha)
	set L $layer_($n)
	$L backoff $alpha
	incr n
	while { $n <= $maxlevel_ } {
		$layer_($n) peg-backoff $L
		incr n
	}
	$self check-equilibrium
}
MMG instproc highest_level_pending {} {
	$self instvar maxlevel_
	set m ""
	set n 0
	incr n
	while { $n <= $maxlevel_ } {
		if [$self level_pending $n] {
			set m $n
		}
		incr n
	}
	return $m
}
MMG instproc rlm_update_D  D {
	global rlm_param
	$self instvar TD TDVAR
	set v [expr abs($D - $TD)]
	set TD [expr $TD * (1 - $rlm_param(g1)) \
				+ $rlm_param(g1) * $D]
	set TDVAR [expr $TDVAR * (1 - $rlm_param(g2)) \
		       + $rlm_param(g2) * $v]
}
MMG instproc exceed_loss_thresh {} {
	$self instvar h_npkts h_nlost
	set npkts [expr [$self mmg_pkts] - $h_npkts]
	if { $npkts >= 10 } {
		set nloss [expr [$self mmg_loss] - $h_nlost]
		set loss [expr double($nloss) / ($nloss + $npkts)]
		$self debug "H-THRESH $nloss $npkts $loss"
		if { $loss > 0.25 } {
			return 1
		}
	}
	return 0
}
MMG instproc enter_M {} {
	$self set-state /M
	$self set_TD_timer_wait
	$self instvar h_npkts h_nlost
	set h_npkts [$self mmg_pkts]
	set h_nlost [$self mmg_loss]
}
MMG instproc enter_D {} {
	$self set-state /D
	$self set_TD_timer_conservative
}
MMG instproc enter_H {} {
	$self set_TD_timer_conservative
	$self set-state /H
}
MMG instproc log-loss {} {
	$self debug "LOSS [$self mmg_loss]"
	$self instvar state_ subscription_ pending_ts_
	if { $state_ == "/M" } {
		if [$self exceed_loss_thresh] {
			$self cancel_timer TD
			$self drop-layer
			$self check-equilibrium
			$self enter_D
		}
		return
	}
	if { $state_ == "/S" } {
		$self cancel_timer TD
		set n [$self highest_level_pending]
		if { $n != "" } {
			$self backoff $n
			if { $n == $subscription_ } {
				set ts $pending_ts_($subscription_)
				$self rlm_update_D [expr [$self now] - $ts]
				$self drop-layer
				$self check-equilibrium
				$self enter_D
				return
			}
			if { $n == [expr $subscription_ + 1] } {
				$self cancel_timer TJ
				$self set_TJ_timer
			}
		}
		if [$self our_level_recently_added] {
			$self enter_M
			return
		}
		$self enter_H
		return
	}
	if { $state_ == "/H" || $state_ == "/D" } {
		return
	}
	puts stderr "rlm state machine botched"
	exit -1
}
MMG instproc relax_TJ {} {
	$self instvar subscription_ layer_
	if { $subscription_ > 0 } {
		$layer_($subscription_) relax
		$self check-equilibrium
	}
}
MMG instproc trigger_TD {} {
	$self instvar state_
	if { $state_ == "/H" } {
		$self enter_M
		return
	}
	if { $state_ == "/D" || $state_ == "/M" } {
		$self set-state /S
		$self set_TD_timer_conservative
		return
	}
	if { $state_ == "/S" } {
		$self relax_TJ
		$self set_TD_timer_conservative
		return
	}
	puts stderr "trigger_TD: rlm state machine botched $state)"
	exit -1
}
MMG instproc set_TJ_timer {} {
	global rlm_param
	$self instvar subscription_ layer_
	set n [expr $subscription_ + 1]
	if ![info exists layer_($n)] {
		return
	}
	set I [$layer_($n) timer]
	set d [expr $I / 2.0 + [trunc_exponential $I]]
	$self debug "TJ $d"
	$self set_timer TJ $d
}
MMG instproc set_TD_timer_conservative {} {
	$self instvar TD TDVAR
	set delay [expr $TD + 1.5 * $TDVAR]
	$self set_timer TD $delay
}
MMG instproc set_TD_timer_wait {} {
	$self instvar TD TDVAR
	$self instvar subscription_
	set k [expr $subscription_ / 2. + 1.5]
	$self set_timer TD [expr $TD + $k * $TDVAR]
}
MMG instproc is-recent { ts } {
	$self instvar TD TDVAR
	set ts [expr $ts + ($TD + 2 * $TDVAR)]
	if { $ts > [$self now] } {
		return 1
	}
	return 0
}
MMG instproc level_pending n {
	$self instvar pending_ts_
	if { [info exists pending_ts_($n)] && \
		 [$self is-recent $pending_ts_($n)] } {
		return 1
	}
	return 0
}
MMG instproc level_recently_joined n {
	$self instvar join_ts_
	if { [info exists join_ts_($n)] && \
		 [$self is-recent $join_ts_($n)] } {
		return 1
	}
	return 0
}
MMG instproc pending_inferior_jexps {} {
	set n 0
	$self instvar subscription_
	while { $n <= $subscription_ } { 
		if [$self level_recently_joined $n] {
			return 1
		}
		incr n
	}
	$self debug "NO-PEND-INF"
	return 0
}
MMG instproc trigger_TJ {} {
	$self debug "trigger-TJ"
	$self instvar state_ ctrl_ subscription_
	if { ($state_ == "/S" && ![$self pending_inferior_jexps] && \
		  [$self current_layer_getting_packets])  } {
		$self add-layer
		$self check-equilibrium
		set msg "add $subscription_"
		$ctrl_ send $msg
		$self local-join
	}
	$self set_TJ_timer
}
MMG instproc our_level_recently_added {} {
	$self instvar subscription_ layer_
	return [$self is-recent [$layer_($subscription_) last-add]]
}
MMG instproc recv-ctrl msg {
	$self instvar join_ts_ pending_ts_ subscription_
	$self debug "X-JOIN $msg"
	set what [lindex $msg 0]
	if { $what != "add" } {
		return
	}
	set level [lindex $msg 1]
	set join_ts_($level) [$self now]
	if { $level > $subscription_ } {
		set pending_ts_($level) [$self now]
	}
}
MMG instproc local-join {} {
	$self instvar subscription_ pending_ts_ join_ts_
	set join_ts_($subscription_) [$self now]
	set pending_ts_($subscription_) [$self now]
}
MMG instproc debug { msg } {
	$self instvar debug_ subscription_ state_
	if {$debug_} {
		puts stderr "[gettimeofday] layer $subscription_ $state_ $msg"
	}
}
MMG instproc dumpLevel {} {
}
Class Layer
Layer instproc init { mmg } {
	$self next
	$self instvar mmg_ TJ npkts_
	global rlm_param
	set mmg_ $mmg
	set TJ $rlm_param(init-tj)
	set npkts_ 0
}
Layer instproc relax {} {
	global rlm_param
	$self instvar TJ
	set TJ [expr $TJ * $rlm_param(beta)]
	if { $TJ <= $rlm_param(init-tj) } {
		set TJ $rlm_param(init-tj)
	}
}
Layer instproc backoff alpha {
	global rlm_param
	$self instvar TJ
	set TJ [expr $TJ * $alpha]
	if { $TJ >= $rlm_param(max) } {
		set TJ $rlm_param(max)
	}
}
Layer instproc peg-backoff L {
	$self instvar TJ
	set t [$L set TJ]    
	if { $t >= $TJ } {
		set TJ $t
	}
}
Layer instproc timer {} {
	$self instvar TJ
	return $TJ
}
Layer instproc last-add {} {
	$self instvar add_time_
	return $add_time_
}
Layer instproc join-group {} {
	$self instvar npkts_ add_time_ mmg_
	set npkts_ [$self npkts]
	set add_time_ [$mmg_ now]
}
Layer instproc leave-group {} {
}
Layer instproc getting-pkts {} {
	$self instvar npkts_
	return [expr [$self npkts] != $npkts_]
}
set rlm_debug_flag 1
Class Layer/mash -superclass Layer
Layer/mash instproc init {mmg net n} {
	$self next $mmg
	$self instvar net_ l_ n_
	set net_ $net
	set n_ $n
	set l_ [$net_ set net_($n)]
}
Layer/mash instproc join-group {} {
	$self instvar mmg_ net_
	set level [expr [$mmg_ set subscription_] - 1]
	$net_ set-subscription-level $level
	$self next
}
Layer/mash instproc leave-group {} {
	$self instvar mmg_ net_
	set level [expr [$mmg_ set subscription_] - 1]
	$net_ set-subscription-level $level
	$self next
}
Layer/mash instproc nlost {} {
	$self instvar l_
	return [$l_ nlost]
}
Layer/mash instproc npkts {} {
	$self instvar l_ n_
	return [$l_ npkts $n_]
}
Class MMG/mash -superclass MMG
MMG/mash instproc init {net caddr} {
	$self instvar net_
	set net_ $net
	$self next [$net set nchan_]
	proc ctrl$self {args} { puts "ctrl: $args" }
	$self set ctrl_ ctrl$self
}
MMG/mash instproc create-layer {layerNo} {
	$self instvar net_
	return [new Layer/mash $self $net_ $layerNo]
}
MMG/mash instproc now {} {
	return [gettimeofday]
}
MMG/mash instproc set_timer {which delay} {
	$self instvar timers_
	if [info exists timers_($which)] {
		puts "timer botched ($which)"
		exit 1
	}
	set delay [expr int($delay * 1000)]
	set timers_($which) [after $delay "$self trigger_timer $which"]
}
MMG/mash instproc trigger_timer {which} {
	$self instvar timers_
	unset timers_($which)
	$self trigger_$which
}
MMG/mash instproc cancel_timer {which} {
	$self instvar ns_ timers_
	if [info exists timers_($which)] {
		after cancel $timers_($which)
		unset timers_($which)
	}
}
MMG/mash instproc debug { msg } {
	$self instvar debug_
	if {!$debug_} { return }
	$self instvar subscription_ state_
	set time [format %.05f [$self now]]
	puts stderr "$time layer $subscription_ $state_ $msg"
}
proc uniform01 {} {
    return [expr double(([random] % 10000000) + 1) / 1e7]
}
proc uniform { a b } {
	return [expr ($b - $a) * [uniform01] + $a]
}
proc exponential mean {
	return [expr - $mean * log([uniform01])]
}
proc trunc_exponential lambda {
	while 1 {
		set u [exponential $lambda]
		if { $u < [expr 4 * $lambda] } {
			return $u
		}
	}
}
Class Network/IP -superclass Network
Network/IP instproc init args {
	puts stderr "Network/IP called... change to Network"
	eval $self next $args
}
Network instproc port args {
	eval $self sport $args
}
proc in_multicast addr {
	return [expr ([lindex [split $addr .] 0] & 0xf0) == 0xe0]
}
Class NetworkLayer
Class NetworkManager
NetworkManager instproc graphics-init n {
	if {$n == 1 || [winfo exists .l]} { return }
	$self instvar nchan_
	set nchan_ $n
	toplevel .l
	set k 0
	while { $k < $nchan_ } {
		radiobutton .l.b$k -command "$self set-subscription-level $k" \
			-text "Level $k" \
			-variable nLayers -value $k
		pack .l.b$k
		incr k
	}
	wm withdraw .l
	bind . <l> { 
		if [winfo ismapped .l] {
			wm withdraw .l
		} else {
			wm deiconify .l
		}
	}
}
NetworkManager instproc set-subscription-level n {
	$self instvar agent_ nchan_ session_ net_
	$agent_ set_maxchannel $n
	$session_ set loopbackLayer_ [expr $n + 1]
	set i 0
	while { $i <= $n } {
		$net_($i) enable
		incr i
	}
	while { $i < $nchan_ } {
		$net_($i) disable
		incr i
	}
	global nLayers
	set nLayers $n
}
NetworkLayer instproc init { session addr sport rport ttl channel } {
	$self next
	$self instvar session_ addr_ port_ ttl_ dn_ cn_ channel_ active_
	set addr_ $addr
	set sport_ $sport
	set rport_ $rport
	set session_ $session
	set ttl_ $ttl
	set channel_ $channel
	set dn_ [new Network]
	$dn_ open $addr_ $sport_ $rport_ $ttl_
	set cn_ [new Network]
	$cn_ open $addr_ [expr $sport_ + 1] [expr $rport + 1] $ttl_
	$cn_ loopback 1
	$session_ data-net $dn_ $channel_
	$session_ ctrl-net $cn_ $channel_
	set active_ 0
	$dn_ drop-membership
	$cn_ drop-membership
	$self set tloss_ 0
}
NetworkLayer instproc destroy {} {
	$self instvar dn_ cn_
	delete $dn_
	delete $cn_
	$self next
}
NetworkLayer instproc data-net {} {
	return [$self set dn_]
}
NetworkLayer instproc ctrl-net {} {
	return [$self set cn_]
}
NetworkLayer instproc enable-send {} {
	$self instvar dn_ cn_ session_ channel_
	$session_ data-net $dn_ $channel_
	$session_ ctrl-net $cn_ $channel_
}
NetworkLayer instproc disable-send {} {
	$self instvar dn_ cn_ session_ channel_
	$session_ data-net "" $channel_
	$session_ ctrl-net "" $channel_
}
NetworkLayer instproc enable {} {
	$self instvar active_ dn_ cn_ session_ channel_
	if !$active_ {
		set active_ 1
		$dn_ add-membership
		$cn_ add-membership
		$session_ data-net $dn_ $channel_
		$session_ ctrl-net $cn_ $channel_
	}
}
NetworkLayer instproc disable {} {
	$self instvar dn_ cn_ active_ session_ channel_
	if $active_ {
		set active_ 0
		$dn_ drop-membership
		$cn_ drop-membership
	}
}
NetworkLayer instproc notify-loss {src} {
	$self instvar loss_ tloss_
	if ![info exists loss_($src)] {
		set loss_($src) 0
	}
	set nloss [$src missing]
	incr tloss_ [expr $nloss - $loss_($src)]
	set loss_($src) $nloss
}
NetworkLayer instproc nlost {} {
	$self instvar tloss_
	return $tloss_
}
NetworkLayer instproc npkts {n} {
	$self instvar agent_
	set npkts 0
	foreach s [$agent_ set sources_] {
		set l [lindex [$s set layers_] $n]
		incr npkts [$l set np_]
	}
	return $npkts
}
NetworkLayer instproc crypt { dc cc } {
	$self instvar dn_ cn_
	$dn_ crypt $dc
	$cn_ crypt $cc
}
NetworkManager instproc init { ab session agent } {
	$self next
	$self instvar session_ agent_ encrypt_ key_ fmt_
	set session_ $session
	set agent_ $agent
	set encrypt_ 0
	set key_ ""
        set fmt_ ""
	$self allocate $ab $session
}
NetworkManager instproc allocate { ab session } {
	$self instvar nchan_ net_ mmg_
	if [info exists nchan_] {
		set oldnchan $nchan_
	} else {
		set oldnchan 0
	}
	set nchan_ 0
	while { $nchan_ < [$ab nchan] } {
		set addr [$ab addr $nchan_]
		set sport [$ab sport $nchan_]
		set rport [$ab rport $nchan_]
		set ttl [$ab ttl $nchan_]
		if [info exists net_($nchan_)] {
			delete $net_($nchan_)
		}
		set net_($nchan_) [new NetworkLayer $session $addr \
					$sport $rport $ttl $nchan_]
		$self instvar agent_
		$net_($nchan_) set agent_ $agent_
		incr nchan_
	}
	set n $nchan_
	while {$n < $oldnchan} {
		if [info exists net_($n)] {
			delete $net_($n)
		}
		incr n
	}
	if [info exists mmg_] {
		delete $mmg_
	}
	$self set-subscription-level 0
	if {$nchan_ == 1} { return }
	if [$self yesno useLayersWindow] {
		$self graphics-init $nchan_
	}
	if [$self get_option useRLM] {
		set caddr ""
		set mmg_ [new MMG/mash $self $caddr]
	}
}
NetworkManager instproc nchan {} {
	return [$self set nchan_]
}
NetworkManager instproc reset ab {
	$self instvar session_
	$self allocate $ab $session_
}
NetworkManager instproc data-net args {
	if { $args == "" } {
		set k 0
	} else {
		set k $args
	}
	$self instvar net_
	return [$net_($k) data-net]
}
NetworkManager instproc ctrl-net args {
	if { $args == "" } {
		set k 0
	} else {
		set k $args
	}
	$self instvar net_
	return [$net_($k) ctrl-net]
}
NetworkManager public loopback enable {
	$self instvar nchan_ net_
	set i 0
	while { $i < $nchan_ } {
		set net $net_($i)
		set dn [$net data-net]
		set cn [$net ctrl-net]
		$dn loopback $enable
		$cn loopback $enable
		incr i
	}
}
NetworkManager instproc install-key key {
	return [$self set_key $key]
}
NetworkManager instproc crypt_all { dc cc } {
	$self instvar net_
	foreach n [array names net_] {
		$net_($n) crypt $dc $cc
	}
}
NetworkManager instproc destroy {} {
	$self instvar dc_ cc_ net_
	if [info exists dc_] {
		delete $dc_
	}
	if [info exists cc_] {
		delete $cc_
	}
	foreach dn [array names net_] {
		delete $net_($dn)
	}
	$self next
}
NetworkManager instproc usingRLM {} {
	$self instvar mmg_
	return [info exists mmg_]
}
NetworkManager instproc notify-loss {src layer} {
	$self instvar net_
	$net_($layer) notify-loss $src
}
NetworkManager instproc crypt_format { key } {
	set k [string first / $key]
	if { $k < 0 } {
		set fmt DES
	} else {
		set fmt [string range $key 0 [expr $k - 1]]
		set key [string range $key [expr $k + 1] end]
	}
	return "$fmt $key"
}
NetworkManager instproc set_key key {
	if { $key == "" } {
		$self crypt_clear
		return ""
	}
	$self instvar encrypt_ 
	set L [$self crypt_format $key]
	set fmt [lindex $L 0]
	set key [lindex $L 1]
	$self instvar key_
	set key_ $key
	$self instvar dc_ cc_ fmt_
	if { $fmt_ != $fmt } {
		if [info exists dc_] {
			delete $dc_
			unset dc_
		}
		if [info exists cc_] {
			delete $cc_
			unset cc_
		}
		set fmt_ $fmt
	}
	if ![info exists dc_] {
		set clist [Crypt/Data info subclass]
		if { [lsearch -exact $clist Crypt/Data/$fmt] < 0 } {
			return "no $fmt encryption support"
		}
		set dc_ [new Crypt/Data/$fmt]
		set cc_ [new Crypt/Control/$fmt]
	}
	if [$dc_ key $key] {
		$cc_ key $key
		$self crypt_all $dc_ $cc_
		set encrypt_ 1
		return ""
	} else {
		$self crypt_clear
		return "your key is cryptographically weak"
	}
}
NetworkManager instproc crypt_clear {} {
	$self instvar encrypt_ key_
	$self crypt_all "" ""
	set key_ ""
	set encrypt_ 0
}
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 SrcList -superclass Callback
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 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 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 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 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_ 	
	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
	entry $dummy
	$self set_widget_default_ $dummy { -font -selectbackground \
			-selectforeground -selectborderwidth }
	destroy $dummy
}
WidgetClass proc set_widget_default_ { path options } {
	$self instvar widget_defaults_
	foreach option $options {
		if { [llength $option]==1 } {
			set option [lindex $option 0]
			set widget_defaults_($option) [$path cget $option]
		} else {
			set widget_defaults_([lindex $option 0]) \
					[$path cget [lindex $option 1]]
		}
	}
}
WidgetClass proc widget_default { option } {
	$self instvar widget_defaults_
	if { [info exists widget_defaults_($option) ] } {
		return $widget_defaults_($option)
	} else {
		error "no such default option \"$option\""
	}
}
WidgetClass proc translate_default { option value } {
	if { ![string compare $value "WidgetDefault"] } {
		return [WidgetClass widget_default $option]
	} elseif { [regexp {WidgetDefault\((.*)\)} $value dummy \
			defaultOption] } {
		return [WidgetClass widget_default $defaultOption]
	}
	return $value
}
WidgetClass set_widget_default
WidgetClass instproc heritage_defaults { } {
	set heritage [$self info heritage]
	set len [expr [llength $heritage]-1]
	while { $len >= 0 } {
		set cl [lindex $heritage $len]
		incr len -1
		if { [isWidgetObject $cl] } {
			$self configspec_ [$cl info configspec] 1
			$self default_ [$cl info default]
		}
	}
}
WidgetClass instproc set_configspec { specs } {
	$self configspec_ $specs 0
}
WidgetClass instproc configspec_ { specs {isAncestor} } {
	$self instvar configspec_
	foreach spec $specs {
		if { ! $isAncestor } {
			set option  [lindex $spec 0]
			set default [lindex $spec 3]
			set spec [lreplace $spec 3 3 [WidgetClass \
					translate_default $option $default]]
			set configspec_($option) $spec
		}
		option add *$self.[lindex $spec 1] \
				[lindex $spec 3] widgetDefault
	}
}
WidgetClass instproc set_alias { aliases } {
	$self instvar configspec_
	foreach alias $aliases {
		set al   [lindex $alias 0]
		set orig [lindex $alias 1]
		if { ![info exists configspec_($orig)] } {
			error "no configspec $orig (specified in alias list)"
		}
		set configspec_($al) $configspec_($orig)
	}
}
WidgetClass instproc set_default { defaults } {
	$self default_ $defaults
	$self set defaults_ $defaults
}
WidgetClass instproc default_ { defaults } {
	foreach default $defaults {
		set option [lindex $default 0]
		set star [string last "*" $option]
		set dot  [string last "." $option]
		if { $star < $dot } {
			set idx [expr $dot+1]
		} else {
			set idx [expr $star+1]
		}
		option add *${self}$option [WidgetClass translate_default \
				-[string tolower [string range $option $idx \
				end]] [lindex $default 1]] widgetDefault
	}
}
WidgetClass instproc create { widget args } {
	eval [list $self] next [list _o$widget] [list $widget] $args
	return $widget
}
WidgetClass instproc info { option args } {
	if { $option == "default" } {
		if { $args != "" } {
			error "extra arguments in call to 'info $option'"
		}
		return [$self set defaults_]
	} elseif { $option == "configspec" } {
		$self instvar configspec_
		set len [llength $args]
		if { $len == 0 } {
			set list {}
			foreach el [array names configspec_] {
				lappend list $configspec_($el)
			}
			return $list
		}
		if { [llength $args] != 1 } {
			error "extra arguments in call to 'info $option'"
		}
		if { [info exists configspec_($args)] } {
			return $configspec_($args)
		} else {
			return ""
		}
		return [eval [list $self] next [list $option] $args]
	} else {
		return [eval [list $self] next [list $option] $args]
	}
}
WidgetClass WidgetObject -configspec {
	{-options options Options {} widget_options widget_options}
}
WidgetObject instproc init { widget args } {
	$self next
	$self instvar path_ widget_proc_
	set path_ $widget
	$self create_root_widget $widget
	if { ![winfo exists $widget] } {
		error "must create a widget $widget inside\
				[$self info class]::create_root_widget"
	}
	$self instvar widget_proc_
	set widget_proc_ "proc_$self"
	rename $widget $widget_proc_
	proc ::$widget { args } "return \[uplevel [list $self] \$args\]"
	$self build_widget $widget
	set heritage [[$self info class] info heritage]
	set idx 0
	for { set idx [expr [llength $heritage]-1] } {$idx>=0} {incr idx -1} {
		set cl [lindex $heritage $idx]
		if { [isWidgetObject $cl] } {
			$self configure_default $cl
		}
	}
	$self configure_default [$self info class]
	if { $args!="" } {
		eval [list $self] configure $args
	}
	if { [winfo toplevel $path_]==$path_ } {
		bind $widget <Destroy> "if \{\"%W\"==\"$path_\"\} \
				\{delete $self\}"
	} else {
		bind $widget <Destroy> "delete $self"
	}
}
WidgetObject instproc create_root_widget { path } {
	frame $path -class [$self info class]
}
WidgetObject instproc build_widget { path } {
}
WidgetObject instproc info { option args } {
	switch $option {
		"path" {
			if { $args != "" } {
				error "extra arguments in call to 'info $option'"
			}
			return [$self set path_]
		}
		"self" { return $self }
		default {
			return [eval [list $self] next [list $option] $args]
		}
	}
}
WidgetObject instproc unknown { method args } {
	return [eval [list $self] widget_proc [list $method] $args]
}
WidgetObject instproc widget_proc { args } {
	$self instvar widget_proc_
	return [eval [list $widget_proc_] $args]
}
WidgetObject instproc config { args } {
	return [eval [list $self] configure $args]
}
WidgetObject instproc configure_default { cl } {
	set path [$self info path]
	set widget_class [winfo class $path]
	if { $widget_class == [$self info class] } {
		foreach spec [$cl info configspec] {
			set optVal [option get $path [lindex $spec 1] $cl]
			$self configure [lindex $spec 0] $optVal
		}
	} else {
		foreach spec [$cl info configspec] {
			$self configure [lindex $spec 0] [lindex $spec 3]
		}
	}
}
WidgetObject instproc configure { args } {
	set len [llength $args]
	switch $len {
		0 { return [$self configure_all] }
		1 { return [$self configure_one $args] }
		default {
			if { $len % 2 != 0 } {
				error "odd number of arguments for configure"
			}
			for { set i 0 } { $i < $len } { incr i 2 } {
				$self configure_one [lindex $args $i] \
						[lindex $args [expr $i+1]]
			}
		}
	}
}
WidgetObject instproc configure_one { args } {
	set option [lindex $args 0]
	if { [string index $option 0] != "-" } {
		error "invalid option $option: must start with -"
	}
	set option [string range $option 1 end]
	set spec [[$self info class] info configspec -$option]
	if { $spec!="" } {
		set config_proc [lindex $spec 4]
		set cget_proc   [lindex $spec 5]
		if { $cget_proc=={} } { set cget_proc $config_proc }
		if { [llength $args] < 2 } {
			return [lreplace $spec 4 end [$self $cget_proc \
					"-$option"]]
		} else {
			return [$self $config_proc "-$option" [lindex $args 1]]
		}
	}
	foreach cl [[$self info class] info heritage] {
		if { [isWidgetObject $cl] } {
			set spec [$cl info configspec -$option]
			if { $spec!="" } {
				set config_proc [lindex $spec 4]
				set cget_proc   [lindex $spec 5]
				if { $cget_proc=={} } {
					set cget_proc $config_proc
				}
				if { [llength $args] < 2 } {
					return [lreplace $spec 4 end \
							[$self $cget_proc \
							"-$option"]]
				} else {
					return [$self $config_proc "-$option" \
							[lindex $args 1]]
				}
			}
		}
	}
	return [eval [list $self] widget_proc configure $args]
}
WidgetObject instproc configure_all { } {
	set result [$self configure_all_ [$self info class]]
	foreach cl [[$self info class] info heritage] {
		if { [isWidgetObject $cl] } {
			set result [concat $result [$self configure_all_ $cl]]
		}
	}
	set result [concat $result [$self widget_proc configure]]
	return $result
}
WidgetObject instproc configure_all_ { cl } {
	set result ""
	foreach spec [$cl info configspec] {
		set option [lindex $spec 0]
		if { $option != "-options" } {
			lappend result [$self configure $option]
		}
	}
	return $result
}
WidgetObject instproc cget { option } {
	return [lindex [$self configure_one $option] 4]
}
WidgetObject instproc widget_options { option args } {
	if { [llength $args]==0 } {
		error "options has no value; cannot read it"
	}
	set root [$self info path]
	foreach option [lindex $args 0] {
		set opt [string trim [lindex $option 0]]
		set arg [lindex $option 1]
		set lastdot [string last . $opt]
		if { $lastdot <= 0 } {
			set path $root
		} else {
			set firstdot  [string first . $opt]
			set path [string range $opt 0 [expr $firstdot-1]]
			set path [$self subwidget $path]
			if { $firstdot < $lastdot } {
				set path $path.[string range $opt \
						[expr $firstdot+1] \
						[expr $lastdot -1]]
			}
		}
		set opt [string range $opt [expr $lastdot+1] end]
		$path configure -$opt $arg
	}
}
WidgetObject instproc subwidget { widget args } {
	set path "[$self info path].$widget"
	if { ![winfo exists $path] } {
		$self instvar subwidgets_
		if { ![info exists subwidgets_($widget)] } {
			error "no subwidget $widget inside [$self info path]"
		}
		set path $subwidgets_($widget)
	}
	if { [llength $args]==0 } {
		return $path
	}
	return [eval [list $path] $args]
}
WidgetObject instproc set_subwidget { name path } {
	$self instvar subwidgets_
	$self set subwidgets_($name) $path
}
WidgetObject instproc ignore_args { args } {
}
WidgetObject instproc do_when_idle { command } {
	$self instvar do_idle_ids_
	set command [string trim $command]
	if ![info exists do_idle_ids_($command)] {
		set do_idle_ids_($command) \
				[after idle "WidgetObject do_idle_ \
				[list $self] [list $command]"]
	}
}
WidgetObject proc do_idle_ { o command } {
	$o instvar do_idle_ids_
	catch {unset do_idle_ids_($command)}
	if { [info command $o]!=$o } {
		return
	}
	set w [$o info path]
	if {![winfo exists $w] || [string compare [winfo class $w] \
			[$o info class]] != 0} {
		return
	} else {
		uplevel #0 $command
	}
}
WidgetClass proc transparent_gif { {color {}} } {
	global TRANSPARENT_GIF_COLOR
	if { $color!={} } {
		set TRANSPARENT_GIF_COLOR $color
	} else {
		set TRANSPARENT_GIF_COLOR [$self widget_default -background]
	}
}
WidgetClass proc EntryBindings { tag } {
	bind $tag <FocusIn>  "$self EntryBindings_FocusIn %W"
	bind $tag <FocusOut> "$self EntryBindings_FocusOut %W"
}
WidgetClass proc EntryBindings_FocusIn { entry } {
	if [string compare [$entry get] ""] {
		$entry selection from 0
		$entry selection to   end
		$entry icursor end
	} else {
		$entry selection clear
	}
}
WidgetClass proc EntryBindings_FocusOut { entry } {
    $entry selection clear
}
WidgetClass EntryBindings Entry
if {$tcl_platform(platform)=="windows"} {
	WidgetClass transparent_gif SystemButtonFace
}
Class Observer
Observer instproc init { args } {
	eval [list $self] next $args
}
Observer instproc update { method args } {
	if [$self has_method $method] {
		eval [list $self] [list $method] $args
	}
}
Class Observable
Observable instproc init { args } {
	eval [list $self] next $args
	$self set observers_ { }
}
Observable instproc attach_observer { observer } {
	$self instvar observers_
	lappend observers_ $observer
}
Observable instproc detach_observer { observer } {
	$self instvar observers_
	set idx [lsearch $observers_ $observer]
	if { $idx != -1 } {
		set observers_ [lreplace $observers_ $idx $idx]
	}
}
Observable instproc notify_observers { method args } {
	$self instvar observers_
	if [info exists observers_] {
		foreach observer $observers_ {
			eval [list $observer] update [list $method] $args
		}
	}
}
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\26\134\43\24\134\43\302\134\43\134\43\330\330\330\370\374\370\134\43\134\43\134\43\70\370\60\200\200\200\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\26\134\43\24\134\43\134\43\3\123\10\272\334\376\120\205\40\142\234\103\20\142\33\316\133\267\174\202\306\111\323\103\232\47\20\14\231\367\146\354\70\233\50\134\134\156\255\13\203\234\17\260\347\323\155\204\73\142\21\106\100\326\74\277\201\223\247\212\106\223\112\211\125\367\204\314\176\130\221\134\43\334\355\224\302\242\5\57\224\146\120\333\360\106\2\134\43\73"]
image create photo Icons(check) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\24\134\43\24\134\43\302\134\43\134\43\330\330\330\370\374\370\134\43\134\43\134\43\370\24\100\200\200\200\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\24\134\43\24\134\43\134\43\3\126\10\272\274\21\55\212\366\306\210\312\116\27\354\330\214\47\154\225\46\20\215\367\1\345\167\22\250\43\12\235\11\303\114\255\332\67\266\153\267\230\157\367\22\16\211\306\43\21\263\370\251\100\251\31\21\232\231\265\134\134\306\347\253\64\352\125\261\267\116\327\13\340\305\36\305\344\70\31\214\264\335\311\5\216\331\110\134\43\134\43\73"]
image create photo Icons(cross) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\22\134\43\22\134\43\302\134\43\134\43\330\330\330\134\43\134\43\134\43\370\374\370\270\274\270\70\370\60\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\22\134\43\22\134\43\134\43\3\112\10\272\334\376\360\205\71\243\232\42\347\52\363\40\104\60\154\116\40\14\50\50\242\103\320\230\254\312\266\14\34\207\63\175\11\140\357\343\256\335\357\47\12\2\114\224\200\52\251\73\236\156\53\226\321\11\235\115\251\51\234\264\44\235\154\45\121\24\47\222\274\132\42\11\134\43\73"]
image create photo Icons(plus) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\22\134\43\22\134\43\302\134\43\134\43\330\330\330\134\43\134\43\134\43\370\374\370\270\274\270\70\370\60\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\22\134\43\22\134\43\134\43\3\101\10\272\334\376\360\205\71\243\232\42\347\52\363\370\337\346\4\2\150\202\101\103\236\147\272\254\154\373\12\104\155\337\301\340\2\344\355\23\271\35\211\102\44\352\146\61\31\62\171\144\300\222\273\27\63\352\314\231\70\221\242\145\273\110\134\43\134\43\73"]
image create photo Icons(minus) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\24\134\43\24\134\43\302\134\43\134\43\330\330\330\120\124\120\134\43\134\43\134\43\270\274\270\370\374\370\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\24\134\43\24\134\43\134\43\3\134\134\10\272\334\356\41\312\327\242\270\170\104\32\260\317\301\43\175\327\4\21\232\44\15\32\24\14\4\312\6\162\272\274\132\254\301\173\72\53\253\330\13\365\122\205\30\64\42\257\270\71\11\227\273\143\5\106\30\106\233\225\130\25\152\312\52\225\105\21\325\212\303\42\265\270\136\13\302\222\105\164\153\27\153\116\224\162\214\166\212\276\221\134\43\134\43\73"]
image create photo Icons(trashcan) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\50\134\43\50\134\43\302\134\43\134\43\330\330\330\170\174\134\43\370\374\134\43\270\274\270\134\43\134\43\134\43\170\174\170\134\43\134\43\134\43\134\43\134\43\134\43\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\50\134\43\50\134\43\134\43\3\270\10\272\334\376\60\312\111\253\275\70\353\27\372\316\201\40\14\304\147\205\342\110\24\346\204\246\53\333\162\151\112\26\362\314\274\165\254\357\265\332\55\247\343\5\175\77\143\160\230\264\21\236\3\30\256\330\173\76\235\323\26\317\172\225\22\65\106\56\101\210\334\204\271\307\54\70\50\20\57\313\30\145\300\252\204\237\330\52\50\233\31\307\267\273\154\166\56\176\2\163\112\42\174\25\207\210\4\121\176\202\20\213\60\204\52\152\22\222\224\75\226\221\231\44\215\204\211\234\224\150\204\220\13\230\42\244\176\241\15\250\171\216\245\233\100\231\264\136\137\247\265\265\103\267\270\271\240\61\262\73\142\303\304\303\70\307\24\307\312\313\314\315\301\17\316\321\316\77\324\325\326\327\330\11\134\43\73"]
image create photo Icons(warning) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\20\134\43\12\134\43\241\134\43\134\43\330\330\330\370\374\370\134\43\134\43\134\43\200\200\200\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\20\134\43\12\134\43\134\43\2\35\204\217\171\301\355\201\202\230\264\212\21\155\35\70\153\256\134\43\322\326\205\343\125\206\42\252\266\356\133\134\43\134\43\73"]
image create photo Icons(minimize) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\20\134\43\12\134\43\241\134\43\134\43\330\330\330\370\374\370\134\43\134\43\134\43\200\200\200\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\20\134\43\12\134\43\134\43\2\35\204\217\251\26\273\41\206\103\120\304\11\252\275\157\173\231\150\236\5\62\343\131\2\303\312\266\51\226\24\134\43\73"]
image create photo Icons(maximize) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\24\134\43\17\134\43\362\134\43\134\43\330\330\330\177\177\177\377\377\134\43\377\377\377\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\24\134\43\17\134\43\134\43\3\101\10\272\334\276\41\306\367\2\20\27\130\12\63\306\222\344\4\103\151\236\145\100\64\344\347\171\52\73\274\56\270\62\55\15\337\320\134\134\277\61\334\340\127\13\366\164\56\243\42\107\274\50\65\241\150\210\267\40\130\257\130\54\147\313\110\134\43\134\43\73"]
image create photo Icons(folder) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\24\134\43\17\134\43\302\134\43\134\43\330\330\330\170\174\170\370\374\370\270\274\270\370\374\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\24\134\43\17\134\43\134\43\3\105\10\272\334\316\41\306\367\202\270\67\120\50\6\361\203\40\111\216\365\235\41\46\26\215\5\242\150\300\56\143\75\22\62\247\356\362\220\323\35\330\253\20\231\1\137\110\331\17\50\104\21\215\114\344\111\6\125\330\154\205\252\42\313\355\166\67\340\105\2\134\43\73"]
image create photo Icons(folderopen) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\24\134\43\17\134\43\362\134\43\134\43\330\330\330\177\177\177\377\377\134\43\377\377\377\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\24\134\43\17\134\43\134\43\3\105\10\272\334\276\41\306\367\2\20\27\130\12\63\306\222\344\4\103\151\236\145\100\64\344\27\174\236\312\16\227\4\203\53\323\206\157\234\103\64\220\47\43\323\15\134\134\267\332\117\101\42\362\160\263\344\255\10\341\131\43\113\5\141\313\355\166\71\140\106\2\134\43\73"]
image create photo Icons(folderup) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\17\134\43\17\134\43\241\134\43\134\43\330\330\330\170\174\170\370\374\370\134\43\134\43\134\43\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\17\134\43\17\134\43\134\43\2\62\204\217\151\301\315\12\202\230\263\51\111\205\113\222\325\66\40\130\126\205\107\347\224\42\111\5\346\242\245\332\33\261\352\31\67\67\154\273\242\3\244\1\6\304\242\21\202\64\24\134\43\134\43\73"]
image create photo Icons(textfile) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\22\134\43\22\134\43\204\134\43\134\43\330\330\330\170\174\170\134\43\370\360\360\370\360\134\43\134\43\134\43\360\374\360\134\43\374\360\134\43\370\370\360\370\370\134\43\170\170\134\43\374\370\370\370\360\134\43\174\170\134\43\134\43\360\134\43\134\43\170\134\43\134\43\370\134\43\134\43\160\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\22\134\43\22\134\43\134\43\5\144\40\40\216\144\151\212\101\32\234\145\52\14\57\101\260\100\134\43\303\205\220\317\147\140\14\277\327\141\300\153\275\4\210\237\62\121\34\331\24\260\5\122\260\140\64\121\57\45\20\310\64\331\250\103\341\300\332\313\231\165\344\336\21\361\142\60\257\43\31\143\156\45\64\32\360\270\214\340\160\30\356\171\47\16\2\200\64\45\203\17\170\206\44\20\177\201\47\62\213\64\41\134\43\73"]
image create photo Icons(browse) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\11\134\43\10\134\43\241\134\43\134\43\330\330\330\370\374\370\134\43\134\43\134\43\200\200\200\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\11\134\43\10\134\43\134\43\2\25\204\21\247\41\243\50\242\63\54\112\150\355\10\134\134\217\11\150\17\360\115\5\134\43\73"]
image create photo Icons(up) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\11\134\43\10\134\43\241\134\43\134\43\330\330\330\370\374\370\134\43\134\43\134\43\200\200\200\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\11\134\43\10\134\43\134\43\2\24\4\202\141\33\342\143\222\23\3\266\71\55\246\54\257\310\175\6\264\24\134\43\73"]
image create photo Icons(down) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\11\134\43\10\134\43\241\134\43\134\43\330\330\330\370\374\370\134\43\134\43\134\43\200\200\200\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\11\134\43\10\134\43\134\43\2\25\204\43\143\213\222\354\242\152\321\215\200\321\330\12\320\356\125\17\125\15\5\134\43\73"]
image create photo Icons(fastup) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\11\134\43\10\134\43\241\134\43\134\43\330\330\330\134\43\134\43\134\43\200\200\200\370\374\370\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\11\134\43\10\134\43\134\43\2\23\104\216\41\60\251\134\43\333\131\154\330\27\335\144\216\362\15\145\136\1\134\43\73"]
image create photo Icons(fastdown) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\34\134\43\24\134\43\245\134\43\134\43\370\370\370\340\340\370\230\230\340\150\150\300\370\340\370\134\43\134\43\300\134\43\134\43\230\134\43\134\43\150\300\230\150\370\370\300\250\300\370\340\300\134\43\300\300\230\300\300\134\43\150\134\43\300\340\340\300\370\370\340\150\150\150\250\254\230\150\134\43\150\340\340\134\43\370\370\230\150\150\340\230\150\134\43\150\150\134\43\300\300\340\340\340\150\300\230\134\43\370\370\150\340\370\370\230\150\150\370\370\134\43\134\43\150\340\230\150\300\340\340\340\300\300\150\370\340\134\43\150\150\230\230\230\300\134\43\150\300\150\134\43\230\340\340\230\134\43\134\43\340\230\230\230\300\230\300\230\230\134\43\340\300\150\300\230\340\370\340\150\370\340\230\370\340\300\340\300\230\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\34\134\43\24\134\43\134\43\6\375\100\200\160\110\54\32\217\110\100\100\60\150\22\222\120\245\240\140\60\34\14\210\104\62\200\124\120\253\13\206\241\241\65\6\12\216\7\244\50\250\32\42\15\111\141\102\131\263\251\207\205\135\330\256\322\37\163\13\25\106\26\125\27\30\24\104\31\137\6\13\11\4\31\32\203\154\125\33\21\33\223\112\214\15\34\104\1\4\35\240\134\43\213\6\33\36\21\211\103\205\206\37\103\113\5\5\40\5\41\42\124\227\245\231\1\156\215\166\147\273\6\27\43\206\300\44\104\253\300\235\232\225\45\140\46\156\164\173\134\43\3\156\15\223\175\33\15\206\44\47\156\202\105\323\225\203\276\36\15\124\320\137\325\204\156\50\51\1\40\277\245\51\52\324\107\35\214\6\367\273\124\36\53\125\54\134\134\105\2\230\30\200\342\300\204\26\54\340\35\150\341\202\24\76\21\107\136\344\203\127\5\226\241\124\256\346\255\243\270\353\340\2\30\321\134\43\264\271\320\300\205\206\30\51\144\244\170\200\62\305\14\15\51\122\304\110\20\122\110\134\43\21\20\152\106\51\22\4\134\43\73"]
image create photo Icons(cal) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\67\141\15\134\43\24\134\43\360\134\43\134\43\377\377\377\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\15\134\43\24\134\43\134\43\2\55\204\217\11\301\235\254\240\11\152\322\145\35\306\162\172\172\65\20\10\162\143\145\155\110\130\256\254\232\225\127\105\242\134\134\344\314\250\356\255\221\377\113\341\64\207\2\134\43\73"]
image create photo Icons(ear) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\67\141\20\134\43\20\134\43\360\134\43\134\43\377\377\377\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\20\134\43\20\134\43\134\43\2\51\204\17\21\310\271\353\40\202\312\120\106\157\332\107\147\316\171\226\3\116\326\327\164\222\324\150\151\7\277\343\374\262\45\326\246\166\154\352\271\121\134\43\134\43\73"]
image create photo Icons(hand) -data $imageObject__
WidgetClass DropDown -configspec {
	{ -variable variable Variable {} config_var cget_var }
	{ -value value Value {} config_value cget_value }
	{ -state state State {normal} config_state }
} -alias {
	{ -var -variable }
} -default {
	{ *button.relief raised }
	{ *button.indicatorOn 1 }
	{ *button.highlightThickness 2 }
	{ *button.takeFocus 1 }
	{ *button.padX 2 }
	{ *button.padY 1 }
	{ *menu.tearOff 0 }
	{ *menu*borderWidth 1 }
	{ *menu*activeBorderWidth 1 }
}
DropDown instproc build_widget { path } {
	menubutton $path.button -menu $path.button.menu
	pack $path.button -fill both -expand 1 -padx 0 -pady 0 -side left
	menu $path.button.menu
	$self set_subwidget menu $path.button.menu
	$self config_var -variable {}
	set script [bind Menubutton <Key-space>]
	bind $path.button <Key-Down> $script
}
DropDown instproc config_var { option var } {
	$self instvar var_
	if { [info exists var_] && $var_!="" } {
		upvar #0 $var_ global_var
		catch { trace vdelete global_var w "$self var_trace" }
	}
	if { $var=="" } {
		set var_ [$self tkvarname defvar_]
	} else {
		set var_ $var
	}
	upvar #0 $var_ global_var
	trace variable global_var w "$self var_trace"
	if { ![info exists global_var] || $global_var=="" } {
		$self set_default_var
	} else {
		$self var_trace $var_ "" w
	}
}
DropDown instproc cget_var { option } {
	$self instvar var_
	if { $var_==[$self tkvarname defvar_] } {
		return ""
	} else {
		return $var_
	}
}
DropDown instproc config_value { option value } {
	$self set_var $value
}
DropDown instproc cget_value { option } {
	upvar #0 [$self set var_] global_var
	if [info exists global_var] {
		return $global_var
	} else {
		return ""
	}
}
DropDown instproc config_state { option {value {}} } {
	if { $value=={} } {
		return [$self subwidget button cget -state]
	} else {
		$self subwidget button configure -state $value
	}
}
DropDown instproc index { index } {
	if { $index=="end" } {
		set index [$self subwidget menu index $index]
		if { $index=="none" } {
			set index -1
		} else {
			incr index
		}
	} else {
		set index [$self subwidget menu index $index]
		if { $index=="none" } {
			set index -1
		}
	}
	return $index
}
DropDown instproc insert { index args } {
	set index [$self index $index]
	if { $index==-1 } {
		set index 0
	}
	foreach arg $args {
		$self insert_item $index $arg
		incr index
	}
	upvar #0 [$self set var_] global_var
	if { ![info exists global_var] || $global_var=="" } {
		$self set_default_var
	}
}
DropDown instproc insert_separator { index } {
	$self subwidget menu insert $index separator
}
DropDown instproc insert_item { index value } {
	$self subwidget menu insert $index command -label $value \
			-command "[list $self] set_var [list $value]"
}
DropDown instproc delete { index1 {index2 {}} } {
	if { $index2=="" } { set index2 $index1 }
	$self subwidget menu delete $index1 $index2
}
DropDown instproc set_var { value } {
	upvar #0 [$self set var_] global_var
	set global_var $value
}
DropDown instproc set_default_var { } {
	set menu [$self subwidget menu]
	set last [$self index end]
	if { $last=="none" } { set last -1 }
	for { set idx 0 } { $idx < $last } { incr idx } {
		if { [$menu type $idx]=="command" } break
	}
	if { $idx < $last } {
		$menu invoke $idx
	} else {
		upvar #0 [$self set var_] global_var
		set global_var ""
	}
}
DropDown instproc var_trace { args } {
	upvar #0 [$self set var_] global_var
	$self subwidget button configure -text $global_var
}
WidgetClass DropDown/Color -superclass DropDown
DropDown/Color instproc insert_item { index value } {
	if { [string index $value 0]=="/" } {
		$self subwidget menu insert $index command \
				-label [list [string range $value 1 end]] \
				-command "[list $self] set_var [list $value]"
	} else {
		$self subwidget menu insert $index command -label {    } \
				-background [list $value] \
				-activebackground [list $value] \
				-command "[list $self] set_var [list $value]"
	}
}
DropDown/Color instproc var_trace { args } {
	upvar #0 [$self set var_] global_var
	if { $global_var=="" } return
	if { $global_var=="/custom" } {
		set current_color [$self subwidget button cget -background]
		set color [tk_chooseColor -title "Choose color" \
				-initialcolor $current_color]
		if { $color=={} } return
		$self insert end $color
		set global_var $color
	}
	$self subwidget button configure -background $global_var \
			-activebackground $global_var -text "    "
}
WidgetClass DropDown/Font -superclass DropDown
DropDown/Font instproc insert_item { index value } {
	$self subwidget menu insert $index command -label ABCabc \
			-font [list $value] \
			-command "[list $self] set_var [list $value]"
}
DropDown/Font instproc var_trace { args } {
	upvar #0 [$self set var_] global_var
	if { $global_var=="" } return
	$self subwidget button configure -font $global_var -text "ABCabc"
}
WidgetClass DropDown/Text -superclass DropDown -configspec {
	{-entryVal entryVal EntryVal {} config_entryVal cget_entryVal}	
} -default {
	{ .highlightThickness 2 }
	{ .takeFocus 0 }
	{ .relief sunken }
	{ .borderWidth 2 }
	{ *button.highlightThickness 0 }
	{ *button.takeFocus 0 }
	{ *button.padX 0 }
	{ *button.padY 0 }
	{ *entry.highlightThickness 0 }
	{ *entry.takeFocus 1 }
	{ *entry.relief flat }
	{ *entry.borderWidth 0 }
}
DropDown/Text instproc config_entryVal { option value} {
	$self subwidget entry delete 0 end
	$self subwidget entry insert 0 $value
}
DropDown/Text instproc cget_entryVal { option value} {
	return [$self subwidget entry get]
}
DropDown/Text instproc build_widget { path } {
	entry $path.entry
	pack $path.entry -side left -fill both -expand 1
	$self next $path
	pack configure $path.button -side right -fill y -expand 0
	set script [bind Menubutton <Key-space>]
	regsub -all -- {%W} $script $path.button new_script
	bind $path.entry <Key-Down> $new_script
	bind $path.entry <Return> "$self return_pressed \[%W get\]"
	bind $path.entry <FocusOut> "$self restore_entry"
}
DropDown/Text instproc return_pressed { text } {
	$self set_var $text
	set path [$self info path]
	$path.entry selection from 0
	$path.entry selection to end
	$path.entry icursor end	
}
DropDown/Text instproc restore_entry {} {
	upvar #0 [$self set var_] global_var
	if [info exists global_var] {
		$self config_entryVal {} $global_var
	} else {
		$self config_entryVal {} {}
	}
}
DropDown/Text instproc config_state { option {value {}} } {
	if { $value=={} } {
		return [$self subwidget cget button -state]
	} else {
		$self subwidget button configure -state $value
		$self subwidget entry  configure -state $value
	}
}
DropDown/Text instproc set_var { value } {
	$self config_entryVal {} $value
	$self next $value
}
DropDown/Text instproc clear { } {
	$self set_var ""
}
DropDown/Text instproc var_trace { args } {
	set path [$self info path]
	if { [$path.entry selection present] && [focus]==$path } {
		$path.entry selection from 0
		$path.entry selection to   end
		$path.entry icursor end
	}
}
DropDown/Text instproc ev_key_down_ { } {
	set button [$self subwidget button]
	set takefocus [$button cget -takefocus]
	$button configure -takefocus 1
	set oldfocus [focus]
	focus $button
	event generate $button <Key-space>
	focus $oldfocus
	$button configure -takefocus $takefocus
}
WidgetClass EntryWithHistory -superclass DropDown/Text -configspec {
	{ -maxhistory maxHistory MaxHistory 15 config_maxhist cget_maxhist }
}
EntryWithHistory instproc add_history { } {
	set value [$self cget -value]
	regsub -all -- {\*} $value {\*} val1
	regsub -all -- {\?} $val1  {\?} val2
	regsub -all -- {\[} $val2  {\[} val1
	regsub -all -- {\]} $val1  {\]} val2
	catch { $self subwidget menu delete "$val2" }
	$self insert 0 $value
	set index [$self subwidget menu index end]
	set maxhistory [$self cget_maxhist -maxhistory]
	if { $index!="none" && $index >= $maxhistory } {
		$self subwidget menu delete $maxhistory end
	}
}
EntryWithHistory instproc config_maxhist { option value } {
	$self instvar max_history_
	set max_history_ $value
	set index [$self subwidget menu index end]
	if { $index!="none" && $index >= $max_history_ } {
		$self subwidget menu delete $index end
	}
}
EntryWithHistory instproc cget_maxhist { option } {
	$self instvar max_history_
	if [info exists max_history_] { return $max_history_ } else {return 0}
}
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 1 config_option }
	{ -closecmd closeCmd CloseCmd {} config_option }
}
Dialog instproc create_root_widget { path } {
	toplevel $path -class [$self info class]
	wm withdraw $path
	wm protocol $path WM_DELETE_WINDOW "$self cancel"
}
Dialog instproc config_defaultfocus { option args } {
	if { [llength $args]==0 } {
		return [$self set default_focus_]
	} else {
		$self set default_focus_ [string trim [lindex $args 0]]
	}
}
Dialog instproc config_wm_option { option args } {
	if { [llength $args]==0 } {
		return [wm [string range [string trim $option] 1 end] \
				[$self info path]]
	} else {
		wm [string range [string trim $option] 1 end] \
				[$self info path] [lindex $args 0]
	}
}
Dialog instproc config_transient { option args } {
	set path [$self info path]
	if { [llength $args]==0 } {
		return [wm transient $path]
	} else {
		set is_mapped [winfo ismapped $path]
		wm transient $path [lindex $args 0]
		if { !$is_mapped } {
			wm withdraw $path
		}
	}
}
Dialog instproc center { } {
	set path [$self info path]
	wm withdraw $path
	update idletasks
	update
	set x [expr [winfo screenwidth $path]/2 - [winfo reqwidth $path]/2 \
			- [winfo vrootx [winfo parent $path]]]
	set y [expr [winfo screenheight $path]/2 - [winfo reqheight $path]/2 \
			- [winfo vrooty [winfo parent $path]]]
	wm geom $path +$x+$y
	wm deiconify $path
	raise $path
}
Dialog instproc grab { {start_focus {}} } {
	$self instvar old_focus_ old_grab_ grab_status_	
	set path [$self info path]
	set old_focus_ [focus]
	set old_grab_ [grab current $path]
	if {$old_grab_ != ""} {
		set grab_status_ [grab status $old_grab_]
	}
	grab $path
	if { [string trim $start_focus]=={} } {
		set start_focus [$self cget -defaultfocus]
	}
	if { $start_focus != {} } {
		focus [eval [list $self] subwidget $start_focus]
	}
}
Dialog instproc release { } {
	$self instvar old_focus_ old_grab_ grab_status_
	catch {focus $old_focus_}
	grab release [$self info path]
	if {$old_grab_ != ""} {
		if {$grab_status_ == "global"} {
			grab -global $old_grab_
		} else {
			grab $old_grab_
		}
	}
}
Dialog instproc wait { } {
	$self tkvar result_
	catch { unset result_ }
	tkwait variable [$self tkvarname result_]
	return $result_
}
Dialog instproc invoke { {start_focus {}} } {
	$self instvar old_focus_ old_grab_ grab_status_
	set path [$self info path]
	$self center
	if { [$self cget -modal] } {
		$self grab $start_focus
		set result [$self wait]
		$self release
		wm withdraw $path
		$self invoke_closecmd
		return $result
	} else {
		if { [string trim $start_focus]=={} } {
			set start_focus [$self cget -defaultfocus]
		}
		if { $start_focus != {} } {
			focus [eval [list $self] subwidget $start_focus]
		}
		$self tkvar result_
		catch { unset result_ }
		trace variable result_ w "Dialog nonmodal_result_ [list $self]\
				; $self ignore_args"
		return ""
	}
}
Dialog instproc cancel { } {
	$self configure -result {}
}
Dialog instproc config_result { option value } {
	$self tkvar result_
	set result_ $value
}
Dialog instproc cget_result { option } {
	$self tkvar result_
	if { [info exists result_] } {
		return $result_
	} else {
		return ""
	}
}
Dialog instproc config_option { option args } {
	$self instvar config_
	if { [llength $args]==0 } {
		return $config_($option)
	} else {
		set config_($option) [lindex $args 0]
	}
}
Dialog instproc invoke_closecmd { } {
	set closecmd [$self cget -closecmd]
	if { [string trim $closecmd]!={} } {
		uplevel #0 $closecmd
	}
}
Dialog proc nonmodal_result_ { dlg } {
	if { [info command $dlg]==$dlg } {
		set path [$dlg info path]
		if { ![winfo exists $path] } return
		wm deiconify [$dlg info path]
		$dlg tkvar result_
		trace vdelete result_ w "Dialog nonmodal_result_ $dlg"
		$dlg invoke_closecmd
	}
}
Dialog proc transient { cl args } {
	set count 0
	set path .dialog__$count
	while { [winfo exists $path] } {
		set path .dialog__$count
		incr count
	}
	eval $cl [list $path] $args
	set modal [$path cget -modal]
	if { ! $modal } {
		set command [$path cget -closecmd]
		append command "; destroy $path"
		$path configure -closecmd $command
		return [$path invoke]
	} else {
		set result [$path invoke]
		destroy $path
		return $result
	}
}
WidgetClass ScrolledWidget -configspec {
	{ -scrollbar scrollbar Scrollbar {none} config_scroll cget_scroll }
}
ScrolledWidget instproc build_widget { path } {
	$self instvar main_
	frame  $path.dummy -borderwidth 0 -relief flat
	set main_ [$self create_main_widget $path]
	scrollbar $path.vscroll -command "$main_ yview" -orient vertical
	scrollbar $path.hscroll -command "$main_ xview" \
			-orient horizontal
	$main_ configure -yscrollcommand "$path.vscroll set"
	$main_ configure -xscrollcommand "$path.hscroll set"
	pack $path.dummy -side top -fill both -expand 1
	pack $main_ -side left -anchor nw -fill both -expand 1 \
			-in $path.dummy
}
ScrolledWidget instproc create_main_widget { path } {
	error "cannot create object of class [$self info class];\
			every subclass MUST redefine the create_main_widget\
			method"
}
ScrolledWidget instproc config_scroll { option scroll } {
	$self instvar main_
	set path [$self info path]
	catch {
		pack forget $path.vscroll
		pack forget $path.hscroll
	}
	switch $scroll {
		horizontal {
			pack $path.hscroll -side bottom -fill x \
					-before $path.dummy
		}
		vertical {
			pack $path.vscroll -side right -fill y \
					-in $path.dummy -before $main_
		}
		both {
			pack $path.hscroll -side bottom -fill x \
					-before $path.dummy
			pack $path.vscroll -side right -fill y \
					-in $path.dummy -before $main_
		}
		auto {
			error "function not implemented"
		}
		default {
			set scroll none
		}
	}
	$self set scroll_ $scroll
}
ScrolledWidget instproc cget_scroll { option } {
	$self instvar scroll_
	if [info exists scroll_] { return $scroll_ } else { return none }
}
WidgetClass ScrolledCanvas -superclass ScrolledWidget
ScrolledCanvas instproc create_main_widget { path } {
	return [canvas $path.bbox]
}
WidgetClass ScrolledText -superclass ScrolledWidget
ScrolledText instproc create_main_widget { path } {
	return [text $path.text]
}
WidgetClass ScrolledWindow -superclass ScrolledCanvas
ScrolledWindow instproc build_widget { path } {
	$self next $path
	frame $path.bbox.window
	$path.bbox create window 0 0 -anchor nw -window $path.bbox.window
	$self set_subwidget window $path.bbox.window
	bind $path.bbox.window <Configure> "+$self ev_window_resize %w %h"
}
ScrolledWindow instproc ev_window_resize { width height } {
	[$self subwidget bbox] configure -scrollregion "0 0 $width $height"
}
WidgetClass ScrolledWindow/Expand -superclass ScrolledWindow
ScrolledWindow/Expand instproc build_widget { path } {
	$self next $path
	set dummy [frame [$self subwidget bbox].dummy_ -width 0 -height 0 \
			-relief flat -bg [[$self subwidget window] cget -bg]]
	pack $dummy -side top -in [$self subwidget window]
	bind [$self subwidget bbox] <Configure> "+$self ev_bbox_resize_ %w %h"
}
ScrolledWindow/Expand instproc ev_bbox_resize_ { w h } {
	set window [$self subwidget window]
	set bbox   [$self subwidget bbox]
	$bbox.dummy_ configure \
			-width [expr $w - ([$bbox cget -bd] + \
			[$window cget -bd] + [$bbox cget -highlightthickness] \
			+ [$window cget -highlightthickness]) * 2]
}
WidgetClass ListLabelItem -configspec {
	{ -value       value       Value       {}            config_value }
	{ -select      select      Select      0             config_option }
	{ -highlight   highlight   Highlight   0             config_option }
	{ -relief relief Relief flat config_relief cget_relief }
	{ -normalbackground normalBackground NormalBackground \
			WidgetDefault(-background) config_option }
	{ -normalforeground normalForeground NormalForeground \
			WidgetDefault(-foreground) config_option }
	{ -normalrelief normalRelief NormalRelief flat config_option }
	{ -selectbackground selectBackground SelectBackground WidgetDefault \
			config_option }
	{ -selectforeground selectForeground SelectForeground WidgetDefault \
			config_option }
	{ -selectrelief selectRelief SelectRelief sunken config_option }
	{ -highlightrelief highlightRelief HighlightRelief raised \
			config_option }
}
ListLabelItem instproc init { args } {
	$self instvar config_
	set config_(-value) {}
	set config_(-select) 0
	set config_(-highlight) 0
	set config_(-normalbackground) Black
	set config_(-normalforeground) Black
	set config_(-normalrelief)     flat
	set config_(-selectbackground) Black
	set config_(-selectforeground) Black
	set config_(-selectrelief)     sunken
	set config_(-highlightrelief)  raised
	eval [list $self] next $args	
}
ListLabelItem instproc create_root_widget { path } {
	label $path -anchor w
	if { [option get $path padX Label]=="" } {
		$path configure -padx 1
	}
	if { [option get $path padX Label]=="" } {
		$path configure -pady 1
	}
}
ListLabelItem instproc config_value { option args } {
	$self instvar config_
	if { [llength $args]==0 } {
		return [$self widget_proc cget -text]
	} else {
		$self widget_proc configure -text [lindex $args 0]
	}
}
ListLabelItem instproc config_option { option args } {
	$self instvar config_
	if { [llength $args]==0 } {
		return $config_($option)
	} else {
		set value [lindex $args 0]
		set config_($option) $value
		$self config_[string range $option 1 end] $value
	}
}
ListLabelItem instproc config_relief { option value } {
	$self widget_proc configure -relief $value
}
ListLabelItem instproc cget_relief { option } {
	$self widget_proc cget -relief
}
ListLabelItem instproc config_normalbackground { value } {
	if { ![$self set config_(-select)] } {
		$self widget_proc configure -bg $value
	}
}
ListLabelItem instproc config_normalforeground { value } {
	if { ![$self set config_(-select)] } {
		$self widget_proc configure -fg $value
	}
}
ListLabelItem instproc config_normalrelief { value } {
	if { ![$self set config_(-select)] && \
			![$self set config_(-highlight)] } {
		$self widget_proc configure -relief $value
	}
}
ListLabelItem instproc config_selectbackground { value } {
	if { [$self set config_(-select)] } {
		$self widget_proc configure -bg $value
	}
}
ListLabelItem instproc config_selectforeground { value } {
	if { [$self set config_(-select)] } {
		$self widget_proc configure -fg $value
	}
}
ListLabelItem instproc config_selectrelief { value } {
	if { [$self set config_(-select)] && \
		![$self set config_(-highlight)] } {
		$self widget_proc configure -relief $value
	}
}
ListLabelItem instproc config_highlightrelief { value } {
	if { [$self set config_(-highlight)] } {
		$self widget_proc configure -relief $value
	}
}
ListLabelItem instproc config_select { value } {
	$self instvar config_
	if { $value } {
		$self widget_proc configure -bg $config_(-selectbackground)
		$self widget_proc configure -fg $config_(-selectforeground)
		if { !$config_(-highlight) } {
			$self widget_proc configure \
					-relief $config_(-selectrelief)
		}
	} else {
		$self widget_proc configure -bg $config_(-normalbackground)
		$self widget_proc configure -fg $config_(-normalforeground)
		if { !$config_(-highlight) } {
			$self widget_proc configure \
					-relief $config_(-normalrelief)
		}
	}
}
ListLabelItem instproc config_highlight { value } {
	$self instvar config_
	if { $value } {
		$self widget_proc configure -relief $config_(-highlightrelief)
	} else {
		if { $config_(-select) } {
			$self widget_proc configure \
					-relief $config_(-selectrelief)
		} else {
			$self widget_proc configure \
					-relief $config_(-normalrelief)
		}
	}
}
WidgetClass ScrolledListbox -superclass ScrolledWindow -configspec {
	{ -itemclass itemClass ItemClass ListLabelItem config_option }
	{ -browsecmd browseCmd BrowseCmd "" config_option }
	{ -command command Command "" config_option }
	{ -selectmode selectMode SelectMode single config_selectmode }
} -default {
	{ *window.takeFocus 1 }
	{ *window.highlightThickness 0 }
}
ScrolledListbox instproc build_widget { path } {
	$self next $path
	set window [$self subwidget window]
	frame $window.dummy_ -width 0 -height 0 -relief flat \
			-bg [$window cget -bg]
	pack $window.dummy_ -side top
	$self create_bindtag
	$self set count_ 0
	$self set highlight_ ""
}
ScrolledListbox instproc create_bindtag { } {
	bind [$self subwidget bbox] <Configure> "+$self ev_bbox_resize_ %w %h"
	set window [$self subwidget window]
	bind $window <KeyPress-Up> "$self ev_key_up_"
	bind $window <KeyPress-Down> "$self ev_key_down_"
	bind $window <KeyPress-space> "$self ev_key_space_"
	bind Bindings_$self <ButtonPress-1> "+$self selection.toggle -widget \
			\[$self root_widget_ %W\]; $self browse \
			\[$self widget_to_id_ \[$self root_widget_ %W\]\]"
	bind Bindings_$self <Double-1> "+$self invoke \
			\[$self widget_to_id_ \[$self root_widget_ %W\]\]"
	bind Bindings_$self <Enter> "+if \{ \[$self root_widget_ %W\] == \
			\"%W\" \} \{ $self highlight.set -widget %W \}"
	bind Bindings_$self <Leave> "+if \{ \[$self root_widget_ %W\] == \
			\"%W\" \} \{ $self highlight.clear -widget %W \}"
}
ScrolledListbox instproc ev_bbox_resize_ { w h } {
	set window [$self subwidget window]
	set bbox   [$self subwidget bbox]
	$window.dummy_ configure \
			-width [expr $w - ([$bbox cget -bd] + \
			[$window cget -bd] + [$bbox cget -highlightthickness] \
			+ [$window cget -highlightthickness]) * 2]
}
ScrolledListbox instproc ev_key_up_ { } {
	set highlight [$self highlight.get]
	if { $highlight != "" } {
		set list [$self widget_list_]
		set idx [lsearch $list [$self id_to_widget_ $highlight]]
		if { $idx <= 0 } {
			return
		}
		incr idx -1
	} else {
		set idx 0
	}
	$self see $idx
	$self highlight.set $idx
}
ScrolledListbox instproc ev_key_down_ { } {
	set highlight [$self highlight.get]
	if { $highlight != "" } {
		set list [$self widget_list_]
		set idx [lsearch $list [$self id_to_widget_ $highlight]]
		if { $idx < 0 || $idx >= [expr [llength $list]-1] } {
			return
		}
		incr idx 1
	} else {
		set idx 0
	}
	$self see $idx
	$self highlight.set $idx
}
ScrolledListbox instproc ev_key_space_ { } {
	set highlight [$self highlight.get]
	if { $highlight != "" } {
		$self selection.toggle -id $highlight
		$self browse $highlight
	}
}
ScrolledListbox instproc root_widget_ { path } {
	set window [$self subwidget window]
	set widget $path
	while { $widget!="" && [winfo parent $widget] != $window } {
		set widget [winfo parent $widget]
	}
	if { $widget=="" } {
		error "invalid widget $path"
	}
	return $widget
}
ScrolledListbox instproc widget_list_ { } {
	set list [pack slaves [$self subwidget window]]
	return [lrange $list 1 end]
}
ScrolledListbox instproc config_option { option args } {
	$self instvar config_
	if { [llength $args]==0 } {
		return $config_($option)
	} else {
		set config_($option) [lindex $args 0]
	}
}
ScrolledListbox instproc config_selectmode { option args } {
	$self instvar config_
	if { [llength $args]==0 } {
		return $config_(-selectmode)
	}
	set value [lindex $args 0]
	switch -exact -- $value {
		single {
			set config_(-selectmode) "single"
			set selection [lindex [$self selection.get all] 0]
			$self selection.clear all
			if { $selection!="" } {
				$self selection.set -id $selection
			}
		}
		multiple {
			set config_(-selectmode) "multiple"
		}
		none {
			set config_(-selectmode) "none"
			$self selection.clear all
		}
		default {
			error "invalid selectmode \"$value\". must be one of\
					\"single\", \"multiple\", or \"none\""
		}
	}
}
ScrolledListbox instproc browse { id } {
	set browsecmd [$self cget -browsecmd]
	if { $browsecmd!="" } {
		uplevel #0 $browsecmd [list $id]
	}
}
ScrolledListbox instproc invoke { id } {
	set command [$self cget -command]
	if { $command!="" } {
		uplevel #0 $command [list $id]
	}
}
ScrolledListbox instproc ID { idVar arguments { idx 0 } } {
	upvar $idVar id
	if { [llength $arguments] <= $idx } {
		error "missing arguments"
	}
	set arg [lindex $arguments $idx]
	switch -exact -- $arg {
		-id {
			set end [expr $idx+2]
			if { [llength $arguments] < $end } {
				error "missing argument for \"-id\""
			}
			set id [lindex $arguments [expr $idx+1]]
			return $end
		}
		-widget {
			set end [expr $idx+2]
			if { [llength $arguments] < $end } {
				error "missing argument for \"-widget\""
			}
			set widget [lindex $arguments [expr $idx+1]]
			set id [$self widget_to_id_ $widget]
			return $end
		}
		-value {
			set end [expr $idx+2]
			if { [llength $arguments] < $end } {
				error "missing argument for \"-value\""
			}
			set widget [lindex $arguments [expr $idx+1]]
			set id [$self value_to_id_ $widget]
			return $end
		}
		default {
			set id [$self index_to_id_ $arg]
			return [expr $idx+1]
		}
	}
}
ScrolledListbox instproc widget_to_id_ { widget } {
	$self instvar widget_to_id_
	if [info exists widget_to_id_($widget)] {
		return $widget_to_id_($widget)
	} else {
		error "invalid widget \"$widget\""
	}
}
ScrolledListbox instproc value_to_id_ { value } {
	foreach widget [self widget_list_] {
		if { $value == [$self info.value -widget $widget] } {
			return $id
		}
	}
	error "invalid value \"$value\""
}
ScrolledListbox instproc index_to_id_ { index } {
	set widget [lindex [$self widget_list_] $index]
	if { $widget=="" } {
		error "invalid index \"$index\""
	}
	return [$self widget_to_id_ $widget]
}
ScrolledListbox instproc id_to_widget_ { id } {
	$self instvar id_to_widget_
	if [info exists id_to_widget_($id)] {
		return $id_to_widget_($id)
	} else {
		error "invalid id \"$id\""
	}
}
ScrolledListbox instproc id_to_value_ { id } {
	set widget [$self id_to_widget_ $id]
	return [$widget cget -value]
}
ScrolledListbox instproc insert { where args } {
	$self instvar count_ id_to_widget_ widget_to_id_
	switch -exact -- $where {
		end {
			set where ""
		}
		after {
			set idx [$self ID where_id $args]
			set where "-after [$self id_to_widget_ $where_id]"
			set args [lrange $args $idx end]
		}
		before {
			set idx [$self ID where_id $args]
			set where "-before [$self id_to_widget_ $where_id]"
			set args [lrange $args $idx end]
		}
		default {
			error "invalid argument \"$where\". must be one of\
					\"end\", \"after\", or \"before\""
		}
	}
	set window [$self subwidget window]
	set item_class [$self cget -itemclass]
	if { $item_class=="" } {
		error "must configure -itemclass before inserting any elements"
	}
	foreach arg $args {
		if { [lindex $arg 0] == "-id" } {
			if { [llength $arg] <= 1 } {
				error "missing argument for \"-id\""
			}
			set id [lindex $arg 1]
			set arg [lrange $arg 2 end]
		} else {
			set id #$count_
		}
		if { [info exists id_to_widget_($id)] } {
			error "id \"$id\" already exists"
		}
		set widget $window.item_$count_
		incr count_
		$item_class $widget -value $arg
		$self bindtag_recursive_ $widget
		if { $where=="" } {
			pack $widget -side top -fill x -expand 1
		} else {
			eval pack [list $widget] -side top -fill x -expand 1 \
					$where
		}
		set id_to_widget_($id) $widget
		set widget_to_id_($widget) $id
	}
}
ScrolledListbox instproc delete { args } {
	$self instvar id_to_widget_ widget_to_id_ selection_ highlight_
	if { [lindex $args 0]=="all" } {
		if { [llength $args]!=1 } {
			error "extra arguments starting at argument 2"
		}
		foreach widget [$self widget_list_] {
			destroy $widget
		}
		catch {
			unset id_to_widget_
			unset widget_to_id_
			unset selection_
		}
		set highlight_ ""
	} else {
		set id [eval [list $self] info.id $args]
		set widget [$self id_to_widget_ $id]
		destroy $widget
		catch {
			unset id_to_widget_($id)
			unset widget_to_id_($widget)
			unset selection_($id)
		}
		if { $highlight_==$id } {
			set highlight_ ""
		}
	}
}
ScrolledListbox instproc bindtag_recursive_ { widget } {
	$self bindtag_ $widget
	foreach path [winfo children $widget] {
		$self bindtag_recursive_ $path
	}
}
ScrolledListbox instproc bindtag_ { widget } {
	set tags [bindtags $widget]
	if {[lsearch -exact $tags Bindings_$self] == -1} {
		bindtags $widget [concat [list Bindings_$self] $tags]
	}
}
ScrolledListbox instproc see { args } {
	set id [eval [list $self] info.id $args]
	set widget [$self id_to_widget_ $id]
	set y1 [winfo y $widget]
	set y2 [expr $y1 + [winfo height $widget] - 1]
	set viewable [$self subwidget bbox yview]
	set scrollregion [$self subwidget bbox cget -scrollregion]
	set height [expr [lindex $scrollregion 3] - [lindex $scrollregion 1]]
	set bbox_y1 [expr $height * [lindex $viewable 0] + \
			[lindex $scrollregion 1]]
	set bbox_y2 [expr $height * [lindex $viewable 1] + \
			[lindex $scrollregion 1]]
	if { $y1 < $bbox_y1 } {
		set bbox_y1 $y1
		$self subwidget bbox yview moveto \
				[expr double($bbox_y1)/double($height)]
	} elseif { $y2 > $bbox_y2 } {
		set bbox_y1 [expr $y2 - ($bbox_y2 - $bbox_y1)]
		$self subwidget bbox yview moveto \
				[expr double($bbox_y1)/double($height)]
	}
}
ScrolledListbox instproc info { method args } {
	if { [$class info instprocs info.$method] == "info.$method" } {
		return [eval [list $self] [list info.$method] $args]
	} else {
		return [eval [list $self] next [list $method] $args]
	}
}
ScrolledListbox instproc info.id { args } {
	set idx [$self ID id $args]
	if { [llength $args] > $idx } {
		error "extra arguments starting with argument $idx"
	}
	return $id
}
ScrolledListbox instproc info.widget { args } {
	set id [eval [list $self] info.id $args]
	return [$self id_to_widget_ $id]
}
ScrolledListbox instproc info.value { args } {
	set id [eval [list $self] info.id $args]
	return [$self id_to_value_ $id]
}
ScrolledListbox instproc info.all { {what {}} } {
	switch -exact -- $what {
		{} -
		-id {
			set ids {}
			foreach widget [$self widget_list_] {
				lappend ids [$self widget_to_id_ $widget]
			}
			return $ids
		}
		-widget {
			return [$self widget_list_]
		}
		-value {
			set values
			foreach widget [$self widget_list_] {
				set id [$self widget_to_id_ $widget]
				lappend values [$self id_to_value_ $id]
			}
			return $values
		}
		default {
			error "invalid argument \"$what\". must be one of\
					\"-id\", \"-widget\", or \"-value\""
		}
	}
}
ScrolledListbox instproc info.exists { args } {
	set len [llength $args]
	if { $len > 2 } {
		error "extra arguments"
	}
	switch -exact -- [lindex $args 0] {
		-id {
			if { $len < 2 } {
				error "missing argument for \"-id\""
			}
			return [info exists id_to_widget_([lindex $args 1])]
		}
		-widget {
			if { $len < 2 } {
				error "missing argument for \"-widget\""
			}
			return [info exists widget_to_id_([lindex $args 1])]
		}
		-value {
			if { $len < 2 } {
				error "missing argument for \"-widget\""
			}
			return ![catch {$self value_to_id_ [lindex $args 1]}]
		}
		default {
			if { $len > 1 } {
				error "extra arguments"
			}
			return ![catch {$self index_to_id_ [lindex $args 1]}]
		}
	}
}
ScrolledListbox instproc info.numelems { } {
	return [llength [$self widget_list_]]
}
ScrolledListbox instproc selection { method args } {
	eval [list $self] [list selection.$method] $args
}
ScrolledListbox instproc selection.set { args } {
	$self instvar selection_
	set selectmode [$self cget -selectmode]
	if { $selectmode=="none" } {
		return
	}
	if { [lindex $args 0]=="all" } {
		if { [llength $args] > 1 } {
			error "extra arguments starting at argument 2"
		}
		foreach widget [$self widget_list_] {
			$self selection.set -widget $widget
		}
	}
	set id [eval [list $self] info.id $args]
	if { [info exists selection_($id)] } {
		return
	}
	if { [$self cget -selectmode]=="single" } {
		$self selection.clear all
	}
	set selection_($id) 1
	set widget [$self id_to_widget_ $id]
	$widget configure -select 1
}
ScrolledListbox instproc selection.get { args } {
	$self instvar selection_
	if { [llength $args]==0 } {
		return [array names selection_]
	}
	if { [lindex $args 0]=="all" } {
		if { [llength $args] > 1 } {
			error "extra arguments starting at argument 2"
		}
		return [array names selection_]
	}
	set id [eval [list $self] info.id $args]
	if { [info exists selection_($id)] } {
		return $id
	} else {
		return ""
	}
}
ScrolledListbox instproc selection.clear { args } {
	$self instvar selection_
	if { [llength $args]==0 } {
		$self selection.clear_all_
		return
	}
	if { [lindex $args 0]=="all" } {
		if { [llength $args] > 1 } {
			error "extra arguments starting at argument 2"
		}
		$self selection.clear_all_
		return
	}
	set id [eval [list $self] info.id $args]
	if { [info exists selection_($id)] } {
		unset selection_($id)
		[$self id_to_widget_ $id] configure -select 0
	} else {
		return
	}
}
ScrolledListbox instproc selection.clear_all_ { } {
	$self instvar selection_
	foreach id [array names selection_] {
		unset selection_($id)
		[$self id_to_widget_ $id] configure -select 0
	}
}
ScrolledListbox instproc selection.toggle { args } {
	set id [eval [list $self] info.id $args]
	if { [$self selection.get -id $id]=="" } {
		$self selection.set -id $id
	} else {
		$self selection.clear -id $id
	}
}
ScrolledListbox instproc highlight { method args } {
	eval [list $self] [list highlight.$method] $args
}
ScrolledListbox instproc highlight.set { args } {
	$self instvar highlight_
	set id [eval [list $self] info.id $args]
	if { $id == $highlight_ } {
		return
	}
	if { $highlight_!="" } {
		[$self id_to_widget_ $highlight_] configure -highlight 0
	}
	set highlight_ $id
	[$self id_to_widget_ $id] configure -highlight 1
}
ScrolledListbox instproc highlight.get { args } {
	$self instvar highlight_
	if { [llength $args]==0 } {
		return $highlight_
	}
	set id [eval [list $self] info.id $args]
	if { $highlight_==$id } {
		return $id
	} else {
		return ""
	}
}
ScrolledListbox instproc highlight.clear { args } {
	$self instvar highlight_
	if { [llength $args]==0 } {
		[$self id_to_widget_ $highlight_] configure -highlight 0
		set highlight_ ""
	} else {
		set id [eval [list $self] info.id $args]
		if { $highlight_==$id } {
			[$self id_to_widget_ $highlight_] configure \
					-highlight 0
			set highlight_ ""
		}
	}
}
ScrolledListbox instproc highlight.toggle { args } {
	$self instvar highlight_
	if { [llength $args]==0 } {
		$self highlight.clear
	} else {
		set id [eval [list $self] info.id $args]
		if { $id == $highlight_ } {
			$self highlight.clear
		} else {
			$self highlight.set -id $id
		}
	}
}
WidgetClass HierarchicalListboxItem -configspec {
	{ -value       value       Value       {}            config_value }
	{ -select      select      Select      0             config_option }
	{ -highlight   highlight   Highlight   0             config_option }
	{ -normalbackground normalBackground NormalBackground \
			WidgetDefault(-background) config_option }
	{ -normalforeground normalForeground NormalForeground \
			WidgetDefault(-foreground) config_option }
	{ -normalrelief normalRelief NormalRelief flat config_option }
	{ -selectbackground selectBackground SelectBackground WidgetDefault \
			config_option }
	{ -selectforeground selectForeground SelectForeground WidgetDefault \
			config_option }
	{ -selectrelief selectRelief SelectRelief sunken config_option }
	{ -highlightrelief highlightRelief HighlightRelief raised \
			config_option }
} -default {
	{ .borderWidth WidgetDefault }
	{ *font WidgetDefault }
	{ *Label.padX 1 }
	{ *Label.padY 0 }
	{ *Label.borderWidth 0 }
}
HierarchicalListboxItem instproc init { args } {
	$self instvar config_
	set config_(-value) {}
	set config_(-select) 0
	set config_(-highlight) 0
	set config_(-normalbackground) Black
	set config_(-normalforeground) Black
	set config_(-normalrelief)     flat
	set config_(-selectbackground) Black
	set config_(-selectforeground) Black
	set config_(-selectrelief)     sunken
	set config_(-highlightrelief)  raised
	eval [list $self] next $args	
}
HierarchicalListboxItem instproc build_widget { path } {
	label $path.padding
	label $path.image
	label $path.text -anchor w
	pack $path.padding -side left
	pack $path.image -side left
	pack $path.text  -side left -fill x -anchor w
}
HierarchicalListboxItem instproc config_value { option args } {
	$self instvar config_
	if { [llength $args]==0 } {
		if [info exists config_(-value)] {
			return $config_(-value)
		} else {
			return ""
		}
	} else {
		set value [lindex $args 0]
		set image [lindex $value 0]
		set config_(-value) [lindex $value 1]
		set split [split $config_(-value) "/"]
		if { $config_(-value)=="/" || [llength $split] <= 1 } {
			set level 0
			set label $config_(-value)
		} else {
			set level [llength $split]
			set label [lindex $split [expr $level-1]]
		}
		$self subwidget padding configure -padx [expr $level * 4]
		$self subwidget image   configure -image $image
		$self subwidget text    configure -text  $label
	}
}
HierarchicalListboxItem instproc config_option { option args } {
	$self instvar config_
	if { [llength $args]==0 } {
		return $config_($option)
	} else {
		set value [lindex $args 0]
		$self config_[string range $option 1 end] $value
		set config_($option) $value
	}
}
HierarchicalListboxItem instproc config_background { value } {
	set path [$self info path]
	$path configure -bg $value
	foreach label [winfo children $path] {
		$label configure -bg $value
	}
}
HierarchicalListboxItem instproc config_foreground { value } {
	foreach label [winfo children [$self info path]] {
		$label configure -fg $value
	}
}
HierarchicalListboxItem instproc config_relief { value } {
	[$self info path] configure -relief $value
}
HierarchicalListboxItem instproc config_normalbackground { value } {
	if { ![$self set config_(-select)] } {
		$self config_background $value
	}
}
HierarchicalListboxItem instproc config_normalforeground { value } {
	if { ![$self set config_(-select)] } {
		$self config_foreground $value
	}
}
HierarchicalListboxItem instproc config_normalrelief { value } {
	if { ![$self set config_(-select)] && \
			![$self set config_(-highlight)] } {
		$self config_relief $value
	}
}
HierarchicalListboxItem instproc config_selectbackground { value } {
	if { [$self set config_(-select)] } {
		$self config_background $value
	}
}
HierarchicalListboxItem instproc config_selectforeground { value } {
	if { [$self set config_(-select)] } {
		$self config_foreground $value
	}
}
HierarchicalListboxItem instproc config_selectrelief { value } {
	if { [$self set config_(-select)] && \
		![$self set config_(-highlight)] } {
		$self config_relief $value
	}
}
HierarchicalListboxItem instproc config_highlightrelief { value } {
	if { [$self set config_(-highlight)] } {
		$self config_relief $value
	}
}
HierarchicalListboxItem instproc config_select { value } {
	$self instvar config_
	if { $value } {
		$self config_background $config_(-selectbackground)
		$self config_foreground $config_(-selectforeground)
		if { !$config_(-highlight) } {
			$self config_relief $config_(-selectrelief)
		}
	} else {
		$self config_background $config_(-normalbackground)
		$self config_foreground $config_(-normalforeground)
		if { !$config_(-highlight) } {
			$self config_relief $config_(-normalrelief)
		}
	}
}
HierarchicalListboxItem instproc config_highlight { value } {
	$self instvar config_
	if { $value } {
		$self config_relief $config_(-highlightrelief)
	} else {
		if { $config_(-select) } {
			$self config_relief $config_(-selectrelief)
		} else {
			$self config_relief $config_(-normalrelief)
		}
	}
}
WidgetClass MultiColumnListbox -superclass ScrolledCanvas -configspec {
	{ -browsecmd browseCmd BrowseCmd "" config_option }
	{ -command command Command "" config_option }
	{ -selectbackground selectBackground SelectBackground #a0a0ff \
			config_option }
	{ -font font Font WidgetDefault	config_option }
} -default {
	{ .scrollbar horizontal }
	{ *hscroll.highlightThickness 0 }
	{ *hscroll.takeFocus 0 }
	{ *bbox.borderWidth 2 }
	{ *bbox.width 400 }
	{ *bbox.height 120 }
}
MultiColumnListbox instproc config_option { option args } {
	$self instvar data
	if { [llength $args] == {} } {
		return $data($option)
	} else {
		set data($option) [lindex $args 0]
	}
}
MultiColumnListbox instproc build_widget { path } {
	$self instvar data
	$self next $path
	set data(canvas) [$self subwidget bbox]
	set data(sbar) [$self subwidget hscroll]
	set data(maxIW) 1
	set data(maxIH) 1
	set data(maxTW) 1
	set data(maxTH) 1
	set data(numItems) 0
	set data(curItem)  {}
	set data(noScroll) 1
	bind $data(canvas) <Configure> "+$self arrange"
	bind $data(canvas) <1>         "$self btn1 %x %y"
	bind $data(canvas) <B1-Motion> "$self motion1 %x %y"
	bind $data(canvas) <Double-1>  "$self double1 %x %y"
	bind $data(canvas) <ButtonRelease-1> "tkCancelRepeat"
	bind $data(canvas) <B1-Leave>  "$self leave1 %x %y"
	bind $data(canvas) <B1-Enter>  "tkCancelRepeat"
	bind $data(canvas) <Up>        "$self up_down -1"
	bind $data(canvas) <Down>      "$self up_down  1"
	bind $data(canvas) <Left>      "$self left_right -1"
	bind $data(canvas) <Right>     "$self left_right  1"
	bind $data(canvas) <Return>    "$self return_key"
	bind $data(canvas) <KeyPress>  "$self key_press %A"
	bind $data(canvas) <Control-KeyPress> ";"
	bind $data(canvas) <Alt-KeyPress>  ";"
	bind $data(canvas) <FocusIn>   "$self focus_in"
}
MultiColumnListbox instproc auto_scan { } {
	$self instvar data
	global tkPriv
	set x $tkPriv(x)
	set y $tkPriv(y)
	if $data(noScroll) {
		return
	}
	if {$x >= [winfo width $data(canvas)]} {
		$data(canvas) xview scroll 1 units
	} elseif {$x < 0} {
		$data(canvas) xview scroll -1 units
	} elseif {$y >= [winfo height $data(canvas)]} {
	} elseif {$y < 0} {
	} else {
		return
	}
	$self motion1 $x $y
	set tkPriv(afterId) [after 50 $self auto_scan]
}
MultiColumnListbox instproc delete_all {} {
	$self instvar data
	$self instvar itemList
	$data(canvas) delete all
	catch {unset data(selected)}
	catch {unset data(rect)}
	catch {unset data(list)}
	catch {unset itemList}
	set data(numItems) 0
	set data(curItem)  {}
}
MultiColumnListbox instproc add {image text} {
	$self instvar data
	$self instvar itemList
	$self instvar textList
	set iTag [$data(canvas) create image 0 0 -image $image -anchor nw]
	set tTag [$data(canvas) create text  0 0 -text  $text  -anchor nw \
			-font $data(-font)]
	set rTag [$data(canvas) create rect  0 0 0 0 -fill "" -outline ""]
	set b [$data(canvas) bbox $iTag]
	set iW [expr [lindex $b 2]-[lindex $b 0]]
	set iH [expr [lindex $b 3]-[lindex $b 1]]
	if {$data(maxIW) < $iW} {
		set data(maxIW) $iW
	}
	if {$data(maxIH) < $iH} {
		set data(maxIH) $iH
	}
	set b [$data(canvas) bbox $tTag]
	set tW [expr [lindex $b 2]-[lindex $b 0]]
	set tH [expr [lindex $b 3]-[lindex $b 1]]
	if {$data(maxTW) < $tW} {
		set data(maxTW) $tW
	}
	if {$data(maxTH) < $tH} {
		set data(maxTH) $tH
	}
	lappend data(list) [list $iTag $tTag $rTag $iW $iH $tW $tH \
			$data(numItems)]
	set itemList($rTag) [list $iTag $tTag $text $data(numItems)]
	set textList($data(numItems)) [string tolower $text]
	incr data(numItems)
}
MultiColumnListbox instproc arrange {} {
	$self instvar data
	if ![info exists data(list)] {
		if {[info exists data(canvas)] && \
				[winfo exists $data(canvas)]} {
			set data(noScroll) 1
			$data(sbar) config -command ""
		}
		return
	}
	set W [winfo width  $data(canvas)]
	set H [winfo height $data(canvas)]
	set pad [expr [$data(canvas) cget -highlightthickness] + \
			[$data(canvas) cget -bd]]
	incr W -[expr $pad*2]
	incr H -[expr $pad*2]
	set dx [expr $data(maxIW) + $data(maxTW) + 4]
	if {$data(maxTH) > $data(maxIH)} {
		set dy $data(maxTH)
	} else {
		set dy $data(maxIH)
	}
	set shift [expr $data(maxIW) + 4]
	set x [expr $pad * 2]
	set y [expr $pad * 1]
	set usedColumn 0
	foreach pair $data(list) {
		set usedColumn 1
		set iTag [lindex $pair 0]
		set tTag [lindex $pair 1]
		set rTag [lindex $pair 2]
		set iW   [lindex $pair 3]
		set iH   [lindex $pair 4]
		set tW   [lindex $pair 5]
		set tH   [lindex $pair 6]
		set i_dy [expr ($dy - $iH)/2]
		set t_dy [expr ($dy - $tH)/2]
		$data(canvas) coords $iTag $x                 [expr $y + $i_dy]
		$data(canvas) coords $tTag [expr $x + $shift] [expr $y + $t_dy]
		$data(canvas) coords $tTag [expr $x + $shift] [expr $y + $t_dy]
		$data(canvas) coords $rTag $x $y [expr $x+$dx] [expr $y+$dy]
		incr y $dy
		if {[expr $y + $dy] >= $H} {
			set y [expr $pad * 1]
			incr x $dx
			set usedColumn 0
		}
	}
	if {$usedColumn} {
		set sW [expr $x + $dx]
	} else {
		set sW $x
	}
	if {$sW < $W} {
		$data(canvas) config -scrollregion "$pad $pad $sW $H"
		$data(sbar) config -command ""
		$data(canvas) xview moveto 0
		set data(noScroll) 1
	} else {
		$data(canvas) config -scrollregion "$pad $pad $sW $H"
		$data(sbar) config -command "$data(canvas) xview"
		set data(noScroll) 0
	}
	set data(itemsPerColumn) [expr ($H-$pad)/$dy]
	if {$data(itemsPerColumn) < 1} {
		set data(itemsPerColumn) 1
	}
	if {$data(curItem) != {}} {
		$self select [lindex [lindex $data(list) $data(curItem)] 2] 0
	}
}
MultiColumnListbox instproc invoke {} {
	$self instvar data
	if {[string compare $data(-command) ""] && \
			[info exists data(selected)]} {
		eval $data(-command) [list $data(selected)]
	}
}
MultiColumnListbox instproc see {rTag} {
	$self instvar data
	$self instvar itemList
	if $data(noScroll) {
		return
	}
	set sRegion [$data(canvas) cget -scrollregion]
	if ![string compare $sRegion {}] {
		return
	}
	if ![info exists itemList($rTag)] {
		return
	}
	set bbox [$data(canvas) bbox $rTag]
	set pad [expr [$data(canvas) cget -highlightthickness] + \
			[$data(canvas) cget -bd]]
	set x1 [lindex $bbox 0]
	set x2 [lindex $bbox 2]
	incr x1 -[expr $pad * 2]
	incr x2 -[expr $pad * 1]
	set cW [expr [winfo width $data(canvas)] - $pad*2]
	set scrollW [expr [lindex $sRegion 2]-[lindex $sRegion 0]+1]
	set dispX [expr int([lindex [$data(canvas) xview] 0]*$scrollW)]
	set oldDispX $dispX
	if {[expr $x2 - $dispX] >= $cW} {
		set dispX [expr $x2 - $cW]
	}
	if {[expr $x1 - $dispX] < 0} {
		set dispX $x1
	}
	if {$oldDispX != $dispX} {
		set fraction [expr double($dispX)/double($scrollW)]
		$data(canvas) xview moveto $fraction
	}
}
MultiColumnListbox instproc select_at_XY {x y} {
	$self instvar data
	$self select [$data(canvas) find closest \
			[$data(canvas) canvasx $x] [$data(canvas) canvasy $y]]
}
MultiColumnListbox instproc select {rTag {callBrowse 1}} {
	$self instvar data
	$self instvar itemList
	if ![info exists itemList($rTag)] {
		return
	}
	set iTag   [lindex $itemList($rTag) 0]
	set tTag   [lindex $itemList($rTag) 1]
	set text   [lindex $itemList($rTag) 2]
	set serial [lindex $itemList($rTag) 3]
	if ![info exists data(rect)] {
		set data(rect) [$data(canvas) create rect 0 0 0 0 \
				-fill $data(-selectbackground) \
				-outline $data(-selectbackground)]
	}
	$data(canvas) lower $data(rect)
	set bbox [$data(canvas) bbox $tTag]
	eval $data(canvas) coords $data(rect) $bbox
	set data(curItem) $serial
	set data(selected) $text
	if {$callBrowse} {
		if [string compare $data(-browsecmd) ""] {
			eval $data(-browsecmd) [list $text]
		}
	}
}
MultiColumnListbox instproc unselect {} {
	$self instvar data
	if [info exists data(rect)] {
		$data(canvas) delete $data(rect)
		unset data(rect)
	}
	if [info exists data(selected)] {
		unset data(selected)
	}
	set data(curItem)  {}
}
MultiColumnListbox instproc get {} {
	$self instvar data
	if [info exists data(selected)] {
		return $data(selected)
	} else {
		return ""
	}
}
MultiColumnListbox instproc btn1 {x y} {
	$self instvar data
	focus $data(canvas)
	$self select_at_XY $x $y
}
MultiColumnListbox instproc motion1 {x y} {
	global tkPriv
	set tkPriv(x) $x
	set tkPriv(y) $y
	$self select_at_XY $x $y
}
MultiColumnListbox instproc double1 {x y} {
	$self instvar data
	if {$data(curItem) != {}} {
		$self invoke
	}
}
MultiColumnListbox instproc return_key {} {
	$self invoke
}
MultiColumnListbox instproc leave1 {x y} {
	global tkPriv
	set tkPriv(x) $x
	set tkPriv(y) $y
	$self auto_scan
}
MultiColumnListbox instproc focus_in {} {
	$self instvar data
	if ![info exists data(list)] {
		return
	}
	if {$data(curItem) == {}} {
		set rTag [lindex [lindex $data(list) 0] 2]
		$self select $rTag
	}
}
MultiColumnListbox instproc up_down {amount} {
	$self instvar data
	if ![info exists data(list)] {
		return
	}
	if {$data(curItem) == {}} {
		set rTag [lindex [lindex $data(list) 0] 2]
	} else {
		set oldRTag [lindex [lindex $data(list) $data(curItem)] 2]
		set rTag [lindex [lindex $data(list) [expr \
				$data(curItem)+$amount]] 2]
		if ![string compare $rTag ""] {
			set rTag $oldRTag
		}
	}
	if [string compare $rTag ""] {
		$self select $rTag
		$self see $rTag
	}
}
MultiColumnListbox instproc left_right {amount} {
	$self instvar data
	if ![info exists data(list)] {
		return
	}
	if {$data(curItem) == {}} {
		set rTag [lindex [lindex $data(list) 0] 2]
	} else {
		set oldRTag [lindex [lindex $data(list) $data(curItem)] 2]
		set newItem [expr $data(curItem)+($amount*\
				$data(itemsPerColumn))]
		set rTag [lindex [lindex $data(list) $newItem] 2]
		if ![string compare $rTag ""] {
			set rTag $oldRTag
		}
	}
	if [string compare $rTag ""] {
		$self select $rTag
		$self see $rTag
	}
}
MultiColumnListbox instproc key_press {key} {
	global tkPriv
	set w [$self info path]
	append tkPriv(ILAccel,$w) $key
	$self goto $tkPriv(ILAccel,$w)
	catch {
		after cancel $tkPriv(ILAccel,$w,afterId)
	}
	set tkPriv(ILAccel,$w,afterId) [after 500 $self reset]
}
MultiColumnListbox instproc goto {text} {
	$self instvar data
	$self instvar textList
	global tkPriv
	if ![info exists data(list)] {
		return
	}
	if {[string length $text] == 0} {
		return
	}
	if {$data(curItem) == {} || $data(curItem) == 0} {
		set start  0
	} else {
		set start  $data(curItem)
	}
	set text [string tolower $text]
	set theIndex -1
	set less 0
	set len [string length $text]
	set len0 [expr $len-1]
	set i $start
	while 1 {
		set sub [string range $textList($i) 0 $len0]
		if {[string compare $text $sub] == 0} {
			set theIndex $i
			break
		}
		incr i
		if {$i == $data(numItems)} {
			set i 0
		}
		if {$i == $start} {
			break
		}
	}
	if {$theIndex > -1} {
		set rTag [lindex [lindex $data(list) $theIndex] 2]
		$self select $rTag 0
		$self see $rTag
	}
}
MultiColumnListbox instproc reset { } {
	global tkPriv
	set w [$self info path]
	catch {unset tkPriv(ILAccel,$w)}
}
WidgetClass CompoundButton -configspec {
	{ -relief relief Relief raised config_all }
	{ -background background Background WidgetDefault config_all }
	{ -foreground foreground Foreground WidgetDefault config_all }
	{ -state state State normal config_all }
	{ -font font Font WidgetDefault config_all }
	{ -command command Command "" config_command }
} -alias {
	{ -bg -background }
	{ -fg -foreground }
} -default {
	{ .highlightThickness WidgetDefault }
	{ .takeFocus 1 }
	{ .borderWidth WidgetDefault }
	{ .relief raised }
}
CompoundButton proc root { className path } {
	while { $path!="" && [winfo class $path]!=$className } {
		set path [winfo parent $path]
	}
	return $path
}
CompoundButton proc init_ { cl } {
	$self instvar init_done_
	if [info exists init_done_($cl)] return
	set init_done_($cl) 1
	bind $cl <B1-Motion> "\[$self root $cl %W\] b1_motion %W %x %y"
	bind $cl <Button-1>  "\[$self root $cl %W\] button_down"
	bind $cl <ButtonRelease-1> "\[$self root $cl %W\] button_up"
}
CompoundButton instproc init { args } {
	CompoundButton init_ [$self info class]
	eval [list $self] next $args
	$self set button_down_ 0
	$self set entered_ 0
}
CompoundButton instproc build_widget { path } {
	bind $path <Enter> "$self enter"
	bind $path <Leave> "$self leave"
	bind $path <Key-space> "$self invoke_with_ui"
}
CompoundButton instproc add { args } {
	set widget_type [lindex $args 0]
	set subwidget   [lindex $args 1]
	set path        [$self info path].$subwidget
	eval [list $widget_type] [list $path] [lrange $args 2 end]
	$self instvar config_
	foreach name [array names config_] {
		$path configure $name $config_($name)
	}
	if { ![catch {$path configure -takefocus}] } {
		$path configure -takefocus 0
	}
	if { ![catch {$path configure -highlightthickness}] } {
		$path configure -highlightthickness 0
	}
	set tags [bindtags $path]
	set idx [lsearch $tags [winfo class $path]]
	if { $idx!=-1 } {
		set tags [lreplace $tags $idx $idx]
	}
	set cl [$self info class]
	if { [lsearch $tags $cl] == -1 } {
		set tags [concat $cl $tags]
	}
	bindtags $path $tags
	return $subwidget
}
CompoundButton instproc remove { subwidget } {
	destroy [$self info path].$subwidget
}
CompoundButton instproc invoke { } {
	set command [$self cget -command]
	if { [string trim $command]!={} } {
		uplevel #0 $command
	}
}
CompoundButton instproc config_command { option args } {
	$self instvar config_
	if { [llength $args] == 0 } {
		return $config_(-command)
	} else {
		set config_(-command) [lindex $args 0]
	}
}
CompoundButton instproc config_all { option args } {
	$self instvar config_
	if { [llength $args]==0 } {
		return $config_($option)
	} else {
		set value [lindex $args 0]
		set config_($option) $value
		if { ![catch {$self widget_proc configure $option}] } {
			$self widget_proc configure $option $value
		}
		foreach child [winfo children [$self info path]] {
			if { ![catch {$child configure $option}] } {
				$child configure $option $value
			}
		}
	}
}
CompoundButton instproc button_down { } {
	$self instvar button_down_ saved_relief_
	set saved_relief_ [$self cget -relief]
	if { [$self cget -state] != "disabled" } {
		set button_down_ 1
		$self configure -relief sunken
	}
}
CompoundButton instproc button_up { } {
	$self instvar entered_ button_down_ saved_relief_
	if { $button_down_ } {
		set button_down_ 0
		$self configure -relief $saved_relief_
		if { $entered_ && [$self cget -state] != "disabled" } {
			$self invoke
		}
	}
}
CompoundButton instproc b1_motion { widget x y } {
	$self instvar button_down_ entered_
	if { !$button_down_ } return
	set root [$self info path]
	if { $widget!=$root } {
		incr x [winfo x $widget]
		incr y [winfo y $widget]
	}
	if { $x >= 0 && $y >= 0 && $x < [winfo width $root] && \
			$y < [winfo height $root] } {
		if { ! $entered_ } {
			$self enter
		}
	} else {
		if { $entered_ } {
			$self leave
		}
	}
}
CompoundButton instproc enter { } {
	$self instvar entered_ button_down_
	if { [$self cget -state] != "disabled" } {
		if { $button_down_ } {
			$self configure -relief sunken
		}
		set entered_ 1
	}
}
CompoundButton instproc leave { } {
	$self instvar entered_ button_down_ saved_relief_
	if { $button_down_ } {
		$self configure -relief $saved_relief_
	}
	set entered_ 0
}
CompoundButton instproc invoke_with_ui { } {
	if {[$self cget -state] != "disabled"} {
		set oldRelief [$self cget -relief]
		$self configure -relief sunken
		update idletasks
		after 100
		$self configure -relief $oldRelief
		$self invoke
	}
}
WidgetClass ImageTextButton -superclass CompoundButton -configspec {
	{ -orient orient Orient horizontal config_orient }
	{ -style style Style imagetext config_style }
	{ -image image Image {} config_imageoption }
	{ -text text Text {} config_textoption }
	{ -underline underline Underline -1 config_textoption }
	{ -command command Command {} config_textoption }
} -alias {
	{ -under -underline }
} -default {
	{ *Button.borderWidth 0 }
	{ *Button.highlightThickness 0 }
	{ *Button.padX 1 }
	{ *Button.padY 1 }
}
ImageTextButton instproc build_widget { path } {
	$self next $path
	$self add button image
	$self add button text
}
ImageTextButton instproc repack { } {
	set path   [$self info path]
	catch { pack forget $path.image }
	catch { pack forget $path.text  }
	switch [$self cget -orient] {
		horizontal {
			set side left
		}
		vertical -
		default {
			set side top
		}
	}
	switch [$self cget -style] {
		imagetext {
			set list "[list $path.image] [list $path.text]"
		}
		image {
			set list $path.image
		}
		text {
			set list $path.text
		}
	}
	eval pack $list -side [list $side] -expand 1 -fill both -padx 2
}
ImageTextButton instproc config_orient { option {orient {}} } {
	$self instvar orient_
	switch -exact -- $orient {
		{} {
			if { [info exists orient_] } {
				return $orient_
			} else {
				return vertical
			}
		}
		vertical -
		horizontal {
			set orient_ $orient
			$self repack
		}
		default {
			error "invalid orientation $orient"
		}
	}
}
ImageTextButton instproc config_style { option {style {}} } {
	$self instvar style_
	switch -exact -- $style {
		{} {
			if { [info exists style_] } {
				return $style_
			} else {
				return imagetext
			}
		}
		imagetext -
		image -
		text {
			set style_ $style
			$self repack
		}
		default {
			error "invalid style $style"
		}
	}
}
ImageTextButton instproc config_imageoption { option args } {
	if { [llength $args]==0 } {
		return [$self subwidget image cget $option]
	} else {
		$self subwidget image configure $option [lindex $args 0]
	}
}
ImageTextButton instproc config_textoption { option args } {
	if { [llength $args]==0 } {
		return [$self subwidget text cget $option]
	} else {
		$self subwidget text configure $option [lindex $args 0]
	}
}
WidgetClass LabeledWidget -configspec {
	{ -label  label Label {} config_label }
	{ -underline underline Underline -1 config_underline }
	{ -widget widget Widget {} config_widget }
	{ -orient orient Orient horizontal config_orient }
} -alias {
	{ -under -underline }
}
LabeledWidget instproc build_widget { path } {
	label $path.label -anchor w
	$self set widget_ ""
}
LabeledWidget instproc config_label { option args } {
	if { [llength $args]==0 } {
		return [$self subwidget label cget -text]
	} else {
		$self subwidget label configure -text [lindex $args 0]
	}
}
LabeledWidget instproc config_underline { option args } {
	if { [llength $args]==0 } {
		return [$self subwidget label cget -underline]
	} else {
		$self subwidget label configure -underline [lindex $args 0]
	}
}
LabeledWidget instproc config_widget { option args } {
	$self instvar widget_
	if { [llength $args]==0 } {
		return $widget_
	} else {
		set widget [lindex $args 0]
		if { $widget != "" && [winfo parent $widget]!=[winfo parent \
				[$self info path]] } {
			error "\"$widget\" must have the same parent as\
					\"[$self info path]\""
		}
		catch { pack forget $widget_ }
		set widget_ $widget
		$self repack
	}
}
LabeledWidget instproc config_orient { option args } {
	$self instvar orient_
	if { [llength $args]==0 } {
		if { [info exists orient_] } {
			return $orient_
		} else {
			return horizontal
		}
	} else {
		$self set orient_ [lindex $args 0]
		$self repack
	}
}
LabeledWidget instproc repack { } {
	$self instvar widget_
	set label [$self subwidget label]
	catch { pack forget $label $widget_ }
	set orient [$self cget -orient]
	switch -exact -- $orient {
		horizontal {
			set side left
			set label_fill x
		}
		vertical {
			set side top
			set label_fill y
		}
		default {
			error "invalid orientation \"$orient\""
		}
	}
	pack $label -side $side -fill $label_fill -anchor w
	if { $widget_!="" } {
		set path [$self info path]
		pack $widget_ -side $side -fill both -expand 1 -in $path
		raise $widget_ $path
	}
}
WidgetClass MessageBox -superclass Dialog -configspec {
	{ -image image Image {} config_image  }
	{ -text  text  Text  {} config_text   }
	{ -type  type  Type  {ok} config_type }
} -default {
	{ .transient . }
	{ .title "Message" }
	{ *image.padX 10 }
	{ *image.padY 5 }
	{ *text.wrapLength 3i }
	{ *ImageTextButton.borderWidth 1 }
	{ *ImageTextButton.highlightThickness 1 }	
}
MessageBox instproc build_widget { path } {
	frame $path.bot -relief raised -bd 1
	pack  $path.bot -side bottom -fill x
	frame $path.top -relief raised -bd 1
	pack  $path.top -side top -fill both -expand 1
	label $path.image
	label $path.text -justify left
	pack $path.image -side left -in $path.top
	pack $path.text -side right -fill both -expand 1 -in $path.top
}
MessageBox instproc config_image { option args } {
	if { [llength $args]==0 } {
		return [$self subwidget image cget -image]
	} else {
		$self subwidget image configure -image [lindex $args 0]
	}
}
MessageBox instproc config_text { option args } {
	if { [llength $args]==0 } {
		return [$self subwidget text cget -text]
	} else {
		$self subwidget text configure -text [lindex $args 0]
	}
}
MessageBox instproc config_type { option args } {
	if { [llength $args]==0 } {
		return [$self set type_]
	}
	$self instvar type_
	set type_ [lindex $args 0]
	foreach button [pack slaves [$self subwidget bot]] {
		destroy $button
	}
	switch -exact -- $type_ {
		abortretryignore {
			set buttons {
				{abort  -text Abort -under 0 \
						-image Icons(cross)}
				{retry  -text Retry -under 0 
						-image Icons(redo) }
				{ignore -text Ignore -under 0 -style text}
			}
		}
		ok {
			set buttons {
				{ok -text OK -under 0 -image Icons(check)}
			}
		}
		okcancel {
			set buttons {
				{ok -text OK -under 0 -image Icons(check) }
				{cancel -text Cancel -under 0 \
						-image Icons(cross) }
			}
		}
		retrycancel {
			set buttons {
				{retry  -text Retry  -under 0 \
						-image Icons(redo) }
				{cancel -text Cancel -under 0 \
						-image Icons(cross) }
			}
		}
		yesno {
			set buttons {
				{yes -text Yes -under 0 -image Icons(check) }
				{no  -text No  -under 0 -image Icons(cross) }
			}
		}
		yesnocancel {
			set buttons {
				{yes -text Yes -under 0 -image Icons(check) }
				{no  -text No  -under 0 -image Icons(cross) }
				{cancel -text Cancel -under 0 -style text}
			}
		}
		none {
			set buttons {}
		}
		default {
			set buttons $type_
		}
	}
	set i 0
	set path [$self info path]
	foreach button [subst $buttons] {
		set name [lindex $button 0]
		set opts [lrange $button 1 end]
		if ![string compare $opts {}] {
			set capName [string toupper [string index \
					$name 0]][string range $name 1 end]
			set opts [list -text $capName]
		}
		eval ImageTextButton $path.$name $opts -orient horizontal \
				-command [list "$self configure -result $name"]
		pack $path.$name -in $path.bot -side left -expand 1 -fill y \
				-padx 3m -pady 2m
		set underIdx [$path.$name cget -under]
		if {$underIdx >= 0} {
			set key [string index [$path.$name cget -text] \
					$underIdx]
			bind $path <Alt-[string tolower $key]> \
					"$path.$name invoke_with_ui"
			bind $path <Alt-[string toupper $key]> \
					"$path.$name invoke_with_ui"
			bind $path <KeyPress-[string tolower $key]> \
					"$path.$name invoke_with_ui"
			bind $path <KeyPress-[string toupper $key]> \
					"$path.$name invoke_with_ui"
		}
		incr i
	}
}
MessageBox instproc config_type_ { option args } {
	if { [llength $args]==0 } {
		return [$self set type_]
	}
	$self instvar type_
	set type_ [lindex $args 0]
	set path [$self info path]
	foreach button [pack slaves [$self subwidget bot]] {
		if { $button == "$path.default" } {
			eval destroy [pack slaves $button]
		}
		destroy $button
	}
	switch -exact -- $type_ {
		abortretryignore {
			set buttons {
				{abort  -width 6 -text Abort -under 0 \
						-image Icons(cross)}
				{retry  -width 6 -text Retry -under 0 \
						-image Icons(redo) }
				{ignore -width 6 -text Ignore -under 0}
			}
		}
		ok {
			set buttons {
				{ok -width 6 -text OK -under 0 \
						-image Icons(check)}
			}
		}
		okcancel {
			set buttons {
				{ok     -width 6 -text OK     -under 0 \
						-image Icons(check) }
				{cancel -width 6 -text Cancel -under 0 \
						-image Icons(cross) }
			}
		}
		retrycancel {
			set buttons {
				{retry  -width 6 -text Retry  -under 0 \
						-image Icons(redo) }
				{cancel -width 6 -text Cancel -under 0 \
						-image Icons(cross) }
			}
		}
		yesno {
			set buttons {
				{yes    -width 6 -text Yes -under 0 \
						-image Icons(check) }
				{no     -width 6 -text No  -under 0 \
						-image Icons(cross) }
			}
		}
		yesnocancel {
			set buttons {
				{yes    -width 6 -text Yes -under 0 \
						-image Icons(check) }
				{no     -width 6 -text No  -under 0 \
						-image Icons(cross) }
				{cancel -width 6 -text Cancel -under 0}
			}
		}
		default {
			error "invalid message box type \"$type_\",\
					must be abortretryignore, ok,\
					okcancel, retrycancel, yesno or\
					yesnocancel"
		}
	}
	set default [$self cget -default]
	if { $default=="" } {
		set default [lindex [lindex $buttons 0] 0]
		$self configure -default $default
	} else {
		set valid 0
		foreach button $buttons {
			if { ![string compare $default [lindex $button 0]] } {
				set valid 1
				break
			}
		}
		if { ! $valid } {
			error "invalid default button \"$default\""
		}
	}
	set i 0
	set path [$self info path]
	foreach button [subst $buttons] {
		set name [lindex $button 0]
		set opts [lrange $button 1 end]
		if ![string compare $opts {}] {
			set capName [string toupper [string index \
					$name 0]][string range $name 1 end]
			set opts [list -text $capName]
		}
		eval ImageTextButton $path.$name $opts \
				-command [list "$self configure -result $name"]
		if ![string compare $name $default] {
			frame $path.default -relief flat -bd 1 -bg black
			raise $path.$name $path.default
			pack $path.default -in $path.bot -side left -expand 1 \
					-padx 3m -pady 2m
			pack $path.$name -in $path.default
		} else {
			pack $path.$name -in $path.bot -side left -expand 1 \
					-padx 3m -pady 2m
		}
		set underIdx [$path.$name cget -under]
		if {$underIdx >= 0} {
			set key [string index [$path.$name cget -text] \
					$underIdx]
			bind $path <Alt-[string tolower $key]> \
					"$path.$name invoke_with_ui"
			bind $path <Alt-[string toupper $key]> \
					"$path.$name invoke_with_ui"
		}
		incr i
	}
	bind $path <Return> "$path.$default invoke_with_ui"
}
WidgetClass FileBox -default {
	{ *font WidgetDefault }
	{ *Button.borderWidth 1 }
	{ *Menubutton.borderWidth 1 }
	{ *Menu.borderWidth 1 }
	{ *Entry.borderWidth 1 }
	{ *Button.highlightThickness 1 }
	{ *Menubutton.highlightThickness 1 }
	{ *MultiColumnListbox.bbox.highlightThickness 1 }
	{ *Entry.highlightThickness 1 }
	{ *MultiColumnListbox.bbox.borderWidth 1 }
	{ *MultiColumnListbox.bbox.relief sunken }
	{ *MultiColumnListbox.Scrollbar.borderWidth 1 }
	{ *MultiColumnListbox.Scrollbar.width 10 }
	{ *Menubutton.anchor w }
	{ *Menubutton.padX 5 }
} -configspec {
	{ -filetypes fileTypes FileTypes "" config_filetypes cget_filetypes }
	{ -directory directory Directory "" config_directory cget_directory }
	{ -filename  filename  Filename  "" config_filename  cget_filename  }
	{ -browsecmd browseCmd BrowseCmd "" config_browsecmd cget_browsecmd }
	{ -command   command   command   "" config_command   cget_command   }
}
FileBox instproc build_widget { path } {
	set f1 [frame $path.f1]
	label $f1.label -text "Directory:" -underline 0
	DropDown $f1.directory -variable [$self tkvarname directory_]
	button $f1.upbutton -image Icons(folderup) \
			-command "$self up_folder_cmd"
	pack $f1.upbutton -side right -padx 4 -fill both
	pack $f1.label -side left -padx 4 -fill both
	pack $f1.directory -expand yes -fill both -padx 4
	$self set_subwidget directory $f1.directory
	$self set_subwidget upbutton  $f1.upbutton
	MultiColumnListbox $path.listbox -browsecmd "$self list_browse" \
			-command "$self list_command"
	set f2 [frame $path.f2]
	label $f2.label -text "File name:" -anchor e -width 14 -underline 5
	entry $f2.filename -textvariable [$self tkvarname filename_]
	pack $f2.label -side left -padx 4
	pack $f2.filename -expand yes -fill both -padx 2 -pady 2
	$self set_subwidget filename $f2.filename
	$self set_subwidget filename_label $f2.label
	set f3 [frame $path.f3]
	label $f3.label -text "Files of type:" -anchor e -width 14 \
			-underline 9
	DropDown $f3.filetypes -variable [$self tkvarname filetypes_]
	pack $f3.label -side left -padx 4
	pack $f3.filetypes -expand yes -fill x -side right
	$self set_subwidget filetypes_label $f3.label
	$self set_subwidget filetypes $f3.filetypes
	pack $f1 -side top -fill x -pady 4
	pack $f3 -side bottom -fill x
	pack $f2 -side bottom -fill x
	pack $path.listbox -expand yes -fill both -padx 4 -pady 2
	set filename [$self subwidget filename]
	bind $filename <Return>   "$self entry_command"
	bind $filename <FocusIn>  "$self subwidget listbox unselect"
	set w [winfo toplevel $path]
	bind $w <Alt-d> "focus [$self subwidget directory subwidget button]"
	bind $w <Alt-t> "focus [$self subwidget filetypes subwidget button]"
	bind $w <Alt-n> "focus [$self subwidget filename]"
	$self tkvar directory_ filetypes_
	$self tkvar filter_
	trace variable directory_ w "$self do_when_idle \"$self update\"; \
			$self ignore_args"
	trace variable filetypes_ w "$self set_filter; \
			$self ignore_args"
	trace variable filter_(current) w "$self do_when_idle \
			\"$self update\"; $self ignore_args"
	$self do_when_idle "$self update"
}
FileBox instproc config_directory { option value } {
	if { $value=={} } {
		set value [pwd]
	}
	$self tkvar directory_
	set directory_ $value
}
FileBox instproc cget_directory { option } {
	$self tkvar directory_
	return $directory_
}
FileBox instproc config_filename { option value } {
	$self tkvar filename_
	set filename_ $value
}
FileBox instproc cget_filename { option } {
	$self tkvar filename_
	return $filename_
}
FileBox instproc config_filetypes { option value } {
	set filetypes [$self subwidget filetypes]
	$filetypes delete 0 end
	$self tkvar filetypes_
	set filetypes_ ""
	$self tkvar filter_
	catch { unset filter_ }
	if { [trace vinfo filter_(current)]=="" } {
		trace variable filter_(current) w "$self do_when_idle \
				\"$self update\"; $self ignore_args"
	}
	if { [llength $value]==0 } {
		$filetypes configure -state disabled
		$self subwidget filetypes_label configure -foreground \
				[$filetypes subwidget button cget \
				-disabledforeground]
		set filter_(all) ""
		set filter_(current) ""
	} else {
		$filetypes configure -state normal
		$self subwidget filetypes_label configure -foreground \
				[$filetypes subwidget button cget \
				-foreground]
		foreach filetype $value {
			set name [lindex $filetype 0]
			append name " ("
			set filter ""
			set first 1
			foreach ext [lindex $filetype 1] {
				set ext [string trim $ext]
				if { $first } {
					set first 0
				} else {
					append name ", "
				}
				if { $ext=="*" } {
					append name "*"
					lappend filter ".*" "*"
				} else {
					append name "*$ext"
					lappend filter "*$ext"
				}
			}
			append name ")"
			set filter_(filter_for_$name) $filter
			$filetypes insert end $name
		}
		set filter_(all) $value
	}
}
FileBox instproc cget_filetypes { option } {
	$self tkvar filter_
	if { [info exists filter_(all)] } {
		return $filter_(all)
	} else {
		return ""
	}
}
FileBox instproc config_browsecmd { option value } {
	$self instvar browsecmd_
	set browsecmd_ [string trim $value]
}
FileBox instproc cget_browsecmd { option } {
	$self instvar browsecmd_
	return $browsecmd_
}
FileBox instproc config_command { option value } {
	$self instvar command_
	set command_ [string trim $value]
}
FileBox instproc cget_command { option } {
	$self instvar command_
	return $command_
}
FileBox instproc set_filter { args } {
	$self tkvar filter_
	$self tkvar filetypes_
	if { [info exists filter_(filter_for_$filetypes_)] } {
		set filter_(current) $filter_(filter_for_$filetypes_)
	} else {
		set filter_(current) $filetypes_
	}
}
FileBox instproc current_filter { args } {
        $self tkvar filter_
        return $filter_(current)
}
FileBox instproc invoke { cmdType args } {
	set varname "${cmdType}_"
	$self instvar "$varname cmd"
	if { $cmd!="" } {
		uplevel #0 $cmd $args
	}
}
FileBox instproc list_browse { text } {
	$self tkvar directory_ filename_
	if {$text == ""} {
		return
	}
	set file [file join $directory_ $text]
		set filename_ $text
	$self invoke browsecmd $text
}
FileBox instproc list_command { text } {
	$self tkvar directory_ filename_
	if {$text == ""} {
		return
	}
	set file [file join $directory_ $text]
	if [file isdirectory $file] {
		set appPWD [pwd]
		if [catch {cd $file}] {
			Dialog transient MessageBox -type ok -text \
				"Cannot change to the directory \"$file\".\
				\nPermission denied." -image Icons(warning)
		} else {
			cd $appPWD
			set directory_ $file
		}
	} else {
		set filename_ $text
		$self invoke command $text
	}
}
FileBox instproc up_folder_cmd { } {
	$self tkvar directory_
	if [string compare $directory_ "/"] {
		set directory_ [file dirname $directory_]
	}
}
FileBox instproc entry_command { } {
	$self tkvar directory_ filename_ filetypes_
	set list [$self resolve_file $directory_ $filename_]
	set flag [lindex $list 0]
	set path [lindex $list 1]
	set file [lindex $list 2]
	case $flag {
		OK {
			set directory_ $path
			set filename_  $file
			if [string compare $file ""] {
				$self invoke command
			}
		}
		PATTERN {
			set directory_ $path
			set filetypes_ $file
		}
		FILE {
			set directory_ $path
			set filename_  $file
			$self invoke command
		}
		PATH {
			Dialog transient MessageBox -image Icons(warning) \
					-type ok -text \
					"Directory \"$path\" does not exist."
			set entry [$self subwidget filename]
			$entry select from 0
			$entry select to end
			$entry icursor end
		}
		CHDIR {
			Dialog transient MessageBox -type ok -text \
					"Cannot change to the directory \"$path\".\nPermission denied."	-image Icons(warning)
			set entry [$self subwidget filename]
			$entry select from 0
			$entry select to end
			$entry icursor end
		}
		ERROR {
			Dialog transient MessageBox -type ok -text \
					"Invalid file name \"$path\"."\
					-image Icons(warning)
			set entry [$self subwidget filename]
			$entry select from 0
			$entry select to end
			$entry icursor end
		}
	}
}
FileBox instproc resolve_file {context text} {
	set appPWD [pwd]
	set path [file join $context $text]
	if [catch {file exists $path}] {
		return [list ERROR $path ""]
	}
	if [file exists $path] {
		if [file isdirectory $path] {
			if [catch {
				cd $path
			}] {
				return [list CHDIR $path ""]
			}
			set directory [pwd]
			set file ""
			set flag OK
			cd $appPWD
		} else {
			if [catch {
				cd [file dirname $path]
			}] {
				return [list CHDIR [file dirname $path] ""]
			}
			set directory [pwd]
			set file [file tail $path]
			set flag OK
			cd $appPWD
		}
	} else {
		set dirname [file dirname $path]
		if [file exists $dirname] {
			if [catch {
				cd $dirname
			}] {
				return [list CHDIR $dirname ""]
			}
			set directory [pwd]
			set file [file tail $path]
			if [regexp {[*]|[?]} $file] {
				set flag PATTERN
			} else {
				set flag FILE
			}
			cd $appPWD
		} else {
			set directory $dirname
			set file [file tail $path]
			set flag PATH
		}
	}
	return [list $flag $directory $file]
}
FileBox instproc update { } {
	$self instvar updateId_
	catch {unset updateId_}
	set appPWD [pwd]
	set dir [$self cget -directory]
	if [catch {
		cd $dir
	}] {
		Dialog transient MessageBox -type ok -text \
				"Cannot change to the directory \"$dir\".\
				\nPermission denied." -image Icons(warning)
		cd $appPWD
		return
	}
	set entry [$self subwidget filename]
	set toplevel [winfo toplevel [$self info path]]
	set entryCursor [$entry cget -cursor]
	set toplevelCursor [$toplevel cget -cursor]
	$entry    config -cursor watch
	$toplevel config -cursor watch
	update idletasks
	set listbox [$self subwidget listbox]
	$listbox delete_all
	foreach f [lsort -command tclSortNoCase [glob -nocomplain .* *]] {
		if ![string compare $f .] {
			continue
		}
		if ![string compare $f ..] {
			continue
		}
		if [file isdirectory ./$f] {
			if ![info exists hasDoneDir($f)] {
				$listbox add Icons(folder) $f
				set hasDoneDir($f) 1
			}
		}
	}
	$self tkvar filter_
	if { ![string compare $filter_(current) *] || \
			$filter_(current)=="" } {
		set files [lsort -command tclSortNoCase \
				[glob -nocomplain .* *]]
	} else {
		set files [lsort -command tclSortNoCase \
				[eval glob -nocomplain $filter_(current)]]
	}
	set top 0
	foreach f $files {
		if ![file isdir $f] {
			if ![info exists hasDoneFile($f)] {
				$listbox add Icons(textfile) $f
				set hasDoneFile($f) 1
			}
		}
	}
	$listbox arrange
	set list ""
	set dir ""
	$self tkvar directory_
	foreach subdir [file split $directory_] {
		set dir [file join $dir $subdir]
		lappend list $dir
	}
	$self subwidget directory delete 0 end
	eval [list $self] subwidget directory insert end $list
	cd $appPWD
	$entry    config -cursor $entryCursor
	$toplevel config -cursor $toplevelCursor
}
WidgetClass DirectoryBox -configspec {
	{ -directory directory Directory { } config_directory cget_directory }
	{ -browsecmd browseCmd BrowseCmd { } config_option }
	{ -command command Command { } config_option }
	{ -allownonexistent allowNonexistent AllowNonexistent { 0 }
	config_option }
} -default {
	{ *font WidgetDefault }
	{ *Entry.borderWidth 1 }
	{ *Entry.highlightThickness 1 }
	{ *ScrolledListbox.borderWidth 1 }
	{ *ScrolledListbox.relief sunken }
	{ *ScrolledListbox.scrollbar both }
	{ *ScrolledListbox.itemClass HierarchicalListboxItem }
	{ *ScrolledListbox.bbox.highlightThickness 1 }
	{ *ScrolledListbox.Scrollbar.borderWidth 1 }
	{ *ScrolledListbox.Scrollbar.borderWidth 1 }
	{ *ScrolledListbox.Scrollbar.highlightThickness 1 }
	{ *ScrolledListbox.Scrollbar.width 10 }
	{ *HierarchicalListboxItem.borderWidth 1 }
}	
DirectoryBox instproc build_widget { path } {
	ScrolledListbox $path.dirbox -browsecmd "$self browse" \
			-command "$self invoke; $self ignore_args"
	frame $path.f1
	label $path.entry_label -text "Directory:"
	entry $path.entry -textvariable [$self tkvarname entry_]
	pack $path.entry_label -side left -in $path.f1
	pack $path.entry -side right -fill x -expand 1 -in $path.f1
	pack $path.f1 -side bottom -fill x
	pack $path.dirbox -side top -fill both -expand 1
	bind $path <Map> "$self set_trace"
	bind $path.entry <Return>   "$self entry_invoke"
	bind $path.entry <FocusIn>  "$self entry_focus_in"
	bind $path.entry <FocusOut> "$self entry_focus_out"
}
DirectoryBox instproc config_directory { option dir } {
	$self tkvar directory_
	if { [string trim $dir]=={} } {
		set directory_ [pwd]
	} else {
		set directory_ $dir
	}
}
DirectoryBox instproc cget_directory { option } {
	$self tkvar directory_
	return $directory_
}
DirectoryBox private set_trace { } {
	$self tkvar directory_
	trace variable directory_ w "$self do_when_idle \"$self update\"; \
			$self ignore_args"
	if [info exists directory_] {
		set directory_ $directory_
	}
	bind [$self info path] <Map> ""
}
DirectoryBox instproc config_option { option args } {
	$self instvar config_
	if { [llength $args]==0 } {
		return $config_($option)
	} else {
		set config_($option) [string trim [lindex $args 0]]
	}
}
DirectoryBox instproc entry_invoke { } {
	$self tkvar entry_ directory_
	set path [file join $directory_ $entry_]
	if { ![file isdirectory $path] } {
		if { ![$self cget -allownonexistent] } {
			Dialog transient MessageBox -type ok -text \
					"Invalid directory \"$path\"" \
					-image Icons(warning)
		} elseif { ![file exists $path] } {
			set retval [Dialog transient MessageBox \
					-type yesno -text \
					"Directory \"$path\" does\nnot exist\
					\n\nWould you like to create it?" \
					-image Icons(warning)]
			if { $retval=="yes" } {
				if [$self create_dir $path] {
					set directory_ $path
					set entry_ ""
				}
			}
		} else {
			Dialog transient MessageBox -type ok -text \
					"There is already a file with the\
					\nsame name" -image Icons(warning)
		}
	} else {
		set directory_ $path
		set entry_ ""
	}
}
DirectoryBox private create_dir { path } {
	set dir ""
	foreach split [file split $path] {
		set dir [file join $dir $split]
		if { ![file exists $dir] } {
			if [catch {file mkdir $dir}] {
				Dialog transient MessageBox -type ok -text \
						"Error occurred while creating\
						\"$dir\"" -image Icons(warning)
				return 0
			}
		}
	}
	return 1
}
DirectoryBox instproc entry_focus_in { } {
	$self tkvar entry_
	set entry [$self subwidget entry]
	if [string compare $entry_ ""] {
		$entry selection from 0
		$entry selection to   end
		$entry icursor end
	} else {
		$entry selection clear
	}
}
DirectoryBox instproc entry_focus_out { } {
	$self subwidget entry selection clear
}
DirectoryBox instproc browse { id } {
	$self tkvar directory_
	set directory [$self subwidget dirbox info value -id $id]
	if { [string compare $directory $directory_] } {
		focus [$self subwidget dirbox subwidget window]
		global tcl_platform
		if { $tcl_platform(platform) == "windows" } {
			if { [string first "/" $directory] == -1 } {
				append directory "/"
			}
		}
		set directory_ $directory
		set browsecmd [$self cget -browsecmd]
		if { $browsecmd != {} } {
			uplevel #0 $browsecmd $directory
		}
	}
}
DirectoryBox instproc invoke { } {
	set command [$self cget -command]
	if { $command != {} } {
		$self tkvar directory_
		uplevel #0 $command $directory_
	}
}
DirectoryBox instproc update { } {
	set directory [$self cget -directory]
	set appPWD [pwd]
	if [catch {
		cd $directory
		set directory [pwd]
	}] {
		Dialog transient MessageBox -type ok -text \
				"Cannot change to the directory \"$directory\"\
				\nPermission denied." -image Icons(warning)
		cd $appPWD
		return
	}
	set dirbox [$self subwidget dirbox]
	$dirbox delete all
	set toplevel [winfo toplevel [$self info path]]
	set toplevelCursor [$toplevel cget -cursor]
	$toplevel config -cursor watch
	update idletasks
	set split [file split $directory]
	set root [lindex $split 0]
	foreach volume [file volume] {
		global tcl_platform
		if { $tcl_platform(platform)=="windows" } {
			set print_vol [string toupper \
					[lindex [split $volume "/"] 0]]
		} else {
			set print_vol $volume
		}
		if { [string tolower $volume]==[string tolower $directory] } {
			$dirbox insert end [list -id curdir Icons(folderopen)\
					$print_vol]
		} else {
			$dirbox insert end [list Icons(folder)\
					$print_vol]
		}
		if { [string tolower $volume]==[string tolower $root] } {
			set dir $root
			foreach subdir [lrange $split 1 end] {
				set dir [file join $dir $subdir]
				if { $dir==$directory } {
					$dirbox insert end [list -id curdir \
							Icons(folderopen) $dir]
				} else {
					$dirbox insert end [list Icons(folder)\
							$dir]
				}
			}
			foreach dir [lsort -command tclSortNoCase \
					[glob -nocomplain .* *]] {
				if ![string compare $dir .] {
					continue
				}
				if ![string compare $dir ..] {
					continue
				}
				set isdir 0
				if { [catch {file isdir $dir} isdir]==0 && \
						$isdir } {
					if ![info exists hasDoneDir($dir)] {
						set path [file join $directory\
								$dir]
						$dirbox insert end [list \
								Icons(folder) \
								$path]
						set hasDoneDir($dir) 1
					}
				}
			}
		}
	}
	cd $appPWD
	$toplevel config -cursor $toplevelCursor
	$dirbox selection set -id curdir
	$self tkvar entry_
	set entry_ $directory
}
WidgetClass FileDialog -superclass Dialog -configspec {
	{ -type type Type open config_type cget_type }
} -default {
	{ *font WidgetDefault }
	{ *ImageTextButton.borderWidth 1 }
	{ *ImageTextButton.highlightThickness 1 }
}
FileDialog instproc build_widget { path } {
	frame   $path.frame
	FileBox $path.filebox -command "$self command; $self ignore_args"
	frame   $path.buttonbox
	ImageTextButton $path.buttonbox.ok -underline 0 -text "Open" \
			-image Icons(check) -orient horizontal \
			-command "$self invoke_ok_ \
			\[string tolower \[$path.buttonbox.ok cget -text\]\]"
	ImageTextButton $path.buttonbox.cancel -image Icons(cross) \
			-orient horizontal -text "Cancel" -underline 0 \
			-command "$self cancel"
	bind $path <Alt-o> "$self invoke_ok_ open"
	bind $path <Alt-s> "$self invoke_ok_ save"
	bind $path <KeyPress-Escape> "$self cancel"
	pack $path.buttonbox.ok $path.buttonbox.cancel -side left -anchor e\
			-padx 5 -pady 2
	pack $path.buttonbox -side bottom -in $path.frame -anchor e
	pack $path.filebox -side top -fill both -expand 1 -in $path.frame
	pack $path.frame -side left -fill both -expand 1
	$self set_subwidget ok     $path.buttonbox.ok
	$self set_subwidget cancel $path.buttonbox.cancel
}
FileDialog instproc config_type { option type } {
	set ok "[$self subwidget buttonbox].ok"
	switch -exact -- $type {
		open {
			$ok configure -text "Open"
		}
		save {
			$ok configure -text "Save"
		}
		default {
			error "invalid type specification; must be 'open' or\
					'save'"
		}
	}
}
FileDialog instproc cget_type { option } {
	set ok "[$self subwidget buttonbox].ok"
	return [string tolower [$ok cget -text]]
}
FileDialog instproc invoke_ok_ { type } {
	if { [$self cget -type] == $type } {
		$self subwidget filebox entry_command
	}
}
FileDialog instproc command { } {
	set filebox [$self subwidget filebox]
	set dir  [$filebox cget -directory]
	set file [$filebox cget -filename]
	if  { $file=="" } return
	set path [file join $dir $file]
	set exists [file exists $path]
	set type   [$self cget -type]
	if { ![string compare $type open] && !$exists } {
		Dialog transient MessageBox -image Icons(warning) -type ok \
				-text "File \"$path\" does not exist."
		return
	}
	if {![string compare $type save] && $exists} {
		set reply [Dialog transient MessageBox -image Icons(warning) \
				-type yesno -text \
				"File \"$path\" already exists.\
				\nDo you want to overwrite it?"]
		if ![string compare $reply "no"] {
			return
		}
	}
	$self config -result $path
}
FileDialog instproc cancel { } {
	$self config -result ""
}
WidgetClass DirectoryDialog -superclass Dialog -default {
	{ *font WidgetDefault }
	{ *ImageTextButton.borderWidth 1 }
	{ *ImageTextButton.highlightThickness 1 }
}
DirectoryDialog instproc build_widget { path } {
	frame  $path.frame
	DirectoryBox $path.dirbox -command "$self ok; $self ignore_args"
	frame  $path.buttonbox
	ImageTextButton $path.buttonbox.ok -underline 0 -text "Ok" \
			-image Icons(check) -orient horizontal \
			-command "$self ok"
	ImageTextButton $path.buttonbox.cancel -text "Cancel" -underline 0 \
			-image Icons(cross) -orient horizontal \
			-command "$self cancel"
	bind $path <KeyPress-Escape> "$self cancel"
	pack $path.buttonbox.ok $path.buttonbox.cancel -side left -anchor e\
			-padx 5 -pady 2
	pack $path.buttonbox -side bottom -in $path.frame -anchor e
	pack $path.dirbox -side top -fill both -expand 1 -in $path.frame
	pack $path.frame -side left -fill both -expand 1
	$self set_subwidget ok     $path.buttonbox.ok
	$self set_subwidget cancel $path.buttonbox.cancel
}
DirectoryDialog instproc ok { } {
	$self configure -result [$self subwidget dirbox cget -directory]
}
WidgetClass 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
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\170\134\43\26\134\43\367\134\43\134\43\134\43\134\43\134\43\150\134\43\134\43\231\134\43\134\43\300\134\43\134\43\341\134\43\134\43\377\134\43\134\43\134\43\150\134\43\150\150\134\43\231\150\134\43\300\150\134\43\341\150\134\43\377\150\134\43\134\43\231\134\43\150\231\134\43\231\231\134\43\300\231\134\43\341\231\134\43\377\231\134\43\134\43\300\134\43\150\300\134\43\231\300\134\43\300\300\134\43\341\300\134\43\377\300\134\43\134\43\341\134\43\150\341\134\43\231\341\134\43\300\341\134\43\341\341\134\43\377\341\134\43\134\43\377\134\43\150\377\134\43\231\377\134\43\300\377\134\43\341\377\134\43\377\377\134\43\134\43\134\43\150\150\134\43\150\231\134\43\150\300\134\43\150\341\134\43\150\377\134\43\150\134\43\150\150\150\150\150\231\150\150\300\150\150\341\150\150\377\150\150\134\43\231\150\150\231\150\231\231\150\300\231\150\341\231\150\377\231\150\134\43\300\150\150\300\150\231\300\150\300\300\150\341\300\150\377\300\150\134\43\341\150\150\341\150\231\341\150\300\341\150\341\341\150\377\341\150\134\43\377\150\150\377\150\231\377\150\300\377\150\341\377\150\377\377\150\134\43\134\43\231\150\134\43\231\231\134\43\231\300\134\43\231\341\134\43\231\377\134\43\231\134\43\150\231\150\150\231\231\150\231\300\150\231\341\150\231\377\150\231\134\43\231\231\150\231\231\231\231\231\300\231\231\341\231\231\377\231\231\134\43\300\231\150\300\231\231\300\231\300\300\231\341\300\231\377\300\231\134\43\341\231\150\341\231\231\341\231\300\341\231\341\341\231\377\341\231\134\43\377\231\150\377\231\231\377\231\300\377\231\341\377\231\377\377\231\134\43\134\43\300\150\134\43\300\231\134\43\300\300\134\43\300\341\134\43\300\377\134\43\300\134\43\150\300\150\150\300\231\150\300\300\150\300\341\150\300\377\150\300\134\43\231\300\150\231\300\231\231\300\300\231\300\341\231\300\377\231\300\134\43\300\300\150\300\300\231\300\300\300\300\300\341\300\300\377\300\300\134\43\341\300\150\341\300\231\341\300\300\341\300\341\341\300\377\341\300\134\43\377\300\150\377\300\231\377\300\300\377\300\341\377\300\377\377\300\134\43\134\43\341\150\134\43\341\231\134\43\341\300\134\43\341\341\134\43\341\377\134\43\341\134\43\150\341\150\150\341\231\150\341\300\150\341\341\150\341\377\150\341\134\43\231\341\150\231\341\231\231\341\300\231\341\341\231\341\377\231\341\134\43\300\341\150\300\341\231\300\341\300\300\341\341\300\341\377\300\341\134\43\341\341\150\341\341\231\341\341\300\341\341\341\341\341\377\341\341\134\43\377\341\150\377\341\231\377\341\300\377\341\341\377\341\377\377\341\134\43\134\43\377\150\134\43\377\231\134\43\377\300\134\43\377\341\134\43\377\377\134\43\377\134\43\150\377\150\150\377\231\150\377\300\150\377\341\150\377\377\150\377\134\43\231\377\150\231\377\231\231\377\300\231\377\341\231\377\377\231\377\134\43\300\377\150\300\377\231\300\377\300\300\377\341\300\377\377\300\377\134\43\341\377\150\341\377\231\341\377\300\341\377\341\341\377\377\341\377\134\43\377\377\150\377\377\231\377\377\300\377\377\341\377\377\377\377\377\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\41\371\4\1\134\43\134\43\327\134\43\54\134\43\134\43\134\43\134\43\170\134\43\26\134\43\100\10\377\134\43\257\11\34\110\260\240\301\203\10\23\52\134\134\310\260\241\303\207\3\241\261\101\102\261\302\21\202\320\242\131\323\170\255\324\304\7\54\126\160\30\230\314\222\25\113\163\216\100\103\251\307\222\216\107\320\344\130\222\71\47\221\300\116\162\56\311\231\63\107\216\216\131\171\330\170\231\305\112\216\234\66\73\311\10\74\372\122\40\317\31\153\256\221\112\42\347\11\233\47\210\4\226\172\42\47\211\23\254\327\130\41\261\362\344\211\225\62\172\236\40\171\2\245\154\123\214\172\346\44\41\121\302\301\36\212\170\221\220\160\240\303\43\105\66\254\6\316\161\242\143\15\235\261\35\304\76\351\40\60\20\222\44\153\55\134\134\54\5\31\11\224\257\211\37\217\230\125\212\242\131\44\53\312\224\42\201\104\5\105\22\116\144\164\210\172\355\11\151\22\117\54\4\231\245\207\4\211\25\120\110\310\130\123\33\352\300\100\266\165\223\120\301\130\141\262\211\24\55\164\101\122\341\321\101\211\155\20\315\22\30\114\227\56\75\316\257\41\263\244\313\122\20\207\53\57\251\377\264\344\75\141\314\113\163\320\313\321\143\23\242\103\126\163\236\174\27\214\267\2\153\117\24\37\124\240\210\240\203\34\274\26\260\66\20\33\163\164\320\223\125\72\4\302\206\25\101\164\302\206\34\17\76\10\5\31\110\24\50\220\36\154\100\125\212\23\120\4\261\12\22\116\254\5\342\113\172\40\41\103\20\217\74\222\310\23\116\314\300\112\210\35\114\167\15\105\35\70\346\104\22\152\41\21\43\105\34\330\44\326\12\305\365\46\140\104\254\314\42\243\173\110\46\251\344\222\114\142\344\11\117\163\104\323\344\224\124\126\271\20\176\24\225\300\1\42\154\224\20\240\101\227\360\167\300\110\2\221\147\111\36\145\164\144\311\45\226\350\61\37\103\244\230\264\106\64\254\40\222\335\101\236\310\301\240\212\171\314\161\226\225\3\355\361\304\156\30\345\145\201\214\22\345\205\4\2\71\360\267\150\161\67\261\241\3\172\101\344\304\301\116\35\254\102\140\214\254\54\130\106\120\135\314\206\141\201\61\311\21\43\64\136\210\252\147\31\253\264\341\304\34\154\274\377\212\104\16\151\226\270\47\53\152\175\307\212\27\107\314\22\337\14\217\224\270\330\32\263\224\65\103\257\126\254\5\251\100\141\122\224\4\31\53\51\212\304\3\144\100\122\237\101\245\264\141\305\21\260\72\221\103\20\260\276\364\244\14\316\361\304\112\121\110\134\43\321\321\210\217\310\105\53\217\301\52\73\43\141\210\264\2\115\132\351\46\22\242\5\2\251\45\3\20\172\165\320\256\156\36\226\134\43\244\100\320\220\246\356\150\44\134\43\161\147\104\326\342\125\231\264\170\325\45\333\221\327\30\51\220\306\33\143\74\113\42\217\170\34\162\306\62\162\234\161\42\323\161\154\344\312\30\17\64\113\212\5\275\114\162\312\55\237\114\63\240\70\347\254\63\170\236\40\107\32\260\346\141\4\315\271\3\131\3\315\320\65\233\127\344\65\110\47\24\315\320\347\56\275\163\130\122\33\204\45\150\25\134\134\321\45\7\65\367\254\327\241\314\166\327\311\174\154\242\364\346\102\245\234\31\304\112\26\42\124\12\204\163\240\104\140\27\111\67\271\25\203\330\42\207\204\5\217\104\377\123\12\20\103\12\204\345\3\53\74\300\332\112\172\100\222\307\167\154\322\141\111\27\121\101\343\111\47\172\4\66\120\51\236\350\321\112\47\155\344\360\110\51\245\54\55\271\36\172\144\345\324\34\135\264\347\21\336\141\221\136\72\101\254\270\156\172\107\201\320\206\135\107\126\140\107\307\23\100\23\324\354\242\43\104\324\63\33\226\260\101\107\247\240\75\60\255\200\236\130\222\3\112\107\64\237\203\116\77\351\324\5\20\164\310\101\267\107\162\344\320\205\121\162\314\326\323\241\75\315\134\43\104\120\126\300\144\224\131\74\311\121\305\154\255\72\141\205\16\144\75\321\367\34\263\2\141\354\347\153\75\361\355\162\376\233\301\215\234\20\43\337\341\5\1\27\141\32\162\36\220\43\13\224\50\113\134\134\363\35\33\300\205\72\75\171\201\15\357\313\323\23\256\200\271\252\224\301\50\101\260\111\317\72\324\51\371\204\245\24\161\271\12\255\246\302\73\56\314\40\131\317\272\206\127\336\162\243\221\260\142\17\126\220\313\254\36\301\242\31\174\47\32\152\21\330\65\377\112\164\242\202\340\57\77\221\233\10\13\52\60\21\55\315\2\71\366\51\110\121\344\323\223\115\141\210\126\172\220\203\371\200\20\4\56\122\310\204\327\30\114\16\326\340\211\324\254\1\177\252\321\101\20\213\265\103\301\264\110\137\72\322\212\262\102\364\255\34\250\140\61\254\200\114\1\177\64\237\47\250\240\167\105\323\33\22\4\231\27\45\46\13\11\173\200\6\101\60\4\25\271\20\360\21\110\60\325\54\240\1\242\53\340\117\76\276\132\313\3\221\60\233\307\274\104\55\117\310\3\105\266\105\311\211\221\6\11\54\210\221\36\112\60\26\327\74\201\3\145\230\313\12\324\102\2\15\21\154\40\256\131\201\25\202\123\300\203\174\202\220\24\33\44\162\20\100\46\201\134\43\101\210\144\350\100\232\130\321\201\67\45\42\7\72\150\246\214\20\221\3\16\164\40\231\337\231\205\65\5\102\315\16\50\223\3\337\111\4\7\254\151\315\21\254\206\40\72\250\100\64\147\43\20\62\344\240\231\145\200\345\54\222\371\60\104\250\363\232\315\304\323\242\324\11\36\204\62\220\41\21\144\100\204\77\311\340\5\40\220\201\14\145\30\331\324\26\312\320\206\72\364\241\2\11\10\134\43\73"]
image create photo MBLogo_Icon -data $imageObject__
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> {
	focus .
	%W select clear
	catch {
		global entryTab
		set entryTab(%W:focus) 0
		set oldval $entryTab(%W:value)
		set v [%W get]
		set entryTab(%W:value) $v
		if [$entryTab(%W:object) update $v] {
			set entryTab(%W:value) $oldval
			%W delete 0 end
			%W insert 0 $oldval
		}
	}
}
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]
	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_
	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 ""
}
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 "XXX"
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]
	}
	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"
    $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 {}
	}
}
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\24\134\43\24\134\43\367\134\43\134\43\330\330\330\370\374\370\71\370\61\134\43\134\43\134\43\200\200\200\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\341\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\341\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\14\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\341\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\14\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\43\341\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\43\341\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\45\341\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\14\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\52\341\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\14\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\14\134\43\134\43\134\43\217\200\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\14\134\43\134\43\134\43\142\200\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\14\134\43\134\43\134\43\43\200\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\14\134\43\134\43\134\43\45\200\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\14\134\43\134\43\134\43\45\200\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\14\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\14\134\43\134\43\134\43\43\201\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\14\134\43\134\43\134\43\45\201\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\21\134\43\134\43\134\43\45\201\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\21\134\43\134\43\134\43\45\201\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\21\134\43\134\43\134\43\67\201\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\14\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\21\134\43\134\43\134\43\246\200\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\14\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\21\134\43\134\43\134\43\222\200\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\26\134\43\134\43\134\43\223\200\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\26\134\43\134\43\134\43\315\200\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\14\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\26\134\43\134\43\134\43\105\341\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\247\247\247\134\43\57\134\43\117\134\43\134\43\21\251\134\43\370\43\134\43\134\43\270\134\43\236\134\43\254\254\254\134\43\255\255\255\134\43\256\256\256\134\43\257\257\257\134\43\260\260\260\134\43\261\261\261\134\43\263\263\263\134\43\264\264\264\134\43\265\265\265\134\43\266\266\266\134\43\267\267\267\134\43\270\270\270\134\43\271\271\271\134\43\272\272\272\134\43\273\273\273\134\43\274\274\274\134\43\275\275\275\134\43\276\276\276\134\43\300\300\300\134\43\301\301\301\134\43\302\302\302\134\43\303\303\303\134\43\304\304\304\134\43\305\305\305\134\43\306\306\306\134\43\307\307\307\134\43\310\310\310\134\43\311\311\311\134\43\312\312\312\134\43\314\314\314\134\43\315\315\315\134\43\316\316\316\134\43\41\371\4\1\134\43\134\43\1\134\43\54\134\43\134\43\134\43\134\43\24\134\43\24\134\43\100\10\135\134\43\3\10\34\110\260\240\301\201\2\22\52\134\134\230\320\320\101\2\20\43\22\70\150\160\41\105\212\14\5\30\232\146\110\42\304\213\40\53\146\24\20\62\300\110\205\33\73\116\44\330\220\243\307\225\45\143\312\304\110\162\246\300\214\62\117\46\4\251\23\345\107\226\43\71\116\223\130\160\241\320\227\7\247\171\31\352\61\144\123\233\62\3\2\134\43\73"]
image create photo VcrIcons(play) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\24\134\43\24\134\43\367\134\43\134\43\330\330\330\370\374\370\71\370\61\134\43\134\43\134\43\200\200\200\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\341\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\341\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\14\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\341\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\14\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\43\341\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\43\341\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\45\341\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\14\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\52\341\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\14\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\14\134\43\134\43\134\43\217\200\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\14\134\43\134\43\134\43\142\200\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\14\134\43\134\43\134\43\43\200\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\14\134\43\134\43\134\43\45\200\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\14\134\43\134\43\134\43\45\200\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\14\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\14\134\43\134\43\134\43\43\201\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\14\134\43\134\43\134\43\45\201\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\21\134\43\134\43\134\43\45\201\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\21\134\43\134\43\134\43\45\201\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\21\134\43\134\43\134\43\67\201\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\14\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\21\134\43\134\43\134\43\246\200\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\14\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\21\134\43\134\43\134\43\222\200\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\26\134\43\134\43\134\43\223\200\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\26\134\43\134\43\134\43\315\200\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\14\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\26\134\43\134\43\134\43\105\341\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\247\247\247\134\43\101\134\43\117\134\43\134\43\21\251\134\43\300\134\43\236\134\43\300\134\43\236\134\43\254\254\254\134\43\255\255\255\134\43\256\256\256\134\43\257\257\257\134\43\260\260\260\134\43\261\261\261\134\43\263\263\263\134\43\264\264\264\134\43\265\265\265\134\43\266\266\266\134\43\267\267\267\134\43\270\270\270\134\43\271\271\271\134\43\272\272\272\134\43\273\273\273\134\43\274\274\274\134\43\275\275\275\134\43\276\276\276\134\43\300\300\300\134\43\301\301\301\134\43\302\302\302\134\43\303\303\303\134\43\304\304\304\134\43\305\305\305\134\43\306\306\306\134\43\307\307\307\134\43\310\310\310\134\43\311\311\311\134\43\312\312\312\134\43\314\314\314\134\43\315\315\315\134\43\316\316\316\134\43\41\371\4\1\134\43\134\43\1\134\43\54\134\43\134\43\134\43\134\43\24\134\43\24\134\43\100\10\173\134\43\3\10\34\110\260\240\301\201\2\22\52\134\134\50\134\43\32\1\2\7\13\302\103\207\356\241\305\210\5\27\42\203\130\220\134\134\105\213\14\5\30\172\210\261\144\311\220\11\35\162\24\10\340\41\112\205\43\127\112\244\150\221\100\302\215\62\115\6\134\43\200\16\34\134\43\235\100\117\212\4\247\63\44\50\2\330\16\276\114\170\124\46\277\245\12\161\22\4\200\15\44\312\230\6\301\221\43\127\123\43\111\214\133\271\76\204\206\25\50\134\43\217\125\311\5\215\30\20\134\43\73"]
image create photo VcrIcons(reverse) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\24\134\43\24\134\43\302\134\43\134\43\330\330\330\370\374\370\270\274\270\134\43\134\43\134\43\200\200\200\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\24\134\43\24\134\43\134\43\3\111\10\272\334\376\360\205\31\26\255\60\210\75\224\346\331\46\14\4\361\215\245\163\222\246\310\252\156\271\246\315\334\162\64\143\333\60\176\243\204\36\220\127\213\375\136\105\37\121\147\134\134\132\232\306\307\140\372\242\42\35\245\254\42\233\153\160\203\200\157\144\114\56\3\22\134\43\73"]
image create photo VcrIcons(pause) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\20\134\43\24\134\43\302\134\43\134\43\330\330\330\134\43\134\43\134\43\270\274\270\120\124\120\370\374\370\200\200\200\134\43\134\43\134\43\134\43\134\43\134\43\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\20\134\43\24\134\43\134\43\3\74\10\272\334\376\60\262\100\253\15\142\216\315\73\321\135\110\24\205\22\204\42\151\242\236\12\234\354\66\226\157\54\273\160\74\257\366\136\367\70\333\300\47\40\30\217\110\237\202\304\154\62\31\316\50\115\102\255\132\1\11\134\43\73"]
image create photo VcrIcons(stop) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\24\134\43\20\134\43\200\134\43\134\43\134\43\134\43\134\43\277\277\277\41\371\4\1\134\43\134\43\1\134\43\54\134\43\134\43\134\43\134\43\24\134\43\20\134\43\134\43\2\34\214\217\251\313\355\17\27\230\224\276\212\57\266\156\363\346\115\232\67\156\145\326\205\321\312\266\114\1\134\43\73"]
image create photo VcrIcons(sstop) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\24\134\43\20\134\43\200\134\43\134\43\134\43\134\43\134\43\277\277\277\41\371\4\1\134\43\134\43\1\134\43\54\134\43\134\43\134\43\134\43\24\134\43\20\134\43\134\43\2\35\214\217\251\313\355\17\27\210\12\130\172\254\306\272\307\16\76\140\330\214\227\110\102\36\67\141\356\213\24\134\43\73"]
image create photo VcrIcons(splay) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\20\134\43\24\134\43\302\134\43\134\43\330\330\330\134\43\134\43\134\43\270\274\270\370\24\100\370\374\370\200\200\200\134\43\134\43\134\43\134\43\134\43\134\43\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\20\134\43\24\134\43\134\43\3\74\10\272\334\376\60\262\100\253\15\142\216\315\73\321\135\110\24\205\22\204\42\151\242\236\12\234\354\66\226\157\54\273\160\74\257\366\136\367\70\333\300\47\40\30\217\110\237\202\304\154\62\31\316\50\115\102\255\132\1\11\134\43\73"]
image create photo VcrIcons(record) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\12\134\43\12\134\43\302\134\43\134\43\330\330\330\370\140\100\370\134\43\134\43\370\244\134\43\260\40\40\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\134\43\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\12\134\43\12\134\43\134\43\3\32\10\272\334\276\41\10\27\106\234\320\136\262\304\25\2\247\200\44\41\216\241\351\230\347\263\44\134\43\73"]
image create photo VcrIcons(redbullet) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\12\134\43\12\134\43\302\134\43\134\43\330\330\330\134\43\374\134\43\370\134\43\134\43\230\370\230\60\314\60\50\210\120\134\43\134\43\134\43\134\43\134\43\134\43\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\12\134\43\12\134\43\134\43\3\32\10\272\334\276\41\10\27\106\44\254\306\100\312\42\27\321\175\242\130\170\344\211\62\352\343\44\134\43\73"]
image create photo VcrIcons(greenbullet) -data $imageObject__
set imageObject__ [new Image/GIF "\107\111\106\70\71\141\12\134\43\12\134\43\302\134\43\134\43\330\330\330\170\174\170\134\43\374\370\370\374\370\134\43\134\43\134\43\134\43\174\170\134\43\134\43\370\134\43\134\43\134\43\41\371\4\1\134\43\134\43\134\43\134\43\54\134\43\134\43\134\43\134\43\12\134\43\12\134\43\134\43\3\40\10\20\254\276\142\10\362\102\214\205\252\40\145\166\226\367\71\104\141\22\32\211\12\106\372\134\43\254\373\260\157\235\134\43\134\43\73"]
image create photo VcrIcons(browse_small) -data $imageObject__
Class 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
                wm iconify .
                wm deiconify .
        } else {
                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	
}
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"
        update idletasks
	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 {[Application instance] reset $ab}
}
SRMAgent instproc set_maxchannel { n } {} 
Session/SRM instproc destroy {} {
    	$self instvar bufferPool_ sa_timer_
    	if [info exists bufferPool_] {
	    	delete $bufferPool_
	}
	if [info exists sa_timer_] {
	    	delete $sa_timer_
	}
	$self next
}
Session/SRM instproc default-local { } {
    $self instvar agent_
    return [$agent_ default-local]
}
Session/SRM instproc create-local {args} {
        return [eval [$self set agent_] create-local $args]
}
Session/SRM instproc start_timers {} {
    $self instvar sa_timer_
    set sa_timer_ [new TimerSA]
    $self sa-timer $sa_timer_
    $sa_timer_ proc reset {} {
	$self period 3000
    }	
    $sa_timer_ proc faster {} {
	$self period 500
    }
    $sa_timer_ faster
}
Session/SRM instproc agent { a } {
	$self source-manager $a
        $self set agent_ $a
	$self instvar bufferPool_
	set bufferPool_ [new BufferPool/SRM]
	$bufferPool_ source-manager $a
	$self buffer-pool $bufferPool_
}
Session/SRM instproc get_agent {} {
	return [$self set agent_]
}
SRMAgent instproc default-local { } {
    $self instvar default_local_
    if { [info exists default_local_] } {
	return $default_local_
    } else {
	return ""
    }
}
SRMAgent instproc have_network {} {
	$self instvar network_
	return [info exists network_]
}
SRMAgent instproc install-key {key} {
	$self instvar network_
	if [info exists network_] {
		$network_ install-key $key
	}
}
SRMAgent instproc network {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	return [$network_ data-net 0]
}
SRMAgent instproc session-addr {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	return [[$self network] addr]
}
SRMAgent instproc session-port {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	return [[$self network] port]
}
SRMAgent instproc session-rport {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	return [[$self network] rport]
}
SRMAgent instproc session-sport {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	return [[$self network] sport]
}
SRMAgent instproc session-ttl {} {
	$self instvar network_
	if ![info exists network_] {
		return none
	}
	return [[$self network] ttl]
}
SRMAgent instproc crypt_clear {} {
	if [info exists network_] {
		$network_ crypt_clear
	}
}
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_]
}
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
	$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 instvar interval_
	$self next
	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 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
	}
}
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_(20) ldct
RTP/Video set default_ptoa_(21) pvh
RTP/Video set default_ptoa_(22) bvc
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_(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_(ldct) LDCT
	set classmap_(h261) H261
	set classmap_(h261v1) H261v1
	set classmap_(nv) NV
	set classmap_(cellb) CellB
	set classmap_(jpeg) JPEG
	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
		if { $line=={} } continue
		set sline [split $line =]
		set tag [lindex $sline 0]
		set value [join [lrange $sline 1 end]]
		set ret [$self check_syntax $lasttag $tag $media]
		if { $ret == "" && $ordered_syntax_==1 } {
			set parse_error_ "$class: syntax error between\
					$lasttag and $tag in line $lnum."
			foreach m $allmsgs {
				delete $m
			}
			return ""
		}
		set lasttag $ret
		switch $tag {
		v { 
			set media ""
			set msg [new SDPMessage]
			lappend allmsgs $msg
			$msg set version_ $value
		}
		o {
			$msg set creator_ [lindex $value 0]
			$msg set createtime_ [lindex $value 1]
			$msg set modtime_  [lindex $value 2]
			$msg set nettype_ [lindex $value 3]	
			$msg set addrtype_ [lindex $value 3]
			$msg set createaddr_ [lindex $value 5]
		}
		s {	
			$msg set session_name_ $value 
		}
		i {	
			if { $media != "" } {
				$media set session_info_ $value 
			} else {
				$msg set session_info_ $value 
			}
		}
		p {
			set tmp "" 
			catch { set tmp [$msg set phonelist_] }
			lappend tmp $value
			$msg set phonelist_ $tmp
		}
		e { 
			set tmp "" 
			catch { set tmp [$msg set emaillist_] }
			lappend tmp $value
			$msg set emaillist_ $tmp
		}
		u { 
			$msg set uri_ $value
		} 
		c {
			if { $media != "" } {
				$media set nettype_ [lindex $value 0]
				$media set addrtype_ [lindex $value 1]
				$media set caddr_ [lindex $value 2]
			} else {
				$msg set nettype_ [lindex $value 0]
				$msg set addrtype_ [lindex $value 1]
				$msg set caddr_ [lindex $value 2]
			}
		}
		b {
			set bwspec [split $value :]
			if { $media != "" } {
				$media set bwmod_ [lindex $bwspec 0]
				$media set bwval_ [lindex $bwspec 1]
			} else {
				$msg set bwmod_ [lindex $bwspec 0]
				$msg set bwval_ [lindex $bwspec 1]
			}
		}
		t {
			set tdes [new SDPTime]
			$tdes set fields_(t) $value
			$tdes set starttime_ [lindex $value 0]
			$tdes set endtime_ [lindex $value 1]
			set tmp [$msg set alltimedes_]
			lappend tmp $tdes
			$msg set alltimedes_ $tmp
		}
		r {
			$tdes set fields_(r) $value
			$tdes set repeat_interval_ [lindex $value 0]
			$tdes set active_duration_ [lindex $value 1]
			$tdes set offlist_ [lrange $value 2 end]
		}
		z {
			set nval [llength $value]
			if [expr 2 * ($nval / 2) != $nval] {
				foreach m $allmsgs {
					delete $m
				}
				return ""
			}
			$self instvar zoneinfo_
			for { set n 0 } { $n < $nval } { incr n } {
				set adjtime [lindex $value $n]
				incr n
				set offset [lindex $value $n]
				lappend zoneinfo_ "$adjtime $offset"
			}
		}
		k {
			set tmp [split $value :]
			if { $media != "" } {
				$media set crypt_method_ [lindex $tmp 0]
				$media set crypt_key_ [lindex $tmp 1]
			} else {
				$msg set crypt_method_ [lindex $tmp 0]
				$msg set crypt_key_ [lindex $tmp 1]
			}
		}
		a {
			set attribute [split $value ":"]
			set attname [lindex $attribute 0]
			set attval [join [lrange $attribute 1 end] ":"]
			if { $media != "" } {
				set target $media
			} else {
				set target $msg
			}
			if [catch {$target set attributes_($attname)}] {
				$target set attributes_($attname) {}
			}
			$target set attributes_($attname) \
			    [concat [$target set attributes_($attname)] \
				 [list $attval]]
		}
		m {
			set media [new SDPMedia $msg]
			set mt [lindex $value 0]
			$media set mediatype_ $mt
			$media set port_  [lindex $value 1]
			$media set proto_ [lindex $value 2]
			$media set fmt_ [lrange $value 3 end]
			set tmp ""
			catch { set tmp [$msg set media_array_($mt)] }
			lappend tmp $media
			$msg set media_array_($mt) $media
			set tmp [$msg set allmedia_]
			lappend tmp $media
			$msg set allmedia_ $tmp
		}
		default {
			set parse_error_ "$class: error unknown modifier $tag."
			foreach m $allmsgs {
				delete $m
			}
			return ""
		}
		}
		set tmp [$msg set msgtext_]
		lappend tmp $line
		$msg set msgtext_ $tmp
		if { $media != "" } {
			$media set fields_($tag) $value
		} else {
			$msg set fields_($tag) $value
		}
	}
	foreach msg $allmsgs {
		set tmp [$msg set msgtext_]
		set tmp [join $tmp \n]
		append tmp \n
		$msg set msgtext_ $tmp
	}
	return $allmsgs
}
SDPParser instproc parse_error { } {
	return [$self set parse_error_]
}
SDPMessage instproc init {} {
	$self next
	$self instvar allmedia_ alltimedes_ msgtext_
	set allmedia_ ""
	set alltimedes_ ""
	set msgtext_ ""
}
SDPMessage instproc destroy {} {
	$self instvar allmedia_ alltimedes_
	foreach m $allmedia_ {
		delete $m
	}
	foreach t $alltimedes_ {
		delete $t
	}
	$self next
}
SDPMessage instproc media { media_type } {
	$self instvar media_array_
	if [info exists media_array_($media_type)] {
		return $media_array_($media_type)
	} else {
		return ""
	}
}
SDPMessage instproc have_field { field } {
	$self instvar fields_
	return [info exists fields_($field)]
}
SDPMessage instproc field_value { field } {
	$self instvar fields_
	if [info exists fields_($field)] {
		return $fields_($field)
	} else {
		return ""
	}
}
SDPMessage instproc attributes {} {
	$self instvar attributes_
	if [info exists attributes_] {
		return [array names attributes_]
	} else {
		return ""
	}
}
SDPMessage instproc have_attr { name } {
	$self instvar attributes_
	return [info exists attributes_($name)]
}
SDPMessage instproc attr_value { name } {
    $self instvar attributes_
    if [info exists attributes_($name)] {
	    return $attributes_($name)
    } else {
	    return ""
    }
}
SDPMessage instproc obj2str {} {
	$self instvar attributes_ alltimedes_ allmedia_
	set o "v=[$self field_value v]"
	foreach f { o s i u } {
		if [$self have_field $f] {
			set n "$f=[$self field_value $f]"
			set o $o\n$n
		}
	}
	$self instvar phonelist_ emaillist_
	if [info exists phonelist_] {
		foreach e $phonelist_ {
			set n "p=$e"
			set o $o\n$n
		}
	}
	if [info exists emaillist_] {
		foreach e $emaillist_ {
			set n "e=$e"
			set o $o\n$n
		}
	}
	foreach f { c b } {
		if [$self have_field $f] {
			set n "$f=[$self field_value $f]"
			set o $o\n$n
		}
	}
	foreach t $alltimedes_ {
		set n [$t obj2str]
		set o $o\n$n
	}
	foreach f { z k } {
		if [$self have_field $f] {
			set n "$f=[$self field_value $f]"
			set o $o\n$n
		}
	}
	foreach a [$self attributes] {
		if { $attributes_($a) == "" } {
			set n "a=$a"
		} else {
			set n "a=$a:$attributes_($a)"
		}
		set o $o\n$n
	}
	foreach m $allmedia_ {
		set n [$m obj2str]
		set o $o\n$n
	}
	return $o
}
SDPMessage public unique_key {} {
    if ![$self have_field o] {
	$self warn "in SDPMessage::unique_key without o= field"
	return ""
    }
    set l [split [$self field_value o]]
    set l [lreplace $l 2 2]
    set key [join $l :]
    return $key
}
SDPMessage instproc htmlify_media { } {
    set html {}
    foreach media [$self set allmedia_] {
	append html [$media create_dynamic_html \
		[DynamicHTMLifier set html_(media)]]
    }
    return $html
}
SDPMessage instproc htmlify_times { } {
    set html {}
    foreach time [$self set alltimedes_] {
	set repeat [string tolower [$time readable_repeat]]
	if { [$time set starttime_] != 0 } {
	    append html [$time create_dynamic_html \
		    [DynamicHTMLifier set html_(time_$repeat)]]
	} else {
	    append html "Unbounded session"
	}
    }
    return $html
}
SDPMessage instproc htmlify_url { } {
    $self instvar uri_
    if [info exists uri_] {
	return "<a href=\"$uri_\">$uri_</a>"
    } else {
	return ""
    }
}
SDPMessage instproc htmlify_list { varname } {
    set list {}
    foreach elt [$self get $varname] {
	if { $list!={} } {
	    append list ", $elt"
	} else {
	    append list $elt
	}
    }
    return $list
}
SDPMessage instproc get { varname } {
    $self instvar $varname
    if [info exists $varname] {
	return [set $varname]
    } else {
	return ""
    }
}
SDPMedia instproc htmlify_mediatype { } {
    return "[$self set mediatype_]"
}
SDPMedia instproc get { varname } {
    $self instvar $varname
    if [info exists $varname] {
	return [set $varname]
    } else {
	return ""
    }
}
SDPMedia instproc init {{msg ""}} {
	$self next
	if {$msg == ""} { return }
	$self instvar attributes_ fields_
	set alist [$msg attributes]
	foreach a $alist {
		set attributes_($a) [$msg set attributes_($a)]
	}
	set vlist [$msg info vars]
	foreach f { session_info_ nettype_ addrtype_ caddr_ bwmod_ bwval_ 
		crypt_method_ crypt_key_ } {
		if { [lsearch -exact $vlist $f] >= 0 } {
			$self set $f [$msg set $f]
		}
	}
	foreach f { i c b k a } {
		if [$msg have_field $f] {
			set fields_($f) [$msg field_value $f]
		}
	}
}
SDPMedia instproc have_field { field } {
	$self instvar fields_
	return [info exists fields_($field)]
}
SDPMedia instproc field_value { field } {
	$self instvar fields_
	if [info exists fields_($field)] {
		return $fields_($field)
	} else {
		return ""
	}
}
SDPMedia instproc have_attr { name } {
	$self instvar attributes_
	return [info exists attributes_($name)]
}
SDPMedia instproc attr_value { name } {
    $self instvar attributes_
    if [info exists attributes_($name)] {
	    return $attributes_($name)
    } else {
	    return ""
    }
}
SDPMedia instproc attributes {} {
	$self instvar attributes_
	if [info exists attributes_] {
		return [array names attributes_]
	} else {
		return ""
	}
}
SDPMedia instproc obj2str {} {
	$self instvar attributes_
	set o "m=[$self field_value m]"
	foreach f { i c b k } {
		if [$self have_field $f] {
			set n "$f=[$self field_value $f]"
			set o $o\n$n
		}
	}
	foreach a [array names attributes_] {
		if { $attributes_($a) == "" } {
			set n "a=$a"
		} else {
			set n "a=$a:$attributes_($a)"
		}
		set o $o\n$n
	}
	return $o
}
SDPTime instproc have_field { field } {
	$self instvar fields_
	return [info exists fields_($field)]
}
SDPTime instproc field_value { field } {
	$self instvar fields_
	if [info exists fields_($field)] {
		return $fields_($field)
	} else {
		return ""
	}
}
SDPTime instproc obj2str {} {
	set o "t=[$self field_value t]"
	if [$self have_field r] {
		set n "r=[$self field_value r]"
		set o $o\n$n
	}
	return $o
}
SDPTime public get { varname } {
    $self instvar $varname
    if [info exists $varname] {
	return [set $varname]
    } else {
	return ""
    }
}
SDPTime public sec_until_current { time_type } {
    set sdp_time [ntp_to_unix [$self get $time_type]]
    set current [clock seconds]
    return [expr $sdp_time - $current]
}
SDPTime public current_in_interval { start end } {
    set current [unix_to_ntp [clock seconds]]
    if { [expr $start == 0 && $end == 0] } {
	return 1
    } elseif { $start == 0 } {
	return [expr $end > $current]
    } elseif { $end == 0 } {
	return [expr $start <= $current]
    } else {
	return [expr $start <= $current && $end > $current]
    }
}
SDPTime public readable_time { time_type } {
    set sec [ntp_to_unix [$self get $time_type]]
    if { $sec == 0 } {
	return *unbounded*
    } else {
	return [clock format $sec -format {%H:%M}]
    }
}
SDPTime public readable_duration { } {
    set duration [$self get active_duration_]
    set hours [expr $duration / 3600]
    if { $hours < 24 } {
	return "$hours hour(s)"
    }
    set days [expr $hours / 24]
    if { $days < 7 } {
	return "$days day(s)"
    }
    set weeks [expr $days / 7]
    return "$weeks week(s)"
}
SDPTime public readable_date { time_type } {
    set sec [ntp_to_unix [$self get $time_type]]
    if { $sec == 0 } {
	return *unbounded*
    } else {
	return [clock format $sec -format {%B %d, %Y}]
    }
}
SDPTime public readable_day { time_type } {
    set sec [ntp_to_unix [$self get $time_type]]
    if { $sec == 0 } {
	return *unbounded*
    } else {
	return [clock format $sec -format {%a}]
    }
}
SDPTime public readable_day_full { time_type } {
    set sec [ntp_to_unix [$self get $time_type]]
    if { $sec == 0 } {
	return *unbounded*
    } else {
	return [clock format $sec -format {%A}]
    }
}
SDPTime public readable_zone { time_type } {
    set sec [ntp_to_unix [$self get $time_type]]
    return [clock format $sec -format {%Z}]
}
SDPTime public readable_repeat { } {
    set interval [$self get repeat_interval_]
    if { $interval == 86400 } {
	return Daily
    } elseif { $interval == 604800 } {
	return Weekly
    } else {
	return None
    }
}
Class 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_]"
		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] != "" } { 
		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_ ""
                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 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
