1 # ui-player.tcl --
2 #
3 # FIXME: This file needs a description here.
4 #
5 # Copyright (c) 1997-2002 The Regents of the University of California.
6 # All rights reserved.
7 #
8 # Redistribution and use in source and binary forms, with or without
9 # modification, are permitted provided that the following conditions are met:
10 #
11 # A. Redistributions of source code must retain the above copyright notice,
12 # this list of conditions and the following disclaimer.
13 # B. Redistributions in binary form must reproduce the above copyright notice,
14 # this list of conditions and the following disclaimer in the documentation
15 # and/or other materials provided with the distribution.
16 # C. Neither the names of the copyright holders nor the names of its
17 # contributors may be used to endorse or promote products derived from this
18 # software without specific prior written permission.
19 #
20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
21 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
23 # ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
24 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
25 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
26 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
27 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
28 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
29 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
30 #
31 # @(#) $Header: /usr/mash/src/repository/mash/mash-1/tcl/applications/player/ui-player.tcl,v 1.8 2002/02/12 22:01:43 lim Exp $
32
33
34 import Dialog ScrolledWindow/Expand Observer FileDialog/Archive VcrIcons \
35 SessionCatalog
36
37 proc address_check { addr } {
38 set addr [split $addr "/"]
39 if { [llength $addr] != 2 } {
40 return 0
41 }
42 set port [string trim [lindex $addr 1]]
43 set addr [string trim [lindex $addr 0]]
44 if { $port=={} || $addr=={} } {
45 return 0
46 }
47
48 set addr [split $addr "."]
49 if { [llength $addr]!=4 } {
50 return 0
51 }
52
53 return 1
54 }
55
56
57 WidgetClass PlayerUI/Main -superclass Dialog -default {
58 { .modal 0 }
59 { .title "Player" }
60 { .session_list.bbox.width 250 }
61 { .session_list.scrollbar both }
62 { *session_list.scrollbar both }
63 { *session_list.borderWidth 1 }
64 { *session_list.relief sunken }
65 { *session_list.bbox.highlightThickness 1 }
66 { *session_list.Scrollbar.borderWidth 1 }
67 { *session_list.Scrollbar.highlightThickness 1 }
68 { *session_list.Scrollbar.width 10 }
69
70 { *ImageTextButton.borderWidth 1 }
71 { *ImageTextButton.highlightThickness 1 }
72 { *font WidgetDefault }
73
74 { .scale.width 10 }
75 { .scale.borderWidth 1 }
76 { .scale.highlightThickness 1 }
77
78 { .menu.tearOff 0 }
79 { .menu.borderWidth 1 }
80 { .menu.highlightThickness 1 }
81 }
82
83
84 PlayerUI/Main instproc build_widget { path } {
85 $self set count_ 0
86 frame $path.buttons
87 frame $path.f1
88
89 ScrolledListbox $path.session_list -itemclass PlayerUI/SessionListItem\
90 -browsecmd "$self browse_session_list"
91 frame $path.session_frame
92
93 # create the various buttons
94
95 label $path.rightbutton \
96 -text "(click right mouse button for more options)"
97 ImageTextButton $path.catalog -image Icons(browse) \
98 -text "Read catalog" \
99 -command "$self catalog"
100 ImageTextButton $path.startplay -image VcrIcons(play) \
101 -text "Start playback" -state disabled \
102 -command "$self start_play"
103 ImageTextButton $path.cancel -image Icons(cross) -text Cancel \
104 -command "exit" \
105 -options { { text.justify left } }
106
107 # create a popup menu
108 menu $path.menu
109 $path.menu add command -label "New session" \
110 -command "$self new_session"
111 $path.menu add command -label "New stream" -command "$self new_stream"
112 $path.menu add command -label "Delete" -command "$self delete"
113 $path.menu add command -label "Start tool" -command "$self start_tool"
114 $path.menu add command -label "Advanced options" \
115 -command "$self advanced_options"
116 bind $path <Button-3> "$self popup_menu %X %Y"
117
118 # pack all widgets
119
120 pack $path.cancel $path.startplay $path.catalog $path.rightbutton \
121 -side right -in $path.buttons -fill y -padx 2
122
123 pack $path.session_list -fill both -side left -in $path.f1 \
124 -padx 5 -pady 5
125 pack $path.session_frame -fill both -expand 1 -side right -in $path.f1\
126 -padx 5 -pady 5
127
128 pack $path.buttons -side bottom -fill x -anchor e -pady 2
129 pack $path.f1 -side top -fill both -expand 1
130
131 # create a dummy session widget to fill up the space while no session
132 # exists
133 $self dummy_session
134
135 $self set ttl_ 16
136 $self set advanced_ [PlayerUI/Advanced $path.advanced]
137 }
138
139
140 PlayerUI/Main instproc dummy_session { } {
141 $self instvar dummy_session_
142 set dummy_session_ [PlayerUI/Session [$self subwidget \
143 session_frame].dummy_session]
144 set bg [WidgetClass widget_default -disabledforeground]
145 $dummy_session_ configure -takefocus 0 -bg $bg
146 $dummy_session_ subwidget bbox configure -takefocus 0 -bg $bg
147 $dummy_session_ subwidget window configure -takefocus 0 -bg $bg
148 $dummy_session_ subwidget hscroll configure -takefocus 0 -bg $bg
149 $dummy_session_ subwidget vscroll configure -takefocus 0 -bg $bg
150
151 pack $dummy_session_ -fill both -expand 1
152 }
153
154
155 PlayerUI/Main instproc start_play { } {
156 # check for duplicate addresses
157
158 set list [$self subwidget session_list]
159 foreach session_widget [$list info all] {
160 set item_widget [$list info widget -id $session_widget]
161 set address [string trim [lindex [$item_widget cget -value] 2]]
162 if [info exists addrlist($address)] {
163 Dialog transient MessageBox -image Icons(warning) \
164 -text "Duplicate address \"$address\"\
165 found in session list. Please fix it\
166 before starting playback"
167 return
168 }
169
170 set addrlist($address) 1
171 }
172
173 # no duplicate addresses found. It's ok to start playback
174
175 $self instvar started_play_
176 set started_play_ 1
177 $self tkvar input_done_
178 set input_done_ yes
179 }
180
181
182 PlayerUI/Main instproc popup_menu { x y } {
183 $self instvar menu_widget_ started_play_
184 set menu [$self subwidget menu]
185 set menu_widget_ [$self find_widget $x $y]
186 if { $menu_widget_ != "" } {
187 if { [$menu_widget_ info class]=="PlayerUI/SessionListItem" } {
188 set type session
189 } else {
190 set type stream
191 }
192 } else {
193 set type ""
194 }
195
196 if [info exists started_play_] {
197 set delete_state disabled
198 $menu entryconfigure "Advanced options" -state disabled
199 } else {
200 set delete_state normal
201 $menu entryconfigure "Advanced options" -state normal
202 }
203
204 switch -exact -- $type {
205 session {
206 $menu entryconfigure "Delete*" -label "Delete session"\
207 -state $delete_state
208 $menu entryconfigure "Start tool" -state normal
209 }
210
211 stream {
212 $menu entryconfigure "Delete*" -label "Delete stream"\
213 -state $delete_state
214 $menu entryconfigure "Start tool" -state disabled
215 }
216
217 default {
218 $menu entryconfigure "Delete*" -label "Delete" \
219 -state disabled
220 $menu entryconfigure "Start tool" -state disabled
221 }
222 }
223
224 tk_popup $menu $x $y
225 }
226
227
228 PlayerUI/Main instproc add_session { protocol media address } {
229 $self instvar count_
230 set widget [PlayerUI/Session [$self subwidget \
231 session_frame].session_$count_]
232 $widget subwidget bbox configure
233 incr count_
234
235 set list [$self subwidget session_list]
236 $list insert end "-id $widget [list $protocol] [list $media] \
237 [list $address]"
238 if { [llength [$list selection get]]==0 } {
239 $list selection set -id $widget
240 $self browse_session_list $widget
241 }
242 return $widget
243 }
244
245
246 PlayerUI/Main instproc delete_session { widget } {
247 destroy $widget
248 set list [$self subwidget session_list]
249 if { [$list selection get -id $widget]!="" } {
250 set selected 1
251 } else {
252 set selected 0
253 }
254
255 $list delete -id $widget
256 if { [$list info numelems] <= 0 } {
257 $self instvar dummy_session_
258 pack $dummy_session_ -fill both -expand 1
259 $self subwidget startplay configure -state disabled
260 } elseif { $selected } {
261 $list selection set 0
262 $self browse_session_list [$list selection get]
263 }
264 }
265
266
267 PlayerUI/Main instproc browse_session_list { widget } {
268 set list [$self subwidget session_list]
269 if { [llength [$list selection get]]==0 } {
270 $list selection set -id $widget
271 }
272
273 catch { pack forget [pack slaves [$self subwidget session_frame]] }
274 pack $widget -fill both -expand 1
275 set old_focus [focus]
276 if { $old_focus != [[$list info widget -id $widget] subwidget \
277 address] && $old_focus!="" } {
278 focus [$list subwidget window]
279 }
280 }
281
282
283 PlayerUI/Main instproc new_session { } {
284 set new [Dialog transient PlayerUI/NewSession]
285 if { $new=="" } return
286
287 set protocol [lindex $new 0]
288 set media [lindex $new 1]
289 set address [lindex $new 2]
290 $self add_session $protocol $media $address
291 }
292
293
294 PlayerUI/Main instproc new_stream { } {
295 set dialog [[Application/Player instance] edit_stream_dialog]
296 $dialog configure -protocol "" -media ""
297 $dialog configure -datafile ""
298 $dialog configure -indexfile ""
299 set result [$dialog invoke]
300 if { $result == "" } return
301
302 $self add_stream [lindex $result 4] [lindex $result 0] \
303 [lindex $result 1] [lindex $result 2] \
304 [lindex $result 3]
305 }
306
307
308 PlayerUI/Main instproc add_stream { name datafile indexfile protocol media } {
309 set session [$self get_session $protocol $media]
310 if { $session!="" } {
311 $session new_stream $name $datafile $indexfile
312 $self subwidget session_list selection set -id $session
313 $self browse_session_list $session
314 }
315 }
316
317
318 PlayerUI/Main instproc start_tool { } {
319 $self instvar menu_widget_
320 $menu_widget_ start_tool
321 }
322
323
324 PlayerUI/Main instproc advanced_options { } {
325 $self instvar advanced_
326 $advanced_ tkvar {ttl_ dlg_ttl}
327 $self instvar ttl_
328
329 set dlg_ttl $ttl_
330 if { [$advanced_ invoke] != "" } {
331 set $ttl_ $dlg_ttl
332 }
333 }
334
335
336 PlayerUI/Main instproc get_session { protocol media } {
337 set list ""
338 set session_list [$self subwidget session_list]
339 foreach session_widget [$session_list info all] {
340 set item_widget [$session_list info widget -id $session_widget]
341 set value [$item_widget cget -value]
342 set p [lindex $value 0]
343 set m [lindex $value 1]
344 if { $protocol==$p && $media==$m } {
345 lappend list "$session_widget $item_widget"
346 }
347 }
348
349 set len [llength $list]
350 switch -exact -- $len {
351 0 {
352 return [$self add_session $protocol $media \
353 224.8.8.1/8000]
354 }
355
356 1 {
357 return [lindex [lindex $list 0] 0]
358 }
359
360 default {
361 return [$self select_session $list]
362 }
363 }
364 }
365
366
367 PlayerUI/Main instproc select_session { list } {
368 set dlg [PlayerUI/SelectSession .select_session]
369 set listbox [$dlg subwidget listbox]
370 foreach s $list {
371 set session_widget [lindex $s 0]
372 set item_widget [lindex $s 1]
373 $listbox insert end "-id $session_widget \
374 [$item_widget cget -value]"
375 set new_item [$listbox info widget -id $session_widget]
376 $new_item subwidget address configure -state disabled
377 }
378
379 $listbox selection set 0
380 set result [$dlg invoke]
381 destroy $dlg
382 return $result
383 }
384
385
386 PlayerUI/Main instproc delete { } {
387 $self instvar menu_widget_
388 if { [$menu_widget_ info class] == "PlayerUI/SessionListItem" } {
389 $self delete_session [$self subwidget session_list info id \
390 -widget $menu_widget_]
391 } else {
392 [$self subwidget session_list selection get] delete_stream \
393 $menu_widget_
394 }
395
396 # set rightbutton [$self subwidget rightbutton]
397 # grab -global $rightbutton
398 # set orig_cursor [$rightbutton cget -cursor]
399 #
400 # global tcl_platform
401 # if {$tcl_platform(platform)=="windows"} {
402 # $rightbutton configure -cursor PIRATE
403 # } else {
404 # $rightbutton configure -cursor pirate
405 # }
406 #
407 # bind $rightbutton <Button-1> "$self try_to_delete %X %Y; \
408 # grab release $rightbutton; \
409 # $rightbutton configure -cursor [list $orig_cursor]; \
410 # bind $rightbutton <Button-1> {}"
411 }
412
413
414 PlayerUI/Main instproc try_to_delete { x y } {
415 set widget [$self find_widget $x $y]
416 if { [$widget info class] == "PlayerUI/SessionListItem" } {
417 $self delete_session [$self subwidget session_list info id \
418 -widget $widget]
419 } else {
420 [$self subwidget session_list selection get] delete_stream \
421 $widget
422 }
423 }
424
425
426 PlayerUI/Main instproc try_to_delete___________ { x y } {
427 set list [$self subwidget session_list]
428 foreach session [$list info all] {
429 set item_widget [$list info widget -id $session]
430 if { [$self is_inside $item_widget $x $y] } {
431 $self delete_session $session
432 return
433 }
434 }
435
436 set session [lindex [$list selection get] 0]
437 if { $session!="" } {
438 foreach stream [$session streams] {
439 if { [$self is_inside $stream $x $y] } {
440 $session delete_stream $stream
441 return
442 }
443 }
444 }
445 }
446
447
448 PlayerUI/Main instproc find_widget { x y } {
449 set list [$self subwidget session_list]
450 foreach session [$list info all] {
451 set item_widget [$list info widget -id $session]
452 if { [$self is_inside $item_widget $x $y] } {
453 return $item_widget
454 }
455 }
456
457 set session [lindex [$list selection get] 0]
458 if { $session!="" } {
459 foreach stream [$session streams] {
460 if { [$self is_inside $stream $x $y] } {
461 return $stream
462 }
463 }
464 }
465
466 return ""
467 }
468
469
470 PlayerUI/Main instproc is_inside { widget x y } {
471 set geom [winfo geometry $widget]
472 set geom [split $geom "+"]
473 set geom_wh [split [lindex $geom 0] "x"]
474 set geom_w [lindex $geom_wh 0]
475 set geom_h [lindex $geom_wh 1]
476
477 set geom_x [expr [winfo rootx $widget] - [winfo vrootx $widget]]
478 set geom_y [expr [winfo rooty $widget] - [winfo vrooty $widget]]
479
480 if { $x >= $geom_x && $y >= $geom_y && $x < [expr $geom_x + $geom_w] \
481 && $y < [expr $geom_y + $geom_h] } {
482 return 1
483 } else {
484 return 0
485 }
486 }
487
488
489 PlayerUI/Main instproc playback_ui { } {
490 set list [$self subwidget session_list]
491 foreach widget [$list info all] {
492 set item_widget [$list info widget -id $widget]
493 $item_widget no_modify
494 $widget no_modify
495 }
496
497 foreach widget [pack slaves [$self subwidget buttons]] {
498 destroy $widget
499 }
500
501 set path [$self info path]
502 #bind $path <Button-3> ""
503 #destroy [$self subwidget menu]
504 set menu [$self subwidget menu]
505 $menu entryconfigure "New session" -state disabled
506 $menu entryconfigure "New stream" -state disabled
507
508 scale $path.scale -orient horizontal -showvalue 0
509 bind $path.scale <ButtonPress-1> "$self scale_start_move"
510 bind $path.scale <ButtonRelease-1> "$self scale_stop_move"
511
512 ImageTextButton $path.playpause -image VcrIcons(pause) -text "Pause" \
513 -command "$self pause" \
514 -options { { text.width 5 } }
515
516 ImageTextButton $path.exit -image Icons(cross) -text "Exit" \
517 -command "exit"
518
519 pack $path.exit $path.playpause -side right -in $path.buttons
520 pack $path.scale -side left -fill x -expand 1 -in $path.buttons \
521 -padx 15
522
523 #menu $path.menu
524 #$path.menu add command -label "Start tool" -command "$self start_tool"
525 }
526
527
528 PlayerUI/Main instproc pause { } {
529 set lts [[Application/Player instance] lts]
530 $lts speed 0.0
531 $self subwidget playpause configure -image VcrIcons(play) \
532 -text "Play" -command "$self play"
533 $self tkvar scale_
534 if [info exists scale_(after_id)] {
535 catch {after cancel $scale_(after_id)}
536 unset scale_(after_id)
537 }
538 }
539
540
541 PlayerUI/Main instproc play { } {
542 set lts [[Application/Player instance] lts]
543 $lts speed 1.0
544 $self subwidget playpause configure -image VcrIcons(pause) \
545 -text "Pause" -command "$self pause"
546 $self tkvar scale_
547 set scale_(after_id) [after 1000 "$self update_scale"]
548 }
549
550
551 PlayerUI/Main instproc scale_start_move { } {
552 $self tkvar scale_
553 set scale_(start_move) $scale_(current)
554 set lts [[Application/Player instance] lts]
555 set scale_(orig_speed) [$lts speed]
556 $lts speed 0.0
557 if { [info exists scale_(after_id)] } {
558 catch {after cancel $scale_(after_id)}
559 unset scale_(after_id)
560 }
561 }
562
563
564 PlayerUI/Main instproc scale_stop_move { } {
565 $self tkvar scale_
566
567 set lts [[Application/Player instance] lts]
568 if { $scale_(start_move) != $scale_(current) } {
569 $lts now_logical $scale_(current)
570 }
571 $lts speed $scale_(orig_speed)
572 set scale_(after_id) [after 1000 "$self update_scale"]
573 unset scale_(start_move) scale_(orig_speed)
574 }
575
576
577 PlayerUI/Main instproc catalog { } {
578 set file_dialog [[Application/Player instance] file_dialog]
579 $file_dialog subwidget filebox configure -filetypes {
580 { {Session catalog files} {.ctg} }
581 { {All files} { * } }
582 }
583
584 set result [$file_dialog invoke]
585 if { $result=="" } {
586 return
587 }
588
589 $self read_catalog $result
590 }
591
592
593 PlayerUI/Main instproc read_catalog { catalog_filename } {
594 set catalog [new SessionCatalog]
595 if { [catch {$catalog open $catalog_filename} error] } {
596 $self invoke_error "Could not open catalog file:\n$error"
597 delete $catalog
598 return
599 }
600
601 if { [catch {$catalog read} error] } {
602 $self invoke_error "Could not read catalog file:\n$error"
603 delete $catalog
604 return
605 }
606
607
608 # delete all previous sessions
609 set list [$self subwidget session_list]
610 foreach session [$list info all] {
611 $self delete_session $session
612 }
613
614 foreach id [$catalog info streams] {
615 lappend sessions([$catalog info session $id]) $id
616 }
617
618 set file [new ArchiveFile]
619 set addr_lobyte 1
620 foreach s [array names sessions] {
621 set address "224.8.8.$addr_lobyte/8000"
622 set session_widget [$self add_session "" "" $address]
623 set item_widget [$list info widget -id $session_widget]
624
625 incr addr_lobyte
626 set protocol ""
627 set media ""
628 foreach id $sessions($s) {
629 set my_datafile [$catalog info datafile $id]
630 set my_indexfile [$catalog info indexfile $id]
631
632 if [catch {$file open $my_datafile} error] {
633 $self invoke_error "Error opening data\
634 file:\n$error"
635 delete $catalog
636 delete $file
637 return
638 }
639
640 if [catch {$file header data_hdr} error] {
641 $self invoke_error "Error reading data\
642 header:\n$error"
643 delete $catalog
644 delete $file
645 return
646 }
647
648 $file close
649
650
651 if [catch {$file open $my_indexfile} error] {
652 $self invoke_error "Error opening index\
653 file:\n$error"
654 delete $catalog
655 delete $file
656 return
657 }
658
659 if [catch {$file header index_hdr} error] {
660 $self invoke_error "Error reading data\
661 header:\n$error"
662 delete $catalog
663 delete $file
664 return
665 }
666
667 $file close
668
669
670 if { $data_hdr(protocol)!=$index_hdr(protocol) } {
671 $self invoke_error "Protocol fields do not\
672 match in data and index files"
673 delete $catalog
674 delete $file
675 return
676 }
677
678 if { $data_hdr(media)!=$index_hdr(media) } {
679 $self invoke_error "Media fields do not\
680 match in data and index files"
681 delete $catalog
682 delete $file
683 return
684 }
685
686 if { $data_hdr(cname)!=$index_hdr(cname) } {
687 $self invoke_error "cname fields do not\
688 match in data and index files"
689 delete $catalog
690 delete $file
691 return
692 }
693
694 if { $data_hdr(name)!=$index_hdr(name) } {
695 $self invoke_error "Name fields do not\
696 match in data and index files"
697 delete $catalog
698 delete $file
699 return
700 }
701
702 $file close
703
704 if { $protocol=="" } {
705 set protocol $data_hdr(protocol)
706 $item_widget configure -value \
707 "[list $protocol] \
708 [list $media] \
709 [list $address]"
710 }
711 if { $media=="" } {
712 set media $data_hdr(media)
713 $item_widget configure -value \
714 "[list $protocol] \
715 [list $media] \
716 [list $address]"
717 }
718
719 if { $protocol!=$data_hdr(protocol) } {
720 $self invoke_error "Streams within the same\
721 session seem to have different\
722 protocols"
723 delete $catalog
724 delete $file
725 return
726 }
727
728 if { $media!=$data_hdr(media) } {
729 $self invoke_error "Streams within the same\
730 session seem to have different\
731 media"
732 delete $catalog
733 delete $file
734 return
735 }
736
737 $session_widget new_stream $data_hdr(name) \
738 $my_datafile $my_indexfile
739 }
740 }
741
742 delete $catalog
743 delete $file
744 }
745
746
747
748 PlayerUI/Main instproc invoke_error { error } {
749 Dialog transient MessageBox -image Icons(warning) -text $error
750 }
751
752
753 PlayerUI/Main instproc config_scale { start end } {
754 $self tkvar scale_
755 set scale [$self subwidget scale]
756 set scale_(start) $start
757 set scale_(end) $end
758 set scale_(current) $start
759 $scale configure -from [expr int($start)] -to [expr int($end)] \
760 -variable [$self tkvarname scale_(current)]
761 $self tkvar scale_
762 set scale_(after_id) [after 1000 "$self update_scale"]
763 }
764
765
766 PlayerUI/Main instproc update_scale { } {
767 set lts [[Application/Player instance] lts]
768 set now [$lts now_logical]
769 $self tkvar scale_
770 if { $now < $scale_(start) } {
771 set now $scale_(start)
772 }
773 if { $now > $scale_(end) } {
774 set now $scale_(end)
775 }
776 set scale_(current) $now
777 $self tkvar scale_
778 set scale_(after_id) [after 1000 "$self update_scale"]
779 }
780
781
782
783
784 WidgetClass PlayerUI/SessionListItem -configspec {
785 { -value value Value {} config_value }
786 { -select select Select 0 config_option }
787 { -highlight highlight Highlight 0 config_option }
788
789 { -normalbackground normalBackground NormalBackground \
790 WidgetDefault(-background) config_option }
791 { -normalforeground normalForeground NormalForeground \
792 WidgetDefault(-foreground) config_option }
793 { -normalrelief normalRelief NormalRelief flat config_option }
794 { -selectbackground selectBackground SelectBackground WidgetDefault \
795 config_option }
796 { -selectforeground selectForeground SelectForeground WidgetDefault \
797 config_option }
798 { -selectrelief selectRelief SelectRelief sunken config_option }
799 { -highlightrelief highlightRelief HighlightRelief raised \
800 config_option }
801 } -default {
802 { .borderWidth 1 }
803 { *font WidgetDefault }
804 { *LabeledWidget.label.font WidgetDefault(-boldfont) }
805 { .address.borderWidth 1 }
806 { .address.relief sunken }
807 { .address.width 18 }
808 }
809
810
811 PlayerUI/SessionListItem instproc build_widget { path } {
812 $self instvar config_
813 set config_(-select) 0
814 set config_(-highlight) 0
815 set config_(-normalbackground) Black
816 set config_(-normalforeground) Black
817 set config_(-normalrelief) flat
818 set config_(-selectbackground) Black
819 set config_(-selectforeground) Black
820 set config_(-selectrelief) sunken
821 set config_(-highlightrelief) raised
822
823 label $path.protocol -anchor w
824 label $path.media -anchor w
825 entry $path.address -textvariable [$self tkvarname address_]
826 pack $path.protocol $path.media -side left -anchor w
827 pack $path.address -fill x -expand 1 -side left -anchor w -padx 5
828
829
830 # bind the up and down keys to the entry box
831 set window [winfo parent $path]
832 bind $path.address <KeyPress-Up> "focus $window; \
833 event generate $window <KeyPress-Up>"
834 bind $path.address <KeyPress-Down> "focus $window; \
835 event generate $window <KeyPress-Down>"
836 }
837
838
839 PlayerUI/SessionListItem instproc config_value { option args } {
840 $self tkvar address_
841 if { [llength $args]==0 } {
842 set protocol [$self subwidget protocol cget -text]
843 set protocol [string range $protocol 0 \
844 [expr [string length $protocol]-2]]
845 set media [$self subwidget media cget -text]
846 return "[list $protocol] [list $media] [list $address_]"
847 } else {
848 set value [lindex $args 0]
849 $self subwidget protocol configure -text "[lindex $value 0]:"
850 $self subwidget media configure -text [lindex $value 1]
851 set address_ [lindex $value 2]
852 }
853 }
854
855
856 PlayerUI/SessionListItem instproc config_option { option args } {
857 $self instvar config_
858 if { [llength $args]==0 } {
859 return $config_($option)
860 } else {
861 set value [lindex $args 0]
862 $self config_[string range $option 1 end] $value
863 set config_($option) $value
864 }
865 }
866
867
868 PlayerUI/SessionListItem instproc config_background { value } {
869 $self configure -bg $value
870 $self subwidget protocol configure -bg $value
871 $self subwidget media configure -bg $value
872 }
873
874
875 PlayerUI/SessionListItem instproc config_foreground { value } {
876 $self subwidget protocol configure -fg $value
877 $self subwidget media configure -fg $value
878 }
879
880
881 PlayerUI/SessionListItem instproc config_relief { value } {
882 $self configure -relief $value
883 }
884
885
886 PlayerUI/SessionListItem instproc config_normalbackground { value } {
887 if { ![$self set config_(-select)] } {
888 $self config_background $value
889 }
890 }
891
892
893 PlayerUI/SessionListItem instproc config_normalforeground { value } {
894 if { ![$self set config_(-select)] } {
895 $self config_foreground $value
896 }
897 }
898
899
900 PlayerUI/SessionListItem instproc config_normalrelief { value } {
901 if { ![$self set config_(-select)] && \
902 ![$self set config_(-highlight)] } {
903 $self config_relief $value
904 }
905 }
906
907
908 PlayerUI/SessionListItem instproc config_selectbackground { value } {
909 if { [$self set config_(-select)] } {
910 $self config_background $value
911 }
912 }
913
914
915 PlayerUI/SessionListItem instproc config_selectforeground { value } {
916 if { [$self set config_(-select)] } {
917 $self config_foreground $value
918 }
919 }
920
921
922 PlayerUI/SessionListItem instproc config_selectrelief { value } {