1 # ui-program.tcl --
2 #
3 # A single program being announced in the session directory user
4 # interface. Builds and manages the window that is created when the
5 # program is selected in the main window of the user interface.
6 #
7 # Copyright (c) 1997-2002 The Regents of the University of California.
8 # All rights reserved.
9 #
10 # Redistribution and use in source and binary forms, with or without
11 # modification, are permitted provided that the following conditions are met:
12 #
13 # A. Redistributions of source code must retain the above copyright notice,
14 # this list of conditions and the following disclaimer.
15 # B. Redistributions in binary form must reproduce the above copyright notice,
16 # this list of conditions and the following disclaimer in the documentation
17 # and/or other materials provided with the distribution.
18 # C. Neither the names of the copyright holders nor the names of its
19 # contributors may be used to endorse or promote products derived from this
20 # software without specific prior written permission.
21 #
22 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
23 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
24 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
25 # ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
26 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
27 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
28 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
29 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
30 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
31 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
32
33 # A single program being announced in the session directory user
34 # interface. Builds and manages the window that is created when
35 # the program is selected in the main window of the user interface.
36 Class ProgramWindow
37
38 # Creates a new ProgramWindow object to display the program in the
39 # Program <i>p</i>
40 ProgramWindow public init {p args} {
41 eval $self next $args
42 $self set prog_ $p
43
44 global tcl_platform
45 if {$tcl_platform(platform) == "unix" || $tcl_platform(platform) == "windows"} {
46 $self set offset_ 2208988800
47 } else {
48 #FIXME
49 self fatal "sorry, net yet ported to $tcl_platform(platform)"
50 }
51 }
52
53 #
54 ProgramWindow public destroy {} {
55 $self instvar win_
56 catch {destroy $win_}
57 $self next
58 }
59
60 #
61 ProgramWindow public title {} {
62 return [[$self set prog_] field_value s]
63 }
64
65 # Maps the window with the information for this program if it is
66 # not currently mapped and unmaps it if it is. Creates the window
67 # if necessary by calling <i>buildwin</i>.
68 ProgramWindow public toggle-window {} {
69 $self instvar win_
70 if ![info exists win_] {
71 set win_ .prog$self
72 $self buildwin $win_
73 return
74 }
75 if [winfo ismapped $win_] {
76 wm withdraw $win_
77 } else {
78 wm deiconify $win_
79 }
80 }
81
82 # Sets the (private) instvar <i>apps_</i> to a list of user
83 # applications that might be started for this program. See
84 # UserApplication::get_apps for details about how this is done.
85 ProgramWindow private set_apps {} {
86 $self set apps_ [UserApplication get_apps [$self set prog_]]
87 }
88
89 # Creates a toplevel window <i>w</i> and instantiates the user
90 # interface elements for the description of this ProgramWindow.
91 ProgramWindow private buildwin w {
92 $self instvar prog_ advanced_
93
94 set advanced_ 0
95
96 toplevel $w
97 wm title $w "nsdr: Program Info"
98
99 set mfont [$self get_option medfont]
100
101 label $w.title -text [$self title] -font $mfont
102 pack $w.title -side top -fill x -expand no
103
104 frame $w.description
105 set t $w.description.t
106 set s $w.description.s
107 text $t -state normal -relief ridge -bd 2 -height 5 \
108 -font $mfont -wrap word -yscroll "$s set"
109 if [$prog_ have_field i] {
110 $t insert 0.0 [$prog_ field_value i]
111 } else {
112 $t insert 0.0 "No description provided."
113 }
114 $t configure -state disabled
115 pack $t -fill both -expand yes
116 scrollbar $w.description.s -command "$t yview"
117 bind $w.description <Configure> "$self fix-scrollbar"
118 pack $w.description -side top -fill both -expand yes
119
120 if ![$self yesno simpleInterface] {
121 $self build-advanced
122 return
123 }
124
125 frame $w.bottom
126
127 frame $w.bottom.f
128
129 $self build-apps $w.bottom.f.apps 1
130 pack $w.bottom.f.apps -side left -fill both -expand yes -padx 2 -pady 2
131
132 $self build-times $w.bottom.f.times
133 pack $w.bottom.f.times -side left -fill both -padx 2 -pady 2
134
135 pack $w.bottom.f -side top -fill both -expand yes
136
137 set f $w.bottom.buttons
138 frame $f
139 button $f.advanced -text "Advanced" -command "$self build-advanced"
140 button $f.dismiss -text "Dismiss" -command "wm withdraw $w"
141 pack $f.advanced $f.dismiss -side left
142 if [$prog_ have_field u] {
143 button $f.web -text "View Web Page" \
144 -command "[Application instance] gourl [$prog_ field_value u]"
145 pack $f.web -side left -before $f.dismiss
146 }
147 pack $f -side top
148
149 pack $w.bottom -fill both -expand yes
150
151 wm protocol $w WM_DELETE_WINDOW "wm withdraw $w"
152 }
153
154 ProgramWindow private build-advanced {} {
155 $self instvar win_ prog_ offset_ advanced_
156
157 set advanced_ 1
158
159 catch {destroy $win_.bottom}
160
161 frame $win_.info -relief flat
162 if [$prog_ have_field u] {
163 set url [$prog_ field_value u]
164 button $win_.info.webb \
165 -text "Web Page:" -command "[Application instance] gourl $url"
166 grid $win_.info.webb -row 0 -column 0 -sticky ew
167 label $win_.info.webl -text $url -relief sunken \
168 -bg white -bd 2 -anchor w
169 grid $win_.info.webl -row 0 -column 1 -sticky ew -padx 5
170 }
171
172 if [$prog_ have_field e] {
173 set email [$prog_ field_value e]
174 label $win_.info.maill -text "E-Mail Contact:"
175 grid $win_.info.maill -row 1 -column 0 -sticky ew
176 label $win_.info.mailv -bg white -relief sunken -bd 2 \
177 -text $email -anchor w
178 grid $win_.info.mailv -row 1 -column 1 -sticky ew -padx 5
179 }
180
181 if [$prog_ have_field p] {
182 set phone [$prog_ field_value p]
183 label $win_.info.phonel -text "Telephone Contact:"
184 grid $win_.info.phonel -row 2 -column 0 -sticky ew
185 label $win_.info.phonev -bg white -relief sunken -bd 2 \
186 -text $phone -anchor w
187 grid $win_.info.phonev -row 2 -column 1 -sticky ew -padx 5
188 }
189 pack $win_.info -fill both -expand yes
190 grid columnconfigure $win_.info 0 -minsize 100 -weight 0
191 grid columnconfigure $win_.info 1 -weight 1
192
193 frame $win_.bottom
194
195 # applications box
196 $self build-apps $win_.bottom.apps 0
197 pack $win_.bottom.apps -side left -fill both -expand yes \
198 -padx 2 -pady 2
199
200 # times box
201 $self build-times $win_.bottom.times
202 pack $win_.bottom.times -side left -fill both -padx 2 -pady 2
203
204 # media streams box
205 frame $win_.bottom.media -relief flat
206 label $win_.bottom.media.l -relief flat -text "Media Streams"
207 pack $win_.bottom.media.l -side top -fill x -expand no
208 set f $win_.bottom.media.f
209 frame $f -relief sunken -bd 2
210
211 set i 0
212 #FIXME
213 foreach media [[$prog_ base] set allmedia_] {
214 label $f.type$i -relief flat -anchor e -text "[$media set mediatype_]:"
215 grid $f.type$i -row $i -column 0 -sticky ew
216
217 if [catch {set addr [$media set caddr_]}] {set addr "???" }
218 set n [string first / $addr]
219 if {$n != -1} { set addr [string range $addr 0 [expr $n-1]] }
220 if [catch {set port [$media set port_]}] {set port "???" }
221 label $f.info$i -relief sunken -bd 1 -bg white \
222 -anchor w -text "$addr/$port"
223 grid $f.info$i -row $i -column 1 -sticky ew -padx 5
224
225 incr i
226 }
227 pack $f -fill both -expand yes
228 pack $win_.bottom.media -side left -fill both -padx 2 -pady 2
229
230 pack $win_.bottom -fill both -expand yes
231
232 frame $win_.buttons
233 button $win_.buttons.source -text "SDP Source" \
234 -command "$self toggle-srcwin"
235 button $win_.buttons.quit -text "Dismiss" \
236 -command "wm withdraw $win_"
237 pack $win_.buttons.source $win_.buttons.quit -side left
238
239 set o [split [$prog_ field_value o]]
240 if {[lindex $o 0] == [user_heuristic] && [lindex $o 5] == [localaddr]} {
241 #FIXME
242 set src [[[Application instance] set ui_] current-source]
243 button $win_.buttons.edit -text "Edit" \
244 -command "new SDPEditWindow $prog_ $src" -state disabled
245 button $win_.buttons.delete -text "Delete Program" \
246 -command "$self stop-announcing"
247 pack $win_.buttons.edit $win_.buttons.delete \
248 -side left -before $win_.buttons.quit
249 }
250
251 pack $win_.buttons
252
253 wm protocol $win_ WM_DELETE_WINDOW "wm withdraw $win_"
254 }
255
256 #
257 ProgramWindow private build-times w {
258 $self instvar prog_ offset_
259
260 if ![winfo exists $w] {
261 frame $w
262 }
263 label $w.l -relief flat -text "Times"
264 pack $w.l -side top -fill x -expand no
265 set f $w.f
266 frame $f -relief sunken -bd 2
267
268 #FIXME needs to be way improved
269 set times [split [$prog_ field_value t]]
270 if {[lindex $times 1] == 0} {
271 set permanent 1
272 set text "Session is always present."
273 } else {
274 set permanent 0
275 set text "Session will be active"
276 if [$prog_ have_field r] {
277 set l [split [$prog_ field_value r]]
278 set secs [lindex $l 0]
279 if {[string first d $secs] > 0} {
280 set i [string first d $secs]
281 set days [string range $secs 0 [expr $i-1]]
282 if {$days == 1} {
283 append text " every day"
284 } else {
285 append text " every $days days"
286 }
287 } elseif {[string first h $secs] > 0} {
288 set i [string first h $secs]
289 set hrs [string range $secs 0 [expr $i-1]]
290 if {$hrs == 1} {
291 append text " every hour"
292 } else {
293 append text " every $hrs hours"
294 }
295 } elseif {[string first m $secs] > 0} {
296 set i [string first m $secs]
297 set mins [string range $secs 0 [expr $i-1]]
298 append text " every $mins minutes"
299 } elseif {$secs % 604800 == 0} {
300 set weeks [expr $secs / 604800]
301 if {$weeks == 1} {
302 append text " every week"
303 } else {
304 append text " every $weeks weeks"
305 }
306 } elseif {$secs % 86400 == 0} {
307 set days [expr $secs / 86400]
308 if {$days == 1} {
309 append text " every day"
310 } else {
311 append text "every $days days"
312 }
313 } elseif {$secs % 3600 == 0} {
314 set hrs [expr $secs / 3600]
315 if {$hrs == 1} {
316 append text " every hour"
317 } else {
318 append text "every $hrs hours"
319 }
320 } elseif {$secs % 60 == 0} {
321 set mins [expr $secs / 60]
322 append text " every $mins minutes"
323 }
324
325 #FIXME need to handle other parts of r= field (offsets)
326 }
327 set start [clock format [expr [lindex $times 0] - $offset_] \
328 -format "%H:%M %b %d"]
329 set end [clock format [expr [lindex $times 1] - $offset_] \
330 -format "%H:%M %b %d"]
331 set text "$text from $start to $end"
332 }
333 message $f.m -relief flat -width 150 -text $text
334 pack $f.m -side top
335
336 pack $f -fill both -expand yes
337 }
338
339 #
340 ProgramWindow private build-apps {w simple} {
341 if ![winfo exists $w] {
342 frame $w -relief flat
343 }
344 label $w.l -relief flat -text "Applications"
345 pack $w.l -side top -fill x -expand no
346 set f $w.f
347 frame $f -relief sunken -bd 2
348
349 set i 0
350 $self set_apps
351 set all_apps {}
352 foreach a [$self set apps_] {
353 set name [lindex $a 0]
354 set cmd [lindex $a 1]
355
356 button $f.r$i -text "Run:" -command "$self run $f.e$i"
357 grid $f.r$i -row $i -column 0 -sticky ew
358
359 entry $f.e$i -bg white -width 20
360 grid $f.e$i -row $i -column 1 -sticky ew
361
362 if {$simple} {
363 $f.e$i insert 0 $name
364 $f.e$i configure -state disabled
365 lappend all_apps $cmd
366
367 $f.r$i configure -command "$self run \{$cmd\}"
368 } else {
369 $f.e$i insert 0 $cmd
370 lappend all_apps $f.e$i
371
372 $f.r$i configure -command "$self run $f.e$i"
373 }
374
375 incr i
376 }
377 grid columnconfigure $f 1 -weight 1
378 button $f.runall -text "Run All Applications" \
379 -command [concat $self run $all_apps]
380 grid $f.runall -row $i -column 0 -columnspan 2
381 pack $f -fill both -expand yes
382 }
383
384 # Decides whether a scrollbar is needed for the text widget containing
385 # the program description and maps it if necessary (or unmaps it if it
386 # is not needed).
387 ProgramWindow private fix-scrollbar {} {
388 $self instvar win_
389 set t "$win_.description.t"
390 set s "$win_.description.s"
391
392 set l [$t yview]
393 if {[lindex $l 0] != 0 || [lindex $l 1] != 1} {
394 pack $s -side right -before $t -fill y
395 } else {
396 pack forget $s
397 }
398 }
399
400 #
401 ProgramWindow public updateprog {p} {
402 $self instvar win_ prog_ advanced_
403
404 if ![info exists win_] {
405 # window hasn't been built yet -- nothing to update
406 return
407 }
408
409 # update title
410 $win_.title configure -text [$self title]
411
412 # update description
413 set t $win_.description.t
414 $t configure -state normal
415 $t delete 0.0 end
416 if [$prog_ have_field i] {
417 $t insert 0.0 [$prog_ field_value i]
418 } else {
419 $t insert 0.0 "No description provided."
420 }
421 $t configure -state disabled
422
423 if $advanced_ {
424 # update url
425 if [$prog_ have_field u] {
426 set url [$prog_ field_value u]
427 if ![winfo exists $win_.info.webb] {
428 #FIXME duplicated in buildwin
429 button $win_.info.webb -text "Web page:"
430 grid $win_.info.webb -row 0 -column 0 -sticky ew
431 label $win_.info.webl -relief sunken -bg white -bd 2 -anchor w
432 grid $win_.info.webl -row 0 -column 1 -sticky ew -padx 5
433 }
434 $win_.info.webb configure \
435 -command "[Application instance] gourl $url"
436 $win_.info.webl configure -text $url
437 }
438
439 # update email
440 if [$prog_ have_field e] {
441 if ![winfo exists $win_.info.maill] {
442 #FIXME duplicated in buildwin
443 label $win_.info.maill -text "E-Mail Contact:"
444 grid $win_.info.maill -row 1 -column 0 -sticky ew
445 label $win_.info.mailv -bg white -relief sunken -bd 2 \
446 -anchor
447 grid $win_.info.mailv -row 1 -column 1 -sticky ew -padx 5
448 }
449 $win_.info.mailv configure -text [$prog_ field_value e]
450 }
451
452 # update phone
453 if [$prog_ have_field p] {
454 if ![winfo exists $win_.info.phonel] {
455 #FIXME duplicated in buildwin
456 label $win_.info.phonel -text "Telephone Contact:"
457 grid $win_.info.phonel -row 2 -column 0 -sticky ew
458 label $win_.info.phonev -bg white -relief sunken -bd 2 \
459 -anchor
460 grid $win_.info.phonev -row 2 -column 1 -sticky ew -padx 5
461 }
462 $win_.info.phonev configure -text [$prog_ field_value p]
463 }
464
465 # update media streams
466 set media [[$prog_ base] set allmedia_]
467 set f $win_.bottom.media.f
468 set i 0
469 foreach m $media {
470 if ![winfo exists $f.type$i] {
471 label $f.type$i -relief flat -anchor e
472 label $f.info$i -relief sunken -bd 1 -bg white -anchor w
473 grid $f.type$i -row $i -column 0 -sticky ew
474 grid $f.info$i -row $i -column 1 -sticky ew -padx 5
475 }
476 if [catch {set addr [$m set caddr_]}] { set addr "???" }
477 set n [string first / $addr]
478 if {$n != -1} { set addr [string range $addr 0 [expr $n-1]] }
479 if [catch {set port [$m set port_]}] { set port "???" }
480
481 $f.type$i config -text "[$m set mediatype_]:"
482 $f.info$i config -text "$addr/$port"
483
484 incr i
485 }
486 set old [llength [winfo children $f]]
487 set new [llength $media]
488 for {set i $old} {$i < $new} {incr i} {
489 destroy $f.type$i $f.info$i
490 }
491 }
492
493
494 if $advanced_ {
495 set appwin $win_.bottom.apps
496 set timewin $win_.bottom.times
497 } else {
498 set appwin $win_.bottom.f.apps
499 set timewin $win_.bottom.f.times
500 }
501
502 # update apps window
503 foreach child [winfo children $appwin] { destroy $child }
504 $self build-apps $appwin $advanced_
505
506 # update times
507 foreach child [winfo children $timewin] { destroy $child }
508 $self build-times $timewin
509 }
510
511 # Maps the window with the SDP source for this program if it is
512 # not currently mapped and unmaps it if it is. Creates the window
513 # if necessary by calling <i>build-srcwin</i>.
514 ProgramWindow private toggle-srcwin {} {
515 $self instvar sw_ win_
516 if ![info exists sw_] {
517 set sw_ "$win_.src"
518 $self build-srcwin $sw_
519 return
520 }
521 if [winfo ismapped $sw_] {
522 wm withdraw $sw_
523 } else {
524 wm deiconify $sw_
525 }
526 }
527
528 # Creates a toplevel window <i>w</i> and displays the SDP source
529 # for this program within.
530 ProgramWindow private build-srcwin w {
531 toplevel $w
532 wm title $w "nsdr: SDP Source"
533
534 #FIXME
535 $self instvar prog_
536 set msg [$prog_ base]
537
538 set t $w.t
539 set sx $w.sx
540 set sy $w.sy
541
542 text $t -font [$self get_option smallfont] -wrap none \
543 -xscroll "$sx set" -yscroll "$sy set"
544 $t insert 0.0 [$msg set msgtext_]
545 grid $t -row 0 -column 0 -sticky nsew
546
547 scrollbar $sx -orient horizontal -command "$t xview" -width 10
548 grid $sx -row 1 -column 0 -sticky ew
549 scrollbar $sy -orient vertical -command "$t yview" -width 10
550 grid $sy -row 0 -column 1 -sticky ns
551
552 button $w.b -text "Dismiss" -command "wm withdraw $w"
553 grid $w.b -row 2 -column 0 -columnspan 2
554
555 wm protocol $w WM_DELETE_WINDOW "wm withdraw $w"
556 }
557
558 # Given an SDPTime object <i>t</i> and an NTP time <i>now</i>,
559 # finds the first time after <i>now</i> when this program will
560 # be active. Returns that time or an empty string if there is
561 # no such time (i.e., if all active times have passed or if the
562 # session is unbounded)
563 #
564 # FIXME maybe this should be moved to SDPTime
565 ProgramWindow private nexttime {t now} {
566 $self instvar offset_
567
568 set first [$t set starttime_]
569 if {$first == 0} { return "" }
570
571 # if start time hasn't come yet, it is the next time
572 # return times in local time
573 if {$now < $first} {
574 return [format %u [expr $first - $offset_]]
575 }
576
577 # at this point, starttime has passed. if there are no
578 # repeats, this time field is hopeless
579 if ![$t have_field "r"] { return "" }
580
581 # try all repeats
582 set end [$t set endtime_]
583 set offs [$t set offlist_]
584 set int [$t set repeat_interval_]
585
586 while {$first < $end} {
587 foreach o $offs {
588 set time [format %u [expr $first + $o]]
589 if {$now < $time} {
590 # found one
591 return [format %u [expr $time - $offset_]]
592 }
593 }
594 set first [format %u [expr $first + $int]]
595 }
596
597 # nothing worked...
598 return ""
599 }
600
601 # Calculates how long (in milliseconds) to wait before posting an
602 # alarm or starting an application for this program. Uses nexttime
603 # to find the next time, subtracts the lead time from the
604 # <i>alarmLead</i> resource, and converts to milliseconds.
605 ProgramWindow private getwait {} {
606 $self instvar prog_ offset_
607
608 set now [clock seconds]
609 set ntpnow [format %u [expr $now + $offset_]]
610 foreach time [[$prog_ base] set alltimedes_] {
611 set t [$self nexttime $time $ntpnow]
612 if {$t == ""} { continue }
613 if ![info exists mintime] {
614 set mintime $t
615 } elseif {$t < $mintime} {
616 set mintime t
617 }
618 }
619 if ![info exists mintime] { return "" }
620 set lead [$self get_option alarmLead]
621 set wait [expr 1000*($mintime - $now - $lead)]
622
623 # set sec [expr $wait/1000]
624 # puts "waiting $sec seconds (until [clock format [expr $now+$sec]])"
625
626 return $wait
627 }
628
629 # Launch an application for this program.
630 ProgramWindow public run {args} {
631 foreach cmd $args {
632 #FIXME
633 if [winfo exists $cmd] {
634 set cmd [$cmd get]
635 }
636
637 # Escape special Tcl characters so exec works ok.
638
639 set escapedCmd $cmd
640 regsub -all {\\} $escapedCmd {\\\\} escapedCmd
641 regsub -all {"} $escapedCmd {\"} escapedCmd
642 set i [expr [string first {\"} $escapedCmd] - 1]
643 set j [expr $i + 2]
644 set escapedCmd \
645 [string range $escapedCmd 0 $i][string range $escapedCmd $j end]
646 set i [expr [string last {\"} $escapedCmd] - 1]
647 set j [expr $i + 2]
648 set escapedCmd \
649 [string range $escapedCmd 0 $i][string range $escapedCmd $j end]
650 regsub -all {\[} $escapedCmd {\[} escapedCmd
651 regsub -all {\]} $escapedCmd {\]} escapedCmd
652 regsub -all {\$} $escapedCmd {\$} escapedCmd
653
654 # FIXME
655 # The <<null is a hack to get nsdr working on Windows. Without it, the
656 # exec fails in TclpCreateProcess when it tries to duplicate the handle
657 # to stdin. Tcl 8.4a2 does not appear to fix this problem because the
658 # stdin handle passed to us is a pipe. --LL
659 #
660 if [catch {eval exec $escapedCmd <<null &} m] {
661 $self warn "couldn't run \"$cmd\": $m"
662 }
663 }
664 }
665
666 #
667 ProgramWindow private stop-announcing {} {
668 # FIXME
669 set src [[[Application instance] set ui_] current-source]
670 $src stop-announce [$self set prog_]
671
672 #FIXME need to delete
673 }
674
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.