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

# head.tcl --
#
#       This header is added to the beginning of all mash-based tools.
#
# Copyright (c) 1993-2002 The Regents of the University of California.
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# A. Redistributions of source code must retain the above copyright notice,
#    this list of conditions and the following disclaimer.
# B. Redistributions in binary form must reproduce the above copyright notice,
#    this list of conditions and the following disclaimer in the documentation
#    and/or other materials provided with the distribution.
# C. Neither the names of the copyright holders nor the names of its
#    contributors may be used to endorse or promote products derived from this
#    software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
# ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
# @(#) $Header: /usr/mash/src/repository/mash/mash-1/head.tcl,v 1.9 2002/02/03 04:41:06 lim Exp $

Object instproc has_method { method } {
	if { [$self info procs $method]!="" } {
		return 1
	}
	return [[$self info class] has_method $method]
}
Class instproc has_method { method } {
	if { [$self info instprocs $method]!="" } {
		return 1
	}
	foreach cl [$self info heritage] {
		if { [$cl info instprocs $method]!="" } {
			return 1
		}
	}
	return 0
}
proc version {} {
	global mash
	return $mash(version)
}
proc local_fqdn {} {
	set host ""
	catch {set host [lookup_host_name [localaddr]]}
	if { [string first . $host] < 0 } {
		return ""
	}
	return $host
}
proc email_heuristic {} {
	set user [user_heuristic]
	set addr [local_fqdn]
	if { $addr == "" } {
		return ""
	}
	return $user@$addr
}
proc user_heuristic {} {
	global env
	if [info exists env(USER)] {
		set user $env(USER)
	} elseif [info exists env(LOGNAME)] {
		set user $env(LOGNAME)
	} else {
		catch {set env(USER) [getusername]}
		if [info exists env(USER)] {
			return $env(USER)
		}
		return "UNKNOWN"
	}
}
proc format_fps f {
	set fps $f
	if { $fps < .1 } {
		set fps "0 f/s"
	} elseif { $fps < 10 } {
		set fps [format "%.1f f/s" $fps]
	} else {
		set fps [format "%2.0f f/s" $fps]
	}
	return $fps
}
proc format_bps b {
	set bps $b
	if { $bps < 1 } {
		set bps "0 bps"
	} elseif { $bps < 1000 } {
		set bps [format "%3.0f bps" $bps]
	} elseif { $bps < 1000000 } {
		set bps [format "%3.1f kb/s" [expr $bps / 1000.]]
	} else {
		set bps [format "%.2f Mb/s" [expr $bps / 1000000.]]
	}
	return $bps
}
proc gettime {sec} {
    clock format $sec
}
proc sdr_gettimeofday {} {
    clock seconds
}
proc gettimenow {} {
    gettime [clock seconds]
}
proc getreadabletime {} {
    return [clock format [clock seconds] -format {%H:%M, %d/%m/%y}]
}
proc unix_to_ntp {unixtime} {
    set oddoffset 2208988800
    if {$unixtime==0} {return 0}
    return [format %u [expr $unixtime + $oddoffset]]
}
proc ntp_to_unix {ntptime} {
    set oddoffset 2208988800
    if {($ntptime==0)||($ntptime==1)} {return $ntptime}
    if {[catch {expr $ntptime - $oddoffset}] !=0} {
	    return 0
    }
    return [format %u [expr $ntptime - $oddoffset]]
}
proc duration_readable {secs {option terse}} {
	set ret ""
	set r [expr round($secs)]
	set h [expr $r / 3600]
	set r [expr $r % 3600]
	set m [expr $r / 60]
	set s [expr $r % 60]
	if {$option == "verbose"} then {
		if {$h} {
			set ret "$ret $h\h"
		}
		if {$m} {
			set ret "$ret $m\m"
		}
		if {$s} {
			set ret "$ret and $s\s"
		}
	} else {
		set ret "$h:$m:$s"
	}
		return $ret
}
proc in_multicast addr {
	return [expr ([lindex [split $addr .] 0] & 0xf0) == 0xe0]
}
proc invalid_addr a {
    set l [split $a .]
    if {[llength $l] != 4} { return 1 }
    foreach i $l {
	if {![is_number $i] || $i<0 || $i>255} { return 1 }
    }
    return 0
}
proc is_number n {
    if [catch {expr $n}] {
	return 0
    }
	return 1
}
proc parray {a {pattern *}} {
    upvar 1 $a array
    if ![array exists array] {
        error "\"$a\" isn't an array"
    }
    set maxl 0
    foreach name [lsort [array names array $pattern]] {
        if {[string length $name] > $maxl} {
            set maxl [string length $name]
        }
    }
    set maxl [expr {$maxl + [string length $a] + 2}]
    foreach name [lsort [array names array $pattern]] {
        set nameString [format %s(%s) $a $name]
        puts stdout [format "%-*s = %s" $maxl $nameString $array($name)]
    }
}
Class Log
Log proc name s {
	Log set name_ $s
}
Log proc warn s {
	Log instvar name_
	if [info exists name_] {
		set name $name_
	} else {
		global argv0
		if [info exists argv0] {
			set name [file tail $argv0]
		} else {
			set name mash
		}
	}
	puts stderr "$name_: $s"
}
Log proc fatal s {
	Log warn $s
	exit 1
}
Class Application
Application public init name {
	$self next
	$self instvar name_ class_
	set name_ $name
	$self add_option appname $name
	Log set name_ $name
	set class_ [string toupper [string index $name_ 0]][string \
		range $name_ 1 end]
	catch "tk appname $name"
	Application set instance_ $self
}
Application proc instance {} {
	return [Application set instance_]
}
Application proc name {} {
	return [[Application instance] set name_]
}
Application proc class {} {
	return [[Application instance] set class_]
}
Application proc toplevel w {
	Application instvar visual_ colormap_
	if [info exists visual_] {
		toplevel $w -class [Application class] \
			-visual $visual_ -colormap $colormap_
	} else {
		toplevel $w -class [Application class]
	}
}
global font
set font(helvetica10) {
	normal--*-100-75-75-*-*-*-*
	normal--10-*-*-*-*-*-*-*
	normal--11-*-*-*-*-*-*-*
	normal--*-100-*-*-*-*-*-*
	normal--*-*-*-*-*-*-*-*
}
set font(helvetica12) {
	normal--*-120-75-75-*-*-*-*
	normal--12-*-*-*-*-*-*-*
	normal--14-*-*-*-*-*-*-*
	normal--*-120-*-*-*-*-*-*
	normal--*-*-*-*-*-*-*-*
}
set font(helvetica14) {
	normal--*-140-75-75-*-*-*-*
	normal--14-*-*-*-*-*-*-*
	normal--*-140-*-*-*-*-*-*
	normal--*-*-*-*-*-*-*-*
}
set font(times14) {
	normal--*-140-75-75-*-*-*-*
	normal--14-*-*-*-*-*-*-*
	normal--*-140-*-*-*-*-*-*
	normal--*-*-*-*-*-*-*-*
}
Application instproc search_font { foundry style weight points slant } {
	global font tcl_version tcl_platform
 	if {$tcl_version >= 8} {
 		if {$slant == "r"} {
 			set slant ""
 		} elseif {$slant == "o"} {
 			set slant "italic"
 		}
		if {$weight == "medium"} {
			set weight ""
		}
 		return "$style -$points $weight $slant"
 	}
	foreach f $font($style$points) {
		set fname -$foundry-$style-$weight-$slant-$f
		if [havefont $fname] {
			return $fname
		}
	}
	$self instvar name_
	puts stderr "$name_: can't find $weight $fname font (using fixed)"
	if ![havefont fixed] {
		puts stderr "$name_: can't find fixed font"
		exit 1
	}
	return fixed
}
Application public init_local {} {
	$self instvar name_
	set f ~/.$name_.tcl
	if [file exists $f] {
		uplevel #0 "source $f"
	}
	set script [$self resource startupScript]
	if { $script != "" } {
		uplevel #0 "source $script"
	}
}
Application instproc user_hook {} {
}
Object instproc options {} {
	$self instvar options_
	if ![info exists options_] {
		Object instvar options_
		if ![info exists options_] {
			set options_ [new Configuration]
			global tcl_platform
			if {"$tcl_platform(platform)"=="windows"} {
				$options_ add_default \
					background SystemButtonFace
				$options_ add_default \
					infoHighlightColor SystemHighlightText
			}
		}
	}
	$options_ add_default appname mash
	return $options_
}
Object instproc optionsFrom o {
	$self set options_ $o
}
Class instproc configuration a {
 	$self instvar options_
	if ![info exists options_] {
		set options_ [new Configuration]
	}
	foreach { option value } $a {
		$options_ add_default $option $value
	}
}
Object instproc get_option r {
	set v [[$self options] get_option $r]
	if { $v != "" } {
		return $v
	}
	set cl [$self info class]
	foreach cl "$cl [$cl info heritage]" {
		$cl instvar options_
		if [info exists options_] {
			set v [$options_ get_option $r]
			if { $v != "" } {
				return $v
			}
		}
	}
	return ""
}
Object instproc resource r {
	return [$self get_option $r]
}
Object instproc add_option { r v } {
	return [[$self options] add_option $r $v]
}
Object instproc add_default { r v } {
	return [[$self options] add_default $r $v]
}
Object instproc yesno r {
	set v [$self get_option $r]
	if [string match \[0-9\]* $v] {
		return $v
	}
	if [string match \[tT\]* $v] {
		return 1
	}
	return 0
}
Object instproc debug s {
	if [$self yesno debug] {
		Log warn $s
	}
}
Object instproc warn s {
	Log warn $s
}
Object instproc fatal s {
	Log fatal $s
}
Class Configuration
Configuration public get_option r {
	$self instvar table_ default_
	if [info exists table_($r)] {
		return $table_($r)
	}
	if [info exists default_($r)] {
		return $default_($r)
	}
	return ""
}
Configuration public add_option { r v } {
	$self instvar table_
	set table_($r) $v
}
Configuration public add_default { r v } {
	$self set default_($r) $v
}
Configuration public register_option  { flag option args } {
	$self instvar arg_option_ usage_ arg_option_default_
	set arg_option_($flag) $option
	if { [lindex $args 0] == "-default" } {
		set arg_option_default_($flag) [lindex $args 1]
		set args [lrange $args 2 end]
	}
	set usage_($flag) $args
}
Configuration public register_boolean_option  { flag option args } {
	$self instvar arg_bool_ arg_bool_val_
	set arg_bool_($flag) $option
	if { $args == "" } {
		set args 1
	}
	set arg_bool_val_($flag) $args
}
Configuration public register_list_option {flag option args} {
	$self instvar arg_list_option_
	set arg_list_option_($flag) $option
	set usage_($flag) $args
}
Configuration private is_arg argv {
	if { $argv != "" } {
		return [string match -* [lindex $argv 0]]
	}
	return 0
}
Configuration instproc parse_args argv {
	$self instvar arg_resource_ bool_resource_
	$self instvar arg_option_ arg_bool_ arg_bool_val_ arg_list_option_ \
			arg_option_default_
	if { [info exists arg_resource_] || [info exists bool_resource_] } {
		puts stderr "your application class needs to be fixed"
		exit 1
	}
	while 1 {
		if ![$self is_arg $argv] {
			break
		}
		set arg [lindex $argv 0]
		set argv [lrange $argv 1 end]
		set val [lindex $argv 0]
		if { $arg == "-help" } {
			$self usage
			exit
		}
		if { $arg == "-X" } {
			set L [split $val =]
			if { [llength $L] != 2 } {
				puts stderr "malformed -X argument"
				exit 1
			}
			$self add_option [lindex $L 0] [lindex $L 1]
			set argv [lrange $argv 1 end]
			continue
		}
		set fatal_msg ""
		if [info exists arg_option_($arg)] {
			if { [llength $argv] > 0 && \
					[string index $val 0]!="-" } {
				$self add_option $arg_option_($arg) $val
				set argv [lrange $argv 1 end]
				continue
			}
			set fatal_msg "must be followed by an argument"
		}
		if [info exists arg_bool_($arg)] {
			$self add_option $arg_bool_($arg) $arg_bool_val_($arg)
			continue
		}
		if [info exists arg_list_option_($arg)] {
			if { [llength $argv] > 0 || \
					[string index $val 0]!="-" } {
				set o $arg_list_option_($arg)
				set l [$self get_option $o]
				lappend l $val
				$self add_option $o $l
				set argv [lrange $argv 1 end]
				continue
			}
			set fatal_msg "must be followed by an argument"
		}
		$self usage
		$self fatal "unknown/invalid command option: $arg ($fatal_msg)"
	}
	return $argv
}
Configuration public usage {} {
	set display_args_on_single_line 0
	if { $display_args_on_single_line } {
		puts "usage: [Application name] [join [$self arg_info]]"
	} else {
		puts "usage: [Application name]"
		foreach arg [$self arg_info] {
			puts $arg
		}
	}
}
Configuration private arg_info {} {
	$self instvar arg_option_ arg_bool_ usage_
	foreach arg [array names arg_option_] {
		set r $arg_option_($arg)
		set d [$self get_option $r]
		if { $d != "" || $usage_($arg) != "required"} {
			lappend opt "\[$arg $r ($d)\]"
		} else {
			lappend req "$arg $r"
		}
	}
	foreach arg [array names arg_bool_] {
		set r $arg_bool_($arg)
		set d [$self get_option $r]
		if { $d != "" } {
		        lappend opt "\[$arg ($d)\]"
		} else {
			lappend opt "\[$arg\]"
		}
	}
	if [info exists opt] {
		if [info exists req] {
			return [concat $opt $req]
		} else {
			return $opt
		}
	} else {
		if [info exists req] {
			return $req
		} else {
			return ""
		}
	}
}
Configuration public load_preferences suffixList {
    global env
    if {![info exists env(HOME)]} {
        new ErrorWindow {Your HOME environment variable must be set.}
        exit 1
    }
	set mash [file join $env(HOME) .mash]
	if {[file isdirectory $mash]} {
		$self load_file $mash/prefs
		foreach suffix $suffixList {
			$self load_file $mash/prefs-$suffix
		}
	}
}
Configuration private load_file fname {
	if ![file readable $fname] {
		return
	}
	set f [open $fname r]
	set count 0
	while 1 {
		incr count
		if [eof $f] {
			close $f
			return
		}
		set line [string trim [gets $f]]
		if { $line == {} || [string index $line 0]=="#" } {
			continue
		}
		set colon [string first ":" $line]
		if { $colon==-1 } {
			puts stderr "Invalid line $count in $fname:\
					Must be of the form \"key: value\""
			continue
		}
		set option [string trim [string range $line 0 [expr $colon-1]]]
		set value [string trim [string range $line \
				[expr $colon+1] end]]
		$self add_option $option $value
	}
}
Configuration public open_preferences { suffix {mode w} } {
    global env
    if {![info exists env(HOME)]} {
        new ErrorWindow {Your HOME environment variable must be set.}
        exit 1
    }
	set mash [file join $env(HOME) .mash]
	if {![file exists $mash]} {
		file mkdir $mash
	}
	set f [open $mash/prefs-$suffix $mode 0644]
	return $f
}
Configuration public write_preference { file key value } {
	puts $file "$key: $value"
}
Configuration public close_preferences { file } {
	close $file
}
Class TkWindow -configuration {
	background gray85
}
Class TopLevelWindow -superclass TkWindow
TkWindow public init {path} {
	$self next
	$self instvar path_
	set path_ $path
}
TkWindow public widget_path {} {
	$self instvar path_
	return $path_
}
TkWindow instproc destroy {} {
	$self instvar path_
	if [winfo exists $path_] {
		destroy $path_
	}
	$self next
}
TkWindow instproc highlight { color } {
	$self instvar path_
	if { $path_ != "" } {
		$path_ configure -background $color
		foreach child [winfo children $path_] {
			window_highlight $child $color
		}
	}
}
TkWindow instproc set_background { color } {
	$self instvar path_
	$path_ configure -background $color
}
TopLevelWindow public build_window {} {
	$self instvar path_
	if ![winfo exists $path_] {
		$self build $path_
	}
}
TopLevelWindow instproc toggle {} {
	$self build_window
	$self instvar path_
	set w $path_
	$self instvar __mappedBefore__
	if { [winfo ismapped $w] } {
		wm withdraw $w
		return
	} elseif ![info exists __mappedBefore__] {
		set __mappedBefore__ 1
		wm transient $w .
		update idletasks
		set x [winfo rootx .]
		set y [winfo rooty .]
		incr y [winfo height .]
		incr y -[winfo reqheight $w]
		incr y -20
		incr x [winfo vrootx .]
		incr y [winfo vrooty .]
		if { $y < 0 } { set y 0 }
		if { $x < 0 } {
			set x 0
		} else {
			set right [expr [winfo screenwidth .] - \
					[winfo reqwidth $w]]
			if { $x > $right } {
				set x $right
			}
		}
		wm geometry $w +$x+$y
	}
	wm deiconify $w
}
TopLevelWindow instproc create-window { w title } {
	Application toplevel $w
	set title "[$self get_option iconPrefix] $title"
	wm transient $w .
	wm title $w $title
	wm iconname $w $title
	bind $w <Enter> "focus $w"
	wm withdraw $w
}
Class HelpWindow -superclass TopLevelWindow
HelpWindow instproc create-window { w title items } {
	$self next $w $title
	frame $w.frame -borderwidth 0 -relief flat
	set p $w.frame
	set n 0
	foreach m $items {
		set h $w.h$n
		incr n
		frame $h
		$self helpitem $h $m
		pack $h -expand 1 -fill both
	}
	button $w.frame.ok -text " Dismiss " -borderwidth 2 -relief raised \
		-command "wm withdraw $w" -font [$self get_option medfont]
	pack $w.frame.ok -pady 6 -padx 6 -anchor e
	pack $w.frame -expand 1 -fill both
        wm protocol $w WM_DELETE_WINDOW "wm withdraw $w"
}
HelpWindow instproc helpitem { w text } {
	set f [$self get_option helpFont]
	canvas $w.bullet -width 12 -height 12
	$w.bullet create oval 6 3 12 9 -fill black
	message $w.msg -justify left -anchor w -font $f -width 450 -text $text
	pack $w.bullet -side left -anchor ne -pady 5
	pack $w.msg -side left -expand 1 -fill x -anchor nw
}
Class ErrorWindow -superclass TopLevelWindow
ErrorWindow public init text {
	set w .dialog
	$self next $w
	catch "destroy $w"
	global V
	set applname [Application name]
	if { $applname == "" } {
		set applname "mash shell"
	}
	$self create-window $w "$applname error"
	label $w.label -text "$applname: $text" -font [$self get_option medfont] \
		-borderwidth 2 -relief groove
	button $w.button -text OK -command "$self destroy" \
			-font [$self get_option medfont]
	pack $w.label -expand 1 -fill x -ipadx 4 -ipady 4
	pack $w.button -pady 4
	wm withdraw $w
	update idletasks
	set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
		- [winfo vrootx [winfo parent $w]]]
	set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
		- [winfo vrooty [winfo parent $w]]]
	wm geom $w +$x+$y
	wm deiconify $w
	bind $w <Enter> "focus $w"
	tkwait window .dialog
}
Class CheckButton
CheckButton public init { w args } {
	$self instvar var_ path_
	set path_ $w
	set var_ [TclObject getid]
	eval checkbutton $w -variable $var_ $args
}
CheckButton instproc get_val {} {
	$self instvar var_
	global $var_
	return [set $var_]
}
CheckButton instproc set_val v {
	$self instvar var_
	global $var_
	set $var_ $v
}
CheckButton instproc set-val v { $self set_val $v }
CheckButton instproc get-val {} { $self get_val }
CheckButton instproc unknown args {
	$self instvar path_
	eval $path_ $args
}
Class RadioButtonsObj
RadioButtonsObj public init { w labelsList args } {
    $self instvar var_ path_ numButtons_
    set path_ $w
    set var_ [TclObject getid]
    set c 0
    foreach i $labelsList {
	eval radiobutton $w.rb$c -variable $var_ $args
	$w.rb$c configure -text [list $i]
	$w.rb$c configure -value [list $i]
	pack $w.rb$c -in $w -anchor w
	incr c
    }
    set numButtons_ $c
}
RadioButtonsObj public get_val {} {
    $self instvar var_
    global $var_
    return [set $var_]
}
RadioButtonsObj public set_val {v} {
    $self instvar var_
    global $var_
    set $var_ $v
}
RadioButtonsObj private unknown args {
    $self instvar path_ numButtons_
    for {set i 0} {$i < $numButtons_} {incr i} {
	eval $path_.rb$i $args
    }
}
Class ScaleObj
ScaleObj public init { w args } {
    $self instvar var_ path_
    set path_ $w
    set var_ [TclObject getid]
    eval scale $w -variable $var_ $args
}
ScaleObj public get_val {} {
    $self instvar var_
    global $var_
    return [set $var_]
}
ScaleObj public set_val {v} {
    $self instvar var_
    global $var_
    set $var_ $v
}
ScaleObj private unknown args {
    $self instvar path_
    eval $path_ $args
}
Class EntryObj
EntryObj public init { w args } {
    $self instvar var_ path_
    set path_ $w
    set var_ [TclObject getid]
    eval entry $w -textvariable $var_ $args
}
EntryObj public get_val {} {
    $self instvar var_
    global $var_
    return [set $var_]
}
EntryObj private unknown args {
    $self instvar path_
    eval $path_ $args
}
namespace eval NotebookWidget {
set commands {configure cget index addTab addFrame addCommand tabPress}
set options {
    -height -width -tabheight -tabwidth -tabpadx -bd -bg -fg -variable -font
}
set defaults(-height) 200
set defaults(-width) 400
set defaults(-tabheight) 30
set defaults(-tabwidth) 0
set defaults(-font) {Helvetica -12 bold}
set defaults(-bd) 2
set defaults(-bg) gray87
set defaults(-fg) black
set defaults(-tabpadx) 5
set defaults(-variable) {}
proc notebook {n args} {
    eval newWidget $n $args
}
proc newWidget {n args} {
    variable options
    variable defaults
    foreach o $options {
	vset $n $o $defaults($o)
    }
    eval configure $n $args
    getMemberVars $n
    calcBG $n
    set pad 2
    incr height [expr 2*$pad]
    incr width [expr 2*$pad]
    canvas $n -height $height -width $width -bg $bg -highlightthickness 0
    bind $n <Configure> "NotebookWidget::resizeContentsFrame $n"
    vset $n pad $pad
    createContentsFrame $n frame frame_ids
    vset $n frame $frame
    vset $n frame_ids $frame_ids
    vset $n numtabs 0
    vset $n activeTab -1
    vset $n tabOffset [expr $pad+$bd]
    vset $n callback 0
    if {[info commands _$n] != ""} {
	rename _$n ""
    }
    rename $n _$n
    proc $n {command args} "eval widgetCommand \$command $n \$args"
    namespace export $n
    namespace eval [namespace parent] "namespace import NotebookWidget::$n"
    return $n
}
proc widgetCommand {command n args} {
    variable commands
    if {[lsearch  $commands  $command] < 0} {
	error "bad option \"$command\": must be one of $commands"
    }
    eval $command $n $args
}
proc configure {n args} {
    variable $n
    variable options
    variable defaults
    set len [llength $args]
    if {$len == 0} {
	foreach switch $options {
	    lappend results [list $switch $defaults($switch) [cget $n $switch]]
	}
	return $results
    }
    if {$len == 1} {
	return [eval cget $n $args]
    }
    if {$len > 1} {
	for {set i 0} {$i < $len} {incr i 2} {
	    cset $n [lindex $args $i] [lindex $args [expr $i+1]]
	}
    }
}
proc cget {n switch} {
    variable options
    if {[lsearch  $options $switch] < 0} {
	error "unknown option \"$switch\""
    } else {
	return [vget $n $switch]
    }
}
proc addTab {n label} {
    set t [vget $n numtabs]
    createTab $n $label win ids
    bind $win <ButtonRelease-1> "$n tabPress $t"
    vset $n tab${t}_win $win
    vset $n tab${t}_ids $ids
    activateTab $n $t
    deactivateTab $n $t
    vset $n numtabs [expr $t+1]
}
proc addFrame {n frame tab args} {
    set total [vget $n numtabs]
    if {$tab < 0 || $tab >= $total} {
	error "bad tab \"$tab\": want range \[0 [expr $total-1]\]"
    }
    vset $n frame${tab} $frame
    vset $n frame${tab}_args $args
    if {[vget $n activeTab] == $tab} {
	tabPress $n $tab
    }
}
proc addCommand {n tab command} {
    set total [vget $n numtabs]
    if {$tab < 0 || $tab >= $total} {
	error "bad tab \"$tab\": want range \[0 [expr $total-1]\]"
    }
    vset $n command${tab} $command
}
proc tabPress {n newTab} {
    if [vget $n callback] {
	return
    }
    set total [vget $n numtabs]
    set t [vget $n activeTab]
    set contents [vget $n frame]
    if {$newTab < 0 || $newTab >= $total} {
	error "bad tab \"$newTab\": want range \[0 [expr $total-1]\]"
    }
    catch {deactivateTab $n $t}
    activateTab $n $newTab
    vset $n activeTab $newTab
    if {[catch {vget $n frame${t}} frame] == 0} {
	pack forget $frame
    }
    if {[catch {vget $n frame${newTab}} frame] == 0} {
	set packArgs [vget $n frame${newTab}_args]
	eval pack $frame -in $contents $packArgs
    }
    if {[catch {vget $n command${newTab}} command] == 0} {
	uplevel #0 $command
    }
    set traceVar [vget $n -variable]
    if {$traceVar != {}} {
	vset $n callback 1
	global $traceVar
	set $traceVar $newTab
	vset $n callback 0
    }
}
proc index {n} {
    variable $n
    return [vget $n activeTab]
}
proc calcBG {n} {
    set rgb [winfo rgb . [cget $n -bg]]
    set r [lindex $rgb 0]
    set g [lindex $rgb 1]
    set b [lindex $rgb 2]
    set dr [expr $r*3/5]
    set dg [expr $g*3/5]
    set db [expr $b*3/5]
    set l1 [expr $r*7/5]
    if {$l1 > 65535} {
	set lr 65535
    } else {
	set l2 [expr (65535+$r)/2]
	if {$l1 > $l2} { set lr $l1 } else { set lr $l2 }
    }
    set l1 [expr $g*7/5]
    if {$l1 > 65535} {
	set lg 65535
    } else {
	set l2 [expr (65535+$g)/2]
	if {$l1 > $l2} { set lg $l1 } else { set lg $l2 }
    }
    set l1 [expr $b*7/5]
    if {$l1 > 65535} {
	set lb 65535
    } else {
	set l2 [expr (65535+$b)/2]
	if {$l1 > $l2} { set lb $l1 } else { set lb $l2 }
    }
    vset $n bgd [format "#%04x%04x%04x" $dr $dg $db]
    vset $n bgl [format "#%04x%04x%04x" $lr $lg $lb]
}
proc cset {n switch value} {
    variable options
    if {[lsearch  $options $switch] < 0} {
	error "unknown option \"$switch\""
    }
    switch -- $switch {
	-variable {
	    global [vget $n -variable]
	    trace vdelete [vget $n -variable] w "NotebookWidget::callback $n"
	}
    }
    vset $n $switch $value
    switch -- $switch {
	-variable {
	    global $value
	    trace variable $value w "NotebookWidget::callback $n"
	}
	-bg {
	    calcBG $n
	}
    }
}
proc vset {n switch value} {
    variable $n
    set ${n}($switch) $value
}
proc vget {n switch} {
    variable $n
    return [set ${n}($switch)]
}
proc callback {n var nothing op} {
    upvar $var index
    tabPress $n $index
}
proc getMemberVars {n} {
    variable $n
    foreach o [array names $n] {
	if {[string index $o 0] == "-"} {
	    upvar [string range $o 1 end] opt
	} else {
	    upvar $o opt
	}
	set opt [vget $n $o]
    }
}
set tnum 0
set cnum 0
proc createTab {n text win_ptr ids_ptr} {
    variable tnum
    upvar $win_ptr win $ids_ptr ids
    getMemberVars $n
    set win [label $n.t[incr tnum] -text $text -bg $bg -fg $fg -padx $tabpadx -font $font]
    set x $tabOffset
    set y $pad
    set w [expr $tabwidth ? $tabwidth : [winfo reqwidth $win]]
    set h $tabheight
    lappend ids [_$n create window [expr $x+$bd] [expr $y+$bd] \
	    -height [expr $h-2*$bd] -width [expr $w-2*$bd] \
	    -window $win -anchor nw]
    lappend ids [_$n create rectangle $x [expr $y+$bd] [expr $x+$bd] \
	    [expr $y+$h-$bd] -fill $bgl -outline {}]
    lappend ids [_$n create arc $x $y [expr $x+2*$bd] [expr $y+2*$bd] \
	    -extent 90 -start 90 -fill $bgl -outline {}]
    lappend ids [_$n create rectangle [expr $x+$bd] $y \
	    [expr $x+$w-$bd] [expr $y+$bd] -fill $bgl -outline {}]
    lappend ids [_$n create arc [expr $x+$w-2*$bd] $y \
	    [expr $x+$w] [expr $y+2*$bd] -extent 90 -start 0 \
	    -fill $bgd -outline {}]
    lappend ids [_$n create rectangle [expr $x+$w-$bd] \
	    [expr $y+$bd] [expr $x+$w] [expr $y+$h-$bd] \
	    -fill $bgd -outline {}]
    lappend ids [_$n create rectangle [expr $x+$bd] [expr $y+$h-$bd] \
	    [expr $x+$w-$bd] [expr $y+$h] -fill $bg -outline {}]
    vset $n tabOffset [expr $tabOffset+$w+1]
}
proc activateTab {n tab} {
    variable $n
    set ids [vget $n tab${tab}_ids]
    set bd [vget $n -bd]
    set id [lindex $ids 0]
    set coords [_$n coords $id]
    _$n coords $id [expr [lindex $coords 0]-$bd] [expr [lindex $coords 1]-$bd]
    set id [lindex $ids 1]
    set coords [_$n coords $id]
    _$n coords $id [expr [lindex $coords 0]-$bd] [expr [lindex $coords 1]-$bd] \
	    [expr [lindex $coords 2]-$bd] [lindex $coords 3]
    _$n raise $id
    set id [lindex $ids 2]
    set coords [_$n coords $id]
    _$n coords $id [expr [lindex $coords 0]-$bd] [expr [lindex $coords 1]-$bd] \
	    [expr [lindex $coords 2]-$bd] [expr [lindex $coords 3]-$bd]
    set id [lindex $ids 3]
    set coords [_$n coords $id]
    _$n coords $id [expr [lindex $coords 0]-$bd] [expr [lindex $coords 1]-$bd] \
	    [expr [lindex $coords 2]+$bd] [expr [lindex $coords 3]-$bd]
    set id [lindex $ids 4]
    set coords [_$n coords $id]
    _$n coords $id [expr [lindex $coords 0]+$bd] [expr [lindex $coords 1]-$bd] \
	    [expr [lindex $coords 2]+$bd] [expr [lindex $coords 3]-$bd]
    set id [lindex $ids 5]
    set coords [_$n coords $id]
    _$n coords $id [expr [lindex $coords 0]+$bd] [expr [lindex $coords 1]-$bd] \
	    [expr [lindex $coords 2]+$bd] [lindex $coords 3]
    _$n raise $id
    set id [lindex $ids 6]
    set coords [_$n coords $id]
    _$n coords $id [expr [lindex $coords 0]-$bd] [lindex $coords 1] \
	    [expr [lindex $coords 2]+$bd] [lindex $coords 3]
    _$n raise $id
}
proc deactivateTab {n tab} {
    variable $n
    set ids [vget $n tab${tab}_ids]
    set bd [vget $n -bd]
    set id [lindex $ids 0]
    set coords [_$n coords $id]
    _$n coords $id [expr [lindex $coords 0]+$bd] [expr [lindex $coords 1]+$bd]
    set id [lindex $ids 1]
    set coords [_$n coords $id]
    _$n coords $id [expr [lindex $coords 0]+$bd] [expr [lindex $coords 1]+$bd] \
	    [expr [lindex $coords 2]+$bd] [lindex $coords 3]
    set id [lindex $ids 2]
    set coords [_$n coords $id]
    _$n coords $id [expr [lindex $coords 0]+$bd] [expr [lindex $coords 1]+$bd] \
	    [expr [lindex $coords 2]+$bd] [expr [lindex $coords 3]+$bd]
    set id [lindex $ids 3]
    set coords [_$n coords $id]
    _$n coords $id [expr [lindex $coords 0]+$bd] [expr [lindex $coords 1]+$bd] \
	    [expr [lindex $coords 2]-$bd] [expr [lindex $coords 3]+$bd]
    set id [lindex $ids 4]
    set coords [_$n coords $id]
    _$n coords $id [expr [lindex $coords 0]-$bd] [expr [lindex $coords 1]+$bd] \
	    [expr [lindex $coords 2]-$bd] [expr [lindex $coords 3]+$bd]
    set id [lindex $ids 5]
    set coords [_$n coords $id]
    _$n coords $id [expr [lindex $coords 0]-$bd] [expr [lindex $coords 1]+$bd] \
	    [expr [lindex $coords 2]-$bd] [lindex $coords 3]
    _$n raise $id
    set id [lindex $ids 6]
    set coords [_$n coords $id]
    _$n coords $id [expr [lindex $coords 0]+$bd] [lindex $coords 1] \
	    [expr [lindex $coords 2]-$bd] [lindex $coords 3]
    _$n lower $id
}
proc createContentsFrame {n win_ptr ids_ptr} {
    variable cnum
    upvar $win_ptr win $ids_ptr ids
    getMemberVars $n
    set win [frame $n.c[incr cnum] -bg $bg]
    pack propagate $win 0
    grid propagate $win 0
    set x $pad
    set y [expr $tabheight-$bd+$pad]
    set height [expr $height-$tabheight+$bd-$pad]
    lappend ids [$n create window [expr $x+$bd] [expr $y+$bd] \
	    -height [expr $height - 2*$bd] -width [expr $width - 2*$bd] \
	    -window $win -anchor nw]
    lappend ids [$n create rectangle $x $y [expr $x+$bd] [expr $y+$height] -fill $bgl -outline {}]
    lappend ids [$n create rectangle $x $y [expr $x+$width] [expr $y+$bd] -fill $bgl -outline {}]
    lappend ids [$n create rectangle [expr $x+$width-$bd] [expr $y+$bd] [expr $x+$width] [expr $y+$height] -fill $bgd -outline {}]
    lappend ids [$n create rectangle [expr $x+$width] [expr $y+$height] [expr $x+$bd] [expr $y+$height-$bd] -fill $bgd -outline {}]
}
proc resizeContentsFrame {n} {
    variable $n
    getMemberVars $n
    set height [expr [winfo height $n] - 2]
    set width [expr [winfo width $n] - 2]
    set win [vget $n frame]
    set ids [vget $n frame_ids]
    set x $pad
    set y [expr $tabheight-$bd+$pad]
    set height [expr $height-$tabheight+$bd-$pad]
    set id [lindex $ids 0]
    _$n coords $id [expr $x+$bd] [expr $y+$bd]
    _$n itemconfigure $id -height [expr $height - 2*$bd] -width [expr $width - 2*$bd]
    set id [lindex $ids 1]
    _$n coords $id $x $y [expr $x+$bd] [expr $y+$height]
    set id [lindex $ids 2]
    _$n coords $id $x $y [expr $x+$width] [expr $y+$bd]
    set id [lindex $ids 3]
    _$n coords $id [expr $x+$width-$bd] [expr $y+$bd] [expr $x+$width] [expr $y+$height]
    set id [lindex $ids 4]
    _$n coords $id [expr $x+$width] [expr $y+$height] [expr $x+$bd] [expr $y+$height-$bd]
}
namespace export notebook
}
namespace import NotebookWidget::notebook
Class NewList
NewList public init {w} {
    $self next
    $self instvar canvas_ sb_
    set canvas_ $w.c
    set sb_ $w.s
    $self set ids_ {}
    canvas $canvas_ -relief groove -bd 0 -yscrollcommand "$sb_ set"
    scrollbar $sb_ -relief groove -bd 2 -command "$canvas_ yview"
    pack $canvas_ -side right -fill both -expand yes
    bind $w <Configure> "$self fix-scrollbar 1"
}
NewList private fix-scrollbar {{update 0}} {
    $self instvar canvas_ sb_
    if {$update != 0} { update }
    set yv [$canvas_ yview]
    if {[lindex $yv 0] != 0 || [lindex $yv 1] != 1} {
	pack $sb_ -side right -before $canvas_ -fill y
    } else {
	pack forget $sb_
    }
}
NewList public insert {i item callback} {
    $self instvar ids_ canvas_ bottom_
    set l [llength $ids_]
    if {$i >= $l } { set i "end" }
    if {$i == 0} {
	set top 2
    } else {
	if {$i == "end"} {
	    set last [lindex $ids_ "end"]
	} else {
	    set last [lindex $ids_ [expr $i-1]]
	}
	set top [expr [lindex [$canvas_ bbox $last] 3] + 2]
    }
    set id [$canvas_ create text 5 $top -text $item -anchor nw]
    set bb [$canvas_ bbox $id]
    set height [expr [lindex $bb 3] - [lindex $bb 1] + 2]
    set ids_ [linsert $ids_ $i $id]
    if {$i != "end"} {
	incr i
	set l [llength $ids_]
	while {$i < $l} {
	    $canvas_ move [lindex $ids_ $i] 0 $height
	    incr i
	}
    }
    $canvas_ bind $id <Enter> "$canvas_ itemconfigure $id -fill \#ff3030"
    $canvas_ bind $id <Leave> "$canvas_ itemconfigure $id -fill black"
    $canvas_ bind $id <Button-1> $callback
    set bottom [lindex [$canvas_ bbox [lindex $ids_ end]] 3]
    $canvas_ config -scrollregion "0 0 2.5i $bottom"
    $self fix-scrollbar
}
NewList public delete {i} {
    $self instvar ids_ canvas_
    set id [lindex $ids_ $i]
    set ids_ [lreplace $ids_ $i $i]
    set bb [$canvas_ bbox $id]
    set height [expr [lindex $bb 3] - [lindex $bb 1] + 2]
    $canvas_ delete $id
    set l [llength $ids_]
    while {$i < $l} {
	$canvas_ move [lindex $ids_ $i] 0 -$height
	incr i
    }
    if { [llength $ids_] == 0 } {
	return
    }
    set bottom [lindex [$canvas_ bbox [lindex $ids_ end]] 3]
    $canvas_ config -scrollregion "0 0 2.5i $bottom"
    $self fix-scrollbar
}
bind Entry <Enter> {
	catch {
		global entryTab
		if $entryTab(%W:focus) {
			focus %W
		}
	}
}
bind Entry <Return> {
    set validateMode [%W cget -validate]
    %W validate
    %W configure -validate $validateMode
}
bind Entry <Escape> {
	focus .
	%W select clear
	%W delete 0 end
	catch {
		global entryTab
		set entryTab(%W:focus) 0
		%W insert 0 $entryTab(%W:value)
	}
}
bind Entry <Control-g> [bind Entry <Escape>]
bind Entry <Control-u> {
    tkEntrySetCursor %W 0
    %W delete insert end
}
proc mk.entry { w action text } {
	puts stderr "Use the new Entry class"
	exit 1
}
Class Entry
Entry instproc init { w value {obj {}} } {
	$self instvar win_
	set win_ $w
	entry $w -relief raised -borderwidth 1 -exportselection 1 \
		-font [$self get_option entryFont] \
                -validate focusout -validatecommand "$self validate %W %P"
	global entryTab
	if {$obj == {}} {
		set entryTab($w:object) $self
	} else {
		set entryTab($w:object) $obj
	}
	set entryTab($w:value) $value
	$w insert 0 $value
}
Entry instproc entry-value { } {
	global entryTab
	$self instvar win_
	$win_ validate
	return $entryTab($win_:value)
}
Entry instproc set-value {v} {
	global entryTab
	$self instvar win_
	$win_ delete 0 end
	$win_ insert 0 $v
	set entryTab($win_:value) $v
}
Entry instproc clear { } {
	global entryTab
	$self instvar win_
	set entryTab($win_:value) 0
	$win_ insert 0 ""
}
Entry instproc validate {entryName newValue} {
    global entryTab
    $self instvar win_
    set validateResult 1
    set oldValue $entryTab($entryName:value)
    if {[catch {set reject [$entryTab($entryName:object) update $newValue]}]} {
        set reject 0
    }
    if {$reject} {
        $win_ delete 0 end
        $win_ insert 0 $oldValue
        bell
        set validateResult 0
    } else {
        set entryTab($entryName:value) $newValue
        set validateResult 1
    }
    return $validateResult
}
set nids 0
proc uniqueID { } {
	global nids
	incr nids
	return $nids
}
proc isCIF fmt {
	if { $fmt == "h261" } {
		return 1
	}
	return 0
}
proc cname_redundant { name cname } {
	set ni [string first @ $name]
	if { $ni < 0 } {
		return 0
	}
	set ci [string first @ $cname]
	if { $ci < 0 } {
		return 0
	}
	if { [string compare \
		[string range $name 0 $ni] \
		[string range $cname 0 $ci]] == 0 } {
		return 1
	}
	return 0
}
set current_icon_mark "FIXME"
proc mk.key w {
	puts stderr "Use the new KeyEditor class"
	exit 1
}
Class KeyEditor
KeyEditor instproc init { w crypt } {
	$self instvar crypt_ entry_ win_
	set crypt_ $crypt
	set win_ $w
	frame $w.key
	checkbutton $w.key.button -text "Encryption Key:" -relief flat \
		-font [$self get_option smallfont] \
		-command "$self toggle" -variable [$self tkvarname encryptOn_]\
		-disabledforeground gray40
	set key [$self get_option sessionKey]
	set entry_ [new Entry $w.key.entry $key $self]
	$self set-key $key
	pack $w.key.button -side left
	pack $w.key.entry -side left -fill x -expand 1
}
KeyEditor instproc disable {} {
	$self instvar win_
	$win_.key.button configure -state disabled
}
KeyEditor instproc enable {} {
	$self instvar win_
	$win_.key.button configure -state normal
}
KeyEditor instproc set-key key {
	$self tkvar encryptOn_
	$self instvar crypt_
	if { $key == "" } {
		$crypt_ crypt_clear
		set encryptOn_ 0
		$self disable
	} elseif { [$crypt_ install-key $key] != "" } {
		$self disable
		set encryptOn_ 0
		$self clear
	} else {
		$self enable
		set encryptOn_ 1
	}
}
KeyEditor instproc toggle {} {
	$self instvar crypt_ entry_
        $self tkvar encryptOn_
	if $encryptOn_ {
		$crypt_ install-key [$entry_ entry-value]
	} else {
		$crypt_ install-key ""
	}
}
KeyEditor instproc update key {
	set key [string trim $key]
	$self set-key $key
	return 0
}
Class TextEntry -superclass Entry
TextEntry instproc init { target w text } {
	$self next $w $text
	$self set target_ $target
}
TextEntry instproc update s {
	$self instvar target_
	if { $s != "" } {
		set s [string trim $s]
	}
	if {$target_ == {}} {
		return 0
	} else {
		return [eval $target_ \"$s"]
	}
}
Class PopupMenu
PopupMenu public init {w args} {
    $self next
    $self instvar win_ n_
    set win_ $w
    menubutton $win_ -indicatoron yes -menu $win_.m -relief raised -bd 2
    menu $win_.m
    set n_ 0
    foreach a $args {
	eval $self add $a
    }
}
PopupMenu public add {text {cmd ""}} {
    $self instvar win_ n_ text_ cmd_
    $win_.m add command -label $text -command "$self select $n_"
    if {$n_ == 0} {
	$win_ configure -text $text
    }
    set text_($n_) $text
    set cmd_($n_) $cmd
    incr n_
}
PopupMenu public get {} {
    $self instvar win_
    return [$win_ cget -text]
}
PopupMenu public clear {} {
    $self instvar win_ n_ text_ cmd_
    $win_.m delete 0 end
    for {set i 0} {$i<$n_} {incr i} {
	unset text_($i)
	unset cmd_($i)
    }
    set n_ 0
}
PopupMenu private select {n} {
    $self instvar win_ text_ cmd_
    $win_ configure -text $text_($n)
    if {$cmd_($n) != ""} {
	catch {eval $cmd_($n)}
    }
}
Class RTP
Class RTP/Video -superclass RTP
Class RTP/Audio -superclass RTP
RTP private init {} {
	eval $self next
	$self instvar rtp_ptoa_
	set rtp_ptoa_(-1) ""
}
RTP/Audio set default_ptoa_(0) pcm
RTP/Audio set default_ptoa_(1) celp
RTP/Audio set default_ptoa_(2) g721
RTP/Audio set default_ptoa_(3) gsm
RTP/Audio set default_ptoa_(5) dvi
RTP/Audio set default_ptoa_(6) dvi
RTP/Audio set default_ptoa_(7) lpc
RTP/Audio set default_ptoa_(8) pcma
RTP/Audio set default_ptoa_(9) g722
RTP/Audio set default_ptoa_(10) lin16
RTP/Audio set default_ptoa_(11) lin16
RTP/Audio set default_ptoa_(14) mpa
RTP/Audio set default_ptoa_(15) g728
RTP/Video set default_ptoa_(21) pvh
RTP/Video set default_ptoa_(25) cellb
RTP/Video set default_ptoa_(26) jpeg
RTP/Video set default_ptoa_(27) cuseeme
RTP/Video set default_ptoa_(28) nv
RTP/Video set default_ptoa_(29) picw
RTP/Video set default_ptoa_(30) cpv
RTP/Video set default_ptoa_(31) h261
RTP/Video set default_ptoa_(32) mpeg
RTP/Video set default_ptoa_(33) mpegs
RTP/Video set default_ptoa_(42) h263+
RTP/Video set default_ptoa_(34) h263
RTP/Audio set default_ptoa_(126) mp3
RTP/Video set default_ptoa_(127) h261v1
RTP/Video set default_ptoa_(50) sc
RTP/Audio public init args {
	$self next
	$class instvar default_ptoa_
	$self instvar rtp_ptoa_ rtp_atop_
	foreach p [array names default_ptoa_] {
		$self add_mapping $p $default_ptoa_($p)
	}
	foreach mapping [$self get_option rtpMap] {
		set l [split $mapping :]
		set pt [lindex $l 0]
		set fmt [lindex $l 1]
		$self add_mapping $pt $fmt
	}
}
RTP/Video public init args {
	$self next
	$class instvar default_ptoa_
	$self instvar rtp_ptoa_ rtp_atop_
        set rtp_ptoa_(-1) ""
	foreach p [array names default_ptoa_] {
		set rtp_ptoa_($p) $default_ptoa_($p)
		set rtp_atop_($default_ptoa_($p)) $p
	}
	foreach mapping [$self get_option rtpMap] {
		set l [split $mapping :]
		set pt [lindex $l 0]
		set fmt [lindex $l 1]
		$self add_mapping $pt $fmt
	}
	$self instvar classmap_
	set classmap_(pvh) PVH
	set classmap_(h261) H261
	set classmap_(h261v1) H261v1
	set classmap_(nv) NV
	set classmap_(cellb) CellB
	set classmap_(jpeg) JPEG
        set classmap_(h263+) H263+
        set classmap_(h263) H263
	set classmap_(sc) SC
}
RTP/Video public classmap type {
	$self instvar classmap_
	if [info exists classmap_($type)] {
		return $classmap_($type)
	}
	return "Null"
}
RTP public add_mapping {pt fmt} {
	$self instvar rtp_ptoa_ rtp_atop_
	set rtp_ptoa_($pt) $fmt
	set rtp_atop_($fmt) $pt
}
RTP public rtp_type pt {
	$self instvar rtp_ptoa_
	if [info exists rtp_ptoa_($pt)] {
		return $rtp_ptoa_($pt)
	} elseif { $pt < 0 }  {
		return ""
	} else {
		return fmt-$pt
	}
}
RTP public rtp_fmt_number fmt {
	$self instvar rtp_atop_
	if [info exists rtp_atop_($fmt)] {
		return $rtp_atop_($fmt)
	} else {
		return -1
	}
}
RTP public rtp_format src {
	$self instvar rtp_ptoa_
	return [$self rtp_type [$src format]]
}
RTP instproc cname_redundant { name cname } {
	set ni [string first @ $name]
	if { $ni < 0 } {
		return 0
	}
	set ci [string first @ $cname]
	if { $ci < 0 } {
		return 0
	}
	if { [string compare \
		[string range $name 0 $ni] \
		[string range $cname 0 $ci]] == 0 } {
		return 1
	}
	return 0
}
RTP public rtp_representation src {
	set fmt [$self rtp_format $src]
	set name [$src sdes name]
	set cname [$src sdes cname]
	set addr [$src addr]
	if { $name == "" } {
		if { $cname == "" } {
			set srcname $addr
			set srcinfo $addr/$fmt
		} else {
			set srcname $cname
			set srcinfo $addr/$fmt
		}
	} elseif [$self cname_redundant $name $cname] {
		set srcname $name
		set srcinfo $addr/$fmt
	} else {
		set srcname $name
		set srcinfo $cname/$fmt
	}
	return "{$srcname} {$srcinfo}"
}
Class SDPMediaEditWindow
SDPMediaEditWindow public init {w msg src} {
    $self set win_ $w
    $self set msg_ $msg
    $self set src_ $src
    $self instvar simple_
    set simple_ [$self yesno simpleInterface]
    if {$simple_} {
	$self set simplewin_ [new SDPMediaEditWindow/Simple $self]
    } else {
	$self set advancedwin_ [new SDPMediaEditWindow/Advanced $self]
    }
}
SDPMediaEditWindow public destroy {} {
    $self instvar simplewin_ advancedwin_ win_
    if [info exists simplewin_] { delete $simplewin_ }
    if [info exists advancedwin_] { delete $advancedwin_ }
    destroy $win_
}
SDPMediaEditWindow public build-simple {} {
    $self instvar simplewin_ advancedwin_ simple_
    if [info exists advancedwin_] {
	$advancedwin_ hide
    }
    if [info exists simplewin_] {
	$simplewin_ show
    } else {
	set simplewin_ [new SDPMediaEditWindow/Simple $self]
    }
    set simple_ 1
}
SDPMediaEditWindow public build-advanced {} {
    $self instvar simplewin_ advancedwin_ simple_
    if [info exists simplewin_] {
	$simplewin_ hide
    }
    if [info exists advancedwin_] {
	$advancedwin_ show
    } else {
	set advancedwin_ [new SDPMediaEditWindow/Advanced $self]
    }
    set simple_ 0
}
SDPMediaEditWindow public buildmsgs {} {
    $self instvar simple_ simplewin_ advancedwin_
    if $simple_ {
	return [list [$simplewin_ buildmsg]]
    } else {
	return [$advancedwin_ buildmsgs]
    }
}
SDPMediaEditWindow proc is-number {n} {
    if [catch {expr $n}] {
	return 0
    }
    return 1
}
SDPMediaEditWindow proc valid-addr {a} {
    set l [split $a .]
    if {[llength $l] != 4} { return 1 }
    foreach i $l {
	if {![$self is-number $i] || $i<0 || $i>255} { return 1 }
    }
    return 0
}
SDPMediaEditWindow proc valid-port {p} {
    if {![$self is-number $p] || $p<0 || $p>65535} { return 1}
    return 0
}
Class SDPMediaEditWindow/Advanced
SDPMediaEditWindow/Advanced public init {parent} {
    $self instvar win_ parent_ msg_ src_
    set win_ "[$parent set win_].advanced"
    frame $win_
    set parent_ $parent
    set msg_ [$parent set msg_]
    set src_ [$parent set src_]
    $self buildwin
    $self show
}
SDPMediaEditWindow/Advanced public hide {} {
    $self instvar win_
    pack forget $win_
}
SDPMediaEditWindow/Advanced public show {} {
    $self instvar win_
    pack $win_ -fill both -expand yes
}
SDPMediaEditWindow/Advanced private buildwin {} {
    $self instvar win_ msg_ src_ scopes_
    $self instvar typemenu_ formatmenu_ protomenu_ attrentries_
    set scopes_ [$src_ scopes]
    $self set streams_ {}
    $self set current_ -1
    set font [$self get_option smallfont]
    frame $win_.list
    label $win_.list.l -text "Streams"
    set h [expr ([winfo reqheight $win_.list.l]/2) + 2]
    frame $win_.list.pad -height $h
    set f $win_.list.f
    frame $f -relief groove -bd 2
    frame $f.pad -height $h
    pack $f.pad -side top
    frame $f.top
    $self instvar lb_
    set lb_ [listbox $f.top.lb -width 15 -height 5 \
		 -exportselection no -selectmode single \
		 -yscrollcommand "$f.top.sb set"]
    bind $f.top.lb <Button-1> "$self streamclick %x %y"
    pack $f.top.lb -side right -fill both -expand yes
    scrollbar $f.top.sb -width 10 -command "$f.top.lb yview"
    pack $f.top.sb -side right -before $f.top.lb -fill y
    pack $f.top -side top -fill both -expand yes
    frame $f.b
    button $f.b.add -text "Add" -command "$self add-stream"
    button $f.b.del -text "Delete" -command "$self delete-stream"
    pack $f.b.add $f.b.del -side left
    pack $f.b
    pack $win_.list.pad -side top
    pack $f -fill both -expand yes -padx 4 -pady 0
    place $win_.list.l -x 6 -y 2
    raise $win_.list.l
    pack $win_.list -side left -fill both -expand no
    frame $win_.prop
    label $win_.prop.l -text "Properties"
    set h [expr ([winfo reqheight $win_.prop.l])/2 + 2]
    frame $win_.prop.pad -height $h
    frame $win_.prop.f -relief groove -bd 2
    frame $win_.prop.f.pad -height $h
    pack $win_.prop.f.pad -side top
    set f $win_.prop.f.f
    frame $f
    frame $f.left
    label $f.left.typet -text "Type:" -anchor e
    grid $f.left.typet -row 0 -column 0 -sticky ew
    set typemenu_ [new PopupMenu $f.left.typem]
    foreach type [UserApplication media] {
	$typemenu_ add $type "$self set-type $type"
    }
    grid $f.left.typem -row 0 -column 1 -sticky ew
    label $f.left.formatt -text "Format:" -anchor e
    grid $f.left.formatt -row 1 -column 0 -sticky ew
    set formatmenu_ [new PopupMenu $f.left.formatm]
    grid $f.left.formatm -row 1 -column 1 -sticky ew
    label $f.left.protot -text "Protocol:" -anchor e
    grid $f.left.protot -row 2 -column 0 -sticky ew
    set protomenu_ [new PopupMenu $f.left.protom]
    grid $f.left.protom -row 2 -column 1 -sticky ew
    set attrentries_ {}
    pack $f.left -side left -fill y -expand yes
    frame $f.right
    $self instvar layeredcb_
    set layeredcb_ [new CheckButton $f.right.cb -text "Use Layering" \
			-command "$self toggle-layering"]
    pack $f.right.cb -side top -fill x
    frame $f.right.addr
    $self set addrframe_ $f.right.addr
    $self set addrblocks_ {}
    pack $f.right.addr -side top -fill both -expand yes
    pack $f.right -fill both -expand yes
    pack $win_.prop.pad -side top -fill both
    pack $win_.prop.f -fill both -expand yes
    pack $f -side left -fill both -expand yes -padx 4 -pady 0
    place $win_.prop.l -x 6 -y 2
    raise $win_.prop.l
    pack $win_.prop -side left -fill both -expand yes
    pack propagate $win_.prop no
    pack $win_ -fill both -expand yes -pady 2
    if {$msg_ == ""} {
	$self add-stream
    } else {
	foreach m [[$msg_ base] set allmedia_] {
	    $self add-stream $m
	}
    }
    $self set layered_ 0
    $self select-stream 0
    $lb_ selection set 0
}
SDPMediaEditWindow/Advanced private streamclick {x y} {
    $self instvar current_ lb_
    if {$current_ >= 0} {
	$self save-stream
    }
    set i [$lb_ nearest $y]
    $self select-stream $i
}
SDPMediaEditWindow/Advanced private save-stream {} {
    $self instvar typemenu_ formatmenu_ protomenu_ \
	addrblocks_ attrentries_ streams_ current_
    set media [$typemenu_ get]
    set fmt [$formatmenu_ get]
    set proto [$protomenu_ get]
    set addrs {}
    foreach b $addrblocks_ {
	lappend addrs [$b get]
    }
    set attrs {}
    foreach e $attrentries_ {
	lappend attrs [$e entry-value]
    }
    if {$proto=={RTP/AVP}} {
      set lfmt [string tolower $fmt]
      if {$media=={video}} {
         set v [new RTP/Video]
         set fmt [$v rtp_fmt_number $lfmt]
         delete $v
      } elseif {$media=={audio}} {
         set a [new RTP/Audio]
         set fmt [$a rtp_fmt_number $lfmt]
         delete $a
      } else {
         puts "nsdr: unknown format named $fmt"
      }
    }
    set stream [list $media $fmt $proto $addrs $attrs]
    set streams_ [lreplace $streams_ $current_ $current_ $stream]
}
SDPMediaEditWindow/Advanced private select-stream {i {layered -1}} {
    $self set current_ $i
    $self instvar current_ streams_ typemenu_ formatmenu_ \
	protomenu_ layeredcb_ addrblocks_ attrentries_ layered_
    set stream [lindex $streams_ $i]
    set type [lindex $stream 0]
    set fmt [lindex $stream 1]
    set proto [lindex $stream 2]
    set addrs [lindex $stream 3]
    set attrs [lindex $stream 4]
    $self set-type $type
    set i [lsearch -exact [UserApplication media] $type]
    $typemenu_ select $i
    set fmts [UserApplication formats $type]
    if {($proto == {RTP/AVP}) && ([string is digit $fmt])} {
        if {$type == {video}} {
            set fmt [string toupper [RTP/Video set default_ptoa_($fmt)]]
        } elseif {$type == {audio}} {
            set fmt [string toupper [RTP/Audio set default_ptoa_($fmt)]]
        } else {
            puts "nsdr: unknown format number $fmt"
        }
    }
    set i [lsearch -exact $fmts $fmt]
    $formatmenu_ select $i
    set protos [UserApplication protos $type]
    set i [lsearch -exact $protos $proto]
    $protomenu_ select $i
    if {$layered == -1} {
	set layered 0
	if {[llength $addrs] > 1 || [lindex [lindex $addrs 0] 2] > 1} {
	    set layered 1
	}
    }
    foreach b $addrblocks_ {
	delete $b
    }
    if {$layered_ == 0 && $layered == 1} {
	$self build-layers
	set layered_ 1
	$layeredcb_ set-val 1
    } elseif {$layered_ == 1 && $layered == 0} {
	$self destroy-layers
	set layered_ 0
	$layeredcb_ set-val 0
    }
    if $layered {
	foreach a $addrs {
	    set b [$self add-addrblock]
	    $b set $a
	}
    } else {
	$self instvar addrframe_
	set addrblocks_ [new AddrBlockWindow $addrframe_ 0 $self]
	$addrblocks_ set-type [lindex $stream 0]
	    $addrblocks_ set [lindex $addrs 0]
    }
    set i [llength $attrs]
    while {$i>0} {
	incr i -1
	set e [lindex $attrentries_ $i]
	set v [lindex $attrs $i]
	$e set-value $v
    }
}
SDPMediaEditWindow/Advanced private add-stream {{m ""}} {
    $self instvar streams_ lb_
    if {$m == ""} {
	set media [lindex [UserApplication media] 0]
	set fmt [lindex [UserApplication formats $media] 0]
	set proto [lindex [UserApplication protos $media] 0]
	set attrs [UserApplication attrs $media]
	set addr [list [$self alloc-addrs 1] [$self alloc-port $media] 1]
	set addrs [list $addr]
	set new [list $media $fmt $proto $addrs $attrs]
    } else {
	set media [$m set mediatype_]
	set fmt [$m set fmt_]
	set proto [$m set proto_]
	set addr [list [$m set caddr_] [$m set port_] ]
	set addrs [list $addr]
	set attrs ""
	set new [list $media $fmt $proto $addrs $attrs]
    }
    lappend streams_ $new
    $lb_ insert end $media
}
SDPMediaEditWindow/Advanced private delete-stream {} {
    $self instvar streams_ lb_ current_
    set streams_ [lreplace $streams_ $current_ $current_]
    $lb_ delete $current_
    set end [expr [$lb_ index end] -1]
    if {$current_ > $end} {
	set new $end
    } else {
	set new $current_
    }
    $self select-stream $new
    $lb_ selection set $new
}
Class AddrBlockWindow
AddrBlockWindow public init {w layered parent} {
    $self next
    $self instvar win_ layered_ parent_ scope_
    $self instvar scopemenu_ addrentry_ portentry_ layerentry_
    set win_ $w
    set layered_ $layered
    set parent_ $parent
    label $w.sl -text "Address Scope:" -anchor e
    grid $w.sl -row 0 -column 0 -sticky ew
    set scopemenu_ [new PopupMenu $w.sm]
    $w.sm config -width 16 -anchor w
    grid $w.sm -row 0 -column 1 -sticky e
    set i 0
    foreach s [$parent_ set scopes_] {
	$scopemenu_ add [$s name] "$self choose-scope $i"
	incr i
    }
    $scopemenu_ select 0
    set scope_ 0
    label $w.al -text "Address:" -anchor e
    grid $w.al -row 1 -column 0 -sticky ew
    set addrentry_ [new TextEntry "SDPMediaEditWindow valid-addr" $w.ae ""]
    $w.ae config -width 16
    grid $w.ae -row 1 -column 1 -sticky ew
    label $w.pl -text "Port:" -anchor e
    grid $w.pl -row 2 -column 0 -sticky ew
    set portentry_ [new TextEntry "SDPMediaEditWindow valid-port" $w.pe ""]
    $w.pe config -width 8
    grid $w.pe -row 2 -column 1 -sticky ew
    set row 3
    if {$layered} {
	label $w.ll -text "Layers:" -anchor e
	grid $w.ll -row 3 -column 0 -sticky ew
	set layerentry_ [new TextEntry "SDPMediaEditWindow valid-port" \
			     $w.le "1"]
	$w.le config -width 8
	grid $w.le -row 3 -column 1 -sticky ew
	incr row
    }
    grid rowconfigure $w $row -weight 1
}
AddrBlockWindow public destroy {} {
    $self instvar scopemenu_ addrentry_ portentry_ layerentry_ win_
    delete $addrentry_
    delete $portentry_
    catch {delete $layerentry_}
    foreach w [winfo children $win_] { destroy $w }
}
AddrBlockWindow private choose-scope {i} {
    $self instvar scope_ addrentry_ layerentry_ parent_
    if {$i == $scope_} { return }
    set scope_ $i
    set l 1
    if [info exists layerentry_] {
	set l [$layerentry_ entry-value]
    }
    set addr [$parent_ alloc-addrs $l [lindex [$parent_ set scopes_] $i]]
    $addrentry_ set-value $addr
}
AddrBlockWindow public set-type {type} {
    $self instvar portentry_ parent_
    set p [$parent_ alloc-port $type]
    $portentry_ set-value $p
}
AddrBlockWindow public get {} {
    $self instvar addrentry_ portentry_ layerentry_
    set addr [$addrentry_ entry-value]
    set port [$portentry_ entry-value]
    set layers 1
    if [info exists layerentry_] {
	set layers [$layerentry_ entry-value]
    }
    return [list $addr $port $layers]
}
AddrBlockWindow public set {l} {
    $self instvar addrentry_ portentry_ layerentry_
    $addrentry_ set-value [lindex $l 0]
    $portentry_ set-value [lindex $l 1]
    if [info exists layerentry_] {
	$layerentry_ set-value [lindex $l 2]
    }
}
SDPMediaEditWindow/Advanced private build-layers {} {
    $self instvar addrframe_ addrcanvas_ addrblocks_
    set f $addrframe_.top
    frame $f
    button $addrframe_.add -text "Add Block" -command "$self add-addrblock"
    pack $addrframe_.add -side bottom
    set addrcanvas_ $f.c
    set sb $f.sb
    canvas $addrcanvas_ -yscrollcommand "$sb set"
    scrollbar $sb -relief groove -bd 2 -width 10 \
	-command "$addrcanvas_ yview"
    pack $addrcanvas_ -side right -fill y
    set addrblocks_ {}
    pack $sb -side right -before $addrcanvas_ -fill y
    pack $f -side bottom  -fill both -expand yes
}
SDPMediaEditWindow/Advanced private destroy-layers {} {
    $self instvar addrframe_
    destroy $addrframe_.top $addrframe_.add
}
SDPMediaEditWindow/Advanced private toggle-layering {} {
    $self instvar streams_ current_ layeredcb_
    $self save-stream
    set stream [lindex $streams_ $current_]
    set addrs [lindex $stream 3]
    set stream [lreplace $stream 3 3 $addrs]
    set streams_ [lreplace $streams_ $current_ $current_ $stream]
    $self select-stream $current_ [$layeredcb_ get-val]
}
SDPMediaEditWindow/Advanced private add-addrblock {} {
    $self instvar addrcanvas_ numblocks_ addrblocks_ type_
    if ![info exists numblocks_] {
	set numblocks_ 0
	set y 0
    } else {
	set bb [$addrcanvas_ bbox all]
	set y [expr [lindex $bb 3] + 4]
    }
    set w $addrcanvas_.addr$numblocks_
    frame $w -relief groove -bd 2
    $addrcanvas_ create window 2 $y -window $w -anchor nw
    set b [new AddrBlockWindow $w 1 $self]
    $b set-type $type_
    lappend addrblocks_ $b
    incr numblocks_
    update
    set bb [$addrcanvas_ bbox all]
    $addrcanvas_ config -width [lindex $bb 2]
    $addrcanvas_ config -scrollregion "0 0 2.5i [lindex $bb 3]"
    return $b
}
SDPMediaEditWindow/Advanced private set-type {type} {
    $self instvar type_ formatmenu_ protomenu_ win_ \
	current_ lb_ addrblocks_ attrentries_
    set type_ $type
    if {$current_ == [$lb_ index end]} {
	set current_ end
    }
    $lb_ delete $current_
    $lb_ insert $current_ $type
    $lb_ selection set $current_
    set current_ [$lb_ index $current_]
    $formatmenu_ clear
    set fmts [UserApplication formats $type]
    foreach f $fmts {
	$formatmenu_ add $f
    }
    $formatmenu_ select 0
    $protomenu_ clear
    foreach proto [UserApplication protos $type] {
	$protomenu_ add $proto
    }
    $protomenu_ select 0
    foreach b $addrblocks_ {
	$b set-type $type
    }
    set f $win_.prop.f.f.left
    foreach e $attrentries_ {
	delete $e
    }
    set row 3
    while {[winfo exists $f.l$row]} {
	destroy $f.l$row
	catch {destroy $f.e$row}
	incr row
    }
    set attrentries_ {}
    set row 3
    set attrs [UserApplication attrs $type]
    foreach attr $attrs {
	if {[llength $attr] == 1} {
	    set label $attr
	    set value ""
	} else {
	    set label [lindex $attr 0]
	    set value [lindex $attr 1]
	}
	append label :
	label $f.l$row -text $label -anchor e
	grid $f.l$row -row $row -column 0 -sticky ew
	lappend attrentries_ [new TextEntry "" $f.e$row $value]
	$f.e$row config -width 10
	grid $f.e$row -row $row -column 1 -sticky ew
	incr row
    }
    grid rowconfigure $f $row -weight 1
}
SDPMediaEditWindow/Advanced private alloc-addrs {n {scope ""}} {
    if {$scope == ""} {
	$self instvar scopes_
	set scope [lindex $scopes_ 0]
    }
    return [[AddressAllocator instance] alloc $scope $n]
}
SDPMediaEditWindow/Advanced private alloc-port {media} {
    switch $media {
	audio { set base 0x4000 }
	whiteboard { set base 0x8000 }
	video - default { set base 0xc000 }
    }
    set port [expr ([random]&0x3ffe) + $base]
    return $port
}
SDPMediaEditWindow/Advanced private find-scope {addr} {
    $self instvar scopes_
    foreach s $scopes_ {
	if [$s contains $addr] {
	    return $s
	}
    }
    return ""
}
SDPMediaEditWindow/Advanced public buildmsgs {} {
    $self save-stream
    set scopes {}
    $self instvar streams_
    foreach s $streams_ {
	foreach a [lindex $s 3] {
	    set scope [$self find-scope [lindex $a 0]]
	    if {$scope == ""} {
		$self warn "Can't find scope for address $a"
		return {}
	    }
	    if { [lsearch -exact $scopes $scope] < 0 } {
		lappend scopes $scope
	    }
	}
    }
    $self instvar scopes_
    foreach s $scopes_ {
	set i [lsearch -exact $scopes $s]
	if {$i == 0} {
	    break
	} elseif {$i>0} {
	    set scopes [concat $s [lreplace $scopes $i $i]]
	    break
	}
    }
    set msgs {}
    foreach scope $scopes {
	set text ""
	foreach stream $streams_ {
	    set media [lindex $stream 0]
	    set fmt [lindex $stream 1]
	    set proto [lindex $stream 2]
	    set addrs [lindex $stream 3]
	    set attrs [lindex $stream 4]
	    set layer 0
	    foreach a $addrs {
		set addr [lindex $a 0]
		set port [lindex $a 1]
		set layers [lindex $a 2]
		if [$scope contains $addr] {
		    set ttl 127
		    append text "m=$media $port $proto $fmt\n"
		    append text "c=IN IP4 $addr/$ttl/$layers\n"
		    if {$layers > 1 || [llength $addrs] > 1} {
			if {$layers == 1} {
			    append text "a=layers:$layer"
			} else {
			    set last [expr $layer + $layers - 1]
			    append text "a=layers:$layer-$last\n"
			}
		    }
		    set i 0
		    set names [UserApplication attrs $media]
		    foreach v $attrs {
			if {$v != ""} {
			    set name [lindex $names $i]
			    if {[llength $name] > 1} {
				set name [lindex $name 0]
			    }
			    append text "a=$name:$v\n"
			    incr i
			}
		    }
		}
		incr layer $layers
	    }
	}
	lappend msgs $text
    }
    return $msgs
}
Class SDPMediaEditWindow/Simple
SDPMediaEditWindow/Simple public init {parent} {
    $self instvar win_ msg_ src_
    set win_ "[$parent set win_].simple"
    frame $win_
    set msg_ [$parent set msg_]
    set src_ [$parent set src_]
    $self buildwin
    $self show
}
SDPMediaEditWindow/Simple public hide {} {
    $self instvar win_
    pack forget $win_
}
SDPMediaEditWindow/Simple public show {} {
    $self instvar win_
    pack $win_ -fill both -expand yes
}
SDPMediaEditWindow/Simple private buildwin {} {
    $self instvar win_ msg_ media_ buttons_ menus_ addrs_ ports_
    set buttons_ {}
    set menus_ {}
    set addrs_ {}
    set ports_ {}
    label $win_.lt -text "Media"
    grid $win_.lt -row 0 -column 0 -columnspan 2 -sticky ew
    label $win_.ft -text "Format"
    grid $win_.ft -row 0 -column 2 -sticky ew
    label $win_.addrt -text "Address"
    grid $win_.addrt -row 0 -column 3 -sticky ew
    label $win_.portt -text "Port"
    grid $win_.portt -row 0 -column 4 -sticky ew
    set media_ [UserApplication media]
    set i 1
    foreach type $media_ {
	if {$msg_ == ""} {
	    set present 1
	    set addr [$self alloc-addr]
	    set port [$self alloc-port $type]
	} else {
	}
	set button [new CheckButton $win_.c$i]
	$button set-val $present
	lappend buttons_ $button
	grid $win_.c$i -row $i -column 0 -padx 2 -pady 2
	label $win_.l$i -text $type -anchor w
	grid $win_.l$i -row $i -column 1 -sticky ew
	set menu [new PopupMenu $win_.f$i]
	lappend menus_ $menu
	foreach fmt [UserApplication formats $type] {
	    $menu add $fmt
	}
	grid $win_.f$i -row $i -column 2 -sticky ew
	set entry [new TextEntry "$self valid-addr" $win_.addr$i ""]
	$win_.addr$i configure -width 16
	$win_.addr$i insert 0 $addr
	lappend addrs_ $entry
	grid $win_.addr$i -row $i -column 3 -sticky ew
	set entry [new TextEntry "$self valid-port" $win_.port$i ""]
	$win_.port$i configure -width 8
	$win_.port$i insert 0 $port
	lappend ports_ $entry
	grid $win_.port$i -row $i -column 4 -sticky ew
	incr i
    }
    message $win_.m \
	-text "WARNING: The simple interface really doesn't work yet."
    grid $win_.m -row $i -column 0 -columnspan 5 -sticky news
    update
    $win_.m configure -width [winfo width $win_.m]
}
SDPMediaEditWindow/Simple private alloc-addr {} { return "224.2.3.4" }
SDPMediaEditWindow/Simple private alloc-port {media} { return "1234" }
SDPMediaEditWindow/Simple public buildobjs {} { return {} }
Class Combobox
Combobox set arrow [image create bitmap -data {
\#define arrow_width 14
\#define arrow_height 14
static char arrow_bits[] = {
   0x00, 0x00, 0xe0, 0x01, 0xe0, 0x01, 0xe0, 0x01, 0xe0, 0x01, 0xfc, 0x0f,
   0xf8, 0x07, 0xf0, 0x03, 0xe0, 0x01, 0xc0, 0x00, 0x00, 0x00, 0xfe, 0x1f,
   0xfe, 0x1f, 0x00, 0x00};
}]
Combobox public init {w value cmd args} {
    $self instvar win_ entry_
    $class instvar arrow
    set win_ $w
    frame $w
    set entry_ [new TextEntry $cmd $w.entry $value]
    pack $w.entry -side left -fill x -expand yes
    menubutton $w.b -image $arrow -menu $w.b.m -indicatoron no \
	-relief raised -bd 2
    pack $w.b
    menu $w.b.m
    foreach a $args {
	$w.b.m add command -label $a -command "$self set \"$a\""
    }
}
Combobox public destroy {} {
    $self instvar win_
    destroy $win_
}
Combobox public set {value} {
    $self instvar entry_
    $entry_ set-value $value
}
Combobox public get {} {
    $self instvar entry_
    return [$entry_ entry-value]
}
Combobox public enable {} {
    $self instvar win_
    $win_.b configure -state normal
    $win_.entry configure -state normal
}
Combobox public disable {} {
    $self instvar win_
    $win_.b configure -state disabled
    $win_.entry configure -state disabled
}
Class SDPTimeEditWindow
SDPTimeEditWindow set times_(minute) 60
SDPTimeEditWindow set times_(hour) 3600
SDPTimeEditWindow set times_(day) 86400
SDPTimeEditWindow set times_(week) 604800
SDPTimeEditWindow set numbers_(one) 1
SDPTimeEditWindow set numbers_(two) 2
SDPTimeEditWindow set numbers_(three) 3
SDPTimeEditWindow set numbers_(four) 4
SDPTimeEditWindow set numbers_(five) 5
SDPTimeEditWindow set numbers_(six) 6
SDPTimeEditWindow set numbers_(seven) 7
SDPTimeEditWindow set numbers_(eight) 8
SDPTimeEditWindow set numbers_(nine) 9
SDPTimeEditWindow set numbers_(ten) 10
SDPTimeEditWindow set numbers_(eleven) 11
SDPTimeEditWindow set numbers_(twelve) 12
SDPTimeEditWindow public init {w msg} {
    $self set win_ $w
    $self set msg_ $msg
    if [$self yesno simpleInterface] {
	$self build-simple
    } else {
	$self build-advanced
    }
}
SDPTimeEditWindow private build-simple {} {
    $self instvar win_
    catch {
	foreach w [winfo children $win_] { destroy $w }
    }
    pack [label $win_.l -text "NEED TO IMPLEMENT SIMPLE INTERFACE"]
}
SDPTimeEditWindow private build-advanced {} {
    $self instvar win_ msg_ src_
    catch {
	foreach w [winfo children $win_] { destroy $w }
    }
    $self instvar startentry_ durationbox_ repeatsbox_
    label $win_.startl -text "Start Time:" -anchor e
    grid $win_.startl -row 0 -column 0 -sticky ew
    if {$msg_ == ""} {
	set now [clock format [expr ([clock seconds]+1)/1800 * 1800] \
		     -format "%I:%M %p %b %d"]
    } else {
	if [$msg_ have_field r] {
            set l [$msg_ field_value r]
	}
	set now "FIXME"
    }
    set startentry_ [entry $win_.starte]
    $startentry_ insert 0 $now
    grid $startentry_ -row 0 -column 1 -sticky ew
    label $win_.durl -text "Duration:" -anchor e
    grid $win_.durl -row 1 -column 0 -sticky ew
    if {$msg_ == ""} {
	set duration "2 hours"
    } else {
	set duration "FIXME"
    }
    set durationbox_ [new Combobox $win_.durc $duration "$self valid-duration" "1 hour" "1 day" "1 week"]
    grid $win_.durc -row 1 -column 1 -sticky ew
    label $win_.repl -text "Repeat:" -anchor e
    grid $win_.repl -row 2 -column 0 -sticky ew
    menubutton $win_.repm -text "No" -anchor w -menu $win_.repm.m \
	-indicatoron yes -relief raised -bd 2
    grid $win_.repm -row 2 -column 1 -sticky ew
    menu $win_.repm.m
    foreach r {"No" "Daily" "Weekly" "Every Two Weeks"} {
	$win_.repm.m add command -label $r \
	    -command "$self set-repeat \"$r\""
    }
    label $win_.repsl -text "for:" -anchor e
    grid $win_.repsl -row 3 -column 0 -sticky ew
    set repeatsbox_ [new Combobox $win_.repsc "1 Week" "$self valid-duration" \
			 "1 Week" "2 Weeks" "1 Month" "2 Months"]
    $repeatsbox_ disable
    grid $win_.repsc -row 3 -column 1 -sticky ew
}
SDPTimeEditWindow private duration2secs {s} {
    $class instvar times_ numbers_
    set l [split $s]
    if {[llength $l] != 2} {
	return -1
    }
    set n [lindex $l 0]
    if {![regexp {[0-9]+} $n]} {
	set n [string tolower $n]
	if ![info exists numbers_($n)] {
	    return -1
	}
	set n $numbers_($n)
    }
    set u [string tolower [lindex $l 1]]
    set i [string last "s" $u]
    if {$i != -1} {
	set u [string range $u 0 [expr $i-1]]
    }
    if ![info exists times_($u)] {
	return -1
    }
    set n [expr $n * $times_($u)]
    return $n
}
SDPTimeEditWindow private valid-duration {t} {
    set s [$self duration2secs $t]
    if {$s < 0} {
	return 1
    }
    return 0
}
SDPTimeEditWindow private set-repeat {r} {
    $self instvar win_ repeatsbox_
    $win_.repm configure -text $r
    if {$r == "No"} {
	$repeatsbox_ disable
    } else {
	$repeatsbox_ enable
    }
}
SDPTimeEditWindow public buildmsg {} {
    $self instvar startentry_ durationbox_ win_ repeatsbox_
    set start [unix_to_ntp [clock scan [$startentry_ get]]]
    set duration [$self duration2secs [$durationbox_ get]]
    set end [format %u [expr $start + $duration]]
    set text "t=$start $end\n"
    return $text
}
Class SDPParser
Class SDPMedia
Class SDPTime
Class SDPMessage
SDPParser instproc init { {ordered_syntax 1} } {
	$self next
	$self instvar nextsym_ ordered_syntax_ parse_error_
	set nextsym_(start) "v"
	set nextsym_(v) "o"
	set nextsym_(o) "s"
	set nextsym_(s) "i u e p c b t"
	set nextsym_(i) "u e p c b t"
	set nextsym_(u) "e p c b t"
	set nextsym_(e) "e p c b t"
	set nextsym_(p) "e p c b t"
	set nextsym_(c) "b t "
	set nextsym_(b) "t"
	set nextsym_(t) "t r z k a m"
	set nextsym_(r) "t z k a m"
	set nextsym_(z) "k a m"
	set nextsym_(k) "a m"
	set nextsym_(a) "a m"
	set nextsym_(m) "m i:m c:m b:m k:m a:m v"
	set nextsym_(i:m) "m c:m b:m k:m a:m v"
	set nextsym_(c:m) "m b:m k:m a:m v"
	set nextsym_(b:m) "m k:m a:m v"
	set nextsym_(k:m) "m a:m v"
	set nextsym_(a:m) "m a:m v"
	set ordered_syntax_ $ordered_syntax
	set parse_error_ ""
}
SDPParser instproc check_syntax { last cur media } {
	$self instvar nextsym_
	if ![info exists nextsym_($last)] {
		return ""
	}
	foreach s $nextsym_($last) {
		set t [split $s :]
		if { [lindex $t 0] == $cur } {
			return $s
		}
	}
	return ""
}
SDPParser instproc parse { announcement } {
	$self instvar parse_error_ ordered_syntax_
	set media ""
	set allmsgs ""
	set lasttag "start"
	set lines [split $announcement "\n"]
	set parse_error_ ""
	set lnum 0
	foreach line $lines {
		incr lnum
		set line [string trimright $line]
		if { $line=={} } continue
		set sline [split $line =]
		set tag [lindex $sline 0]
		set value [join [lrange $sline 1 end]]
		set ret [$self check_syntax $lasttag $tag $media]
		if { $ret == "" && $ordered_syntax_==1 } {
			set parse_error_ "$class: syntax error between\
					$lasttag and $tag in line $lnum."
			foreach m $allmsgs {
				delete $m
			}
			return ""
		}
		set lasttag $ret
		switch $tag {
		v {
			set media ""
			set msg [new SDPMessage]
			lappend allmsgs $msg
			$msg set version_ $value
		}
		o {
			if {![info exists msg]} {
				set media ""
				set msg [new SDPMessage]
				lappend allmsgs $msg
				$msg set version_ 0
				set tmp [$msg set msgtext_]
				lappend tmp "v=0"
				$msg set msgtext_ $tmp
			}
			$msg set creator_ [lindex $value 0]
			$msg set createtime_ [lindex $value 1]
			$msg set modtime_  [lindex $value 2]
			$msg set nettype_ [lindex $value 3]
			$msg set addrtype_ [lindex $value 3]
			$msg set createaddr_ [lindex $value 5]
		}
		s {
			$msg set session_name_ $value
		}
		i {
			if { $media != "" } {
				$media set session_info_ $value
			} else {
				$msg set session_info_ $value
			}
		}
		p {
			set tmp ""
			catch { set tmp [$msg set phonelist_] }
			lappend tmp $value
			$msg set phonelist_ $tmp
		}
		e {
			set tmp ""
			catch { set tmp [$msg set emaillist_] }
			lappend tmp $value
			$msg set emaillist_ $tmp
		}
		u {
			$msg set uri_ $value
		}
		c {
			if { $media != "" } {
				$media set nettype_ [lindex $value 0]
				$media set addrtype_ [lindex $value 1]
				$media set caddr_ [lindex $value 2]
			} else {
				$msg set nettype_ [lindex $value 0]
				$msg set addrtype_ [lindex $value 1]
				$msg set caddr_ [lindex $value 2]
			}
		}
		b {
			set bwspec [split $value :]
			if { $media != "" } {
				$media set bwmod_ [lindex $bwspec 0]
				$media set bwval_ [lindex $bwspec 1]
			} else {
				$msg set bwmod_ [lindex $bwspec 0]
				$msg set bwval_ [lindex $bwspec 1]
			}
		}
		t {
			set tdes [new SDPTime]
			$tdes set fields_(t) $value
			$tdes set starttime_ [lindex $value 0]
			$tdes set endtime_ [lindex $value 1]
			set tmp [$msg set alltimedes_]
			lappend tmp $tdes
			$msg set alltimedes_ $tmp
		}
		r {
			$tdes set fields_(r) $value
			$tdes set repeat_interval_ [lindex $value 0]
			$tdes set active_duration_ [lindex $value 1]
			$tdes set offlist_ [lrange $value 2 end]
		}
		z {
			set nval [llength $value]
			if [expr 2 * ($nval / 2) != $nval] {
				foreach m $allmsgs {
					delete $m
				}
				return ""
			}
			$self instvar zoneinfo_
			for { set n 0 } { $n < $nval } { incr n } {
				set adjtime [lindex $value $n]
				incr n
				set offset [lindex $value $n]
				lappend zoneinfo_ "$adjtime $offset"
			}
		}
		k {
			set tmp [split $value :]
			if { $media != "" } {
				$media set crypt_method_ [lindex $tmp 0]
				$media set crypt_key_ [lindex $tmp 1]
			} else {
				$msg set crypt_method_ [lindex $tmp 0]
				$msg set crypt_key_ [lindex $tmp 1]
			}
		}
		a {
			set attribute [split $value ":"]
			set attname [lindex $attribute 0]
			set attval [join [lrange $attribute 1 end] ":"]
			if { $media != "" } {
				set target $media
			} else {
				set target $msg
			}
			if [catch {$target set attributes_($attname)}] {
				$target set attributes_($attname) {}
			}
			$target set attributes_($attname) \
			    [concat [$target set attributes_($attname)] \
				 [list $attval]]
		}
		m {
			set media [new SDPMedia $msg]
			set mt [lindex $value 0]
			$media set mediatype_ $mt
			$media set port_  [lindex $value 1]
			$media set proto_ [lindex $value 2]
			$media set fmt_ [lrange $value 3 end]
			set tmp ""
			catch { set tmp [$msg set media_array_($mt)] }
			lappend tmp $media
			$msg set media_array_($mt) $media
			set tmp [$msg set allmedia_]
			lappend tmp $media
			$msg set allmedia_ $tmp
		}
		default {
			set parse_error_ "$class: error unknown modifier $tag."
			foreach m $allmsgs {
				delete $m
			}
			return ""
		}
		}
		set tmp [$msg set msgtext_]
		lappend tmp $line
		$msg set msgtext_ $tmp
		if { $media != "" && [regexp {[icbka]} $tag] } {
			$media set fields_($tag) $value
		} else {
			$msg set fields_($tag) $value
		}
	}
	foreach msg $allmsgs {
		set tmp [$msg set msgtext_]
		set tmp [join $tmp \n]
		append tmp \n
		$msg set msgtext_ $tmp
	}
	return $allmsgs
}
SDPParser instproc parse_error { } {
	return [$self set parse_error_]
}
SDPMessage instproc init {} {
	$self next
	$self instvar allmedia_ alltimedes_ msgtext_
	set allmedia_ ""
	set alltimedes_ ""
	set msgtext_ ""
}
SDPMessage instproc destroy {} {
	$self instvar allmedia_ alltimedes_
	foreach m $allmedia_ {
		delete $m
	}
	foreach t $alltimedes_ {
		delete $t
	}
	$self next
}
SDPMessage instproc media { media_type } {
	$self instvar media_array_
	if [info exists media_array_($media_type)] {
		return $media_array_($media_type)
	} else {
		return ""
	}
}
SDPMessage instproc have_field { field } {
	$self instvar fields_
	return [info exists fields_($field)]
}
SDPMessage instproc field_value { field } {
	$self instvar fields_
	if [info exists fields_($field)] {
		return $fields_($field)
	} else {
		return ""
	}
}
SDPMessage instproc attributes {} {
	$self instvar attributes_
	if [info exists attributes_] {
		return [array names attributes_]
	} else {
		return ""
	}
}
SDPMessage instproc have_attr { name } {
	$self instvar attributes_
	return [info exists attributes_($name)]
}
SDPMessage instproc attr_value { name } {
    $self instvar attributes_
    if [info exists attributes_($name)] {
	    return $attributes_($name)
    } else {
	    return ""
    }
}
SDPMessage instproc obj2str {} {
	$self instvar attributes_ alltimedes_ allmedia_
	set o "v=[$self field_value v]"
	foreach f { o s i u } {
		if [$self have_field $f] {
			set n "$f=[$self field_value $f]"
			set o $o\n$n
		}
	}
	$self instvar phonelist_ emaillist_
	if [info exists phonelist_] {
		foreach e $phonelist_ {
			set n "p=$e"
			set o $o\n$n
		}
	}
	if [info exists emaillist_] {
		foreach e $emaillist_ {
			set n "e=$e"
			set o $o\n$n
		}
	}
	foreach f { c b } {
		if [$self have_field $f] {
			set n "$f=[$self field_value $f]"
			set o $o\n$n
		}
	}
	foreach t $alltimedes_ {
		set n [$t obj2str]
		set o $o\n$n
	}
	foreach f { z k } {
		if [$self have_field $f] {
			set n "$f=[$self field_value $f]"
			set o $o\n$n
		}
	}
	foreach a [$self attributes] {
		if { $attributes_($a) == "" } {
			set n "a=$a"
		} else {
			set n "a=$a:$attributes_($a)"
		}
		set o $o\n$n
	}
	foreach m $allmedia_ {
		set n [$m obj2str]
		set o $o\n$n
	}
	return $o
}
SDPMessage public unique_key {} {
    if ![$self have_field o] {
	$self warn "in SDPMessage::unique_key without o= field"
	return ""
    }
    set l [split [$self field_value o]]
    set l [lreplace $l 2 2]
    set key [join $l :]
    return $key
}
SDPMessage instproc htmlify_media { } {
    set html {}
    foreach media [$self set allmedia_] {
	append html [$media create_dynamic_html \
		[DynamicHTMLifier set html_(media)]]
    }
    return $html
}
SDPMessage instproc htmlify_times { {single_line 0} } {
    set html {}
    if $single_line { set t time1 } else { set t time }
    foreach time [$self set alltimedes_] {
	set repeat [string tolower [$time readable_repeat]]
	if { [$time set starttime_] != 0 } {
	    append html [$time create_dynamic_html \
			    [DynamicHTMLifier set html_(${t}_$repeat)]]
	} else {
	    append html "Unbounded session"
	}
    }
    return $html
}
SDPMessage instproc htmlify_url { } {
    $self instvar uri_
    if [info exists uri_] {
	return "<a href=\"$uri_\">$uri_</a>"
    } else {
	return ""
    }
}
SDPMessage instproc htmlify_list { varname } {
    set list {}
    foreach elt [$self get $varname] {
	if { $list!={} } {
	    append list ", $elt"
	} else {
	    append list $elt
	}
    }
    return $list
}
SDPMessage instproc get { varname } {
    $self instvar $varname
    if [info exists $varname] {
	return [set $varname]
    } else {
	return ""
    }
}
SDPMedia instproc htmlify_mediatype { } {
    return "[$self set mediatype_]"
}
SDPMedia instproc get { varname } {
    $self instvar $varname
    if [info exists $varname] {
	return [set $varname]
    } elseif { $varname == "spec_" } {
	    set caddr [split [$self get caddr_] /]
	    set port [$self get port_]
	    set spec [lindex $caddr 0]/$port
	    set ttl [lindex $caddr 1]
	    if { $ttl != {} } { append spec /$ttl }
	    return $spec
    } else {
	return ""
    }
}
SDPMedia instproc init {{msg ""}} {
	$self next
	if {$msg == ""} { return }
	$self instvar attributes_ fields_
	set alist [$msg attributes]
	foreach a $alist {
		set attributes_($a) [$msg set attributes_($a)]
	}
	set vlist [$msg info vars]
	foreach f { session_info_ nettype_ addrtype_ caddr_ bwmod_ bwval_
		crypt_method_ crypt_key_ } {
		if { [lsearch -exact $vlist $f] >= 0 } {
			$self set $f [$msg set $f]
		}
	}
	foreach f { i c b k a } {
		if [$msg have_field $f] {
			set fields_($f) [$msg field_value $f]
		}
	}
}
SDPMedia instproc have_field { field } {
	$self instvar fields_
	return [info exists fields_($field)]
}
SDPMedia instproc field_value { field } {
	$self instvar fields_
	if [info exists fields_($field)] {
		return $fields_($field)
	} else {
		return ""
	}
}
SDPMedia instproc have_attr { name } {
	$self instvar attributes_
	return [info exists attributes_($name)]
}
SDPMedia instproc attr_value { name } {
    $self instvar attributes_
    if [info exists attributes_($name)] {
	    return $attributes_($name)
    } else {
	    return ""
    }
}
SDPMedia instproc attributes {} {
	$self instvar attributes_
	if [info exists attributes_] {
		return [array names attributes_]
	} else {
		return ""
	}
}
SDPMedia instproc obj2str {} {
	$self instvar attributes_
	set o "m=[$self field_value m]"
	foreach f { i c b k } {
		if [$self have_field $f] {
			set n "$f=[$self field_value $f]"
			set o $o\n$n
		}
	}
	foreach a [array names attributes_] {
		if { $attributes_($a) == "" } {
			set n "a=$a"
		} else {
			set n "a=$a:$attributes_($a)"
		}
		set o $o\n$n
	}
	return $o
}
SDPTime instproc have_field { field } {
	$self instvar fields_
	return [info exists fields_($field)]
}
SDPTime instproc field_value { field } {
	$self instvar fields_
	if [info exists fields_($field)] {
		return $fields_($field)
	} else {
		return ""
	}
}
SDPTime instproc obj2str {} {
	set o "t=[$self field_value t]"
	if [$self have_field r] {
		set n "r=[$self field_value r]"
		set o $o\n$n
	}
	return $o
}
SDPTime public get { varname } {
    $self instvar $varname
    if [info exists $varname] {
	return [set $varname]
    } else {
	return ""
    }
}
SDPTime public sec_until_current { time_type } {
    set sdp_time [ntp_to_unix [$self get $time_type]]
    set current [clock seconds]
    return [expr $sdp_time - $current]
}
SDPTime public current_in_interval { start end } {
    set current [unix_to_ntp [clock seconds]]
    if { [expr $start == 0 && $end == 0] } {
	return 1
    } elseif { $start == 0 } {
	return [expr $end > $current]
    } elseif { $end == 0 } {
	return [expr $start <= $current]
    } else {
	return [expr $start <= $current && $end > $current]
    }
}
SDPTime public readable_time { time_type } {
    set sec [ntp_to_unix [$self get $time_type]]
    if { $sec == 0 } {
	return *unbounded*
    } else {
	return [clock format $sec -format {%H:%M}]
    }
}
SDPTime public readable_duration { } {
    set duration [$self get active_duration_]
    set hours [expr $duration / 3600]
    if { $hours < 24 } {
	return "$hours hour(s)"
    }
    set days [expr $hours / 24]
    if { $days < 7 } {
	return "$days day(s)"
    }
    set weeks [expr $days / 7]
    return "$weeks week(s)"
}
SDPTime public readable_date { time_type {numonly 0} } {
    set sec [ntp_to_unix [$self get $time_type]]
    if { $sec == 0 } {
	return *unbounded*
    } elseif $numonly {
	return [clock format $sec -format {%m/%d/%y}]
    } else {
	return [clock format $sec -format {%B %d, %Y}]
    }
}
SDPTime public readable_day { time_type } {
    set sec [ntp_to_unix [$self get $time_type]]
    if { $sec == 0 } {
	return *unbounded*
    } else {
	return [clock format $sec -format {%a}]
    }
}
SDPTime public readable_day_full { time_type } {
    set sec [ntp_to_unix [$self get $time_type]]
    if { $sec == 0 } {
	return *unbounded*
    } else {
	return [clock format $sec -format {%A}]
    }
}
SDPTime public readable_zone { time_type } {
    set sec [ntp_to_unix [$self get $time_type]]
    return [clock format $sec -format {%Z}]
}
SDPTime public readable_repeat { } {
    set interval [$self get repeat_interval_]
    if { $interval == 86400 } {
	return Daily
    } elseif { $interval == 604800 } {
	return Weekly
    } else {
	return None
    }
}
Class SDPEditWindow
SDPEditWindow public init {msg src args} {
    eval $self next $args
    $self instvar win_ msg_ src_
    set win_ .new$self
    set msg_ $msg
    set src_ $src
    $self buildwin $win_
}
SDPEditWindow public destroy {} {
    $self instvar mediawin_ timewin_ win_
    $self instvar title_ url_ email_ phone_
    foreach o "$mediawin_ $timewin_ $title_ $url_ $email_ $phone_" {
	delete $o
    }
    destroy $win_
}
SDPEditWindow private buildwin w {
    $self instvar msg_ src_ switchbutton_ mediawin_ timewin_ simple_
    toplevel $w
    wm title $w "nsdr: Edit Program"
    $self instvar notebook_
    set notebook_ [notebook $w.n -width 500 -height 200 \
		       -tabheight 27 -tabpadx 2 -bd 2 \
		       -font [$self get_option smallfont]]
    pack $notebook_ -side bottom -fill both -expand yes -padx 2 -pady 2
    set f $w.buttons
    frame $f
    set switchbutton_ [button $f.switch -command "$self toggle-advanced"]
    button $f.cancel -text "Cancel" -command "delete $self"
    pack $f.switch $f.cancel -side left
    if {$msg_ == ""} {
	button $f.create -text "Create" -command "$self create"
	pack $f.create -side left
    } else {
	button $f.change -text "Change" -command "$self change"
	pack $f.change -side left
    }
    pack $f -side bottom -before $notebook_
    $notebook_ addTab "Session Information"
    set f [frame $notebook_.info]
    $notebook_ addFrame $f 0 -expand yes -fill both -padx 2 -pady 2
    $self build-info $f
    $notebook_ addTab "Media Streams"
    set f [frame $notebook_.streams]
    $notebook_ addFrame $f 1 -expand yes -fill both -padx 2 -pady 2
    set mediawin_ [new SDPMediaEditWindow $f $msg_ $src_]
    $notebook_ addTab "Times"
    set f [frame $notebook_.times]
    $notebook_ addFrame $f 2 -expand yes -fill both -padx 2 -pady 2
    set timewin_ [new SDPTimeEditWindow $f $msg_]
    set simple_ [$self yesno simpleInterface]
    if {$simple_ == 0} {
	$switchbutton_ configure -text "Simple"
    } else {
	$switchbutton_ configure -text "Advanced"
    }
    $notebook_ tabPress 0
}
SDPEditWindow private toggle-advanced {} {
    $self instvar simple_ switchbutton_ mediawin_ timewin_
    if {$simple_ == 0} {
	set simple_ 1
	$switchbutton_ configure -text "Advanced"
	$mediawin_ build-simple
	$timewin_ build-simple
    } else {
	set simple_ 0
	$switchbutton_ configure -text "Simple"
	$mediawin_ build-advanced
	$timewin_ build-advanced
    }
}
SDPEditWindow private build-info w {
    $self instvar msg_
    $self instvar title_ desc_ url_ email_ phone_
    if {$msg_ == ""} {
	set title "New Session"
	set desc ""
	set url ""
	set name [$self get_option nsdrName]
	set addr [$self get_option rtpEmail]
	if {$addr == "" } {
	    set addr [email_heuristic]
	}
	set email "$name <$addr>"
	set phone "$name [$self get_option nsdrPhone]"
    } else {
	set title [$msg_ field_value s]
	set desc [$msg_ field_value i]
	set url [$msg_ field_value u]
	set email [$msg_ field_value e]
	set phone [$msg_ field_value p]
    }
    set f $w.title
    frame $f
    label $f.l -text "Session Title:"
    pack $f.l -side left
    set title_ [new TextEntry "$self notnull" $f.entry $title]
    pack $f.entry -side left -fill x -expand yes
    pack $f -side top -fill x
    set f $w.desc
    frame $f
    label $f.l -text "Session Description:"
    pack $f.l -side top
    set desc_ $f.t
    text $f.t -bg white -height 4 -font [$self get_option entryFont]
    $f.t insert 0.0 $desc
    pack $f.t -fill both
    pack $f -fill x
    set f $w.web
    frame $f
    label $f.l -text "Web Page:" -anchor e
    pack $f.l -side left
    set url_ [new TextEntry "1" $f.e $url]
    pack $f.e -side left -fill x -expand yes
    button $f.b -text "Test" \
	-command "[Application instance] gourl \[$url_ entry-value\]"
    pack $f.b
    pack $f -fill x
    set f $w.mail
    frame $f
    label $f.l -text "E-Mail:" -anchor e
    pack $f.l -side left
    set email_ [new TextEntry "1" $f.e $email]
    pack $f.e -side left -fill x -expand yes
    pack $f -fill x
    set f $w.phone
    frame $f
    label $f.l -text "Phone:" -anchor e
    pack $f.l -side left
    set phone_ [new TextEntry "1" $f.e $phone]
    pack $f.e -side left -fill x -expand yes
    pack $f -fill x
}
SDPEditWindow private notnull s {
    if {$s == ""} {
	return 1
    }
    return 0
}
SDPEditWindow private create {} {
    $self instvar title_ timewin_ mediawin_ src_
    set base "v=0\n"
    append base "o=[$self generate_o]\n"
    append base "s=[string trim [$title_ entry-value]]\n"
    set time [$timewin_ buildmsg]
    set media [$mediawin_ buildmsgs]
    if {[llength $media] == 0} {
	puts "returning coz media is '$media'"
	return
    }
    set text $base
    append text [$self build_details]
    append text $time
    append text "a=tool:Nsdr-[version]\n"
    append text [lindex $media 0]
    set msgs [list $text]
    foreach m [lrange $media 1 end] {
	set text $base
	append text $time
	append text "a=Nsdr-[version]\n"
	append text $m
	lappend msgs $text
    }
    set parser [new SDPParser]
    set objs {}
    foreach msg $msgs {
	lappend objs [$parser parse $msg]
    }
    destroy $parser
    set prog [eval new Program $objs]
    set announcer [[Application instance] set announcer_]
    $announcer announce $prog
}
SDPEditWindow private build_details {} {
    $self instvar desc_ url_ email_ phone_
    set text ""
    set desc [$desc_ get 0.0 end]
    regsub -all "\n|\r" $desc " " desc
    set desc [string trim $desc]
    if {$desc != ""} {
	append text "i=$desc\n"
    }
    set url [string trim [$url_ entry-value]]
    if {$url != ""} {
	append text "u=$url\n"
    }
    set email [string trim [$email_ entry-value]]
    if {$email != ""} {
	append text "e=$email\n"
    }
    set phone [string trim [$phone_ entry-value]]
    if {$phone != ""} {
	append text "p=$phone\n"
    }
    after 1 "delete $self"
    return $text
}
SDPEditWindow private generate_o {} {
    set user [user_heuristic]
    set sid [clock seconds]
    set version [clock seconds]
    set addr "IN IP4 [localaddr]"
    return "$user $sid $version $addr"
}
SDPEditWindow private change {} {
    puts "change"
}
Class ProgramWindow
ProgramWindow public init {p args} {
	eval $self next $args
	$self set prog_ $p
	global tcl_platform
	if {$tcl_platform(platform) == "unix" || $tcl_platform(platform) == "windows"} {
		$self set offset_ 2208988800
	} else {
		self fatal "sorry, net yet ported to $tcl_platform(platform)"
	}
}
ProgramWindow public destroy {} {
	$self instvar win_
	catch {destroy $win_}
	$self next
}
ProgramWindow public title {} {
    return [[$self set prog_] field_value s]
}
ProgramWindow public toggle-window {} {
    $self instvar win_
    if ![info exists win_] {
	set win_ .prog$self
	$self buildwin $win_
	return
    }
    if [winfo ismapped $win_] {
	wm withdraw $win_
    } else {
	wm deiconify $win_
    }
}
ProgramWindow private set_apps {} {
    $self set apps_ [UserApplication get_apps [$self set prog_]]
}
ProgramWindow private buildwin w {
    $self instvar prog_ advanced_
    set advanced_ 0
    toplevel $w
    wm title $w "nsdr: Program Info"
    set mfont [$self get_option medfont]
    label $w.title -text [$self title] -font $mfont
    pack $w.title -side top -fill x -expand no
    frame $w.description
    set t $w.description.t
    set s $w.description.s
    text $t -state normal -relief ridge -bd 2 -height 5 \
	-font $mfont -wrap word -yscroll "$s set"
    if [$prog_ have_field i] {
	$t insert 0.0 [$prog_ field_value i]
    } else {
	$t insert 0.0 "No description provided."
    }
    $t configure -state disabled
    pack $t -fill both -expand yes
    scrollbar $w.description.s -command "$t yview"
    bind $w.description <Configure> "$self fix-scrollbar"
    pack $w.description -side top -fill both -expand yes
    if ![$self yesno simpleInterface] {
	$self build-advanced
	return
    }
    frame $w.bottom
    frame $w.bottom.f
    $self build-apps $w.bottom.f.apps 1
    pack $w.bottom.f.apps -side left -fill both -expand yes -padx 2 -pady 2
    $self build-times $w.bottom.f.times
    pack $w.bottom.f.times -side left -fill both -padx 2 -pady 2
    pack $w.bottom.f -side top -fill both -expand yes
    set f $w.bottom.buttons
    frame $f
    button $f.advanced -text "Advanced" -command "$self build-advanced"
    button $f.dismiss -text "Dismiss" -command "wm withdraw $w"
    pack $f.advanced $f.dismiss -side left
    if [$prog_ have_field u] {
	button $f.web -text "View Web Page" \
	    -command "[Application instance] gourl [$prog_ field_value u]"
	pack $f.web -side left -before $f.dismiss
    }
    pack $f -side top
    pack $w.bottom -fill both -expand yes
    wm protocol $w WM_DELETE_WINDOW "wm withdraw $w"
}
ProgramWindow private build-advanced {} {
    $self instvar win_ prog_ offset_ advanced_
    set advanced_ 1
    catch {destroy $win_.bottom}
    frame $win_.info -relief flat
    if [$prog_ have_field u] {
	set url [$prog_ field_value u]
	button $win_.info.webb \
	    -text "Web Page:" -command "[Application instance] gourl $url"
	grid $win_.info.webb -row 0 -column 0 -sticky ew
	label $win_.info.webl -text $url -relief sunken \
	    -bg white -bd 2 -anchor w
	grid $win_.info.webl -row 0 -column 1 -sticky ew -padx 5
    }
    if [$prog_ have_field e] {
	set email [$prog_ field_value e]
	label $win_.info.maill -text "E-Mail Contact:"
	grid $win_.info.maill -row 1 -column 0 -sticky ew
	label $win_.info.mailv -bg white -relief sunken -bd 2 \
	    -text $email -anchor w
	grid $win_.info.mailv -row 1 -column 1 -sticky ew -padx 5
    }
    if [$prog_ have_field p] {
	set phone [$prog_ field_value p]
	label $win_.info.phonel -text "Telephone Contact:"
	grid $win_.info.phonel -row 2 -column 0 -sticky ew
	label $win_.info.phonev -bg white -relief sunken -bd 2 \
	    -text $phone -anchor w
	grid $win_.info.phonev -row 2 -column 1 -sticky ew -padx 5
    }
    pack $win_.info -fill both -expand yes
    grid columnconfigure $win_.info 0 -minsize 100 -weight 0
    grid columnconfigure $win_.info 1 -weight 1
    frame $win_.bottom
    $self build-apps $win_.bottom.apps 0
    pack $win_.bottom.apps -side left -fill both -expand yes \
	-padx 2 -pady 2
    $self build-times $win_.bottom.times
    pack $win_.bottom.times -side left -fill both -padx 2 -pady 2
    frame $win_.bottom.media -relief flat
    label $win_.bottom.media.l -relief flat -text "Media Streams"
    pack $win_.bottom.media.l -side top -fill x -expand no
    set f $win_.bottom.media.f
    frame $f -relief sunken -bd 2
    set i 0
    foreach media [[$prog_ base] set allmedia_] {
	label $f.type$i -relief flat -anchor e -text "[$media set mediatype_]:"
	grid $f.type$i -row $i -column 0 -sticky ew
	if [catch {set addr [$media set caddr_]}] {set addr "???" }
	set n [string first / $addr]
	if {$n != -1} { set addr [string range $addr 0 [expr $n-1]] }
	if [catch {set port [$media set port_]}] {set port "???" }
	label $f.info$i -relief sunken -bd 1 -bg white \
	    -anchor w -text "$addr/$port"
	grid $f.info$i -row $i -column 1 -sticky ew -padx 5
	incr i
    }
    pack $f -fill both -expand yes
    pack $win_.bottom.media -side left -fill both -padx 2 -pady 2
    pack $win_.bottom -fill both -expand yes
    frame $win_.buttons
    button $win_.buttons.source -text "SDP Source" \
	-command "$self toggle-srcwin"
    button $win_.buttons.quit -text "Dismiss" \
	-command "wm withdraw $win_"
    pack $win_.buttons.source $win_.buttons.quit -side left
    set o [split [$prog_ field_value o]]
    if {[lindex $o 0] == [user_heuristic] && [lindex $o 5] == [localaddr]} {
	set src [[[Application instance] set ui_] current-source]
	button $win_.buttons.edit -text "Edit" \
	    -command "new SDPEditWindow $prog_ $src" -state disabled
	button $win_.buttons.delete -text "Delete Program" \
	    -command "$self stop-announcing"
	pack $win_.buttons.edit $win_.buttons.delete \
	    -side left -before $win_.buttons.quit
    }
    pack $win_.buttons
    wm protocol $win_ WM_DELETE_WINDOW "wm withdraw $win_"
}
ProgramWindow private build-times w {
    $self instvar prog_ offset_
    if ![winfo exists $w] {
	frame $w
    }
    label $w.l -relief flat -text "Times"
    pack $w.l -side top -fill x -expand no
    set f $w.f
    frame $f -relief sunken -bd 2
    set times [split [$prog_ field_value t]]
    if {[lindex $times 1] == 0} {
	set permanent 1
	set text "Session is always present."
    } else {
	set permanent 0
	set text "Session will be active"
	if [$prog_ have_field r] {
	    set l [split [$prog_ field_value r]]
	    set secs [lindex $l 0]
	    if {[string first d $secs] > 0} {
		set i [string first d $secs]
		set days [string range $secs 0 [expr $i-1]]
		if {$days == 1} {
		    append text " every day"
		} else {
		    append text " every $days days"
		}
	    } elseif {[string first h $secs] > 0} {
		set i [string first h $secs]
		set hrs [string range $secs 0 [expr $i-1]]
		if {$hrs == 1} {
		    append text " every hour"
		} else {
		    append text " every $hrs hours"
		}
	    } elseif {[string first m $secs] > 0} {
		set i [string first m $secs]
		set mins [string range $secs 0 [expr $i-1]]
		append text " every $mins minutes"
	    } elseif {$secs % 604800 == 0} {
		set weeks [expr $secs / 604800]
		if {$weeks == 1} {
		    append text " every week"
		} else {
		    append text " every $weeks weeks"
		}
	    } elseif {$secs % 86400 == 0} {
		set days [expr $secs / 86400]
		if {$days == 1} {
		    append text " every day"
		} else {
		    append text "every $days days"
		}
	    } elseif {$secs % 3600 == 0} {
		set hrs [expr $secs / 3600]
		if {$hrs == 1} {
		    append text " every hour"
		} else {
		    append text "every $hrs hours"
		}
	    } elseif {$secs % 60 == 0} {
		set mins [expr $secs / 60]
		append text " every $mins minutes"
	    }
	}
	set start [clock format [expr [lindex $times 0] - $offset_] \
		       -format "%H:%M %b %d"]
	set end [clock format [expr [lindex $times 1] - $offset_] \
		     -format "%H:%M %b %d"]
	set text "$text from $start to $end"
    }
    message $f.m -relief flat -width 150 -text $text
    pack $f.m -side top
    pack $f -fill both -expand yes
}
ProgramWindow private build-apps {w simple} {
    if ![winfo exists $w] {
	frame $w -relief flat
    }
    label $w.l -relief flat -text "Applications"
    pack $w.l -side top -fill x -expand no
    set f $w.f
    frame $f -relief sunken -bd 2
    set i 0
    $self set_apps
    set all_apps {}
    foreach a [$self set apps_] {
	set name [lindex $a 0]
	set cmd [lindex $a 1]
	button $f.r$i -text "Run:" -command "$self run $f.e$i"
	grid $f.r$i -row $i -column 0 -sticky ew
	entry $f.e$i -bg white -width 20
	grid $f.e$i -row $i -column 1 -sticky ew
	if {$simple} {
	    $f.e$i insert 0 $name
	    $f.e$i configure -state disabled
	    lappend all_apps $cmd
	    $f.r$i configure -command "$self run \{$cmd\}"
	} else {
	    $f.e$i insert 0 $cmd
	    lappend all_apps $f.e$i
	    $f.r$i configure -command "$self run $f.e$i"
	}
	incr i
    }
    grid columnconfigure $f 1 -weight 1
    button $f.runall -text "Run All Applications" \
	-command [concat $self run $all_apps]
    grid $f.runall -row $i -column 0 -columnspan 2
    pack $f -fill both -expand yes
}
ProgramWindow private fix-scrollbar {} {
    $self instvar win_
    set t "$win_.description.t"
    set s "$win_.description.s"
    set l [$t yview]
    if {[lindex $l 0] != 0 || [lindex $l 1] != 1} {
	pack $s -side right -before $t -fill y
    } else {
	pack forget $s
    }
}
ProgramWindow public updateprog {p} {
    $self instvar win_ prog_ advanced_
    if ![info exists win_] {
	return
    }
    $win_.title configure -text [$self title]
    set t $win_.description.t
    $t configure -state normal
    $t delete 0.0 end
    if [$prog_ have_field i] {
	$t insert 0.0 [$prog_ field_value i]
    } else {
	$t insert 0.0 "No description provided."
    }
    $t configure -state disabled
    if $advanced_ {
	if [$prog_ have_field u] {
	    set url [$prog_ field_value u]
	    if ![winfo exists $win_.info.webb] {
		button $win_.info.webb -text "Web page:"
		grid $win_.info.webb -row 0 -column 0 -sticky ew
		label $win_.info.webl -relief sunken -bg white -bd 2 -anchor w
		grid $win_.info.webl -row 0 -column 1 -sticky ew -padx 5
	    }
	    $win_.info.webb configure \
		-command "[Application instance] gourl $url"
	    $win_.info.webl configure -text $url
	}
	if [$prog_ have_field e] {
	    if ![winfo exists $win_.info.maill] {
		label $win_.info.maill -text "E-Mail Contact:"
		grid $win_.info.maill -row 1 -column 0 -sticky ew
		label  $win_.info.mailv -bg white -relief sunken -bd 2 \
		    -anchor
		grid $win_.info.mailv -row 1 -column 1 -sticky ew -padx 5
	    }
	    $win_.info.mailv configure -text [$prog_ field_value e]
	}
	if [$prog_ have_field p] {
	    if ![winfo exists $win_.info.phonel] {
		label $win_.info.phonel -text "Telephone Contact:"
		grid $win_.info.phonel -row 2 -column 0 -sticky ew
		label  $win_.info.phonev -bg white -relief sunken -bd 2 \
		    -anchor
		grid $win_.info.phonev -row 2 -column 1 -sticky ew -padx 5
	    }
	    $win_.info.phonev configure -text [$prog_ field_value p]
	}
	set media [[$prog_ base] set allmedia_]
	set f $win_.bottom.media.f
	set i 0
	foreach m $media {
	    if ![winfo exists $f.type$i] {
		label $f.type$i -relief flat -anchor e
		label $f.info$i -relief sunken -bd 1 -bg white -anchor w
		grid $f.type$i -row $i -column 0 -sticky ew
		grid $f.info$i -row $i -column 1 -sticky ew -padx 5
	    }
	    if [catch {set addr [$m set caddr_]}] { set addr "???" }
	    set n [string first / $addr]
	    if {$n != -1} { set addr [string range $addr 0 [expr $n-1]] }
	    if [catch {set port [$m set port_]}] { set port "???" }
	    $f.type$i config -text "[$m set mediatype_]:"
	    $f.info$i config -text "$addr/$port"
	    incr i
	}
	set old [llength [winfo children $f]]
	set new [llength $media]
	for {set i $old} {$i < $new} {incr i} {
	    destroy $f.type$i $f.info$i
	}
    }
    if $advanced_ {
	set appwin $win_.bottom.apps
	set timewin $win_.bottom.times
    } else {
	set appwin $win_.bottom.f.apps
	set timewin $win_.bottom.f.times
    }
    foreach child [winfo children $appwin] { destroy $child }
    $self build-apps $appwin $advanced_
    foreach child [winfo children $timewin] { destroy $child }
    $self build-times $timewin
}
ProgramWindow private toggle-srcwin {} {
    $self instvar sw_ win_
    if ![info exists sw_] {
	set sw_ "$win_.src"
	$self build-srcwin $sw_
	return
    }
    if [winfo ismapped $sw_] {
	wm withdraw $sw_
    } else {
	wm deiconify $sw_
    }
}
ProgramWindow private build-srcwin w {
    toplevel $w
    wm title $w "nsdr: SDP Source"
    $self instvar prog_
    set msg [$prog_ base]
    set t $w.t
    set sx $w.sx
    set sy $w.sy
    text $t -font [$self get_option smallfont] -wrap none \
	-xscroll "$sx set" -yscroll "$sy set"
    $t insert 0.0 [$msg set msgtext_]
    grid $t -row 0 -column 0 -sticky nsew
    scrollbar $sx -orient horizontal -command "$t xview" -width 10
    grid $sx -row 1 -column 0 -sticky ew
    scrollbar $sy -orient vertical -command "$t yview" -width 10
    grid $sy -row 0 -column 1 -sticky ns
    button $w.b -text "Dismiss" -command "wm withdraw $w"
    grid $w.b -row 2 -column 0 -columnspan 2
    wm protocol $w WM_DELETE_WINDOW "wm withdraw $w"
}
ProgramWindow private nexttime {t now} {
    $self instvar offset_
    set first [$t set starttime_]
    if {$first == 0} { return "" }
    if {$now < $first} {
	return [format %u [expr $first - $offset_]]
    }
    if ![$t have_field "r"] { return "" }
    set end [$t set endtime_]
    set offs [$t set offlist_]
    set int [$t set repeat_interval_]
    while {$first < $end} {
	foreach o $offs {
	    set time [format %u [expr $first + $o]]
	    if {$now < $time} {
		return [format %u [expr $time - $offset_]]
	    }
	}
	set first [format %u [expr $first + $int]]
    }
    return ""
}
ProgramWindow private getwait {} {
    $self instvar prog_ offset_
    set now [clock seconds]
    set ntpnow [format %u [expr $now + $offset_]]
    foreach time [[$prog_ base] set alltimedes_] {
	set t [$self nexttime $time $ntpnow]
	if {$t == ""} { continue }
	if ![info exists mintime] {
	    set mintime $t
	} elseif {$t < $mintime} {
	    set mintime t
	}
    }
    if ![info exists mintime] { return "" }
    set lead [$self get_option alarmLead]
    set wait [expr 1000*($mintime - $now - $lead)]
    return $wait
}
ProgramWindow public run {args} {
    foreach cmd $args {
        if [winfo exists $cmd] {
            set cmd [$cmd get]
        }
        set escapedCmd $cmd
        regsub -all {\\} $escapedCmd {\\\\} escapedCmd
        regsub -all {"} $escapedCmd {\"} escapedCmd
        set i [expr [string first {\"} $escapedCmd] - 1]
        set j [expr $i + 2]
        set escapedCmd \
            [string range $escapedCmd 0 $i][string range $escapedCmd $j end]
        set i [expr [string last {\"} $escapedCmd] - 1]
        set j [expr $i + 2]
        set escapedCmd \
            [string range $escapedCmd 0 $i][string range $escapedCmd $j end]
        regsub -all {\[} $escapedCmd {\[} escapedCmd
        regsub -all {\]} $escapedCmd {\]} escapedCmd
        regsub -all {\$} $escapedCmd {\$} escapedCmd
        if [catch {eval exec $escapedCmd <<null &} m] {
            $self warn "couldn't run \"$cmd\": $m"
        }
    }
}
ProgramWindow private stop-announcing {} {
    set src [[[Application instance] set ui_] current-source]
    $src stop-announce [$self set prog_]
}
Class NsdrUI
NsdrUI public init {w app} {
    $self set app_ $app
    $self set w_ $w
    $self instvar notebook_
    set notebook_ [notebook $w.n -tabheight 27 -tabpadx 2 -bd 2 ]
    $self set sources_ {}
    set helpWindow [new NsdrHelpWindow .help]
    set b "$w.bar"
    frame $b -relief ridge -bd 2
    label $b.title -text "nsdr v[version]" -relief flat -justify left
    button $b.new -relief raised -highlightthickness 1 \
	-text "New" -command "$self new-program"
    button $b.help -relief raised -highlightthickness 1 \
	-text "Help" -command "$helpWindow toggle"
    button $b.quit -relief raised -highlightthickness 1 \
	-text "Quit" -command "$app exit"
    pack $b.title -side left -fill both -expand yes
    pack $b.new $b.help $b.quit -side left -padx 1 -pady 1
    pack $b -side bottom -fill x -expand no
    pack $notebook_ -fill both -expand yes -padx 2 -pady 2
}
NsdrUI public addsource s {
    $self instvar sources_
    set n [llength $sources_]
    lappend sources_ $s
    $self set orders_($n) {}
    $self instvar notebook_
    $notebook_ addTab [$s name]
    set f [frame $notebook_.f$n]
    $notebook_ addFrame $f $n -expand yes -fill both -pady 2
    $self set lists_($n) [new NewList $f]
    if {$n == 0} {
	$notebook_ tabPress 0
    }
}
NsdrUI private lookup {src} {
    $self instvar sources_ progs_
    set n [lsearch -exact $sources_ $src]
    if {$n == -1} {
	$self fatal "NsdrUI inconsistency in sources_"
    }
    return $n
}
NsdrUI public addprog {src prog} {
    $self instvar sources_ progs_ orders_ lists_
    set n [$self lookup $src]
    set o [$prog unique_key]
    set p [new ProgramWindow $prog]
    set progs_($n:$o) $p
    set title [string tolower [$p title]]
    set order $orders_($n)
    set i 0
    set pr [lindex $order 0]
    while {$pr != ""} {
	set title2 [string tolower [$pr title]]
	if {[string compare $title $title2] <= 0} break
	incr i
	set pr [lindex $order $i]
    }
    if {$pr == ""} {set i "end" }
    set orders_($n) [linsert $order $i $p]
    $self instvar lists_
    $lists_($n) insert $i [$p title] "$p toggle-window"
}
NsdrUI public removeprog {src prog} {
    $self instvar sources_ progs_ orders_ lists_
    set n [$self lookup $src]
    set o [$prog unique_key]
    if ![info exists progs_($n:$o)] {
	$self fatal "NsdrUI::removeprog: inconsistency in progs_!"
    }
    set p $progs_($n:$o)
    set i [lsearch -exact $orders_($n) $p]
    if {$i < 0} {
	$self fatal "NsdrUI::removeprog: insconsistency in orders_!"
    }
    set orders_($n) [lreplace $orders_($n) $i $i]
    $lists_($n) delete $i
    delete $p
}
NsdrUI public updateprog {src prog} {
    $self instvar sources_ progs_
    set n [$self lookup $src]
    set o [$prog unique_key]
    if ![info exists progs_($n:$o)] {
	$self fatal "NsdrUI inconsistency in progs_"
    }
    $progs_($n:$o) updateprog $prog
}
NsdrUI public current-source {} {
    $self instvar notebook_ sources_
    set i [$notebook_ index]
    return [lindex $sources_ $i]
}
NsdrUI private new-program {} {
    new SDPEditWindow "" [$self current-source]
}
Class NsdrHelpWindow -superclass HelpWindow
NsdrHelpWindow instproc build w {
	$self create-window $w "nsdr: Help" {
"Click on a program name to display detailed information \
and launch media tools."
"Use ``New'' button to create new session announcements."
"If the user interface looks peculiar, you might \
have X resources that conflict with tk.  A common problem is \
defining ``*background'' and/or ``*foreground''."
"Bugs and suggestions to openmash-users@openmash.org.  Thanks."
	}
    }
Class UserApplication
UserApplication proc init_apps {} {
    set files [concat [$self get_option appFiles] \
	       [$self get_option extraAppFiles]]
    foreach f $files {
	catch {source $f}
    }
    $self set instances_ {}
    foreach a [$self info subclass] {
	new $a
    }
}
UserApplication public init {} {
    $class instvar instances_
    lappend instances_ $self
    UserApplication set mega_rport_ 10004
}
UserApplication proc get_apps {prog} {
    set apps {}
    foreach app [$self set instances_] {
	if [catch {set cmds [$app match $prog]} m] {
	    puts stderr "warning: app match failed for [$app info class]: $m"
	    continue
	}
	set apps [concat $apps $cmds]
    }
    return $apps
}
UserApplication private name {} {
    $self warn "in UserApplication::name"
    return "unknown app"
}
UserApplication private match {prog} {
    $self warn "in UserApplication::match"
    return ""
}
UserApplication set media_ {}
UserApplication proc register_media {m} {
    $self instvar media_
    if {[lsearch -exact $media_ $m] == -1} {
	lappend media_ $m
    }
}
UserApplication proc media {} {
    $self instvar media_
    return $media_
}
UserApplication proc register_formats {media args} {
    $self instvar formats_
    if ![info exists formats_($media)] {
	set formats_($media) {}
    }
    foreach fmt $args {
	if {[lsearch -exact $formats_($media) $fmt ] == -1} {
	    lappend formats_($media) $fmt
	}
    }
}
UserApplication proc formats {media} {
    $self instvar formats_
    if ![info exists formats_($media)] { return "" }
    return $formats_($media)
}
UserApplication proc register_protos {media args} {
	$self instvar protos_
	if ![info exists protos_($media)] {
		set protos_($media) {}
	}
	foreach proto $args {
		if {[lsearch -exact $protos_($media) $proto] == -1} {
			lappend protos_($media) $proto
		}
	}
}
UserApplication proc protos {media} {
	$self instvar protos_
	if ![info exists protos_($media)] { return "" }
	return $protos_($media)
}
UserApplication proc register_attrs {media args} {
    $self instvar attrs_
    if ![info exists attrs_($media)] {
	set attrs_($media) {}
    }
    foreach attr $args {
	if {[lsearch -exact $attrs_($media) $attr ] == -1} {
	    lappend attrs_($media) $attr
	}
    }
}
UserApplication proc attrs {media} {
    $self instvar attrs_
    if ![info exists attrs_($media)] { return "" }
    return $attrs_($media)
}
UserApplication private mega_options { prog sspec ofmt } {
    set sname [join [$prog field_value o] :]
    set maxsbw [$self get_option megaMaxBW]
    set sbw [$self get_option megaStartupBW]
    set p [UserApplication set mega_rport_]
    set addr [intoa [lookup_host_addr [$self get_option megaAddrs]]]
    set ctrlrport [expr $p + 2]
    set megactrl $addr/60000:$ctrlrport/1
    set rport $p:$ctrlrport
    UserApplication set mega_rport_ [expr $p+4]
    set o "-usemega $sname -maxsbw $maxsbw -sbw $sbw -ofmt $ofmt \
	    -megactrl $megactrl -rport $rport -sspec $sspec"
    return $o
}
UserApplication private map_args { media } {
	set mapargs ""
	foreach a [$media attr_value "rtpmap"] {
		set L [split $a]
		if {[llength $L] != 2} {
			$self warn "bogus rtpmap attribute \"$a\""
			continue
		}
		set pt [lindex $L 0]
		set type [lindex $L 1]
		append mapargs "-map $pt:$type "
	}
	return $mapargs
}
UserApplication register_media audio
UserApplication register_formats audio PCM DVI GSM LPC
UserApplication register_protos audio RTP/AVP
Class UserApplication/Vat -superclass UserApplication
UserApplication/Vat instproc name {} {
    return "vat"
}
UserApplication/Vat instproc match {prog} {
    set app [Application instance]
    set v [[$prog base] media "video"]
    if {[llength $v] > 0 && [$app yesno unifiedVic]} { return "" }
    set title [$prog field_value s]
    set cmds {}
    set media [[$prog base] media "audio"]
    set i 0
    foreach m $media {
	set mapargs [$self map_args $m]
	set port [$m set port_]
	set caddr [$m set caddr_]
	set l [split $caddr "/"]
	if {[llength $l] == 1} {
	    set addr $caddr
	    set ttl 1
	} else {
	    set addr [lindex $l 0]
	    set ttl [lindex $l 1]
	}
	if { [$self get_option megaAddrs] == "" } {
	    set cmd "vat -C \"$title\" $mapargs -t $ttl $addr/$port"
	} else {
	    set spec $addr/$port/$ttl
	    set ofmt gsm
	    set mega_args [$self mega_options $prog $spec $ofmt]
	    set cmd "vat -C \"$title\" $mapargs $mega_args"
	}
	set description "vat audio tool"
	if {[llength $media] > 1} {
	    if [$media have_field i] {
		append description " for stream [$media field_value i]"
	    } else {
		append description " for stream $i"
	    }
	    incr i
	}
	lappend cmds [list $description $cmd]
    }
    return $cmds
}
UserApplication register_media video
UserApplication register_formats video JPEG H261 PVH
UserApplication register_protos video RTP/AVP
UserApplication register_attrs video {scuba {}}
Class UserApplication/Vic -superclass UserApplication
UserApplication/Vic private mega_options { msg sspec ofmt mrec mtype} {
    if { $mtype != "video" } {
	    return ""
    }
    set o "[$self next $msg $sspec $ofmt]"
    if ![$mrec have_attr scuba] {
	    set o "$o -scuba"
    }
    return $o
}
UserApplication/Vic instproc name {} {
    return "vic"
}
UserApplication/Vic instproc match {prog} {
    set title [$prog field_value s]
    set app [Application instance]
    set aspec ""
    if [$app yesno unifiedVic] {
	set a [[$prog base] media "audio"]
	if {[llength $a] > 1} {
	    puts stderr "warning: multiple audio sessions are present."
	}
	if {[llength $a] > 0} {
	    set am [lindex $a 0]
	    set aport [$am set port_]
	    set aaddr [lindex [split [$am set caddr_] "/"] 0]
	    set aspec "-a $aaddr/$aport"
	}
    }
    set cmds {}
    set rspec ""
    set rend [[$prog base] media "data"]
    if {[llength $rend] > 0} {
	set rm [lindex $rend 0]
	set rport [$rm set port_]
	set raddr [lindex [split [$rm set caddr_] "/"] 0]
	set rspec "-rendez $raddr/$rport"
    }
    set media [[$prog base] media "video"]
    set i 0
    foreach m $media {
	set cmd "vic -C \"$title\" [$self map_args $m]"
	set f [lindex [$m set fmt_] 0]
	if [catch {RTP/Video set default_ptoa_($f)} fmt] {
	    set fmt "fmt-$f"
	}
	set port [$m set port_]
	set caddr [$m set caddr_]
	set l [split $caddr "/"]
	set len [llength $l]
	set addr [lindex $l 0]
	set ttl 1
	set count 1
	if {$len > 1} {
	    set ttl [lindex $l 1]
	}
	if {$len > 2} {
	    set count [lindex $l 2]
	}
	set spec "$addr/$port/$fmt/$ttl/$count"
	foreach msg [$prog set msgs_] {
	    if {$msg == [$prog base] } { continue }
	    set m [$msg media "video"]
	    if {[llength $m] != 1} {
		$self warn "layered stream with multiple video streams"
		set m [lindex $m 0]
	    }
	    set port [$m set port_]
	    set caddr [[lindex $m 0] set caddr_]
	    set l [split $caddr "/"]
	    set len [llength $l]
	    set addr [lindex $l 0]
	    set count 1
	    set ttl 1
	    if {$len > 1} {
		set ttl [lindex $l 1]
	    }
	    if {$len > 2} {
		set count [lindex $l 2]
	    }
	    append spec ",$addr/$port/$fmt/$ttl/$count"
	}
	if {[$m have_attr scuba] && [$m attr_value scuba]} {
	    append cmd " -scuba "
	}
	if { [$self get_option megaAddrs] == "" } {
	    if {[$m have_attr scuba] && [$m attr_value scuba]} {
		  set b [expr 1000*[$m attr_value scuba]]
		  append cmd " -maxsbw $b "
	    }
	    append cmd " $aspec $rspec $spec"
	} else {
	    set spec $addr/$port/$ttl
	    set ofmt h261
	    append cmd " [$self mega_options $prog $spec $ofmt $m video]"
	}
	set description "vic video tool"
	if {[llength $media] > 1} {
	    if [$media have_field i] {
		append description " for stream [$media field_value i]"
	    } else {
		append description " for stream $i"
	    }
	    incr i
	}
	lappend cmds [list $description $cmd]
    }
    return $cmds
}
UserApplication register_media whiteboard
UserApplication register_protos whiteboard udp
UserApplication register_formats whiteboard mb wb
Class UserApplication/MB -superclass UserApplication
UserApplication/MB instproc name {} {
    return "mb"
}
UserApplication/MB instproc match {prog} {
    set title [$prog field_value s]
    set cmds {}
    set media [[$prog base] media "whiteboard"]
    set i 0
    foreach m $media {
	set port [$m set port_]
	set caddr [$m set caddr_]
	set fmt [lindex [$m set fmt_] 0]
	set l [split $caddr "/"]
	if {[llength $l] == 1} {
	    set addr $caddr
	    set ttl 1
	} else {
	    set addr [lindex $l 0]
	    set ttl [lindex $l 1]
	}
	if {$fmt == "wb"} {
	    set cmd "wb -C \"$title\" -t $ttl $addr/$port"
	} elseif { [$self get_option megaAddrs] == "" } {
	    set cmd "mb -C \"$title\" -sa $addr/$port/$ttl"
	} else {
	    set spec $addr/$port/$ttl
	    set cmd "mb -C \"$title\" [$self mega_options $prog $spec null]"
	}
	set description "mb mediaboard tool"
	if {[llength $media] > 1} {
	    if [$media have_field i] {
		append description " for stream [$media field_value i]"
	    } else {
		append description " for stream $i"
	    }
	    incr i
	}
	lappend cmds [list $description $cmd]
    }
    return $cmds
}
Class UserApplication/Collaborator -superclass UserApplication
UserApplication/Collaborator instproc name {} { return "collaborator" }
UserApplication/Collaborator instproc match {prog} {
	set options [$self generate_options $prog]
	if { $options == "" } {
		return ""
	} else {
		set description "collaborator integrated mash tool"
		append cmd "collaborator $options"
		if { [$self get_option megaAddrs] != "" } {
			set spec $addr/$port/$ttl
			set mega_args [$self mega_options $prog]
			append cmd " $mega_args"
		}
		return [list [list $description $cmd]]
	}
}
UserApplication/Collaborator public generate_options {prog} {
	set title [$prog field_value s]
	set sdp_message [$prog base]
	set video [lindex [$sdp_message media "video"] 0]
	set audio [lindex [$sdp_message media "audio"] 0]
	set whiteboard [lindex [$sdp_message media "whiteboard"] 0]
	if { $whiteboard!={} } {
		if { [lindex [$whiteboard set fmt_] 0]!="mb" } {
			set whiteboard {}
		}
	}
	set video_options [$self video2options $video]
	set audio_options [$self audio2options $audio]
	set mb_options [$self mb2options $whiteboard]
	append media_options "$video_options $audio_options $mb_options"
	if { $video_options=={} && $audio_options=={} && $mb_options=={} } {
		return ""
	} else {
		return "-C \"$title\" $media_options"
	}
}
UserApplication/Collaborator instproc mega_options prog {
	return ""
}
UserApplication/Collaborator private video2options { video } {
	if { $video == {} } {
		return {}
	}
	set f [lindex [$video set fmt_] 0]
	if [catch {RTP/Video set default_ptoa_($f)} fmt] {
		set fmt "fmt-$f"
	}
	set port [$video set port_]
	set caddr [$video set caddr_]
	set l [split $caddr "/"]
	set len [llength $l]
	set addr [lindex $l 0]
	set ttl 1
	set count 1
	if {$len > 1} {
		set ttl [lindex $l 1]
	}
	set spec "$addr/$port/$fmt/$ttl"
	if {[$video have_attr scuba] && [$video attr_value scuba]} {
		append cmd " -scuba "
	}
	if {[$video have_attr scuba] && [$video attr_value scuba]} {
		set b [expr 1000*[$video attr_value scuba]]
		append cmd " -vsbw $b "
	}
	append cmd " -video $spec "
	return $cmd
}
UserApplication/Collaborator private audio2options { audio } {
	if { $audio == {} } {
		return {}
	}
	set port [$audio set port_]
	set caddr [$audio set caddr_]
	set l [split $caddr "/"]
	if {[llength $l] == 1} {
	    set addr $caddr
	    set ttl 1
	} else {
	    set addr [lindex $l 0]
	    set ttl [lindex $l 1]
	}
	return "-audio $addr/$port/$ttl"
}
UserApplication/Collaborator private mb2options { mb } {
	if { $mb == {} } {
		return {}
	}
	set port [$mb set port_]
	set caddr [$mb set caddr_]
	set fmt [lindex [$mb set fmt_] 0]
	set l [split $caddr "/"]
	if {[llength $l] == 1} {
	    set addr $caddr
	    set ttl 1
	} else {
	    set addr [lindex $l 0]
	    set ttl [lindex $l 1]
	}
	return "-mb $addr/$port/$ttl"
}
Class UserApplication/Recorder -superclass UserApplication
UserApplication/Recorder instproc name {} { return "recorder" }
UserApplication/Recorder instproc match {prog} {
	set streams ""
	foreach m [[$prog base] set allmedia_] {
		set addr [lindex [split [$m set caddr_] /] 0]
		set port [$m set port_]
		set spec "$addr/$port"
		set media [$m set mediatype_]
		set proto [$m set proto_]
		set fmt [lindex [$m set fmt_] 0]
		if {$media == "whiteboard" && $proto == "udp" && $fmt == "mb"} {
			append streams " -add \"SRM mediaboard $spec\""
		} elseif {$proto == "RTP/AVP"} {
			append streams " -add \"RTP $media $spec\""
		}
	}
	if {$streams == ""} { return {} }
	set cmd "recorder $streams"
	set dir [$self get_option recordDir]
	if {$dir != ""} {
		append cmd " -directory $dir -noinput"
	}
	return [list [list "mash recording tool" $cmd]]
}
UserApplication register_media data
UserApplication register_protos data udp
UserApplication register_formats data rendezvous
Class UserApplication/Ctrl -superclass UserApplication
UserApplication/Ctrl instproc name {} { return "universalclient" }
UserApplication/Ctrl instproc match {prog} {
    set title [$prog field_value s]
    set base [$prog base]
	set d [$base media "data"]
	if {$d != {} && [lindex [$d set fmt_] 0] == "rendezvous"} {
		set port [$d set port_]
		set caddr [$d set caddr_]
		set l [split $caddr "/"]
		if {[llength $l] == 1} {
			set addr $caddr
			set ttl 1
		} else {
			set addr [lindex $l 0]
			set ttl [lindex $l 1]
		}
		set spec $addr/$port/$ttl
		return [list [list \
			"universal client" "uc -rendez $spec"]]
	}
	return ""
}
Class ScopeZone
ScopeZone public init {range {bw 200} {name ""}} {
    $self instvar range_ bw_
    set range_ $range
    set bw_ $bw
    if {$range == "224.2.128.0/17"} {
	set o [$self options]
	set addr [$o get_option SAPaddress]
        set port [$o get_option SAPport]
	$self set sapAddr_ "$addr/$port"
	$self set name_ "Global"
	return
    }
    if {$name != ""} {
	$self set name_ $name
    } else {
	$self set name_ "Admin Zone $range"
    }
    $self set sapAddr_ [$self addr $range]
}
ScopeZone private addr {spec} {
    if {$spec == "224.2.128.0/17"} {
        set o [$self options]
        set addr [$o get_option SAPaddress]
        set port [$o get_option SAPport]
	puts "returning $addr/$port"
	return "$addr/$port"
    }
    set l [split $spec /]
    set len [llength $l]
    if { $len < 2 || $len > 3} {
	$self warn "Bogus scope zone spec $spec"
	exit 1
    }
    set base [lindex $l 0]
    set mask [lindex $l 1]
    set comps [split $base .]
    if {[llength $comps] != 4 || $mask > 24} {
	$self warn "Bogus scope zone spec $spec"
	exit 1
    }
    set a [lindex $comps 0]
    set b [lindex $comps 1]
    set c [lindex $comps 2]
    set d [lindex $comps 3]
    if {$a<224 || $a>239 || $b<0 || $b>255 || $c<0 || $c>255 || $d<0 || $d>255} {
	$self warn "Bogus scope zone spec $spec"
	exit 1
    }
    if {$mask < 16} {
	set b [expr $b | ~((-1)<<(16-$mask))]
	set mask 16
    }
    if {$mask < 24} {
	set c [expr $c | ~((-1)<<(24-$mask))]
	set mask 24
    }
    set d [expr $d | ~((-1)<<(32-$mask))]
    if {$len == 3} {
	set port [lindex $l 2]
    } else {
	set port 9875
    }
    set addr "$a.$b.$c.$d/$port"
    return $addr
}
ScopeZone public name {} {
    return [$self set name_]
}
ScopeZone public bw {} {
    return [$self set bw_]
}
ScopeZone public range {} {
    return [$self set range_]
}
ScopeZone public sapAddr {} {
    return [$self set sapAddr_]
}
ScopeZone private inet_addr {a} {
    set l [split $a .]
    set addr [expr [lindex $l 0] <<24]
    incr addr [expr [lindex $l 1] <<16]
    incr addr [expr [lindex $l 2] <<8]
    incr addr [lindex $l 3]
    return $addr
}
ScopeZone public contains {addr} {
    $self instvar range_
    set l [split $range_ /]
    set base [$self inet_addr [lindex $l 0]]
    set mask [lindex $l 1]
    set addr [$self inet_addr $addr]
    if {$base == [expr $addr & ((-1)<<(32-$mask))]} {
	return 1
    }
    return 0
}
Class Program
Program public init {args} {
    $self next
    $self set complete_ 0
    $self set msgs_ {}
    foreach m $args {
	$self message $m
    }
}
Program public destroy {} {
	$self instvar msgs_
	foreach msg $msgs_ {
		delete $msg
	}
	$self next
}
Program public complete {} {
    return [$self set complete_]
}
Program public base {} {
    $self instvar msgs_
    if {[llength $msgs_] < 1} {
	return ""
    }
    return [lindex $msgs_ 0]
}
Program public have_attr {a} {
    $self instvar msgs_
    foreach m $msgs_ {
	if [$m have_attr $a] {
	    return 1
	}
    }
    return 0
}
Program public attr_value {a} {
    $self instvar msgs_
    foreach m $msgs_ {
	set v [$m attr_value $a]
	if {$v != ""} {
	    return $v
	}
    }
    return ""
}
Program public have_field {f} {
    $self instvar msgs_
    foreach m $msgs_ {
	if [$m have_field $f] {
	    return 1
	}
    }
    return 0
}
Program public field_value {f} {
    $self instvar msgs_
    foreach m $msgs_ {
	set v [$m field_value $f]
	if {$v != ""} {
	    return $v
	}
    }
    return ""
}
Program public unique_key {} {
    set b [$self base]
    if {$b == ""} { return "" }
    return [$b unique_key]
}
Program private parse_layers {attr begin end total} {
    upvar $begin b $end e $total t
    set l [split $attr "/"]
    set len [llength $l]
    if {$len < 1 || $len > 2} {
	$self warn "Malformed layers attribute \"$t\""
	return 1
    }
    if {$len == 2} {
	set t [lindex $l 1]
    } else {
	set t ""
    }
    set layers [lindex $l 0]
    set bounds [split $layers "-"]
    set b [lindex $bounds 0]
    set l [llength $bounds]
    if {$l == 1} {
	set e $b
    } elseif {$l == 2 } {
	set e [lindex $bounds 1]
    } else {
	$self warn "Malformed layers attribute \"$t\""
	return 1
    }
    return 0
}
Program public message {msg} {
    $self instvar msgs_ complete_
    set len [llength $msgs_]
    if {$len == 0} {
	set msgs_ [list $msg]
	set complete_ 1
	foreach m [$msg set allmedia_] {
	    if [$m have_attr layers] {
		set a [$m attr_value layers]
		if [$self parse_layers $a begin end total] {
		    continue
		}
		if {$begin > 0} {
		    set complete_ 0
		}
		if {$total != "" && $end < [expr $total-1]} {
		    set complete_ 0
		}
	    }
	}
	return 1
    }
    set layered 0
    foreach m [$msg set allmedia_] {
	if [$m have_attr layers] {
	    set layered 1
	    break
	}
    }
    if {$layered == 0} {
	if {$len == 1} {
	    return [$self update $msg 0]
	} else {
	    $self warn "Got apparent layered announcement without layers attribute"
	    return 0
	}
    }
    foreach m [$msg set allmedia_] {
	if [$m have_attr layers] {
	    break
	}
    }
    set type [$m set mediatype_]
    if [$self parse_layers [$m attr_value layers] begin end total] {
	delete $msg
	return
    }
    set position end
    set i 0
    while {$i < $len} {
	set a [[[lindex $msgs_ $i] media $type] attr_value layers]
	if [$self parse_layers $a begin2 end2 total2] {
	    $self fatal "have message is msgs_ with bogus layers attr"
	}
	if {$begin == $begin2 && $end == $end2} {
	    return [$self update $msg $i]
	}
	if {$begin < $begin2} {
	    set position $i
	    break
	}
	incr i
    }
    set msgs_ [linsert $msgs_ $position $msg]
    incr len
    set next 0
    set i 0
    while {$i < $len} {
	set a [[[lindex $msgs_ $i] media $type] attr_value layers]
	if [$self parse_layers $a begin end total2] {
	    $self fatal "have message is msgs_ with bogus layers attr"
	}
	if {$begin == $next} {
	    set next [expr $end+1]
	} else {
	    return 0
	}
	incr i
    }
    if {$total != "" && $next != $total} {
	return 0
    }
    set complete_ 1
    return 1
}
Program private update {msg i} {
    $self instvar msgs_
    set old [lindex $msgs_ $i]
    set oldversion [lindex [$old field_value o] 2]
    set newversion [lindex [$msg field_value o] 2]
    if {$newversion > $oldversion} {
	set msgs_ [lreplace $msgs_ $i $i $msg]
	delete $old
	return 1
    } else {
	delete $msg
	return 0
    }
}
Class ProgramSource
ProgramSource public init {rcvr} {
    $self set rcvr_ $rcvr
    $rcvr addsource $self
    $self set sdp_ [new SDPParser 0]
}
ProgramSource public recv {data} {
    $self process [string trim $data]
}
ProgramSource private process {data} {
    $self instvar sdp_ rcvr_
    set progs {}
    foreach msg [$sdp_ parse $data] {
	set o [$msg unique_key]
	$self instvar progs_
	if ![info exists progs_($o)] {
	    set p [new Program $msg]
	    set o [$msg unique_key]
	    $self set progs_($o) $p
	    if [$p complete] {
		$rcvr_ addprog $self $p
	    }
	} else {
	    set p $progs_($o)
	    set wascomplete [$p complete]
	    if [$p message $msg] {
		if {$wascomplete == 0} {
		    $self instvar rcvr_
		    $rcvr_ addprog $self $p
		} else {
		    $rcvr_ updateprog $self $p
		}
	    }
	}
	lappend progs $p
    }
    return $progs
}
ProgramSource public timeout {p timeout} {
    $self instvar timeouts_
    set o [$p unique_key]
    if [info exists timeouts_($o)] {
	after cancel $timeouts_($o)
    }
    set timeouts_($o) [after [expr 1000*$timeout] "$self remove $p"]
}
ProgramSource public remove {p} {
    $self instvar progs_ rcvr_
    set o [$p unique_key]
    if {![info exists progs_($o)] || $progs_($o) != $p} {
	$self warn "inconsistency in ProgramSource::remove"
	return
    }
    $rcvr_ removeprog $self $p
    delete $p
    unset progs_($o)
}
ProgramSource private readcache {} {
    $self instvar cache_
    if {![info exists cache_] || ![file readable $cache_]} {
	return
    }
    set fp [open $cache_ r]
    set progs [$self process [read $fp]]
    close $fp
    foreach p $progs {
	$self timeout $p 1800
    }
}
ProgramSource public shutdown {} {
    $self writecache
}
ProgramSource private writecache {} {
    $self instvar cache_
    if ![info exists cache_] { return }
    if ![file isdirectory [file dirname $cache_]] {
	file mkdir [file dirname $cache_]
    }
    if [catch {set fp [open $cache_ w]} m] {
	$self warn "couldn't open cache file $cache_ for writing: $m"
	return
    }
    $self instvar progs_
    foreach o [array names progs_] {
	foreach m [$progs_($o) set msgs_] {
	    puts $fp [$m set msgtext_]
	}
    }
    close $fp
}
ProgramSource public periodic-writecache {time} {
    $self writecache
    after [expr 1000 * $time] "$self periodic-writecache $time"
}
Class AddressBlock -configuration {
	defaultTTL 1
	maxbw -1
}
Class AddressBlock/RTP -superclass AddressBlock
Class AddressBlock/Simple -superclass AddressBlock
AddressBlock instproc init spec {
	$self next
	$self set nchan_ 0
	foreach s [split $spec ,] {
		set err [$self parse $s]
		if { $err != "" } {
			$self fatal $err
		}
	}
}
AddressBlock instproc data-port p {
	return [expr $p &~ 1]
}
AddressBlock instproc fmt {} {
	$self instvar fmt_
	if [info exists fmt_] { return $fmt_ } else { return "" }
}
AddressBlock instproc ctrl-port p {
	return [expr [$self data-port $p] + 1]
}
AddressBlock instproc addr {{k 0}} {
	return [$self set addr_($k)]
}
AddressBlock instproc sport {{k 0}} {
	return [$self set sport_($k)]
}
AddressBlock instproc rport {{k 0}} {
	return [$self set rport_($k)]
}
AddressBlock instproc ttl {{k 0}} {
	$self instvar ttl_
	if [info exists ttl_($k)] { return $ttl_($k) } else { return {} }
}
AddressBlock instproc nchan {} {
	return [$self set nchan_]
}
AddressBlock instproc parse s {
	set dst [split $s /]
	set n [llength $dst]
	if { $n < 2 } {
		return "must specify both address and port in the form addr/port ($s)"
	}
	set addr [lindex $dst 0]
	set ports [split [lindex $dst 1] :]
	set sport [lindex $ports 0]
	if { [llength $ports] == 1 } {
		set rport $sport
	} else {
		set rport [lindex $ports 1]
	}
	set firstchar [string index $addr 0]
	if [string match \[a-zA-Z\] $firstchar] {
		set s [gethostbyname $addr]
		if { $s == "" } {
			return "cannot lookup host name: $addr"
		}
		set addr $s
	}
	foreach port "$sport $rport" {
		if { ![string match \[0-9\]* $port] || $port >= 65536 } {
			$self fatal "illegal port '$port'"
		}
	}
	set ttl [$self get_option defaultTTL]
	set cnt 1
	if { $n >= 3 } {
		set fmt [lindex $dst 2]
		if { $n==3 && [regexp {^[0-9]+$} $fmt] } {
			set ttl $fmt
			set fmt {}
		}
		if { $n >= 4 } {
			set ttl [lindex $dst 3]
			if { $n > 4 } {
				set cnt [lindex $dst 4]
				if { ![string match \[0-9\]* $cnt] ||
				     $cnt >= 20 } {
					return "$dst: bad layered addr count"
					exit 1
				}
				if { $n > 5 } {
					return "$dst: malformed address"
				}
			}
		}
	}
	if { $ttl < 0 || $ttl > 255 } {
		return "$dst: invalid ttl ($ttl)"
	}
	set oct [split $addr .]
	set base [lindex $oct 0].[lindex $oct 1].[lindex $oct 2]
	set off [lindex $oct 3]
	$self instvar addr_ sport_ rport_ ttl_ nchan_
	set i 0
	while { $i < $cnt } {
		set sp [$self data-port $sport]
		set rp [$self data-port $rport]
		set addr_($nchan_) $base.$off
		set sport_($nchan_) $sp
		set rport_($nchan_) $rp
		set ttl_($nchan_) $ttl
		if [in_multicast $addr] {
			incr off
		}
		incr sport 2
		incr rport 2
		incr i
		incr nchan_
	}
	if { [info exists fmt] && $fmt != "" } {
		$self set fmt_ $fmt
	}
	if [info exists confid] {
		$self add_option confid $confid
	}
	if [info exists ttl] {
		$self add_option defaultTTL $ttl
	}
	$self bandwidth_heuristic
}
AddressBlock instproc bandwidth_heuristic {} {
	$self instvar nchan_ addr_ ttl_ maxbw_
	set i 0
	while { $i < $nchan_ } {
		set maxbw [$self get_option maxbw]
		if { $maxbw <= 0 } {
			set ttl $ttl_($i)
			if { $ttl <= 16 || ![in_multicast $addr_($i)] } {
				set maxbw 10000000
			} elseif { $ttl <= 64 } {
				set maxbw 4000000
			} elseif  { $ttl <= 128 } {
				set maxbw 1000000
			} elseif { $ttl <= 192 } {
				set maxbw 128000
			} else {
				set maxbw 56000
			}
		}
		set maxbw_($i) $maxbw
		incr i
	}
}
AddressBlock/Simple instproc data-port p {
	return $p
}
AddressBlock/RTP instproc data-port p {
	return [expr $p &~ 1]
}
set rlm_param(alpha) 4
set rlm_param(alpha) 2
set rlm_param(beta) 0.75
set rlm_param(init-tj) 1.5
set rlm_param(init-tj) 10
set rlm_param(init-tj) 5
set rlm_param(init-td) 5
set rlm_param(init-td-var) 2
set rlm_param(max) 600
set rlm_param(max) 60
set rlm_param(g1) 0.25
set rlm_param(g2) 0.25
Class MMG
MMG instproc init { levels } {
	$self next
	$self instvar debug_ env_ maxlevel_
	set debug_ 0
	set env_ [lindex [split [$self info class] /] 1]
	set maxlevel_ $levels
	global rlm_debug_flag
	if [info exists rlm_debug_flag] {
		set debug_ $rlm_debug_flag
	}
	$self instvar TD TDVAR state_ subscription_
	global rlm_param
	set TD $rlm_param(init-td)
	set TDVAR $rlm_param(init-td-var)
	set state_ /S
	$self instvar layer_ layers_
	set i 1
	while { $i <= $maxlevel_ } {
		set layer_($i) [$self create-layer [expr $i - 1]]
		lappend layers_ $layer_($i)
		incr i
	}
	set subscription_ 0
	$self add-layer
	set state_ /S
	$self set_TJ_timer
}
MMG instproc set-state s {
	$self instvar state_
	set old $state_
	set state_ $s
	$self debug "FSM: $old -> $s"
}
MMG instproc drop-layer {} {
	$self dumpLevel
	$self instvar subscription_ layer_
	set n $subscription_
	if { $n > 0 } {
		$self debug "DRP-LAYER $n"
		$layer_($n) leave-group
		incr n -1
		set subscription_ $n
	}
	$self dumpLevel
}
MMG instproc add-layer {} {
	$self dumpLevel
	$self instvar maxlevel_ subscription_ layer_
	set n $subscription_
	if { $n < $maxlevel_ } {
		$self debug "ADD-LAYER"
		incr n
		set subscription_ $n
		$layer_($n) join-group
	}
	$self dumpLevel
}
MMG instproc current_layer_getting_packets {} {
	$self instvar subscription_ layer_ TD
	set n $subscription_
	if { $n == 0 } {
		return 0
	}
	set l $layer_($subscription_)
	$self debug "npkts [$l npkts]"
	if [$l getting-pkts] {
		return 1
	}
	set delta [expr [$self now] - [$l last-add]]
	if { $delta > $TD } {
		set TD [expr 1.2 * $delta]
	}
	return 0
}
MMG instproc mmg_loss {} {
	$self instvar layers_
	set loss 0
	foreach l $layers_ {
		incr loss [$l nlost]
	}
	return $loss
}
MMG instproc mmg_pkts {} {
	$self instvar layers_
	set npkts 0
	foreach l $layers_ {
		incr npkts [$l npkts]
	}
	return $npkts
}
MMG instproc check-equilibrium {} {
	global rlm_param
	$self instvar subscription_ maxlevel_ layer_
	set n [expr $subscription_ + 1]
	if { $n >= $maxlevel_ || [$layer_($n) timer] >= $rlm_param(max) } {
		set eq 1
	} else {
		set eq 0
	}
	$self debug "EQ $eq"
}
MMG instproc backoff-one { n alpha } {
	$self debug "BACKOFF $n by $alpha"
	$self instvar layer_
	$layer_($n) backoff $alpha
}
MMG instproc backoff n {
	$self debug "BACKOFF $n"
	global rlm_param
	$self instvar maxlevel_ layer_
	set alpha $rlm_param(alpha)
	set L $layer_($n)
	$L backoff $alpha
	incr n
	while { $n <= $maxlevel_ } {
		$layer_($n) peg-backoff $L
		incr n
	}
	$self check-equilibrium
}
MMG instproc highest_level_pending {} {
	$self instvar maxlevel_
	set m ""
	set n 0
	incr n
	while { $n <= $maxlevel_ } {
		if [$self level_pending $n] {
			set m $n
		}
		incr n
	}
	return $m
}
MMG instproc rlm_update_D  D {
	global rlm_param
	$self instvar TD TDVAR
	set v [expr abs($D - $TD)]
	set TD [expr $TD * (1 - $rlm_param(g1)) \
				+ $rlm_param(g1) * $D]
	set TDVAR [expr $TDVAR * (1 - $rlm_param(g2)) \
		       + $rlm_param(g2) * $v]
}
MMG instproc exceed_loss_thresh {} {
	$self instvar h_npkts h_nlost
	set npkts [expr [$self mmg_pkts] - $h_npkts]
	if { $npkts >= 10 } {
		set nloss [expr [$self mmg_loss] - $h_nlost]
		set loss [expr double($nloss) / ($nloss + $npkts)]
		$self debug "H-THRESH $nloss $npkts $loss"
		if { $loss > 0.25 } {
			return 1
		}
	}
	return 0
}
MMG instproc enter_M {} {
	$self set-state /M
	$self set_TD_timer_wait
	$self instvar h_npkts h_nlost
	set h_npkts [$self mmg_pkts]
	set h_nlost [$self mmg_loss]
}
MMG instproc enter_D {} {
	$self set-state /D
	$self set_TD_timer_conservative
}
MMG instproc enter_H {} {
	$self set_TD_timer_conservative
	$self set-state /H
}
MMG instproc log-loss {} {
	$self debug "LOSS [$self mmg_loss]"
	$self instvar state_ subscription_ pending_ts_
	if { $state_ == "/M" } {
		if [$self exceed_loss_thresh] {
			$self cancel_timer TD
			$self drop-layer
			$self check-equilibrium
			$self enter_D
		}
		return
	}
	if { $state_ == "/S" } {
		$self cancel_timer TD
		set n [$self highest_level_pending]
		if { $n != "" } {
			$self backoff $n
			if { $n == $subscription_ } {
				set ts $pending_ts_($subscription_)
				$self rlm_update_D [expr [$self now] - $ts]
				$self drop-layer
				$self check-equilibrium
				$self enter_D
				return
			}
			if { $n == [expr $subscription_ + 1] } {
				$self cancel_timer TJ
				$self set_TJ_timer
			}
		}
		if [$self our_level_recently_added] {
			$self enter_M
			return
		}
		$self enter_H
		return
	}
	if { $state_ == "/H" || $state_ == "/D" } {
		return
	}
	puts stderr "rlm state machine botched"
	exit -1
}
MMG instproc relax_TJ {} {
	$self instvar subscription_ layer_
	if { $subscription_ > 0 } {
		$layer_($subscription_) relax
		$self check-equilibrium
	}
}
MMG instproc trigger_TD {} {
	$self instvar state_
	if { $state_ == "/H" } {
		$self enter_M
		return
	}
	if { $state_ == "/D" || $state_ == "/M" } {
		$self set-state /S
		$self set_TD_timer_conservative
		return
	}
	if { $state_ == "/S" } {
		$self relax_TJ
		$self set_TD_timer_conservative
		return
	}
	puts stderr "trigger_TD: rlm state machine botched $state)"
	exit -1
}
MMG instproc set_TJ_timer {} {
	global rlm_param
	$self instvar subscription_ layer_
	set n [expr $subscription_ + 1]
	if ![info exists layer_($n)] {
		return
	}
	set I [$layer_($n) timer]
	set d [expr $I / 2.0 + [trunc_exponential $I]]
	$self debug "TJ $d"
	$self set_timer TJ $d
}
MMG instproc set_TD_timer_conservative {} {
	$self instvar TD TDVAR
	set delay [expr $TD + 1.5 * $TDVAR]
	$self set_timer TD $delay
}
MMG instproc set_TD_timer_wait {} {
	$self instvar TD TDVAR
	$self instvar subscription_
	set k [expr $subscription_ / 2. + 1.5]
	$self set_timer TD [expr $TD + $k * $TDVAR]
}
MMG instproc is-recent { ts } {
	$self instvar TD TDVAR
	set ts [expr $ts + ($TD + 2 * $TDVAR)]
	if { $ts > [$self now] } {
		return 1
	}
	return 0
}
MMG instproc level_pending n {
	$self instvar pending_ts_
	if { [info exists pending_ts_($n)] && \
		 [$self is-recent $pending_ts_($n)] } {
		return 1
	}
	return 0
}
MMG instproc level_recently_joined n {
	$self instvar join_ts_
	if { [info exists join_ts_($n)] && \
		 [$self is-recent $join_ts_($n)] } {
		return 1
	}
	return 0
}
MMG instproc pending_inferior_jexps {} {
	set n 0
	$self instvar subscription_
	while { $n <= $subscription_ } {
		if [$self level_recently_joined $n] {
			return 1
		}
		incr n
	}
	$self debug "NO-PEND-INF"
	return 0
}
MMG instproc trigger_TJ {} {
	$self debug "trigger-TJ"
	$self instvar state_ ctrl_ subscription_
	if { ($state_ == "/S" && ![$self pending_inferior_jexps] && \
		  [$self current_layer_getting_packets])  } {
		$self add-layer
		$self check-equilibrium
		set msg "add $subscription_"
		$ctrl_ send $msg
		$self local-join
	}
	$self set_TJ_timer
}
MMG instproc our_level_recently_added {} {
	$self instvar subscription_ layer_
	return [$self is-recent [$layer_($subscription_) last-add]]
}
MMG instproc recv-ctrl msg {
	$self instvar join_ts_ pending_ts_ subscription_
	$self debug "X-JOIN $msg"
	set what [lindex $msg 0]
	if { $what != "add" } {
		return
	}
	set level [lindex $msg 1]
	set join_ts_($level) [$self now]
	if { $level > $subscription_ } {
		set pending_ts_($level) [$self now]
	}
}
MMG instproc local-join {} {
	$self instvar subscription_ pending_ts_ join_ts_
	set join_ts_($subscription_) [$self now]
	set pending_ts_($subscription_) [$self now]
}
MMG instproc debug { msg } {
	$self instvar debug_ subscription_ state_
	if {$debug_} {
		puts stderr "[gettimeofday] layer $subscription_ $state_ $msg"
	}
}
MMG instproc dumpLevel {} {
}
Class Layer
Layer instproc init { mmg } {
	$self next
	$self instvar mmg_ TJ npkts_
	global rlm_param
	set mmg_ $mmg
	set TJ $rlm_param(init-tj)
	set npkts_ 0
}
Layer instproc relax {} {
	global rlm_param
	$self instvar TJ
	set TJ [expr $TJ * $rlm_param(beta)]
	if { $TJ <= $rlm_param(init-tj) } {
		set TJ $rlm_param(init-tj)
	}
}
Layer instproc backoff alpha {
	global rlm_param
	$self instvar TJ
	set TJ [expr $TJ * $alpha]
	if { $TJ >= $rlm_param(max) } {
		set TJ $rlm_param(max)
	}
}
Layer instproc peg-backoff L {
	$self instvar TJ
	set t [$L set TJ]
	if { $t >= $TJ } {
		set TJ $t
	}
}
Layer instproc timer {} {
	$self instvar TJ
	return $TJ
}
Layer instproc last-add {} {
	$self instvar add_time_
	return $add_time_
}
Layer instproc join-group {} {
	$self instvar npkts_ add_time_ mmg_
	set npkts_ [$self npkts]
	set add_time_ [$mmg_ now]
}
Layer instproc leave-group {} {
}
Layer instproc getting-pkts {} {
	$self instvar npkts_
	return [expr [$self npkts] != $npkts_]
}
set rlm_debug_flag 1
Class Layer/mash -superclass Layer
Layer/mash instproc init {mmg net n} {
	$self next $mmg
	$self instvar net_ l_ n_
	set net_ $net
	set n_ $n
	set l_ [$net_ set net_($n)]
}
Layer/mash instproc join-group {} {
	$self instvar mmg_ net_
	set level [expr [$mmg_ set subscription_] - 1]
	$net_ set-subscription-level $level
	$self next
}
Layer/mash instproc leave-group {} {
	$self instvar mmg_ net_
	set level [expr [$mmg_ set subscription_] - 1]
	$net_ set-subscription-level $level
	$self next
}
Layer/mash instproc nlost {} {
	$self instvar l_
	return [$l_ nlost]
}
Layer/mash instproc npkts {} {
	$self instvar l_ n_
	return [$l_ npkts $n_]
}
Class MMG/mash -superclass MMG
MMG/mash instproc init {net caddr} {
	$self instvar net_
	set net_ $net
	$self next [$net set nchan_]
	proc ctrl$self {args} { puts "ctrl: $args" }
	$self set ctrl_ ctrl$self
}
MMG/mash instproc create-layer {layerNo} {
	$self instvar net_
	return [new Layer/mash $self $net_ $layerNo]
}
MMG/mash instproc now {} {
	return [gettimeofday]
}
MMG/mash instproc set_timer {which delay} {
	$self instvar timers_
	if [info exists timers_($which)] {
		puts "timer botched ($which)"
		exit 1
	}
	set delay [expr int($delay * 1000)]
	set timers_($which) [after $delay "$self trigger_timer $which"]
}
MMG/mash instproc trigger_timer {which} {
	$self instvar timers_
	unset timers_($which)
	$self trigger_$which
}
MMG/mash instproc cancel_timer {which} {
	$self instvar ns_ timers_
	if [info exists timers_($which)] {
		after cancel $timers_($which)
		unset timers_($which)
	}
}
MMG/mash instproc debug { msg } {
	$self instvar debug_
	if {!$debug_} { return }
	$self instvar subscription_ state_
	set time [format %.05f [$self now]]
	puts stderr "$time layer $subscription_ $state_ $msg"
}
proc uniform01 {} {
    return [expr double(([random] % 10000000) + 1) / 1e7]
}
proc uniform { a b } {
	return [expr ($b - $a) * [uniform01] + $a]
}
proc exponential mean {
	return [expr - $mean * log([uniform01])]
}
proc trunc_exponential lambda {
	while 1 {
		set u [exponential $lambda]
		if { $u < [expr 4 * $lambda] } {
			return $u
		}
	}
}
Class Network/IP -superclass Network
Network/IP instproc init args {
	puts stderr "Network/IP called... change to Network"
	eval $self next $args
}
Network instproc port args {
	eval $self sport $args
}
proc in_multicast addr {
	return [expr ([lindex [split $addr .] 0] & 0xf0) == 0xe0]
}
Class NetworkLayer
Class NetworkManager
NetworkManager instproc graphics-init n {
	if {$n == 1 || [winfo exists .l]} { return }
	$self instvar nchan_
	set nchan_ $n
	toplevel .l
	set k 0
	while { $k < $nchan_ } {
		radiobutton .l.b$k -command "$self set-subscription-level $k" \
				-text "Level $k" \
				-variable nLayers -value $k
		pack .l.b$k
		incr k
	}
	wm withdraw .l
	bind . <l> {
		if [winfo ismapped .l] {
			wm withdraw .l
		} else {
			wm deiconify .l
		}
	}
}
NetworkManager instproc set-subscription-level n {
	$self instvar agent_ nchan_ session_ net_
	$agent_ set_maxchannel $n
	$session_ set loopbackLayer_ [expr $n + 1]
	set i 0
	while { $i <= $n } {
		$net_($i) enable
		incr i
	}
	while { $i < $nchan_ } {
		$net_($i) disable
		incr i
	}
	global nLayers
	set nLayers $n
}
NetworkLayer instproc init { session addr sport rport ttl channel } {
	$self next
	$self instvar session_ addr_ port_ ttl_ dn_ cn_ channel_ active_
	set addr_ $addr
	set port_ $rport
	set sport_ $sport
	set rport_ $rport
	set session_ $session
	set ttl_ $ttl
	set channel_ $channel
	set dn_ [new Network]
	set result [$dn_ open $addr_ $sport_ $rport_ $ttl_]
	if {$result == {0}} {
		new ErrorWindow {Cannot open network connection.}
		exit 1
	}
	set cn_ [new Network]
	set result [$cn_ open $addr_ [expr $sport_ + 1] [expr $rport_ + 1] $ttl_]
	if {$result == {0}} {
		new ErrorWindow {Cannot open network connection.}
		exit 1
	}
	$cn_ loopback 1
	$session_ data-net $dn_ $channel_
	$session_ ctrl-net $cn_ $channel_
	set active_ 0
	$dn_ drop-membership
	$cn_ drop-membership
	$session_ data-net "" $channel_
	$session_ ctrl-net "" $channel_
	$self set tloss_ 0
}
NetworkLayer instproc destroy {} {
	$self instvar dn_ cn_
	if [info exists dn_] {
		delete $dn_
	}
	if [info exists cn_] {
		delete $cn_
	}
	$self next
}
NetworkLayer instproc data-net {} {
	return [$self set dn_]
}
NetworkLayer instproc ctrl-net {} {
	return [$self set cn_]
}
NetworkLayer instproc enable-send {} {
	$self instvar dn_ cn_ session_ channel_
	$session_ data-net $dn_ $channel_
	$session_ ctrl-net $cn_ $channel_
}
NetworkLayer instproc disable-send {} {
	$self instvar dn_ cn_ session_ channel_
	$session_ data-net "" $channel_
	$session_ ctrl-net "" $channel_
}
NetworkLayer instproc enable {} {
	$self instvar active_ dn_ cn_ session_ channel_
	if !$active_ {
		set active_ 1
		$dn_ add-membership
		$cn_ add-membership
		$session_ data-net $dn_ $channel_
		$session_ ctrl-net $cn_ $channel_
	}
}
NetworkLayer instproc disable {} {
	$self instvar dn_ cn_ active_ session_ channel_
	if $active_ {
		set active_ 0
		$dn_ drop-membership
		$cn_ drop-membership
		$session_ data-net "" $channel_
		$session_ ctrl-net "" $channel_
	}
}
NetworkLayer instproc notify-loss {src} {
	$self instvar loss_ tloss_
	if ![info exists loss_($src)] {
		set loss_($src) 0
	}
	set nloss [$src missing]
	incr tloss_ [expr $nloss - $loss_($src)]
	set loss_($src) $nloss
}
NetworkLayer instproc nlost {} {
	$self instvar tloss_
	return $tloss_
}
NetworkLayer instproc npkts {n} {
	$self instvar agent_
	set npkts 0
	foreach s [$agent_ set sources_] {
		set l [lindex [$s set layers_] $n]
		incr npkts [$l set np_]
	}
	return $npkts
}
NetworkLayer instproc crypt { dc cc } {
	$self instvar dn_ cn_
	$dn_ crypt $dc
	$cn_ crypt $cc
}
NetworkManager instproc init { ab session agent } {
	$self next
	$self instvar session_ agent_ encrypt_ key_ fmt_
	set session_ $session
	set agent_ $agent
	set encrypt_ 0
	set key_ ""
	set fmt_ ""
	$self allocate $ab $session
}
NetworkManager instproc allocate { ab session } {
	$self instvar nchan_ net_ mmg_
	if [info exists nchan_] {
		set oldnchan $nchan_
	} else {
		set oldnchan 0
	}
	set nchan_ 0
	while { $nchan_ < [$ab nchan] } {
		set addr [$ab addr $nchan_]
		set sport [$ab sport $nchan_]
		set rport [$ab rport $nchan_]
		set ttl [$ab ttl $nchan_]
		if [info exists net_($nchan_)] {
			delete $net_($nchan_)
		}
		set net_($nchan_) [new NetworkLayer $session $addr \
				$sport $rport $ttl $nchan_]
		$self instvar agent_
		$net_($nchan_) set agent_ $agent_
		incr nchan_
	}
	set n $nchan_
	while {$n < $oldnchan} {
		if [info exists net_($n)] {
			delete $net_($n)
		}
		incr n
	}
	if [info exists mmg_] {
		delete $mmg_
	}
	$self set-subscription-level 0
	if {$nchan_ == 1} { return }
	if [$self yesno useLayersWindow] {
		$self graphics-init $nchan_
	}
	if [$self get_option useRLM] {
		set caddr ""
		set mmg_ [new MMG/mash $self $caddr]
	}
}
NetworkManager instproc nchan {} {
	return [$self set nchan_]
}
NetworkManager instproc reset ab {
	$self instvar session_
	$self allocate $ab $session_
}
NetworkManager instproc data-net args {
	if { $args == "" } {
		set k 0
	} else {
		set k $args
	}
	$self instvar net_
	return [$net_($k) data-net]
}
NetworkManager instproc ctrl-net args {
	if { $args == "" } {
		set k 0
	} else {
		set k $args
	}
	$self instvar net_
	return [$net_($k) ctrl-net]
}
NetworkManager public loopback enable {
	$self instvar nchan_ net_
	set i 0
	while { $i < $nchan_ } {
		set net $net_($i)
		set dn [$net data-net]
		set cn [$net ctrl-net]
		$dn loopback $enable
		$cn loopback $enable
		incr i
	}
}
NetworkManager instproc install-key key {
	return [$self set_key $key]
}
NetworkManager instproc crypt_all { dc cc } {
	$self instvar net_
	foreach n [array names net_] {
		$net_($n) crypt $dc $cc
	}
}
NetworkManager instproc destroy {} {
	$self instvar net_
	foreach chan [array names net_] {
		delete $net_($chan)
	}
	$self next
}
NetworkManager instproc usingRLM {} {
	$self instvar mmg_
	return [info exists mmg_]
}
NetworkManager instproc notify-loss {src layer} {
	$self instvar net_
	$net_($layer) notify-loss $src
}
NetworkManager instproc crypt_format { key } {
	set k [string first / $key]
	if { $k < 0 } {
		set fmt DES
	} else {
		set fmt [string range $key 0 [expr $k - 1]]
		set key [string range $key [expr $k + 1] end]
	}
	return "$fmt $key"
}
NetworkManager instproc set_key key {
	if { $key == "" } {
		$self crypt_clear
		return ""
	}
	$self instvar encrypt_
	set L [$self crypt_format $key]
	set fmt [lindex $L 0]
	set key [lindex $L 1]
	$self instvar key_
	set key_ $key
	$self instvar dc_ cc_ fmt_
	if { $fmt_ != $fmt } {
		if [info exists dc_] {
			delete $dc_
			unset dc_
		}
		if [info exists cc_] {
			delete $cc_
			unset cc_
		}
		set fmt_ $fmt
	}
	if ![info exists dc_] {
		set clist [Crypt/Data info subclass]
		if { [lsearch -exact $clist Crypt/Data/$fmt] < 0 } {
			return "no $fmt encryption support"
		}
		set dc_ [new Crypt/Data/$fmt]
		set cc_ [new Crypt/Control/$fmt]
	}
	if [$dc_ key $key] {
		$cc_ key $key
		$self crypt_all $dc_ $cc_
		set encrypt_ 1
		return ""
	} else {
		$self crypt_clear
		return "your key is cryptographically weak"
	}
}
NetworkManager instproc crypt_clear {} {
	$self instvar encrypt_ key_
	$self crypt_all "" ""
	set key_ ""
	set encrypt_ 0
}
Class Timer
Class Timer/Periodic -superclass Timer
Class Timer/Adaptive -superclass Timer
Class Timer/Adaptive/ConstBW -superclass Timer/Adaptive
Timer public init {} {
	$self next
	$self randomize 0
	$self set randwt_ 1.0
}
Timer public destroy {} {
	$self cancel
	$self next
}
Timer public randomize { {yesno 1} {randwt {}} } {
	if { $randwt!={} } {
		$self set randwt_ $randwt
	}
	if {$yesno=="yes"} {set yesno 1} elseif {$yesno=="no"} {set yesno 0}
	$self set randomize_ $yesno
}
Timer private sched { t } {
	$self msched $t
}
Timer public msched { t } {
	$self instvar id_ randomize_ randwt_
	if [info exists id_] {
		puts stderr "warning: $self ([$self info class]):\
				overlapping timers"
	}
	if $randomize_ {
		set r [expr [random]/double(0x7fffffff)-0.5]
		set t [expr $t+$t*$r*$randwt_]
	}
	set t [expr int($t+0.5)]
	set id_ [after $t "$self do_timeout"]
}
Timer private do_timeout {} {
	$self instvar id_
	if ![info exists id_] {
		puts stderr "warning: $self ($class) no timer id_"
	} else {
		unset id_
	}
	$self timeout
}
Timer public is_sched { } {
	$self instvar id_
	return [info exists id_]
}
Timer public cancel {} {
	$self instvar id_
	if [info exists id_] {
		after cancel $id_
		unset id_
	}
}
Timer/Periodic public init { {period 5000} } {
	$self next
	$self set period_ $period
}
Timer/Periodic public start { {period {}} } {
	$self instvar period_
	if { $period!={} } { set period_ $period }
	if [$self is_sched] { $self cancel }
	$self msched $period_
}
Timer/Periodic instproc do_timeout {} {
	$self instvar period_
	$self next
	if { [info commands $self]=="" } return
	$self msched $period_
}
Timer/Adaptive public init { {interval 5000} } {
	$self next
	$self set interval_ $interval
}
Timer/Adaptive public start {} {
	$self instvar interval_
	if [$self is_sched] { $self cancel }
	set interval_ [$self adapt $interval_]
	$self msched [expr int($interval_+0.5)]
}
Timer/Adaptive public do_timeout {} {
	$self next
	if { [info commands $self]=="" } return
	$self instvar interval_
	set interval_ [$self adapt $interval_]
	$self msched [expr int($interval_+0.5)]
}
Timer/Adaptive private adapt {interval} {
	return $interval
}
Timer/Adaptive/ConstBW public init { bw {thresh {}} {size_gain {}} } {
	$self instvar size_gain_ avgsize_ nsrcs_ bw_ thresh_ interval_
	if { $size_gain!={} } {
		set size_gain_ $size_gain
	} else {
		set size_gain_ 0.125
	}
	set avgsize_ 28
	set nsrcs_ 0
	set bw_ $bw
	if { $thresh=={} } {
		set thresh_ 500
	} else {
		set thresh_ $thresh
	}
	$self next $thresh_
}
Timer/Adaptive/ConstBW public threshold { {thresh {}} } {
    $self instvar thresh_
    if {$thresh=={}} {
	return $thresh_
    } else {
	set thresh_ $thresh
    }
}
Timer/Adaptive/ConstBW public bandwidth { {bw {}} } {
    $self instvar bw_
    if {$bw=={}} {
	return $bw_
    } else {
	set bw_ $bw
    }
}
Timer/Adaptive/ConstBW public sample_size { size } {
	$self instvar avgsize_ size_gain_
	set avgsize_ [expr $avgsize_ + $size_gain_ * ($size + 28 - $avgsize_)]
}
Timer/Adaptive/ConstBW public update_nsrcs { nsrcs } {
	$self set nsrcs_ $nsrcs
}
Timer/Adaptive/ConstBW public nsrcs { nsrcs } {
	return [$self set nsrcs_]
}
Timer/Adaptive/ConstBW public incr_nsrcs { {incr 1} } {
        $self instvar nsrcs_
        incr nsrcs_ $incr
}
Timer/Adaptive/ConstBW private adapt {interval} {
	$self instvar avgsize_ bw_ nsrcs_ thresh_
	set t [expr 1000 * ($nsrcs_ * $avgsize_ * 8) / $bw_]
	if { $t < $thresh_ } {
		return $thresh_
	} else {
		return $t
	}
}
AnnounceListenManager public init { spec {mtu 1500} } {
	$self next $mtu
	$self instvar data_ snet_ rnet_
	set data_ ""
	set snet_ ""
	set rnet_ ""
	if [regexp {^[0-9]*$} $spec] {
		set rnet_ [new Network]
		$rnet_ open $spec
	} else {
		set ab [new AddressBlock/Simple $spec]
		set addr  [$ab addr]
		set sport [$ab sport]
		set rport [$ab rport]
		set ttl   [$ab ttl]
		delete $ab
		set snet_ [new Network]
		if [in_multicast $addr] {
			$snet_ open $addr $sport $rport $ttl
			set rnet_ $snet_
		} else {
			if { $rport != 0 } {
				set rnet_ [new Network]
				$rnet_ open $rport
			}
			$snet_ open $addr $sport 0 1
		}
	}
	if { $snet_ != "" } {
		$snet_ loopback 1
		$self send_network $snet_
	}
	if { $rnet_ != "" } {
		$self recv_network $rnet_
	}
}
AnnounceListenManager public destroy {} {
	$self instvar snet_ rnet_ timers_
	if { $rnet_==$snet_ } {
		delete $snet_
	} else {
		if { $snet_ != "" } {
			delete $snet_
		}
		if { $rnet_ != "" } {
			delete $rnet_
		}
	}
	if [info exists timers_] {
		foreach t [array names timers_] {
			delete $timers_($t)
		}
	}
	$self next
}
AnnounceListenManager public timer {args} {
	$self instvar timers_
	if {[llength $args]==1} {
		set d __default_timer__
		set t [lindex $args 0]
		if {$t!={}} { $t proc timeout { } "$self send_announcement" }
	} else {
		set d [lindex $args 0]
		set t [lindex $args 1]
		if {$t!={}} { $t proc timeout { } \
				[list $self send_announcement $d] }
	}
	if [info exists timers_($d)] {
		set sched [$timers_($d) is_sched]
		delete $timers_($d)
	} else {
		set sched 0
	}
	if {$t!={}} {
		set timers_($d) $t
		if $sched {
			$t start
		}
	} else {
		catch {unset timers_($d)}
	}
	return $t
}
AnnounceListenManager public get_timer {args} {
	$self instvar timers_
	if {[llength $args]==0} {
		set d __default_timer__
	} else {
		set d [lindex $args 0]
	}
	if [info exists timers_($d)] { return $timers_($d) } else { return "" }
}
AnnounceListenManager public start {args} {
	if { [llength $args]==0 } {
		set t [$self get_timer]
	} else {
		set d [lindex $args 0]
		set t [$self get_timer $d]
	}
	if { $t=={} } {
		set t [new Timer/Periodic]
		$t randomize 1
		if [info exists d] { $self timer $d $t } else { $self timer $t}
	}
	if [info exists d] {$self send_announcement $d} \
			else {$self send_announcement}
	$t start
}
AnnounceListenManager public stop {args} {
	$self instvar timers_
	if {[llength $args]==0} {
		foreach d [array names timers_] {
			$timers_($d) cancel
		}
	} else {
		set d [lindex $args 0]
		$timers_($d) cancel
	}
}
AnnounceListenManager public recv_announcement { addr port data len } {
	puts "ALM::recv_announcement $addr/$port \[$len\]: $data"
}
AnnounceListenManager public send_announcement {args} {
	$self instvar data_
	if {[llength $args]==0} {
		if { $data_!={} } { $self announce $data_ }
	} else {
		$self announce [lindex $args 0]
	}
}
AnnounceListenManager public set_announcement { data } {
	$self set data_ $data
}
AnnounceListenManager public get_announcement { } {
	return [$self set data_]
}
AnnounceListenManager public ttl {num} {
	$self instvar snet_
	$snet_ ttl $num
}
Class Timer/Adaptive/SAP -superclass Timer/Adaptive
Timer/Adaptive/SAP public init { alm } {
	$self set alm_ $alm
	$self next
}
Timer/Adaptive/SAP private adapt {interval} {
	$self instvar alm_
	return [expr 1000*[$alm_ interval 1]]
}
Class AnnounceListenManager/SAP/Nsdr -superclass AnnounceListenManager/SAP
AnnounceListenManager/SAP/Nsdr public init {s mtu scope} {
	set ttl [$self get_option sapTTL]
	set spec "[$scope sapAddr]/none/$ttl"
	$self next $spec $mtu
	$self set bw_ [$scope bw]
	$self set s_ $s
	$self set avgsize_ 500
	$self set nsrcs_ 0
}
AnnounceListenManager/SAP/Nsdr public destroy {} {
	$self next
}
AnnounceListenManager/SAP/Nsdr private recv_announcement args {
	$self instvar s_
	eval $s_ recv $self $args
}
AnnounceListenManager/SAP/Nsdr public sample_size {size} {
	$self instvar avgsize_
	set avgsize_ [expr $avgsize_ + ($size-$avgsize_)>>3]
}
AnnounceListenManager/SAP/Nsdr public incrnsrcs {n} {
	$self instvar nsrcs_
	incr nsrcs_ $n
}
AnnounceListenManager/SAP/Nsdr public interval {rand} {
	$self instvar avgsize_ nsrcs_ bw_
	set i [expr 8 * $avgsize_ * $nsrcs_ / $bw_]
	if {$rand != 0} {
		set r1 [expr [random]/double(0x7fffffff)]
		set r2 [expr ($r1*2.0/3.0) + 2.0/3.0]
		set i [expr int($i*$r2)]
	}
	if {$i < 5} {
		set i 5
	}
	return $i
}
AnnounceListenManager/SAP/Nsdr public start {msg} {
	$self instvar nsrcs_
	incr nsrcs_
	$self timer $msg [new Timer/Adaptive/SAP $self]
	$self next $msg
}
AnnounceListenManager/SAP/Nsdr private send_announcement {msg} {
	set text [$msg set msgtext_]
	$self sample_size [string length $text]
	$self announce $text
}
Class ProgramSource/SAP -superclass ProgramSource
ProgramSource/SAP public init {ui args} {
	$self next $ui
	$self instvar scopes_ addrs_ cache_ announce_file_
	set scopes_ {}
	set addrs_ {}
	foreach scope $args {
		lappend scopes_ $scope
		set al [new AnnounceListenManager/SAP/Nsdr $self 2048 $scope]
		lappend addrs_ $al
	}
	set dir [$self get_option cachedir]
	if {![info exists cache_] && $dir != ""} {
		set o [$self options]
        	set addr [$o get_option SAPaddress]
		set cache_ [file join $dir global-$addr]
	}
	$self readcache
	set write_interval [$self get_option cacheWriteInterval]
	if {$write_interval != ""} {$self periodic-writecache $write_interval }
	set a [lindex $addrs_ 0]
	if {$a == ""} {
		set announce_file_ ""
	} else {
		set if [[$a set snet_] interface]
		set announce_file_ [file join $dir announce-$if]
	}
	if [file readable $announce_file_] {
		$self instvar sdp_
		set fp [open $announce_file_ r]
		set msgs [$sdp_ parse [read $fp]]
		close $fp
		file delete $announce_file_
		foreach m $msgs {
			set p [new Program $m]
			$self announce $p
		}
	}
}
ProgramSource/SAP public destroy {} {
	$self next
	$self instvar addrs_
	foreach a $addrs_ { delete $a }
}
ProgramSource/SAP public name {} {
	return "SAP: Global"
}
ProgramSource/SAP public scopes {} {
	return [$self set scopes_]
}
ProgramSource/SAP public recv {child addr port data size} {
	$self instvar progs_
	set old [array size progs_]
	set objs [$self next $data]
	$child incrnsrcs [expr [array size progs_] - $old]
	$child sample_size $size
	$self instvar progs_ timeouts_
	foreach o $objs {
		set t [expr 10 * [$child interval 0]]
		if {$t < 1800} { set t 1800 }
		$self timeout $o $t
	}
}
ProgramSource/SAP private timestamp-gt {a b} {
	if {$b == 0} { return 1 }
	if {$a > 0 && $b < 0} { return 0 }
	return [expr $a > $b]
}
ProgramSource/SAP public announce {prog} {
	$self instvar announce_file_ rcvr_
	foreach msg [$prog set msgs_] {
		set al [$self alof $msg]
		$al start $msg
		if {$announce_file_ != ""} {
			if [catch {set fp [open $announce_file_ a]} m] {
				$self warn "couldn't open announcements file\
						for writing: $m"
				continue
			}
			puts $fp [$msg set msgtext_]
			close $fp
		}
	}
	$rcvr_ addprog $self $prog
	set end 0
	foreach t [[$prog base] set alltimedes_] {
		set newend [$t set endtime_]
		if [$self timestamp-gt $newend $end] { set end $newend }
	}
	if {$end != 0} {
		set wait [expr $end - 2208988800 - [clock seconds]]
		if {$wait <= 0} {
			$self stop-announce $prog
		} else {
			after [expr int($wait * 1000)] "$self stop-announce $prog"
		}
	}
}
ProgramSource/SAP public stop-announce {prog} {
	$self instvar announce_file_ sdp_ rcvr_
	foreach msg [$prog set msgs_] {
		set al [$self alof $msg]
		$al stop $msg
		set backup $announce_file_
		append backup "~"
		file delete $backup
		set backup_good 1
		if {[catch {file copy $announce_file_ $backup} m] \
				|| [catch {set fp [open $backup r]} m] \
				|| [catch {set fp2 [open $announce_file_ w]} m]} {
			$self warn "couldn't fix announcement file: $m"
			set backup_good 0
			continue
		}
		set buffer ""
		while { ![eof $fp] } {
			set line [gets $fp]
			if {![eof $fp] && [string compare $line "v=0"] != 0} {
				append buffer $line
				append buffer \n
				continue
			}
			if {[string trim $buffer] != ""} {
				set msg2 [$sdp_ parse $buffer]
				if {[$msg unique_key] != [$msg2 unique_key]} {
					puts $fp2 $buffer
				}
				delete $msg2
			}
			set buffer $line
			append buffer \n
		}
		close $fp
		close $fp2
		if {![file size $announce_file_]} {
			file delete $announce_file_
		}
		if {$backup_good} {
			file delete $backup
		}
	}
	$rcvr_ removeprog $self $prog
}
ProgramSource/SAP private alof {msg} {
	$self instvar scopes_ addrs_
	if [$msg have_field c] {
		set addr [$msg set caddr_]
	} else {
		set media [lindex [$msg set allmedia_] 0]
		set addr [$media set caddr_]
	}
	set addr [lindex [split $addr /] 0]
	set i 0
	set found 0
	set len [llength $scopes_]
	while {$i < $len} {
		set scope [lindex $scopes_ $i]
		if [$scope contains $addr] {
			set found 1
			break
		}
		incr i
	}
	if {$found == 0} {
		$self fatal "Program/SAP got address ($addr) not in any known scope"
	}
	return [lindex $addrs_ $i]
}
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 MeGa
MeGa instproc init args {
	eval $self next $args
	$self set sdp_ [new SDPParser]
}
MeGa instproc destroy {} {
	$self instvar sdp_
	delete $sdp_
	$self next
}
MeGa proc ctrlchan { media spec } {
	set tmp [split $spec /]
	set addr [lindex $tmp 0]
	if ![in_multicast $addr] {
		return $spec
	}
	set port [lindex $tmp 1]
	switch $media {
	video {
		incr port 2
	}
	audio {
		incr port 4
	}
	mb {
		incr port 6
	}
	sdp {
		incr port 8
	}
	hm {
		incr port 10
	}
	}
	set ttl [lindex $tmp 2]
	return $addr/$port/$ttl
}
Class AnnounceListenManager/AS/Client/MeGa \
		-superclass { AnnounceListenManager/AS/Client MeGa }
Class AnnounceListenManager/AS/Client/MeGa/Audio \
	-superclass { AnnounceListenManager/AS/Client/MeGa RTP/Audio }
Class AnnounceListenManager/AS/Client/MeGa/Video \
	-superclass { AnnounceListenManager/AS/Client/MeGa RTP/Video }
AnnounceListenManager/AS/Client/MeGa instproc init { agent spec bw toolname media sname sspec rportspec ofmt srv_loc } {
	set spec [MeGa ctrlchan $media $spec]
	$self next $spec $bw $srv_loc
	$self instvar agent_ toolname_ sname_ sspec_ media_ rportspec_ ofmt_
	set toolname_ $toolname
	set media_ $media
	set sname_ $sname
	set sspec_ $sspec
	set rportspec_ $rportspec
	set ofmt_ $ofmt
	set agent_ $agent
	$self instvar srv_inst_
	[$self get_timer] threshold 15000
	set srv_inst_ [$self service_instance]
}
AnnounceListenManager/AS/Client/MeGa instproc reset_spec {sspec} {
    $self instvar sspec_ srv_inst_ index_
    set sspec_ $sspec
    set rand [random]
    set index_ $rand
    set srv_inst_ [$self service_instance]
}
AnnounceListenManager/AS/Client/MeGa instproc recv_msg { atype aspec addr srv_name srv_loc srv_inst ssg_port msg } {
	if { $atype != "srv" } {
		return
	}
	$self instvar agent_ srv_inst_
	if { $srv_inst_ != $srv_inst } {
		return
	}
	$self instvar sdp_
	set msg [$sdp_ parse $msg]
	if { $msg == "" } {
		return
	}
	if [$agent_ have_network] {
		set addr [$agent_ session-addr]
		set sport [$agent_ session-sport]
		set rport [$agent_ session-rport]
		set ttl [$agent_ session-ttl]
		set curspec $addr/$sport:$rport/$ttl
	} else {
		set curspec ""
		set ttl -1
	}
	set media [$msg set allmedia_]
	$self instvar media_ rportspec_
	foreach mrec [$msg set allmedia_] {
		if [$mrec have_attr global] {
			continue
		}
		set tmp [split [$mrec set caddr_] /]
		set laddr [lindex $tmp 0]
		set lttl [lindex $tmp 1]
		set pspec [split [$mrec set port_] :]
		set sport [lindex $pspec 0]
		set rport [lindex $pspec 1]
		set myrport [lindex [split $rportspec_ :] 0]
		if { ([in_multicast $laddr] && $myrport == 0) || \
		     ($laddr == [localaddr] && $sport == $myrport) } {
	     		if { ![in_multicast $laddr] } {
				set laddr [$msg set createaddr_]
			}
	     		set newspec $laddr/$rport:$sport/$lttl
			if { $newspec != $curspec } {
				set fmt [$mrec set fmt_]
				set fmt [$self format_name $fmt]
				if { $fmt == "" } {
					set fmt null
				}
				$agent_ reset_spec \
						$laddr/$rport:$sport/$fmt/$lttl
				$self send_announcement
			}
			delete $msg
	     		return
		}
	}
	delete $msg
}
AnnounceListenManager/AS/Client/MeGa private format_name { fmt } {
	return ""
}
AnnounceListenManager/AS/Client/MeGa/Audio private format_name { fmt } {
	return [$self rtp_type $fmt]
}
AnnounceListenManager/AS/Client/MeGa/Video private format_name { fmt } {
	return [$self rtp_type $fmt]
}
AnnounceListenManager/AS/Client/MeGa instproc register { atype aspec addr srv_name srv_inst msg } {
}
AnnounceListenManager/AS/Client/MeGa instproc unregister { atype aspec addr srv_name srv_inst msg } {
}
AnnounceListenManager/AS/Client/MeGa public agent_data {} {
	$self instvar id1_ id2_ agent_ media_ agent_ sname_ sspec_ \
		toolname_ rportspec_ ofmt_
	set o "v=0"
	set n "o=client [pid] 0 IN IP4 [localaddr]"
	set o $o\n$n
	set n "s=$sname_"
	set o $o\n$n
	set n "c=IN IP4 $sspec_"
	set o $o\n$n
	if { $media_ == "video" } {
		set n "b=AS:[$agent_ set sessionbw_]"
		puts "!!SESSIONBW $n"
		set o $o\n$n
		set n "t=0 0"
		set o $o\n$n
		if { [$self get_option localScubaScope] != "" } {
			set n "a=localscuba"
			set o $o\n$n
		}
	} else  {
		set n "t=0 0"
		set o $o\n$n
	}
	set n "a=tool:$toolname_"
	set o $o\n$n
	set fmt [$self format_num $ofmt_]
	set rportspec [split $rportspec_ :]
	set rport [lindex $rportspec 0]
	set n "m=$media_ $rport RTP/AVP $fmt"
	set o $o\n$n
	if [$agent_ have_network] {
		set addr [$agent_ session-addr]
		set sport [$agent_ session-sport]
		set rport [$agent_ session-rport]
		set ttl [$agent_ session-ttl]
		set n "c=IN IP4 $addr/$sport:$rport/$ttl"
	} else {
		set n "c=IN IP4 none"
	}
	set o $o\n$n
	return $o
}
AnnounceListenManager/AS/Client/MeGa private format_num { fmt } {
	return -1
}
AnnounceListenManager/AS/Client/MeGa/Video private format_num { fmt } {
	return [$self rtp_fmt_number $fmt]
}
AnnounceListenManager/AS/Client/MeGa/Audio private format_num { fmt } {
	return [$self rtp_fmt_number $fmt]
}
AnnounceListenManager/AS/Client/MeGa instproc service_name {} {
	return MeGa
}
AnnounceListenManager/AS/Client/MeGa instproc service_instance {} {
	$self instvar sname_ rportspec_ media_ index_
	set o $sname_:$media_
	set rportspec [split $rportspec_ :]
	set rport [lindex $rportspec 0]
	if { $rport != 0 } {
		set o $o:[localaddr]/$rport
	    if {[info exists index_]} {
		set o $o:$index_
	    }
	}
	return $o
}
AnnounceListenManager/AS/Client/MeGa instproc agent_instance {} {
    $self instvar index_
    if {[info exists index_]} {
	return "[pid]@[lookup_host_name [localaddr]]:$index_"
    } else {
	return "[pid]@[lookup_host_name [localaddr]]"
    }
}
AnnounceListenManager/AS/Client/MeGa instproc ssg_port {} {
	$self instvar rportspec_
	set rportspec [split $rportspec_ :]
	set rport [lindex $rportspec 0]
	if { $rport != 0 } {
		return [lindex $rportspec 1]
	} else {
		return "-"
	}
}
Class AnnounceListenManager/SAP/MeGa -superclass AnnounceListenManager/SAP
AnnounceListenManager/SAP/MeGa public init {s spec {mtu 2048} } {
    $self next $spec $mtu
    $self set s_ $s
}
AnnounceListenManager/SAP/MeGa private recv_announcement {args} {
    $self instvar s_
    eval $s_ recv $self $args
}
AnnounceListenManager/SAP/MeGa private incrnsrcs {args} {}
AnnounceListenManager/SAP/MeGa private sample_size {args} {}
AnnounceListenManager/SAP/MeGa private interval {args} { return 0 }
Class ProgramSource/SAP/MeGa -superclass ProgramSource/SAP
ProgramSource/SAP/MeGa public init {ui addr} {
    $self set name_ "MeGa Proxy: $addr"
    set addr [intoa [lookup_host_addr $addr]]
    set d [$self get_option cachedir]
    if {$d != ""} {
	$self set cache_ [file join $d $addr]
    }
    eval $self next $ui
    $self instvar app_
    set app_ [Application instance]
    $self instvar bw_
    set bw_ [$app_ get_option megaBW]
    set bw [expr 0.02 * $bw_]
    set spec "$addr/60000:10002/1"
    $app_ add_default megaStartupWait 60
    set sname sdp:0:0:IN:IP4:224.2.127.254
    set sspec 224.2.127.254/9875/127
    $app_ add_default megaCtrl $spec
    set rportspec 10000:10002
    $self instvar al_
    set loc [$self get_option serviceLocation]
    set al_ [new AnnounceListenManager/AS/Client/MeGa $self \
		 $spec $bw Nsdr sdp $sname $sspec $rportspec null $loc]
    $al_ start
}
ProgramSource/SAP/MeGa public name {} {
    return [$self set name_]
}
ProgramSource/SAP/MeGa public reset_spec {spec} {
    set l [split $spec /]
    $self instvar addr_ sport_ rport_ ttl_
    set addr_ [lindex $l 0]
    set ports [split [lindex $l 1] :]
    set sport_ [lindex $ports 0]
    set rport_ [lindex $ports 1]
    set ttl_ [lindex $l 3]
    $self instvar addrs_
    foreach a $addrs_ {
	delete $a
    }
    set addrs_ {}
    set s $addr_/$sport_:$rport_/$ttl_
    lappend addrs_ [new AnnounceListenManager/SAP/MeGa $self $s]
}
ProgramSource/SAP/MeGa public scopes {} {
    return {}
}
ProgramSource/SAP/MeGa instproc have_network {} {
    $self instvar addr_
    return [info exists addr_]
}
ProgramSource/SAP/MeGa instproc session-addr {} {
    $self instvar addr_
    return $addr_
}
ProgramSource/SAP/MeGa instproc session-sport {} {
    $self instvar sport_
    return $sport_
}
ProgramSource/SAP/MeGa instproc session-rport {} {
    $self instvar rport_
    return $rport_
}
ProgramSource/SAP/MeGa instproc session-ttl {} {
    $self instvar ttl_
    return $ttl_
}
Class TCP
Class TCP/Server -superclass TCP
Class TCP/Client -superclass TCP
TCP public destroy {} {
	$self close
	$self next
}
TCP public shutdown {} {
}
TCP public set_binary { {flag 1} } {
	$self instvar chan_
	if { $flag } {
		fconfigure $chan_ -translation {binary binary}
	} else {
		fconfigure $chan_ -translation {auto auto}
	}
}
TCP public open { chan {blocking 0} } {
	$self instvar chan_
	set chan_ $chan
	fileevent $chan_ readable "$self readable"
	if { $blocking } {
		fconfigure $chan_ -blocking true
	} else {
		fconfigure $chan_ -blocking false
	}
}
TCP public is_open { } {
	$self instvar chan_
	if { [info exists chan_] && ![eof $chan_] } {
		return 1
	}
	return 0
}
TCP public close {} {
	$self instvar chan_
	if [info exists chan_] {
		close $chan_
		unset chan_
	}
}
TCP public channel {} {
	$self instvar chan_
	if [info exists chan_] { return $chan_ } else { return "" }
}
TCP private readable {} {
	$self instvar chan_
	set cnt [gets $chan_ s]
	if { $cnt < 0 } {
		if [eof $chan_] {
			$self close
			$self shutdown
		}
		return
	}
	if { $cnt >= 0 } {
		$self recv $s
	}
}
TCP public send s {
	$self instvar chan_
	puts -nonewline $chan_ $s
	flush $chan_
}
TCP public send_data {} {
	$self instvar chan_ data_
	puts -nonewline $chan_ $data_
	flush $chan_
}
TCP public sendline s {
	$self instvar chan_
	puts $chan_ $s
	flush $chan_
}
TCP public recv s {
}
TCP/Client public init args {
}
TCP/Client public open { host port {blocking 0} } {
	$self instvar chan_
	set chan_ [socket $host $port]
	fileevent $chan_ readable "$self readable"
	if { $blocking } {
		fconfigure $chan_ -blocking true
	} else {
		fconfigure $chan_ -blocking false
	}
}
TCP/Server public open { port {create_channel {}} } {
	$self instvar chan_ client_class_ create_channel_proc_
	set chan_ [socket -server "$self accept" $port]
	if { $create_channel != {} } {
		if { [Class info instances $create_channel]!="" } {
			set client_class_ $create_channel
		} else {
			set create_channel_proc_ $create_channel
		}
	}
}
TCP/Server public close { } {
	$self instvar client_class_ create_channel_proc_
	if [info exists client_class_] {
		unset client_class_
	}
	if [info exists create_channel_proc_] {
		unset create_channel_proc_
	}
	$self next
}
TCP/Server private accept { chan host port } {
	set o [$self create_channel $chan]
}
TCP/Server private create_channel { chan } {
	$self instvar client_class_ create_channel_proc_
	if [info exists create_channel_proc_] {
		eval $create_channel_proc_ $chan
	} elseif [info exists client_class_] {
		set o [new $client_class_]
		$o open $chan
	} else {
		error "must redefine TCP/Server::create_channel in a subclass\
				\nor specify a channel creation mechanism in\
				TCP/Server::open"
	}
}
Class ProgramSource/Proxy -superclass { ProgramSource TCP/Client }
ProgramSource/Proxy public init {ui spec} {
    $self set name_ "Proxy: $spec"
    $self next $ui
    $self instvar cache_
    catch {unset cache_}
    $self set buffer_ ""
    $self connect $spec
}
ProgramSource/Proxy public destroy {} {
    $self next
}
ProgramSource/Proxy public name {} {
    return [$self set name_]
}
ProgramSource/Proxy public scopes {} {
    return {}
}
ProgramSource/Proxy private connect {spec} {
    set l [split $spec /]
    set host [lindex $l 0]
    set port [lindex $l 1]
    $self open $host $port
    $self send "subscribe\n"
}
ProgramSource/Proxy public recv s {
    $self instvar buffer_
    append buffer_ "$s\n"
    if {[string trim $s] == ""} {
	set i [string wordend $buffer_ 0]
	set cmd [string trim [string range $buffer_ 0 $i]]
	set data [string trim [string range $buffer_ $i end]]
	switch $cmd {
	    "add" - "update" {
		$self next $data
	    }
	    "remove" {
		$self instvar progs_
		if ![info exists progs_($data)] {
		    $self warn "got remove for nonexistent prog \"$data\""
		} else {
		    $self remove $progs_($data)
		}
	    }
	    default {
		$self warn "got bogus command \"$cmd\""
	    }
	}
	set buffer_ ""
    }
}
ProgramSource/Proxy public announce {msg scope} {
}
Class AddressAllocator
AddressAllocator public init {} {
    AddressAllocator set instance_ $self
}
AddressAllocator proc instance {} {
    return [AddressAllocator set instance_]
}
AddressAllocator public alloc {zone {n 1}} {
    $self fatal "AddressAllocator::alloc called -- should be overridden in child"
}
Class AddressAllocator/SAP -superclass AddressAllocator
AddressAllocator/SAP public init {source} {
    $self next
    $self set source_ $source
}
AddressAllocator/SAP public alloc {zone {n 1}} {
    $self instvar source_
    set conflict 1
    while {$conflict != 0} {
	set conflict 0
	set base [$self random-addr $zone]
	set addr $base
	for {set i 0} {$i<$n} {incr i} {
	    incr conflict [$self conflict $addr $zone $source_]
	    set addr [$self inet_ntoa [expr [$self inet_addr $addr] + 1]]
	}
    }
    return $addr
}
AddressAllocator/SAP private random-addr {zone} {
    set range [$zone range]
    set l [split $range /]
    set bits [lindex $l 1]
    set mask [expr ~((-1)<<(32 - $bits))]
    set base [expr [$self inet_addr [lindex $l 0]] &~ $mask]
    set addr [expr $base + ([random] & $mask)]
    return [$self inet_ntoa $addr]
}
AddressAllocator/SAP private conflict {addr zone source} {
    set conflict 0
    $source instvar progs_
    foreach p [array names progs_] {
	foreach msg [$progs_($p) set msgs_] {
	    if {[$msg have_field c] && $addr == [$msg set caddr_]} {
		set conflict 1
		break
	    }
	    foreach media [$msg set allmedia_] {
		if {[$media have_field c] && $addr == [$media set caddr_]} {
		    set conflict 1
		    break
		}
	    }
	}
    }
    return $conflict
}
AddressAllocator/SAP private inet_addr {a} {
    set l [split $a .]
    set addr [expr [lindex $l 0] <<24]
    incr addr [expr [lindex $l 1] <<16]
    incr addr [expr [lindex $l 2] <<8]
    incr addr [lindex $l 3]
    return $addr
}
AddressAllocator/SAP private inet_ntoa {n} {
    set a [expr ($n>>24) & 0xff]
    set b [expr ($n>>16) & 0xff]
    set c [expr ($n>>8) & 0xff]
    set d [expr $n & 0xff]
    return "$a.$b.$c.$d"
}
UDPChannel public init { {spec ""} {mtu 1024} } {
	$self next $mtu
	$self instvar net_
	set net_ [new Network]
	$net_ loopback 1
	if {$spec == ""} {
		$net_ open 0
	} elseif [regexp {^[0-9]*$} $spec] {
		$net_ open $spec
	} else {
		set spec [split $spec /]
		set len [llength $spec]
		if { $len<2 || $len>3 } {
			$self fatal "invalid spec \"$spec\"."
		}
		set addr [lindex $spec 0]
		set ports [split [lindex $spec 1] :]
		set ttl 15
		if {$len == 3} {
			set ttl [lindex $spec 2]
		}
		if {[llength $ports] == 1} {
			set port [lindex $ports 0]
			$net_ open $addr $port $ttl
		} else {
			set sport [lindex $ports 0]
			set rport [lindex $ports 1]
			$net_ open $addr $sport $rport $ttl
		}
	}
	$self network $net_
}
UDPChannel public destroy {} {
	$self instvar net_
	delete $net_
	$self next
}
UDPChannel public ttl {t} {
	$self instvar net_
	$net_ ttl $t
}
Class ERSServer -superclass UDPChannel
ERSServer public init {spec} {
	$self next $spec
}
ERSServer private recv {addr port data len} {
	set l [split $data \n]
	set port [lindex $l 0]
	set data [join [lrange $l 1 end] \n]
	set reply [$self build_reply $data]
	$self sendto $addr $port $reply
}
ERSServer private sendto {addr port data} {
	set c [new UDPChannel $addr/$port]
	$c send $data
	delete $c
}
ERSServer public build_reply {data} {
	$self instvar net_
	return [$net_ interface]
}
Class ERSClient -superclass UDPChannel
ERSClient public init {spec} {
	$self next
	$self instvar chan_ timer_ delay_ maxttl_
	set chan_ [new UDPChannel $spec]
	set timer_ ""
	set delay_ 200
	set maxttl_ 63
}
ERSClient public destroy {} {
	$self instvar chan_ timer_
	delete $chan_
	catch {after cancel $timer_}
	$self next
}
ERSClient public search {} {
	$self instvar net_
	set port [$net_ rport]
	set request [$self build_request]
	set pkt "$port\n$request"
	$self send_request $pkt 1
}
ERSClient private send_request {pkt ttl} {
	$self instvar chan_
	$self ttl $ttl
	$chan_ send $pkt
	$self instvar maxttl_ timer_ delay_
	incr ttl
	if {$ttl > $maxttl_} {
		$self response ""
		return
	}
	set timer_ [after $delay_ "$self send_request \"$pkt\" $ttl"]
}
ERSClient public build_request {} {
	return ""
}
ERSClient private recv {addr data len} {
	$self instvar timer_
	after cancel $timer_
	$self response $data
}
ERSClient public response {data} {
	puts "got response \"$data\""
}
Class ERSClient/Sdfor -superclass ERSClient
ERSClient/Sdfor public init {parent scope spec} {
	$self next $spec
	$self instvar parent_ scope_
	set parent_ $parent
	set scope_ $scope
}
ERSClient/Sdfor private response {data} {
	$self instvar parent_ scope_
	$parent_ found_server $scope_ $data
}
Class ProgramAnnouncer -configuration { sdforPort 12000 }
ProgramAnnouncer public init {src} {
	$self instvar src_ scopes_
	set src_ $src
	set scopes_ [$src scopes]
}
ProgramAnnouncer private scopeof {msg} {
	$self instvar scopes_
	if [$msg have_field c] {
		set addr [$msg set caddr_]
	} else {
		set media [lindex [$msg set allmedia_] 0]
		set addr [$media set caddr_]
	}
	set addr [lindex [split $addr /] 0]
	set i 0
	set found 0
	set len [llength $scopes_]
	while {$i < $len} {
		set scope [lindex $scopes_ $i]
		if [$scope contains $addr] {
			set found 1
			break
		}
		incr i
	}
	if {$found == 0} {
		$self fatal "address $addr not in any known scope"
	}
	return $scope
}
ProgramAnnouncer public announce {prog} {
	$self instvar src_
	if ![$self get_option useProxyAnnouncer] {
		$src_ announce $prog
		return
	}
	foreach msg [$prog set msgs_] {
		$self send $msg
	}
}
ProgramAnnouncer private send {msg} {
	$self instvar servers_ ers_ pending_
	set scope [$self scopeof $msg]
	if ![info exists servers_($scope)] {
		if ![info exists ers_($scope)] {
			set spec [split [$scope sapAddr] /]
			set addr [lindex $spec 0]
			set port [lindex $spec 1]
			set ersspec "$addr/[expr $port + 1]"
			set ers [new ERSClient/Sdfor $self $scope $ersspec]
			set ers_($scope) $ers
			$ers search
		}
		if ![info exists pending_($scope)] {
			set pending_($scope) [list $msg]
		} else {
			lappend pending_($scope) [list $msg]
		}
		return
	}
	set l [split $servers_($scope) /]
	set addr [lindex $l 0]
	set port [lindex $l 1]
	set c [new TCP/Client]
	$c open $addr $port
	$c send "advertise [$msg set msgtext_]\n"
	$c close
}
ProgramAnnouncer public found_server {scope data} {
	$self instvar servers_ pending_ ers_
	if {$data == ""} {
		$self warn "didn't find server for [$scope range]"
		return
	}
	set servers_($scope) $data
	if [info exists pending_($scope)] {
		foreach msg $pending_($scope) {
			$self send $msg
		}
	}
	unset pending_($scope)
	delete $ers_($scope)
	unset ers_($scope)
}
Class NsdrApplication -superclass Application
NsdrApplication public init argv {
    $self next nsdr
    global env
    if {![info exists env(HOME)]} {
        new ErrorWindow {Your HOME environment variable must be set.}
        exit 1
    }
    label .label
    set defaultLabelFont [.label cget -font]
    destroy .label
    set o [$self options]
    $self init_args $o
    $self init_resources $o
    set argv [$o parse_args $argv]
	if {[$o get_option userhookFile] != ""} {
		if {[file isfile [$o get_option userhookFile]] && \
			[file readable [$o get_option userhookFile]]} {
			source [$o get_option userhookFile]
		} else {
			puts stderr "Unable to source \"[$o get_option userhookFile]\". Not a file or not readable."
		}
	}
    if {$argv!=""} {
	set dst [split $argv /]
	set n [llength $dst]
	if { $n < 2 } {
	    $self fatal "must specify both address and port in the form addr/port ($s)"
	}
        set addr [lindex $dst 0]
        set port [lindex $dst 1]
        set firstchar [string index $addr 0]
        if [string match \[a-zA-Z\] $firstchar] {
	    set s [gethostbyname $addr]
	    if { $s == "" } {
		$self fatal "cannot lookup host name: $addr"
	    }
	    set addr $s
        }
	if { ![string match \[0-9\]* $port] || $port >= 65536 } {
	    $self fatal "illegal port '$port'"
	}
	set octets [split $addr .]
	set n [llength $octets]
	if { $n != 4 } {
	    puts "invalid address (not IP4)"
	    $self fatal "invalid address (not IP4)"
	}
	set first 1
	foreach octet $octets {
	    if {$first == 1} {
		if {$octet <224 || $octet >239} {
		    puts "not in class D multicast"
		    $self fatal "not in class D multicast"
		}
		set first 0
	    } else {
		if {$octet <0 || $octet>255} {
		    puts "invalid addr: not 8-byte"
		    $self fatal "invalid addr: not 8-byte"
		}
	    }
	}
	$o add_default SAPaddress $addr
	$o add_default SAPport $port
    }
    wm withdraw .
    toplevel .startup
    wm title .startup [winfo name .]
    label .startup.label -text {Starting up...} -font $defaultLabelFont
    pack .startup.label -fill both -expand true
    update
    $self init_local
    UserApplication init_apps
    $self init_ui
    $self init_sap
    $self init_proxy
    $self init_mega
    $self instvar ui_
    if {[llength [$ui_ set sources_]] == 0} {
	puts stderr "No program sources..."
	exit 1
    }
    $self user_hook
    destroy .startup
    wm deiconify .
}
NsdrApplication instproc init_args o {
	$o register_option -a extraAppFiles
	$o register_option -u userhookFile
    	$o register_option -usemega megaAddrs
	$o register_option -sloc serviceLocation
        $o register_option -sapAdr SAPaddress
        $o register_option -sapPrt SAPport
	$o register_boolean_option -simple simpleInterface
	foreach a "SAP Mega Scuba Proxy" {
	    	$o register_boolean_option -use$a use$a
		$o register_boolean_option -no$a use$a 0
	}
}
NsdrApplication instproc init_resources o {
    $o load_preferences "nsdr"
    global env
    $o add_default cachedir [file join $env(HOME) .mash nsdr-cache]
    $o add_default cacheWriteInterval 300
    $o add_default useSAP 1
    $o add_default SAPaddress 224.2.127.254
    $o add_default SAPport 9875
    $o add_default sapZones 224.2.128.0/17,239.255.0.0/16
    $o add_default sapTTL 255
    $o add_default useProxy 0
    $o add_default proxyLocation quimby.cs.berkeley.edu/12000
    $o add_default useProxyAnnouncer 0
    $o add_default simpleInterface 0
    $o add_default alarmLead 300
    $o add_default webbrowser xm
    $o add_default unifiedVic 0
    set filename [file join $env(HOME) .mash nsdr-apps.tcl]
    if {![file exists $filename]} {
        set filename {}
    }
    $o add_default appFiles $filename
    $o add_default useMega 0
    $o add_default megaBW 128000
    $o add_default megaStartupBW 64000
    $o add_default megaMaxBW 128000
    $o add_default asCtrl 224.4.5.24/50000/31
    $o add_default asCtrlBW 20000
    $o add_default serviceLocation static:sdgw
    $o add_default foundry adobe
    set foundry [$o get_option foundry]
    set helv10 [$self search_font $foundry helvetica medium 10 r]
    set helv10b [$self search_font $foundry helvetica bold 10 r]
    set helv10o [$self search_font $foundry helvetica bold 10 o]
    set helv12b [$self search_font $foundry helvetica bold 12 r]
    set times14 [$self search_font $foundry times medium 14 r]
    $o add_default medfont $helv12b
    $o add_default smallfont $helv10b
    $o add_default entryFont $helv10
    $o add_default helpFont $times14
    option add *Font [$self get_option medfont] startupFile
    option add *Button.Font [$self get_option smallfont] startupFile
    option add *Checkbutton.Font [$self get_option smallfont] startupFile
    option add *Label.Font [$self get_option smallfont] startupFile
    option add *Listbox.Font [$self get_option smallfont] startupFile
    option add *Menu.Font [$self get_option smallfont] startupFile
    option add *Menubutton.Font [$self get_option smallfont] startupFile
    option add *Message.Font [$self get_option smallfont] startupFile
    option add *Entry.Font [$self get_option entryFont] startupFile
    option add *Entry.Background white
    option add *padX 2
    option add *padY 2
    set name [$self get_option nsdrName]
    set phone [$self get_option nsdrPhone]
    if {$name == "" || $phone == ""} {
	$self run_resource_dialog $name $phone
    }
}
NsdrApplication private run_resource_dialog {name phone} {
    set w .form
    frame $w
    frame $w.msg -relief ridge
    label $w.msg.label -font [$self get_option medfont] \
	-wraplength 4i -justify left \
	-text "Please specify values for the following resources. \
These strings will identify you and give your phone number in \
outgoing session announcements that you create.  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 phone} {
	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
    }
    if {"[$self get_option rtpName]" != ""} {
	$w.name.entry insert end [$self get_option rtpName]
    }
    $w.name.label config -text Name:
    $w.phone.label config -text Phone:
    pack $w.msg -pady 10
    pack $w.name $w.phone -side top -fill x
    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 phone [string trim [$w.phone.entry get]]
	if { [string length $phone] <= 10} {
	    new ErrorWindow "please enter a complete phone number"
	    continue
	}
	break
    }
    $self add_option nsdrName $name
    $self add_option nsdrPhone $phone
    global env
	set mash [file join $env(HOME) .mash]
    if {![file exists $mash]} {
        file mkdir $mash
    }
    set f [open [file join $mash prefs-nsdr] a+ 0644]
    puts $f "nsdrName: $name"
    puts $f "nsdrPhone: $phone"
    close $f
    unset dialogDone
    pack forget $w
    destroy $w
}
NsdrApplication instproc init_ui {} {
    pack [frame .f] -fill both -expand yes
    $self set ui_ [new NsdrUI .f $self]
    wm geometry . 300x500
    wm protocol . WM_DELETE_WINDOW "$self exit"
}
NsdrApplication instproc init_sap {} {
    if ![$self yesno useSAP] {
	return
    }
    set zones {}
    foreach zone [split [$self get_option sapZones] ","] {
	lappend zones [new ScopeZone $zone]
    }
    $self instvar ui_
    set s [eval new ProgramSource/SAP $ui_ $zones]
    $self instvar allocator_
    set allocator_ [new AddressAllocator/SAP $s]
    $self instvar announcer_
    set announcer_ [new ProgramAnnouncer $s]
    $self instvar sources_
    lappend sources_ $s
}
NsdrApplication private init_proxy {} {
    if ![$self yesno useProxy] {
	return
    }
    $self instvar sources_ ui_
    set spec [$self get_option proxyLocation]
    lappend sources_ [new ProgramSource/Proxy $ui_ $spec]
}
NsdrApplication instproc init_mega {} {
    if { [$self get_option megaAddrs] != "" } {
	$self instvar source_ ui_
	foreach addr [split [$self get_option megaAddrs] ","] {
	    set s [new ProgramSource/SAP/MeGa $ui_ $addr]
	    $self instvar sources_
	    lappend sources_ $s
	}
    }
}
NsdrApplication instproc gourl {url} {
    set browser [$self get_option webbrowser]
    catch {exec $browser $url &}
}
NsdrApplication instproc exit {} {
    $self instvar sources_
    foreach s $sources_ {
	$s shutdown
    }
    exit
}
new NsdrApplication $argv
