openbsd-ports/mbone/sdr/patches/patch-sdr_src_sdr_tcl

1037 lines
43 KiB
Plaintext
Raw Normal View History

$OpenBSD: patch-sdr_src_sdr_tcl,v 1.1 2001/03/17 17:33:20 wilfried Exp $
--- sdr/src/sdr.tcl.orig Fri Jul 16 18:16:52 1999
+++ sdr/src/sdr.tcl Fri Mar 16 20:55:41 2001
@@ -92,7 +92,20 @@ proc getreadabletime {} {
set sdrversion "v2.7e"
set titlestr "Multicast Session Directory $sdrversion"
+# return the 'current window' (usually ".w0", unless we're updating a subdir):
+set lastWindowNum 0
+set currentWindow .w[set lastWindowNum]
+proc cw {} {
+ global currentWindow
+ return $currentWindow
+}
+proc setcw {w} {
+ global currentWindow
+ set currentWindow $w
+}
+
proc initialise_resources {} {
+ wm withdraw .
global gui tcl_platform
if {$gui=="NO_GUI"} { return }
#Tk4.0 standard bg
@@ -219,44 +232,53 @@ proc scroll_to_session {key list} {
$sessbox($list) see $i.0
}
-proc build_interface {first} {
+proc build_interface {first {dirName {}}} {
global tcl_platform ifstyle gui sessbox
global logfile argv0 argv
if {$gui=="NO_GUI"} { return }
log "Sdr started by [getusername] at [getreadabletime]"
set lb $ifstyle(labels)
global titlestr
- wm title . "sdr:[getemailaddress]"
- wm iconname . "sdr:[getemailaddress]"
- wm iconbitmap . sdr
- wm group . .
- wm command . [concat $argv0 $argv]
- wm protocol . WM_DELETE_WINDOW quit
- if {$first=="first"} {
+ if {$first=="first"} {
set tmpfile [clock format [clock seconds] -format {%H%M%S}]
set logfile "[glob -nocomplain [resource sdrHome]]/log$tmpfile.txt"
# puts "debug - logfile will be $logfile"
set startlogtime "[clock format [clock seconds]]"
putlogfile "logfile started at $startlogtime"
+ }
- frame .f1 -relief groove -borderwidth 2
-# label .f1.l2 -bitmap ucl
-# pack .f1.l2 -side left -fill x
- label .f1.l -text $titlestr -width 32
- pack .f1.l -side left -fill x
- frame .f2 -relief sunken -borderwidth 2
- label .f2.l -text "Public Sessions" -font [option get . infoFont Sdr] \
+ set isNewWindow [expr {![info exists [cw]]}]
+ if {$isNewWindow} {
+ toplevel [cw]
+ wm protocol [cw] WM_DELETE_WINDOW [list handleWindowClose [cw]]
+ wm protocol [cw] WM_SAVE_YOURSELF [list quit [cw]]
+
+ global sd_sess
+ if {$dirName != {}} {set dirName " ($dirName)"}
+ wm title [cw] "sdr[set dirName]:[getemailaddress]"
+ wm iconname [cw] "sdr[set dirName]:[getemailaddress]"
+ wm iconbitmap [cw] sdr
+ wm group [cw] [cw]
+ wm command [cw] [concat $argv0 $argv]
+
+ frame [cw].f1 -relief groove -borderwidth 2
+# label [cw].f1.l2 -bitmap ucl
+# pack [cw].f1.l2 -side left -fill x
+ label [cw].f1.l -text $titlestr -width 32
+ pack [cw].f1.l -side left -fill x
+ frame [cw].f2 -relief sunken -borderwidth 2
+ label [cw].f2.l -text "Public Sessions" -font [option get [cw] infoFont Sdr] \
-relief raised -borderwidth 1
- pack .f2.l -side top -fill x
- text .f2.lb -width 20 -height 15 -yscroll ".f2.sb set" \
+ pack [cw].f2.l -side top -fill x
+ text [cw].f2.lb -width 20 -height 15 -yscroll "[cw].f2.sb set" \
-relief flat -wrap none\
-selectforeground [resource activeForeground] \
-selectbackground [resource activeBackground] \
-highlightthickness 0
- init_session_list norm .f2.lb
+ init_session_list [cw].norm [cw].f2.lb
- scrollbar .f2.sb -command ".f2.lb yview" \
+ scrollbar [cw].f2.sb -command "[cw].f2.lb yview" \
-background [resource scrollbarForeground] \
-troughcolor [resource scrollbarBackground] \
-borderwidth 1 -relief flat \
@@ -264,104 +286,104 @@ proc build_interface {first} {
- pack .f2.lb -side left -fill both -expand true
- pack .f2.sb -side right -fill y
+ pack [cw].f2.lb -side left -fill both -expand true
+ pack [cw].f2.sb -side right -fill y
- frame .f4 -relief sunken -borderwidth 2
- label .f4.l -text "Private Sessions" \
- -font [option get . infoFont Sdr] \
+ frame [cw].f4 -relief sunken -borderwidth 2
+ label [cw].f4.l -text "Private Sessions" \
+ -font [option get [cw] infoFont Sdr] \
-relief raised -borderwidth 1
- pack .f4.l -side top -fill x
- text .f4.lb -width 20 -height 3 -yscroll ".f4.sb set" \
+ pack [cw].f4.l -side top -fill x
+ text [cw].f4.lb -width 20 -height 3 -yscroll "[cw].f4.sb set" \
-relief flat -wrap none \
-selectforeground [resource activeForeground] \
-selectbackground [resource activeBackground] \
-highlightthickness 0
- init_session_list priv .f4.lb
- scrollbar .f4.sb -command ".f4.lb yview" \
+ init_session_list [cw].priv [cw].f4.lb
+ scrollbar [cw].f4.sb -command "[cw].f4.lb yview" \
-background [resource scrollbarForeground] \
-troughcolor [resource scrollbarBackground] \
-borderwidth 1 -relief flat \
-highlightthickness 0
- pack .f4.lb -side left -fill both -expand true
- pack .f4.sb -side right -fill y
+ pack [cw].f4.lb -side left -fill both -expand true
+ pack [cw].f4.sb -side right -fill y
} else {
- destroy .f3
+ destroy [cw].f3
}
- frame .f3
- menubutton .f3.new -relief raised -menu .f3.new.m \
+ frame [cw].f3
+ menubutton [cw].f3.new -relief raised -menu [cw].f3.new.m \
-padx 0 -pady 1 -borderwidth 1 -highlightthickness 0 -takefocus 1
- menu .f3.new.m -tearoff 0
- .f3.new.m add command -label [tt "Create advertised session"] \
- -command {new new}
- .f3.new.m add command -label [tt "Quick Call"] -command {qcall}
+ menu [cw].f3.new.m -tearoff 0
+ [cw].f3.new.m add command -label [tt "Create advertised session"] \
+ -command [list new new [cw]]
+ [cw].f3.new.m add command -label [tt "Quick Call"] -command {qcall}
- button .f3.cal -relief raised -command {calendar} \
+ button [cw].f3.cal -relief raised -command [list calendar [cw]] \
-padx 0 -pady 1 -borderwidth 1 -highlightthickness 0
- tixAddBalloon .f3.cal Button [tt "Display a calendar listing booked sessions"]
+ tixAddBalloon [cw].f3.cal Button [tt "Display a calendar listing booked sessions"]
- button .f3.prefs -relief raised -command {preferences2} \
+ button [cw].f3.prefs -relief raised -command [list preferences2 [cw]] \
-padx 0 -pady 1 -borderwidth 1 -highlightthickness 0
- tixAddBalloon .f3.prefs Button [tt "Set the way sdr does things"]
+ tixAddBalloon [cw].f3.prefs Button [tt "Set the way sdr does things"]
#AUTH
- menubutton .f3.help -relief raised -menu .f3.help.m \
+ menubutton [cw].f3.help -relief raised -menu [cw].f3.help.m \
-padx 0 -pady 1 -borderwidth 1 -highlightthickness 0 -takefocus 1
- menu .f3.help.m -tearoff 0
- .f3.help configure -text [tt "Help"]
+ menu [cw].f3.help.m -tearoff 0
+ [cw].f3.help configure -text [tt "Help"]
#AUTH
- .f3.help.m add command -label [tt "sdr Help"] \
- -command {help}
- #tixAddBalloon .f3.help.m Button "Turn these help messages on and off"
- .f3.help.m add command -label [tt "key setup"] -command {Help_asym asym_help}
+ [cw].f3.help.m add command -label [tt "sdr Help"] \
+ -command [list help [cw]]
+ #tixAddBalloon [cw].f3.help.m Button "Turn these help messages on and off"
+ [cw].f3.help.m add command -label [tt "key setup"] -command {Help_asym asym_help}
- # button .f3.help -text [tt "Help"] -relief raised -command {help} \
+ # button [cw].f3.help -text [tt "Help"] -relief raised -command [list help [cw]] \
# -padx 0 -pady 1 -borderwidth 1 -highlightthickness 0
- # button .f3.help -text [tt "Help"] -relief raised -command {help} \
+ # button [cw].f3.help -text [tt "Help"] -relief raised -command [list help [cw]] \
# -padx 0 -pady 1 -borderwidth 1 -highlightthickness 0
-# tixAddBalloon .f3.help Button "Turn these help messages on and off"
+# tixAddBalloon [cw].f3.help Button "Turn these help messages on and off"
- button .f3.quit -text [tt "Quit"] -relief raised -command quit \
+ button [cw].f3.quit -text [tt "Quit"] -relief raised -command [list quit [cw]] \
-padx 0 -pady 1 -borderwidth 1 -highlightthickness 0
- tixAddBalloon .f3.quit Button [tt "Quit from sdr. Conference tools already running will continue."]
+ tixAddBalloon [cw].f3.quit Button [tt "Quit from sdr. Conference tools already running will continue."]
if {$lb=="short"} {
- .f3.new configure -text [tt "New"]
- .f3.cal configure -text [tt "Calendar"]
- .f3.prefs configure -text [tt "Prefs"]
+ [cw].f3.new configure -text [tt "New"]
+ [cw].f3.cal configure -text [tt "Calendar"]
+ [cw].f3.prefs configure -text [tt "Prefs"]
} else {
- .f3.new configure -text " [tt "Create Session"] "
- .f3.cal configure -text " [tt "Daily Listings"] "
- .f3.prefs configure -text " [tt "Preferences"] "
- .f3.help configure -text " [tt Help] "
- .f3.quit configure -text " [tt Quit] "
+ [cw].f3.new configure -text " [tt "Create Session"] "
+ [cw].f3.cal configure -text " [tt "Daily Listings"] "
+ [cw].f3.prefs configure -text " [tt "Preferences"] "
+ [cw].f3.help configure -text " [tt Help] "
+ [cw].f3.quit configure -text " [tt Quit] "
}
- hlfocus .f3.new
- hlfocus .f3.cal
- hlfocus .f3.prefs
- hlfocus .f3.help
- hlfocus .f3.quit
+ hlfocus [cw].f3.new
+ hlfocus [cw].f3.cal
+ hlfocus [cw].f3.prefs
+ hlfocus [cw].f3.help
+ hlfocus [cw].f3.quit
- pack .f3.new -side left -fill both -pady 0 -expand true
- pack .f3.cal -side left -fill both -pady 0 -expand true
- pack .f3.prefs -side left -fill both -pady 0 -expand true
- pack .f3.help -side left -fill both -pady 0 -expand true
- pack .f3.quit -side left -fill both -pady 0 -expand true
- if {$first=="first"} {
- pack .f3 -side top -fill x
- pack .f1 -side bottom -fill x
- pack .f2 -side top -fill both -expand true
- bind_listbox norm
- bind_listbox priv
+ pack [cw].f3.new -side left -fill both -pady 0 -expand true
+ pack [cw].f3.cal -side left -fill both -pady 0 -expand true
+ pack [cw].f3.prefs -side left -fill both -pady 0 -expand true
+ pack [cw].f3.help -side left -fill both -pady 0 -expand true
+ pack [cw].f3.quit -side left -fill both -pady 0 -expand true
+ if {$isNewWindow} {
+ pack [cw].f3 -side top -fill x
+ pack [cw].f1 -side bottom -fill x
+ pack [cw].f2 -side top -fill both -expand true
+ bind_listbox [cw].norm
+ bind_listbox [cw].priv
} else {
- pack .f3 -side top -before .f2 -fill x
+ pack [cw].f3 -side top -before [cw].f2 -fill x
}
}
@@ -378,7 +400,7 @@ proc bind_listbox {list} {
bind $lb <B2-Motion> {break}
bind $lb <B2-Leave> {break}
bind $lb <Enter> "focus $lb"
- bind $lb <Leave> "focus ."
+ bind $lb <Leave> "focus [cw]"
bind $lb <KeyPress> "scroll_to_session %K $list; break"
tixAddBalloon $lb Listbox "Click button 1 on a listed session for more information on it or to participate in it.
@@ -428,8 +450,9 @@ all this lot is obsolete...
bind $lb j {tkListboxUpDown %W 1}
}
-proc quit {} {
+proc quit {w} {
global log
+ setcw $w
give_status_msg "Writing cache files..."
update idletasks
write_cache
@@ -439,10 +462,26 @@ proc quit {} {
destroy .
}
+proc handleWindowClose {w} {
+ global windowForGroupPort
+ foreach gp [array names windowForGroupPort] {
+ if {[string compare $windowForGroupPort($gp) $w] == 0} {
+ unset windowForGroupPort($gp)
+ }
+ }
+
+ # If there are no longer any windows open, quit
+ if {[array size windowForGroupPort] == 0} {
+ quit $w
+ }
+
+ catch {destroy $w}
+}
+
proc give_status_msg {text} {
global titlestr
- .f1.l configure -text $text -font [option get . italfont Sdr]
- after 2000 .f1.l configure -text \"$titlestr\" -font [option get . font Sdr]
+ [cw].f1.l configure -text $text -font [option get [cw] italfont Sdr]
+ after 2000 [cw].f1.l configure -text \"$titlestr\" -font [option get [cw] font Sdr]
}
set fullnumitems 0
@@ -787,7 +826,21 @@ proc add_to_list {} {
set ldata($aid,medianum) 0
}
set medianum 0
+
+ # Display the session, but first make sure we use the right window for it:
+ global windowForGroupPort
+ if {![catch {set w $windowForGroupPort($recvsap_addr,$recvsap_port)}]} {
+ set oldCW [cw]
+ setcw $w
display_session $aid $code
+ setcw $oldCW
+ } else {
+ # There's no window for this (group,port) now, but there may be later,
+ # so save this entry for later:
+ global entryForGroupPort
+ set entryForGroupPort($recvsap_addr,$recvsap_port,$aid) $aid
+ }
+
# set tfrom 0
# set tto 0
}
@@ -824,12 +877,12 @@ proc display_session {aid code} {
#actually display it
#AUTH
if {$ldata($aid,key)!=""} {
- add_to_display_list $aid priv
+ add_to_display_list $aid [cw].priv
} else {
if { ($ldata($aid,enctype) == "x509")||($ldata($aid,enctype) == "pgp") } {
- add_to_display_list $aid priv
+ add_to_display_list $aid [cw].priv
} else {
- add_to_display_list $aid norm
+ add_to_display_list $aid [cw].norm
}
}
@@ -853,7 +906,7 @@ proc add_to_display_list {aid list} {
#check if it's already displayed
foreach index [array names ix] {
- if {[string compare "[string range $index 0 3],$ix($index)" "$list,$aid"]==0} {
+ if {[string compare "[lindex [split $index ,] 0],$ix($index)" "$list,$aid"]==0} {
debug "session already displayed - why are we here?"
return 0
}
@@ -912,6 +965,8 @@ proc add_to_display_list {aid list} {
proc list_session {aid lastix list} {
global sessbox ldata ifstyle
+ if {![winfo exists $sessbox($list)]} return
+
#puts "$ldata($aid,session)"
set newname $ldata($aid,session)
if {$ldata($aid,trust)!="sip"} {
@@ -938,12 +993,12 @@ proc list_session {aid lastix list} {
-bitmap [get_type_icon $ldata($aid,type) $autht $enct] \
-borderwidth 2 -relief groove
bind $sessbox($list).win$aid <Enter> \
- "highlight_tag $aid enter"
+ "setcw [cw]; highlight_tag $aid enter"
bind $sessbox($list).win$aid <Leave> \
- "highlight_tag $aid leave"
- bind $sessbox($list).win$aid <1> "toggle_popup $aid"
- bind $sessbox($list).win$aid <2> "start_all $aid"
- bind $sessbox($list).win$aid <3> "hide_session $aid"
+ "setcw [cw]; highlight_tag $aid leave"
+ bind $sessbox($list).win$aid <1> "setcw [cw]; toggle_popup $aid"
+ bind $sessbox($list).win$aid <2> "setcw [cw]; start_all $aid"
+ bind $sessbox($list).win$aid <3> "setcw [cw]; hide_session $aid"
}
#puts "$sessbox($list) window create ..."
$sessbox($list) window create [expr $lastix+1].0 -window \
@@ -956,31 +1011,31 @@ proc list_session {aid lastix list} {
# PCs will crash here if the scrollbar is being used at the same time.....
$sessbox($list) tag add t$aid [expr $lastix+1].0 [expr $lastix+1].end
- $sessbox($list) tag bind t$aid <1> "toggle_popup $aid"
- $sessbox($list) tag bind t$aid <2> "start_all $aid"
- $sessbox($list) tag bind t$aid <3> "hide_session $aid"
+ $sessbox($list) tag bind t$aid <1> "setcw [cw]; toggle_popup $aid"
+ $sessbox($list) tag bind t$aid <2> "setcw [cw]; start_all $aid"
+ $sessbox($list) tag bind t$aid <3> "setcw [cw]; hide_session $aid"
$sessbox($list) tag bind t$aid <Enter> \
- "highlight_tag $aid enter"
+ "setcw [cw]; highlight_tag $aid enter"
$sessbox($list) tag bind t$aid <Leave> \
- "highlight_tag $aid leave"
+ "setcw [cw]; highlight_tag $aid leave"
if {[ispopped $aid]==1} {
$sessbox($list) tag configure t$aid \
- -foreground [option get . background Sdr] \
- -background [option get . foreground Sdr]
+ -foreground [option get [cw] background Sdr] \
+ -background [option get [cw] foreground Sdr]
catch {$sessbox($ldata($aid,list)).win$aid configure \
- -foreground [option get . background Sdr] \
- -background [option get . foreground Sdr] }
+ -foreground [option get [cw] background Sdr] \
+ -background [option get [cw] foreground Sdr] }
} elseif {[listing_criteria $aid future]==1} {
$sessbox($list) tag configure t$aid \
- -foreground [option get . disabledForeground Sdr] \
- -background [option get . background Sdr]
+ -foreground [option get [cw] disabledForeground Sdr] \
+ -background [option get [cw] background Sdr]
catch {$sessbox($list).win$aid configure \
- -foreground [option get . disabledForeground Sdr] \
- -background [option get . background Sdr] }
+ -foreground [option get [cw] disabledForeground Sdr] \
+ -background [option get [cw] background Sdr] }
} else {
$sessbox($list) tag configure t$aid \
- -foreground [option get . foreground Sdr] \
- -background [option get . background Sdr]
+ -foreground [option get [cw] foreground Sdr] \
+ -background [option get [cw] background Sdr]
}
}
@@ -1020,52 +1075,52 @@ proc highlight_tag {aid mode} {
enter {
if {[ispopped $aid]==1} {
$win tag configure t$aid \
- -foreground [option get . activeBackground Sdr]
+ -foreground [option get [cw] activeBackground Sdr]
catch {$icon configure \
- -foreground [option get . activeBackground Sdr]}
+ -foreground [option get [cw] activeBackground Sdr]}
} else {
$win tag configure t$aid -background \
- [option get . activeBackground Sdr]
+ [option get [cw] activeBackground Sdr]
catch {$icon configure -background \
- [option get . activeBackground Sdr]}
+ [option get [cw] activeBackground Sdr]}
}
}
leave {
if {[ispopped $aid]==1} {
$win tag configure t$aid \
- -foreground [option get . background Sdr]
+ -foreground [option get [cw] background Sdr]
catch {$icon configure \
- -foreground [option get . background Sdr]}
+ -foreground [option get [cw] background Sdr]}
} else {
$win tag configure t$aid \
- -background [option get . background Sdr]
+ -background [option get [cw] background Sdr]
catch {$icon configure \
- -background [option get . background Sdr]}
+ -background [option get [cw] background Sdr]}
}
}
popup {
$win tag configure t$aid \
- -foreground [option get . background Sdr] \
- -background [option get . foreground Sdr]
+ -foreground [option get [cw] background Sdr] \
+ -background [option get [cw] foreground Sdr]
catch {$icon configure \
- -foreground [option get . background Sdr] \
- -background [option get . foreground Sdr]}
+ -foreground [option get [cw] background Sdr] \
+ -background [option get [cw] foreground Sdr]}
}
popdown {
if {[listing_criteria $aid future]==1} {
$win tag configure t$aid \
- -foreground [option get . disabledForeground Sdr] \
- -background [option get . background Sdr]
+ -foreground [option get [cw] disabledForeground Sdr] \
+ -background [option get [cw] background Sdr]
catch {$icon configure \
- -foreground [option get . disabledForeground Sdr] \
- -background [option get . background Sdr]}
+ -foreground [option get [cw] disabledForeground Sdr] \
+ -background [option get [cw] background Sdr]}
} else {
$win tag configure t$aid \
- -foreground [option get . foreground Sdr] \
- -background [option get . background Sdr]
+ -foreground [option get [cw] foreground Sdr] \
+ -background [option get [cw] background Sdr]
catch {$icon configure \
- -foreground [option get . foreground Sdr] \
- -background [option get . background Sdr]}
+ -foreground [option get [cw] foreground Sdr] \
+ -background [option get [cw] background Sdr]}
}
}
}
@@ -1084,8 +1139,8 @@ proc toggle_popup {aid} {
proc show_session_list {list} {
debug "show_session_list $list"
- if {$list=="priv"} {
- catch {pack .f4 -side top -fill both -expand true -after .f2}
+ if {$list=="[cw].priv"} {
+ catch {pack [cw].f4 -side top -fill both -expand true -after [cw].f2}
}
debug "done"
}
@@ -1168,6 +1223,8 @@ proc make_rpt_time {secs} {
proc reshow_sessions {spec} {
global ldata fullnumitems fullix items ix sessbox sesslists ifstyle
foreach box [array names sessbox] {
+ if {![winfo exists sessbox($box)]} continue
+
if {$ifstyle(list)=="normal"} {
$sessbox($box) configure -spacing1 4
} else {
@@ -1395,7 +1452,7 @@ proc highlight_url {win {inbrowser 0}} {
}
for {set i 1} {$i <= $tagnum} {incr i} {
$win tag configure url$i \
- -foreground [option get . hotForeground Sdr]
+ -foreground [option get [cw] hotForeground Sdr]
$win tag configure url$i -relief raised
if {$inbrowser} {
$win tag bind url$i <1> \
@@ -1404,21 +1461,21 @@ proc highlight_url {win {inbrowser 0}} {
webdisp [set url$i]"
$win tag bind url$i <Enter> \
"$win tag configure url$i \
- -foreground [option get . activehotForeground Sdr];\
+ -foreground [option get [cw] activehotForeground Sdr];\
overhref [set url$i]"
$win tag bind url$i <Leave> \
"$win tag configure url$i \
- -foreground [option get . hotForeground Sdr];\
+ -foreground [option get [cw] hotForeground Sdr];\
overhref"
} else {
$win tag bind url$i <1> \
"get_uri [set url$i]"
$win tag bind url$i <Enter> \
"$win tag configure url$i \
- -foreground [option get . activehotForeground Sdr]"
+ -foreground [option get [cw] activehotForeground Sdr]"
$win tag bind url$i <Leave> \
"$win tag configure url$i \
- -foreground [option get . hotForeground Sdr]"
+ -foreground [option get [cw] hotForeground Sdr]"
}
}
}
@@ -1627,7 +1684,7 @@ proc popup {aid ifstyle msgsrc} {
wm iconname $wname "Sdr: Incoming call from $msgsrc"
frame $win.inv -borderwidth 2 -relief groove
pack $win.inv -side top -fill x -expand true
- label $win.inv.l -text "Incoming Call" -font [option get . largeFont Sdr]
+ label $win.inv.l -text "Incoming Call" -font [option get [cw] largeFont Sdr]
pack $win.inv.l -side top
frame $win.inv.f -borderwidth 0
pack $win.inv.f -side top -fill x -expand true
@@ -1667,8 +1724,8 @@ proc popup {aid ifstyle msgsrc} {
-highlightthickness 0
#TBD
-# -activeforeground [option get . scrollbarActiveForeground Sdr] \
-# -foreground [option get . scrollbarForeground Sdr]
+# -activeforeground [option get [cw] scrollbarActiveForeground Sdr] \
+# -foreground [option get [cw] scrollbarForeground Sdr]
# $win.f0.desc insert 0.0 [text_wrap $ldata($aid,desc) 40]
$win.f0.desc insert 0.0 $ldata($aid,desc)
$win.f0.desc configure -state disabled
@@ -1679,7 +1736,7 @@ proc popup {aid ifstyle msgsrc} {
highlight_url $win.f0.desc
- set mf [option get . mediumFont Sdr]
+ set mf [option get [cw] mediumFont Sdr]
pack [frame $win.hidden1 -width 1 -height 1] -side top -padx 0 -pady 0
if {$ldata($aid,tfrom)!=0} {
# if {($ldata($aid,no_of_times)>1)||($ldata($aid,time0,no_of_rpts)>0)} {
@@ -1738,7 +1795,7 @@ proc popup {aid ifstyle msgsrc} {
}
iconbutton $win.buttons.info -text $str -bitmap www -relief raised \
-borderwidth 1 -command "get_uri $ldata($aid,uri)" \
- -font [option get . mediumFont Sdr] -pad $pad
+ -font [option get [cw] mediumFont Sdr] -pad $pad
tixAddBalloon $win.buttons.info Frame [tt "Click here for more \
information about the session. The information will be in the \
@@ -1758,13 +1815,13 @@ choose Web"]
}
iconbutton $win.buttons.contact -text $str -bitmap phone -relief raised \
-borderwidth 1 -command "contact $win $aid" \
- -font [option get . mediumFont Sdr] -pad $pad
+ -font [option get [cw] mediumFont Sdr] -pad $pad
tixAddBalloon $win.buttons.contact Frame [tt "Display the name, email address, and phone number of the person who is responsible for this session."]
incr $win.visible
pack $win.buttons.contact -side left -fill x -expand true
# if {($ldata($aid,no_of_times)>1)||($ldata($aid,time0,no_of_rpts)>0)} {
# iconbutton $win.buttons.times -text "Detailed times" -bitmap clock -relief raised \
-# -borderwidth 1 -command "show_times $win $aid" -font [option get . mediumFont Sdr]
+# -borderwidth 1 -command "show_times $win $aid" -font [option get [cw] mediumFont Sdr]
# tixAddBalloon $win.buttons.times Button [tt "Display detailed information about when this session is active."]
# incr $win.visible
# pack $win.buttons.times -side left -fill x -expand true
@@ -1772,7 +1829,7 @@ choose Web"]
if {$ifstyle=="norm"} {
iconbutton $win.buttons.tech -text "Media\nDetails" -command \
"popup $aid tech $msgsrc;break" -borderwidth 1 -relief raised \
- -bitmap tools -font [option get . mediumFont Sdr] -pad 0
+ -bitmap tools -font [option get [cw] mediumFont Sdr] -pad 0
tixAddBalloon $win.buttons.tech Frame [tt "Click here for information \
about the media used in the session and their formats, and to start up the \
media tools individually."]
@@ -1897,11 +1954,11 @@ if {$ifstyle=="norm"} {
if {$ifstyle=="tech"} {
label $win.heard -text \
"[tt "Heard from"] $ldata($aid,heardfrom) [tt at] $ldata($aid,theard)" \
- -font [option get . infoFont Sdr]
+ -font [option get [cw] infoFont Sdr]
pack $win.heard -side top
if {$ldata($aid,source)!=$ldata($aid,heardfrom)} {
label $win.src -text "[tt "Originally announced from"] $ldata($aid,source)" \
- -font [option get . infoFont Sdr]
+ -font [option get [cw] infoFont Sdr]
pack $win.src -side top
}
}
@@ -2048,7 +2105,7 @@ proc popup_update_media {aid medianum fm
set code 0
catch {set code [$fname.d6 delete 0 end;$fname.d6 insert 0 $vars]}
if {$code==0} {
- set infofont "[option get . infoFont Sdr]"
+ set infofont "[option get [cw] infoFont Sdr]"
label $fname.l6 -text "Vars:" -font $infofont
entry $fname.d6 -relief sunken -borderwidth 1\
-font $infofont
@@ -2106,7 +2163,7 @@ proc contact {win aid} {
incr $win.visible -1
if {[set $win.visible]==0} {pack forget $win.buttons}
frame $win.cinfo -borderwidth 2 -relief groove
- set mf [option get . mediumFont Sdr]
+ set mf [option get [cw] mediumFont Sdr]
pack $win.cinfo -side top -fill x -after $win.hidden2
label $win.cinfo.created -text "Created by: $ldata($aid,creator)@$ldata($aid,createaddr)" -font $mf
pack $win.cinfo.created -side top
@@ -2255,7 +2312,15 @@ proc text_times_english {aid} {
}
} else {
- if {$ldata($aid,endtime) == 0} {
+ # NOTE TO UCL: There was a bug in your original code here.
+ # If you create an "advertised session" and choose the default
+ # settings throughout the creation dialog, "ldata(new,endtime)"
+ # does not exist at this point. To overcome this bug, I've added
+ # the "![info exists ..." line below.
+ # Ross Finlayson (finlayson@live.com)
+ if {
+ ![info exists ldata($aid,endtime)] ||
+ $ldata($aid,endtime) == 0} {
set timestr [format "%sstarting at %s %s %s" $timestr\
[croptime $ldata($aid,tfrom,$i)]\
[croptz $ldata($aid,tfrom,$i)]\
@@ -2343,8 +2408,8 @@ proc record {aid} {
-highlightthickness 0
#TBD
-# -foreground [option get . scrollbarForeground Sdr] \
-# -activeforeground [option get . scrollbarActiveForeground Sdr]
+# -foreground [option get [cw] scrollbarForeground Sdr] \
+# -activeforeground [option get [cw] scrollbarActiveForeground Sdr]
foreach i [exec ls -a] {
.record.f.f0.lb insert end $i
}
@@ -2478,8 +2543,9 @@ proc stuff_mosaic {} {
}
}
-proc preferences2 {} {
+proc preferences2 {w} {
global showwhich balloonHelp binder_tags prefprocs
+ setcw $w
catch {destroy .prefs}
sdr_toplevel .prefs "Preferences"
posn_win .prefs
@@ -2500,7 +2566,7 @@ proc preferences2 {} {
frame .prefs.f0
pack .prefs.f0 -side top
canvas .prefs.f0.c -width 600 -height 300
-#-background [option get . prefsBackground Sdr]
+#-background [option get [cw] prefsBackground Sdr]
pack .prefs.f0.c -side top
set xpos 20
@@ -2517,7 +2583,7 @@ proc preferences2 {} {
bind .prefs.f3.mode <Tab> "focus $binder_tags(show,button)"
post_binder .prefs.f0.c show
label .prefs.help -relief raised -borderwidth 1 \
- -font [option get . infoFont Sdr]
+ -font [option get [cw] infoFont Sdr]
pack .prefs.help -side top -fill x -expand true
frame .prefs.f1
button .prefs.f1.cancel -text [tt "Cancel"] -command {destroy .prefs}
@@ -2832,7 +2898,7 @@ proc select_show_web {win width height}
-highlightthickness 0 \
-variable prefs(web_webtype) -value startmosaic -relief flat
bind_help $win.f.f.r2 [tt "Select this to start a new copy of the web browser for each URL."]
- entry $win.f.f.wwwname -width 10 -relief sunken -background [option get . entryBackground Sdr] -textvariable prefs(web_webclient)
+ entry $win.f.f.wwwname -width 10 -relief sunken -background [option get [cw] entryBackground Sdr] -textvariable prefs(web_webclient)
frame $win.f.f2
radiobutton $win.f.f2.r4 -text [tt "Use sdr's built in web browser"] \
@@ -2842,8 +2908,8 @@ proc select_show_web {win width height}
frame $win.f.f2.f
label $win.f.f2.f.l1 -text [tt " Proxy:"]
label $win.f.f2.f.l2 -text [tt "in the form \"host:port\""] \
- -font [option get . infoFont Sdr]
- entry $win.f.f2.f.wwwproxy -width 25 -relief sunken -background [option get . entryBackground Sdr] -textvariable prefs(web_webproxy)
+ -font [option get [cw] infoFont Sdr]
+ entry $win.f.f2.f.wwwproxy -width 25 -relief sunken -background [option get [cw] entryBackground Sdr] -textvariable prefs(web_webproxy)
bind_help $win.f.f2.f.wwwproxy [tt "Enter your web proxy in the form ``host:port''. This is optional."]
tixAddBalloon $win.f.f2 Frame [tt "Enter your web proxy in the form \"host:port\"."]
@@ -3089,35 +3155,35 @@ proc select_your_info {win width height}
pack $win.f.n -side top -fill x -expand true -pady 5
label $win.f.n.l -text [tt "Name:"]
pack $win.f.n.l -side left
- entry $win.f.n.e -width 30 -relief sunken -background [option get . entryBackground Sdr] -textvariable prefs(pers_name)
+ entry $win.f.n.e -width 30 -relief sunken -background [option get [cw] entryBackground Sdr] -textvariable prefs(pers_name)
pack $win.f.n.e -side right
frame $win.f.e
pack $win.f.e -side top -fill x -expand true -pady 5
label $win.f.e.l -text [tt "Email:"]
pack $win.f.e.l -side left
- entry $win.f.e.e -width 30 -relief sunken -background [option get . entryBackground Sdr] -textvariable prefs(pers_email)
+ entry $win.f.e.e -width 30 -relief sunken -background [option get [cw] entryBackground Sdr] -textvariable prefs(pers_email)
pack $win.f.e.e -side right
frame $win.f.p
pack $win.f.p -side top -fill x -expand true -pady 5
label $win.f.p.l -text [tt "Phone:"]
pack $win.f.p.l -side left
- entry $win.f.p.e -width 30 -relief sunken -background [option get . entryBackground Sdr] -textvariable prefs(pers_phone)
+ entry $win.f.p.e -width 30 -relief sunken -background [option get [cw] entryBackground Sdr] -textvariable prefs(pers_phone)
pack $win.f.p.e -side right
- message $win.f.sipa -aspect 400 -font [option get . infoFont Sdr] -text \
+ message $win.f.sipa -aspect 400 -font [option get [cw] infoFont Sdr] -text \
"A SIP alias is a name people can put in a session invitation to call you. Normally they will use your username, but if you want sdr to answer calls addressed to a more human-readable name, you can add it here. You cannot add another valid username."
pack $win.f.sipa -side top
frame $win.f.a
pack $win.f.a -side top -fill x -expand true -pady 5
label $win.f.a.l -text [tt "SIP Alias:"]
pack $win.f.a.l -side left
- entry $win.f.a.e -width 30 -relief sunken -background [option get . entryBackground Sdr] -textvariable prefs(pers_alias)
+ entry $win.f.a.e -width 30 -relief sunken -background [option get [cw] entryBackground Sdr] -textvariable prefs(pers_alias)
pack $win.f.a.e -side right
frame $win.f.ss
pack $win.f.ss -side top -fill x -expand true -pady 5
label $win.f.ss.l -text [tt "SIP Server URL:"]
pack $win.f.ss.l -side left
- entry $win.f.ss.e -width 30 -relief sunken -background [option get . entryBackground Sdr] -textvariable prefs(pers_sipserv)
+ entry $win.f.ss.e -width 30 -relief sunken -background [option get [cw] entryBackground Sdr] -textvariable prefs(pers_sipserv)
pack $win.f.ss.e -side right
frame $win.f2 -borderwidth 0 -relief flat -width 1 -height \
@@ -3324,8 +3390,9 @@ proc save_prefs {} {
give_status_msg [tt "Preferences Saved"]
}
-proc help {} {
+proc help {w} {
global balloonHelp
+ setcw $w
catch {destroy .help}
sdr_toplevel .help "Help"
posn_win .help
@@ -3412,8 +3479,8 @@ proc pref_sessions {win} {
-highlightthickness 0
#TBD
-# -foreground [option get . scrollbarForeground Sdr] \
-# -activeforeground [option get . scrollbarActiveForeground Sdr]
+# -foreground [option get [cw] scrollbarForeground Sdr] \
+# -activeforeground [option get [cw] scrollbarActiveForeground Sdr]
foreach aid $prefs(show_aids) {
$win.f1.l1 insert end $ldata($aid,session)
if {$prefs(show_aid_$aid)==1} {
@@ -3458,11 +3525,11 @@ proc toggle_pref_session {win i} {
proc pref_sess_enable {win} {
global prefs
if {$prefs(show_showwhich)=="pref"} {
- $win.f1.l1 configure -foreground [option get . foreground Sdr]
- $win.f1.l2 configure -foreground [option get . foreground Sdr]
+ $win.f1.l1 configure -foreground [option get [cw] foreground Sdr]
+ $win.f1.l2 configure -foreground [option get [cw] foreground Sdr]
} else {
- $win.f1.l1 configure -foreground [option get . disabledForeground Sdr]
- $win.f1.l2 configure -foreground [option get . disabledForeground Sdr]
+ $win.f1.l1 configure -foreground [option get [cw] disabledForeground Sdr]
+ $win.f1.l2 configure -foreground [option get [cw] disabledForeground Sdr]
}
}
@@ -3489,7 +3556,8 @@ proc add_ttl_scope {sap_addr sap_port ba
#note this must be done after all admin scope zones have been added.
#this must not be called more than once!
#
- global zone
+ global windowForGroupPort zone
+ set windowForGroupPort($sap_addr,$sap_port) [cw]
set no_of_zones $zone(no_of_zones)
set zone(sap_addr,$no_of_zones) $sap_addr
set zone(sap_port,$no_of_zones) $sap_port
@@ -3505,7 +3573,8 @@ proc add_admin {name sap_addr sap_port b
#an old one.
#to remove one, specify its name and set sap_addr to ""
#
- global zone
+ global windowForGroupPort zone
+ set windowForGroupPort($sap_addr,$sap_port) [cw]
set no_of_zones $zone(no_of_zones)
for {set i 0} {$i < $no_of_zones} {incr i} {
if {$zone(name,$i)==$name} {
@@ -3542,6 +3611,61 @@ proc sdr_new_session_hook {advert} {
proc sdr_delete_session_hook {advert} {
}
+proc launch_directory {addr port ttl dirName} {
+ global windowForGroupPort
+
+ # If we don't yet have a window open for the directory's (group,port),
+ # then open one now:
+ if {![info exists windowForGroupPort($addr,$port)]} {
+ set oldCW [cw]
+ global lastWindowNum
+ set newWindow .w[incr lastWindowNum]
+ set windowForGroupPort($addr,$port) $newWindow
+
+ # Create the new window:
+ setcw $newWindow
+ build_interface again $dirName
+
+ # Enter any members that we saw earlier, but couldn't enter back then:
+ global entryForGroupPort
+ foreach gpa [array names entryForGroupPort [set addr],[set port],*] {
+ set aid $entryForGroupPort($gpa)
+ display_session $aid 0
+ }
+ setcw $oldCW
+
+ # Set up the 'zone' information for this directory, to be used when
+ # new sessions are created in it.
+ # Begin with the original set of zones:
+ global zone; array set newZoneData [array get zone]
+
+ # Then, remove all zones that don't enclose this dir's SAP addr ($addr)
+
+ # Then, replace each remaining zone's SAP address and port with ours:
+ foreach a [array names newZoneData sap_addr,*] {
+ set newZoneData($a) $addr
+ }
+ foreach p [array names newZoneData sap_port,*] {
+ set newZoneData($p) $port
+ }
+ # Set each zone's TTL to be no larger than ours:
+ for {set i 0} {$i <= $newZoneData(no_of_zones)} {incr i} {
+ if {![info exists newZoneData(ttl,$i)]
+ || $newZoneData(ttl,$i) > $ttl} {
+ set newZoneData(ttl,$i) $ttl
+ }
+ }
+
+ # Remember this new zone data:
+ global zoneDataForWindow
+ set zoneDataForWindow($newWindow) [array get newZoneData]
+
+ # Finally, start listening to the directory:
+ sd_listen $addr $port
+ }
+ return 1
+}
+
set fh [font metrics -adobe-courier-bold-r-normal--*-120-*-*-m-*-iso8859-1 -linespace]
set fw [font measure -adobe-courier-bold-r-normal--*-120-*-*-m-*-iso8859-1 m]
set font -adobe-courier-bold-r-normal--*-120-*-*-m-*-iso8859-1
@@ -3567,8 +3691,9 @@ foreach i {3 23} {
set ending($i) "rd"
}
-proc calendar {} {
+proc calendar {w} {
global ldata fullix fullnumitems daysinmonth taglist fh fw font ifstyle
+ setcw $w
catch {destroy .cal}
catch {unset taglist}
sdr_toplevel .cal "Daily Listings" "Calendar"
@@ -3576,7 +3701,7 @@ proc calendar {} {
frame .cal.f0 -borderwidth 2 -relief groove
if {$ifstyle(labels)=="long"} {
label .cal.f0.l -text "Click on a day to show what's on." \
- -anchor w -font [option get . infoFont Sdr]
+ -anchor w -font [option get [cw] infoFont Sdr]
pack .cal.f0.l -side top -fill x -expand true
}
@@ -3587,7 +3712,7 @@ proc calendar {} {
have sessions scheduled. Click on a date to get the listing for that \
day."]
- set fg [option get . foreground Sdr]
+ set fg [option get [cw] foreground Sdr]
set tstr [gettimenow]
set daynow [fixint [lindex $tstr 2]]
set monnow [fixint [lindex $tstr 1]]
@@ -3686,7 +3811,7 @@ day."]
set eom [lindex $daysinmonth [expr $mon - 1]]
}
for {set day $som} {$day <= $eom} {incr day} {
- catch { highlight_day $day $mon $syear $first([expr $mon+0]) $monnow [option get . activeBackground Sdr] [option get . hotForeground Sdr] \"$aid\" $t -1 -1}
+ catch { highlight_day $day $mon $syear $first([expr $mon+0]) $monnow [option get [cw] activeBackground Sdr] [option get [cw] hotForeground Sdr] \"$aid\" $t -1 -1}
}
}
} else {
@@ -3752,7 +3877,7 @@ day."]
set eom [lindex $daysinmonth [expr $mon - 1]]
}
for {set day $som} {$day <= $eom} {incr day} {
- catch { highlight_day $day $mon $syear $first([expr $mon+0]) $monnow [option get . activeBackground Sdr] [option get . hotForeground Sdr] \"$aid\" $t $r $rctr $o}
+ catch { highlight_day $day $mon $syear $first([expr $mon+0]) $monnow [option get [cw] activeBackground Sdr] [option get [cw] hotForeground Sdr] \"$aid\" $t $r $rctr $o}
}
}
set starttime [expr $starttime + $ldata($aid,time$t,interval$r)]
@@ -3789,17 +3914,17 @@ proc highlight_day {day mon yr offset mo
.cal.f0.c addtag $day.$mon withtag \
[.cal.f0.c create rectangle [expr $xpos - 2] $ypos \
[expr $xpos + ($fw*2) +2] [expr $ypos + $fh - 1] -fill $col \
- -outline [option get . foreground Sdr]]
+ -outline [option get [cw] foreground Sdr]]
.cal.f0.c addtag t.$day.$mon withtag \
[.cal.f0.c create text $xpos $ypos -anchor nw \
- -fill [option get . hotForeground Sdr] -font $font \
+ -fill [option get [cw] hotForeground Sdr] -font $font \
-text "$daystr"]
set taglist($day.$mon) "$aid $tindex $rindex $rctr $off"
.cal.f0.c bind t.$day.$mon <1> \
"display_bookings $dow $day $mon $yr \$taglist($day.$mon)"
.cal.f0.c bind t.$day.$mon <Enter> \
".cal.f0.c itemconfigure t.$day.$mon -fill \
- [option get . activehotForeground Sdr]"
+ [option get [cw] activehotForeground Sdr]"
.cal.f0.c bind t.$day.$mon <Leave> \
".cal.f0.c itemconfigure t.$day.$mon -fill $fgcol"
} else {
@@ -3816,9 +3941,9 @@ proc display_bookings {dow day mon yr bo
set title \
"[tt "Sessions on"] $dow $day$ending($day) [getmonname $mon -long]"
set blist [split $bookings "\n"]
- set fg [option get . foreground Sdr]
- set hotfg [option get . hotForeground Sdr]
- set ahotfg [option get . activehotForeground Sdr]
+ set fg [option get [cw] foreground Sdr]
+ set hotfg [option get [cw] hotForeground Sdr]
+ set ahotfg [option get [cw] activehotForeground Sdr]
set booknum 0
set aid ""
foreach booking $blist {
@@ -3837,7 +3962,7 @@ proc display_bookings {dow day mon yr bo
pack $win.f.f -side top -fill x -expand true
label $win.f.f.l -text $title
pack $win.f.f.l -side left
- label $win.f.f.exp -font [option get . infoFont Sdr] -text "" \
+ label $win.f.f.exp -font [option get [cw] infoFont Sdr] -text "" \
-justify l -anchor w
pack $win.f.f.exp -side left -fill x -expand true
if {$ifstyle(labels)=="long"} {
@@ -3848,7 +3973,7 @@ proc display_bookings {dow day mon yr bo
for {set t 0} {$t < 24} {incr t} {
$win.f.c addtag hour$t withtag \
[$win.f.c create text [expr ($t * 20)+10] 5 -anchor n\
- -fill $fg -font [option get . font Sdr]]
+ -fill $fg -font [option get [cw] font Sdr]]
$win.f.c create line [expr ($t * 20) +20 ] 20\
[expr ($t * 20) +20 ] 30 -fill $fg
$win.f.c create line [expr ($t * 20) +10 ] 20\
@@ -3968,7 +4093,7 @@ proc display_bookings {dow day mon yr bo
$win.f.c addtag t$lnum withtag \
[$win.f.c create text 495 \
[expr 25+$lnum] -anchor w\
- -fill $hotfg -font [option get . font Sdr]]
+ -fill $hotfg -font [option get [cw] font Sdr]]
$win.f.c insert t$lnum 0 $ldata($aid,session)
$win.f.c bind t$lnum <1> "popup $aid \$ifstyle(view) advert"
$win.f.c bind t$lnum <Enter> \
@@ -3982,7 +4107,7 @@ proc display_bookings {dow day mon yr bo
}
}
button $win.f.f.dismiss -text "[tt Hide] $day [getmonname $mon -long]" \
- -command "destroy $win" -font [option get . infoFont Sdr] \
+ -command "destroy $win" -font [option get [cw] infoFont Sdr] \
-borderwidth 1 -relief raised -pady 0 -padx 1 \
-highlightthickness 0
pack $win.f.f.dismiss -side right
@@ -4263,7 +4388,7 @@ proc authinfo {win bgcolour authm} {
incr $win.visible -1
if {[set $win.visible]==0} {pack forget $win.buttons}
frame $win.authinfo -borderwidth 2 -relief groove
- set mf [option get . mediumFont Sdr]
+ set mf [option get [cw] mediumFont Sdr]
pack $win.authinfo -side top -fill x -after $win.hidden2
message $win.authinfo.authmsg -aspect 600 -text "Authentication Information: $authm " -font $mf -bg $bgcolour
pack $win.authinfo.authmsg -side top -expand true
@@ -4275,7 +4400,7 @@ proc encinfo {win bgcolour encm} {
incr $win.visible -1
if {[set $win.visible]==0} {pack forget $win.buttons}
frame $win.encinfo -borderwidth 2 -relief groove
- set mf [option get . mediumFont Sdr]
+ set mf [option get [cw] mediumFont Sdr]
pack $win.encinfo -side top -fill x -after $win.hidden2
message $win.encinfo.encmsg -aspect 800 -text "Encryption Information: $encm " -font $mf -bg $bgcolour
pack $win.encinfo.encmsg -side top -expand true
@@ -4368,6 +4493,7 @@ add_admin "Region (ttl 63)" 224.2.127.25
add_admin "World (ttl 127)" 224.2.127.254 9875 224.2.128.0 17 127
# add_admin sap_addr sap_port base_addr netmask ttl
add_ttl_scope 224.2.127.254 9875 224.2.128.0 17
+set zoneDataForWindow([cw]) [array get zone]
#create the interface
build_interface first