1 # ui-menu.tcl --
2 #
3 # FIXME: This file needs a description here.
4 #
5 # Copyright (c) 1993-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
32 import WidgetClass Configuration
33 WidgetClass transparent_gif
34 import MBLogo_Icon StackTrace DbgInfoWindow MBPres KeyEditor
35
36 #
37 # The menubar along the top of the mediaboard... <br>
38 # File Edit View Help Logo
39 #
40 Class MBMenu -configuration {
41 showOwnerTip 1
42 # show owner tip when items are being manipulated
43 showOwnerAsDrawn 1
44 followActive 1
45 }
46
47 MBMenu proc make_menu { parent menuList } {
48 foreach {menuName label} $menuList {
49 set menuBut $parent.$menuName
50 set menu $menuBut.menu
51 menubutton $menuBut -menu $menu -text $label -underline 0
52 pack $menuBut -side left
53 menu $menu -tearoff false
54 }
55 }
56
57 # <!FIXME: this function should go into MBPageMgr >
58 #
59 MBMenu instproc create_new_page {{page_name {}}} {
60 $self instvar mbui_
61 [[$mbui_ mgr] page_manager] create_new_page
62 }
63
64 #
65 MBMenu instproc init {ui fr mgr exitCmd args} {
66 $self instvar mbui_ mgr_
67 set mbui_ $ui
68 set mgr_ $mgr
69
70 set menubar [eval frame $fr.menu $args]
71 set logoF [frame $fr.info]
72 pack $logoF -side right -anchor e
73
74 set logofont [$self get_option logofont]
75 # image create photo mblogo -file "c:/temp/mb.gif"
76
77 set logoImageL [button $logoF.imgL -image MBLogo_Icon \
78 -highlightthickness 0 -relief flat -command {
79 set p [new StackTrace]
80 global errorInfo
81 $p open $errorInfo
82 }]
83 pack $logoImageL -side right -fill y -anchor s -expand false
84
85 set menuList { file "File" edit "Edit" view "View" help "Help"}
86 MBMenu make_menu $menubar $menuList
87
88 # FILE
89 set filemenu $menubar.file.menu
90 $filemenu add command -label Save -underline 0 \
91 -command "$self save"
92
93 $filemenu add command -label "Save as PostScript" -underline 9 \
94 -command "$self postscript"
95
96 $filemenu add command -label Load -underline 0 \
97 -command "$self load"
98
99 if { $exitCmd != {} } {
100 $filemenu add command -label Quit -underline 0 \
101 -command "$exitCmd"
102 }
103
104
105 # EDIT
106
107 # add all these entries to the list that is to be disabled with
108 # set to readonly mode
109 $self instvar readonlyList_
110 set editmenu $menubar.edit.menu
111 set i 0
112 $editmenu add command -label "Erase Last" -underline 0 \
113 -command "$self erase_last"
114 lappend readonlyList_ [list $editmenu $i]
115 incr i
116 $editmenu add command -label "Unerase" -underline 0 \
117 -command "$self unerase"
118 lappend readonlyList_ [list $editmenu $i]
119 incr i
120 $editmenu add command -label "New Page" -underline 0 \
121 -command "$self insert_page"
122 lappend readonlyList_ [list $editmenu $i]
123 incr i
124 $editmenu add command -label "Import..." -underline 0 \
125 -command "$self import_ext"
126 lappend readonlyList_ [list $editmenu $i]
127
128
129 # VIEW
130 set viewmenu $menubar.view.menu
131 # don't view source list by default
132
133 $self tkvar showSrcList_
134 set srcList [$mbui_ set srcList_]
135
136 $viewmenu add checkbutton -label "Members..." -underline 0 \
137 -variable [$self tkvarname showSrcList_] \
138 -command "$srcList toggle_window \
139 \[set [$self tkvarname showSrcList_]\]"
140
141 # install callback
142 $srcList add_callback dismiss "set [$self tkvarname showSrcList_] 0"
143 $srcList add_callback followAny "set [$self tkvarname follow_active_]"
144
145 # follow_active on by default
146 $self tkvar follow_active_
147 set follow_active_ [$self get_option followActive]
148 $srcList set_followAny $follow_active_
149
150 $self tkvar browseTime_
151 $viewmenu add checkbutton -label "Past Activity..." -underline 0 \
152 -variable [$self tkvarname browseTime_] \
153 -command "$mbui_ browseTime [$self tkvarname browseTime_]"
154
155 $viewmenu add command -label "Session info..." \
156 -underline 8 -command "$self disp-sess-info"
157
158 # puts "follow active set to $follow_active_"
159 $viewmenu add checkbutton -label "Follows activity" \
160 -underline 0 \
161 -variable [$self tkvarname follow_active_]
162
163 set pageList [[[$self set mbui_] set pageNavPanel_] set pageList_]
164 $viewmenu add cascade -label "Page" \
165 -menu [$pageList get_copy $viewmenu] -underline 0
166
167 set tipOptionMenu $viewmenu.tipOptions
168 $viewmenu add cascade -label "Tips" \
169 -menu $tipOptionMenu -underline 0
170
171 menu $tipOptionMenu -tearoff 0
172
173 $self tkvar showOwnerTip_
174 $tipOptionMenu add checkbutton -label "under cursor" -underline 0 \
175 -variable [$self tkvarname showOwnerTip_] \
176 -command "$self show_owner_tip"
177 set showOwnerTip_ [$self get_option showOwnerTip]
178
179 $self tkvar showOwnerAsDrawn_
180 $tipOptionMenu add checkbutton -label "when drawn" -underline 0 \
181 -variable [$self tkvarname showOwnerAsDrawn_] \
182 -command "$self show_owner_as_drawn"
183 set showOwnerAsDrawn_ [$self get_option showOwnerAsDrawn]
184
185 set optionmenu $viewmenu.option
186 $viewmenu add cascade -label "Options" \
187 -menu $optionmenu \
188 -underline 0
189
190 menu $optionmenu -tearoff 0
191
192 $self tkvar enable_debug_
193 set enable_debug_ 0
194 set dbgVarName [$self tkvarname enable_debug_]
195 set debugDlg [$mbui_ set debug_]
196 $optionmenu add checkbutton -label "simulate pkt drop" -underline 0 \
197 -variable $dbgVarName \
198 -command "[$mbui_ set debug_] change_state \
199 \[set $dbgVarName\]"
200 $debugDlg add_callback disable_drop "set [$self tkvarname enable_debug_] 0"
201
202
203 $self tkvar enable_trace_
204 set enable_trace_ 0
205 $optionmenu add command -label "toggle trace window" -underline 0 \
206 -command "[MTrace set mtrace] toggle_window"
207 $optionmenu add checkbutton -label "status bar on top" \
208 -variable [$mbui_ tkvarname statusbarOnTop_] \
209 -command "$mbui_ redraw_statusbar"
210
211 set dbgmenu $viewmenu
212 set dumpm $dbgmenu.dumpm
213 $dbgmenu add cascade -label "Debug Info" -menu $dumpm -underline 0
214 menu $dumpm -tearoff 0
215 set sender [[$mbui_ mgr] sender]
216 $dumpm add command -label "TimeStamps" -underline 0 \
217 -command "$self dump_ts"
218 set pageMgr [[$mbui_ mgr] page_manager]
219 $dumpm add command -label "Canvas" -underline 0 \
220 -command "$self dump_canv"
221
222 set helpmenu $menubar.help.menu
223 $helpmenu add command -label About -underline 0 \
224 -command "$self about"
225
226 pack $menubar -side left -fill y -anchor w -expand true
227 return $menubar
228 }
229
230 #
231 MBMenu instproc disp-sess-info {} {
232 $self instvar mgr_ sessDlg_
233
234 if ![info exists sessDlg_] {
235 set sessDlg_ [MBSessionDlg .mbSessDlg -mgr $mgr_ \
236 -title "MediaBoard Session Information" \
237 -name [[$mgr_ local_src] cname]]
238 }
239 wm deiconify $sessDlg_
240 }
241
242 MBMenu instproc about {} {
243 append msg "MediaBoard \n" \
244 "Version [version]\n" \
245 "\n" \
246 "MASH Group \n" \
247 "University of Califonia, Berkeley"
248
249 set msgBox [Dialog transient MessageBox -title "About MediaBoard" \
250 -text $msg -type ok]
251 }
252
253 MBMenu instproc followActivePage {} {
254 $self tkvar follow_active_
255 return $follow_active_
256 }
257
258 MBMenu instproc insert_page {} {
259 $self instvar mbui_
260 set new_pgid [$self create_new_page]
261 set pageMgr [[$mbui_ mgr] page_manager]
262 $pageMgr switch_page_later $new_pgid
263 }
264
265 MBMenu instproc import_ext {} {
266 $self instvar mbui_
267 set toolbar [$mbui_ set toolbar_]
268 # interrupt the current tool
269 $toolbar deactivate_tool [$toolbar current_tool]
270 [$toolbar tool import] activate [[[$mbui_ mgr] page_manager] current_page]
271 }
272
273 #
274 MBMenu instproc tool {toolname} {
275 return [[[$self set mbui_] set toolbar_] tool $toolname]
276 }
277
278 MBMenu instproc paste {} {
279 $self instvar mbui_
280 set c [[[$mbui_ mgr] page_manager] current_canvas]
281 set textTool [$self tool text]
282 mtrace trcMB "texttool: $textTool"
283 # put it on the top left corner
284 $textTool paste $c [$c canvasxy 1.0 1.0]
285 }
286
287 # change settings of show owner under cursor
288 MBMenu instproc show_owner_tip {} {
289 $self tkvar showOwnerTip_
290 $self instvar mbui_
291 # puts "showOwnerTip_ is $showOwnerTip_"
292 [[[$mbui_ mgr] page_manager] current_canvas] enable_tip $showOwnerTip_
293 }
294
295 # change settings of showing the owner as the items are being displayed
296 MBMenu instproc show_owner_as_drawn {} {
297 $self tkvar showOwnerAsDrawn_
298 $self instvar mbui_
299 $mbui_ enable_tip_as_drawn $showOwnerAsDrawn_
300 }
301
302 MBMenu instproc showOwnerVal {} {
303 $self tkvar showOwnerTip_
304 return $showOwnerTip_
305 }
306
307 MBMenu instproc unerase {} {
308 set ueTool [$self tool unerase]
309 $self instvar mbui_
310 $ueTool unerase [[[$mbui_ mgr] page_manager] current_page]
311 }
312
313 MBMenu instproc erase_last {} {
314 $self instvar mbui_
315 set eTool [$self tool erase]
316 $eTool erase_last [[[$mbui_ mgr] page_manager] current_page]
317 }
318
319 MBMenu instproc readonly {on} {
320 $self instvar readonlyList_
321 if {$on} {
322 foreach item $readonlyList_ {
323 set widget [lindex $item 0]
324 set index [lindex $item 1]
325 eval $widget entryconfigure $index -state disabled
326 }
327 } else {
328 foreach item $readonlyList_ {
329 set widget [lindex $item 0]
330 set index [lindex $item 1]
331 eval $widget entryconfigure $index -state normal
332 }
333 }
334 }
335
336 #
337 # prints the current page
338 #
339 MBMenu instproc postscript {} {
340 $self instvar mbui_
341 if {[[[$mbui_ mgr] page_manager] current_page] != {}} {
342 [$mbui_ printUI] show
343 }
344 }
345
346 #
347 MBMenu instproc load {} {
348 $self instvar mbpres_ mbui_
349 if ![info exists mbpres_] {
350 set filename [Dialog transient FileDialog \
351 -title "Choose file to load from" \
352 -type open]
353 set mbpres_ [new MBPres [$mbui_ mgr] $filename]
354 }
355 $mbpres_ load
356 }
357
358 MBMenu instproc save {} {
359 $self instvar mbui_
360 set canv [[[$mbui_ mgr] page_manager] current_canvas]
361 MBPres save_canvas $canv "pres-out.mb"
362 }
363
364 MBMenu instproc dump_ts {} {
365 $self instvar mbui_
366 set sender [[$mbui_ mgr] sender]
367 if ![catch {$sender dump timestamps} result] {
368 if {$result != {}} {
369 new DbgInfoWindow "timestamps" $result
370 }
371 }
372 }
373
374 MBMenu instproc dump_canv {} {
375 $self instvar mbui_
376 set sender [[$mbui_ mgr] sender]
377 if ![catch {$sender dump canvas} result] {
378 if {$result != {}} {
379 append result [DumpCanvas [$pageMgr \
380 current_canvas]]
381 new DbgInfoWindow "timestamps" $result
382 }
383 }
384 }
385
386 # Session Information Dialog
387 WidgetClass MBSessionDlg -superclass Dialog -configspec {
388 { -mgr mgr Mgr "" config_mgr cget_mgr }
389 { -name name Name "" config_name cget_name }
390 }
391
392 MBSessionDlg private build_widget { path } {
393 $self set path_ $path
394 set f [frame $path.topframe -bd 2 -relief flat]
395 pack $f -fill both -expand 1 -side top
396
397 set infoLabel [label $f.ilabel -text "Network Information" -font \
398 [$self get_option medfont]]
399 pack $infoLabel -fill x -side top
400
401 set ef [frame $path.entryframe -bd 2 -relief sunken]
402 $self set_subwidget entryframe $ef
403 pack $ef -fill both -expand 1 -side top
404
405 set ft [frame $path.topframe.infoframe -bd 2 -relief sunken]
406 label $ft.text -justify left
407 $self set_subwidget text $ft.text
408 pack $ft.text -side top -anchor w -expand 1 -fill both
409 pack $ft -side top -fill both
410
411 set configLabel [label $f.clabel -text "Configurations" -font \
412 [$self get_option medfont]]
413 pack $configLabel -fill x -side top
414
415 $self instvar nameEntry_
416
417 set nf [frame $ef.nf]
418 set ne [entry $nf.name -font [$self get_option smallfont]]
419 set nameEntry_ $ne
420 set nl [label $nf.label -font [$self get_option smallfont] \
421 -text "Name: "]
422
423 bind $ne <Return> "$self update_name \[%W get\]"
424 bind $ne <Escape> "$self configure -name \[set [$self tkvarname name_]\]; break"
425 bind $ne <FocusOut> "$self update_name \[%W get\]"
426 pack $nf -side top -fill x -expand 1 -padx 1 -pady 1
427 pack $nl -side left -expand 0
428 pack $ne -side left -fill x -anchor w -expand 1 -padx 1
429
430 set bf [frame $path.bframe -bd 1 -relief flat]
431 ImageTextButton $bf.ok -underline 0 -text "Ok" \
432 -image Icons(check) -orient horizontal \
433 -command "$self dismiss"
434
435 pack $bf.ok -expand 0 -pady 2
436 pack $bf -fill x -expand 0 -side bottom -anchor s
437 }
438
439 MBSessionDlg private config_name {option name} {
440 $self tkvar name_
441 set name_ $name
442 $self instvar nameEntry_
443 $nameEntry_ del 0 end
444 $nameEntry_ insert 0 $name_
445 }
446
447 MBSessionDlg private cget_name {name} {
448 $self tkvar name_
449 return $name_
450 }
451
452 MBSessionDlg private update_name {name} {
453 $self instvar mgr_
454 $mgr_ update_name $name
455 }
456
457 MBSessionDlg private config_mgr {opt mgr} {
458 if {$mgr == {}} {
459 return
460 }
461 $self instvar mgr_
462 set mgr_ $mgr
463 $self subwidget text configure -text [$self get_sessionInfo]
464 set t [$self subwidget entryframe]
465 $self instvar ke_
466 if [info exists ke_] {
467 delete $ke_
468 }
469 set ke_ [new KeyEditor $t [[$mgr session] get_agent]]
470 pack $t.key -side bottom -fill x -anchor w -padx 1
471 }
472
473 MBSessionDlg private cget_mgr {} {
474 return [$self set mgr_]
475 }
476
477 MBSessionDlg private get_sessionInfo {} {
478 $self instvar mgr_
479
480 set dn [[$mgr_ session] data-net]
481 set cn [[$mgr_ session] ctrl-net]
482
483 append msg "Session address: " [$dn addr] "\n" \
484 "Data port: " [$dn sport] "\n" \
485 "Control port: " [$cn sport] "\n" \
486 "Session TTL: " [$dn ttl] "\n" \
487 "Session interface: " [$dn interface]
488 return $msg
489 }
490
491 MBSessionDlg private dismiss { } {
492 $self instvar nameEntry_ path_
493 if {[$nameEntry_ get] != [$self cget -name]} {
494 $self update_name [$nameEntry_ get]
495 }
496 wm withdraw $path_
497 raise $path_
498 }
499
500
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.