~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~ [ freetext search ] ~ [ file search ] ~

Open Mash Cross Reference
mash/tcl/mb/ui-mboard.tcl

Component: ~ [ mash ] ~ [ apps ] ~ [ gsm ] ~ [ lib ] ~ [ otcl ] ~ [ srm ] ~ [ tcl8.3 ] ~ [ tclcl ] ~ [ tk8.3 ] ~ [ tutorials ] ~

  1 # ui-mboard.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 #
 33 Class MBWidget
 34 
 35 #
 36 MBWidget instproc pack {args} {
 37         eval pack [$self set path_] $args
 38 }
 39 
 40 #
 41 MBWidget instproc unpack {} {
 42         $self instvar path_
 43         pack forget [$self set path_]
 44 }
 45 
 46 import SrcList MBOptionMenu MBPageNavPanel MBUI_Print MBCanvas \
 47                 MBMenu MBToolbar MBTimeBrowser Observer Configuration
 48 
 49 # This class contains MediaBoard user-interface functions
 50 Class MBUI -superclass Observer -configuration {
 51         canvWidth 500
 52         canvHeight 430
 53         showLocalOwnerTip 0
 54         drop 0
 55         psOrient portrait
 56         psColorMode gray
 57         psContent full
 58         statusbarOnTop 1
 59 }
 60 
 61 #
 62 # Pack a mediaboard in the frame, <i>path</i>, which the caller is responsible for instantiating and packing.
 63 #
 64 MBUI instproc init {path mgr sender vis exitCmd} {
 65         $self instvar idleHandler_  mgr_ vis_ printUI_ srcList_
 66         set idleHandler_ {}
 67         set mgr_ $mgr
 68         set vis_ $vis
 69         set srcList_ [new SrcList]
 70         $srcList_ add_callback track "$self track"
 71 
 72         $self set tipsAsDrawn_ 1
 73 
 74         $self instvar mainframe_ tframe_ canvframe_ \
 75                         canvframetext_ canvframebut_ bframe_ mframe_ menu_
 76         set mainframe_ $path
 77 
 78         set tframe_ [frame $mainframe_.tf -borderwidth 0 -relief raised]
 79         set canvframe_ [frame $tframe_.cf -borderwidth 2 -relief ridge]
 80 
 81         set canvframetext_ [label $canvframe_.l \
 82                         -text "\nWaiting for network specs.\n" ]
 83         set canvframebut_ [button $canvframe_.b \
 84                         -text "Create new page" -state disabled \
 85                         -command "\[$self set menu_\] insert_page" ]
 86 
 87         if $vis_ {
 88                 pack $canvframe_ -side left -fill both \
 89                                 -expand true -padx 1 -pady 1
 90                 pack $canvframetext_ -side top -anchor c \
 91                                 -fill both -expand true
 92                 pack $canvframebut_ -side top -anchor c \
 93                                 -fill x -expand true -anchor s -pady 3 -padx 3
 94         }
 95 
 96         $self set bframe_ [frame $mainframe_.bf \
 97                         -borderwidth 0 -relief raised -height 22p]
 98 
 99         $self set mframe_ [frame $mainframe_.mf \
100                         -borderwidth 1 -relief raised ]
101 
102         if $vis_ {
103                 pack $mframe_ -side top -fill x -expand false -anchor n
104                 pack propagate $bframe_ FALSE
105         }
106 
107         $self instvar props_ toolbar_
108         set props_ [new MBProps]
109         $props_ draw_panel $bframe_
110         $self draw_navPanel $bframe_
111         $self tkvar statusbarOnTop_
112         set statusbarOnTop_ [$self get_option statusbarOnTop]
113 
114         $self instvar debug_
115         set debug_ [new MBDebugDlg $mgr_ $vis_]
116         $mgr_ attach_debug $debug_
117         set drop [$self get_option drop]
118         $debug_ change_state $drop
119         set menu_ [new MBMenu $self $mframe_ $mgr_ $exitCmd]
120         set toolbar_ [new MBToolbar $self $tframe_ $mgr $sender ""]
121 
122         # add callback
123         $toolbar_ trace_tool "$self tool_changed"
124 
125         if $vis_ {
126                 pack $tframe_ -side top -fill both -expand true -anchor nw
127         }
128 
129         set geom [$self get_option geometry]
130         if {$vis} {
131                 wm geometry . $geom
132                 global mash
133                 if { ![info exists mash(environ)] || $mash(environ)!="mplug"} {
134                         wm iconify .
135                         wm deiconify .
136                 }
137 #temporarily commenting out because if $path passed to this method is not packed already, this will hang forever
138 #               tkwait visibility $canvframebut_
139 #                focus $canvframebut_
140         } else {
141                 global mash
142                 if { ![info exists mash(environ)] || $mash(environ)!="mplug"} {
143                         wm iconify .
144                         wm title . [lindex [split [info hostname] .] 0]
145                 }
146         }
147 
148         set orient [$self get_option psOrient]
149         set color [$self get_option psColorMode]
150         set content [$self get_option psContent]
151 
152         set printUI_ [MBUI_Print .mbuiprint -colorMode $color \
153                         -orient $orient -content $content \
154                         -pageMgr [$mgr_ page_manager]]
155         $printUI_ hide
156         $self set browsePage_ {}
157         [$mgr_ page_manager] attach_observer $self
158 
159         global mb
160         set pswin [new MBPSProcessor .mbps]
161         DbgOut [concat "Window ID for MBPSProcessor: " [winfo id .mbps]]
162         set mb(gsinterp) [new MBPSInterp $pswin]
163 }
164 
165 #
166 MBUI instproc reset { session } {
167         # set the window & icon title from the conference name
168         set prefix [$self get_option iconPrefix]
169         set hostname [lindex [split [info hostname] .] 0]
170         append prefix "@" $hostname ":"
171         set conf [$self get_option conferenceName]
172         if {$conf=={}} {
173                 set conf [[$session data-net] addr]
174                 append conf /
175                 append conf [[$session data-net] sport]
176         }
177         $self window_title $prefix $conf
178 
179         $self activate
180 }
181 
182 #
183 MBUI instproc destroy {} {
184 }
185 
186 #
187 MBUI instproc mgr {} {
188         return [$self set mgr_]
189 }
190 
191 #
192 MBUI instproc printUI {} { return [$self set printUI_] }
193 
194 #
195 MBUI instproc window_title { prefix name } {
196         $self instvar name_ prefix_
197         set name_ $name
198         set prefix_ $prefix
199         wm iconname . "$prefix_$name_"
200         wm title . "$prefix_$name_"
201 }
202 
203 #
204 MBUI instproc activate {} {
205         $self instvar canvframebut_ canvframetext_
206         if [winfo exists $canvframebut_] {
207                 $canvframebut_ configure -state normal
208         }
209         if [winfo exists $canvframetext_] {
210                 $canvframetext_ configure \
211                                 -text "\nPlease wait for data to arrive from the network\n or \nclick on the button below to create a new page.\n        "
212         }
213 }
214 
215 #
216 # toggle/display the position of the status bar
217 #
218 MBUI instproc redraw_statusbar {} {
219         $self tkvar statusbarOnTop_
220         $self instvar bframe_ tframe_
221         if {$statusbarOnTop_} {
222                 pack $bframe_ -before $tframe_ \
223                                 -side top -fill x -expand false -anchor s
224         } else {
225                 pack $bframe_ -before $tframe_ \
226                                 -side bottom -fill x -expand false -anchor s
227         }
228 
229 }
230 
231 # packs the status bar as well as toolbar
232 MBUI instproc pack_panels {} {
233         $self instvar canvframetext_ canvframebut_ toolbar_ canvframe_ vis_ \
234                         mgr_
235         destroy $canvframetext_
236         destroy $canvframebut_
237 
238         # pack the panel of buttons and the bottom status panel
239         $self redraw_statusbar
240         if $vis_ {
241                 $self show_toolbar 1
242         }
243 }
244 
245 #
246 MBUI instproc activity {src {page_id {}} {canv {}} {id {}}} {
247         # -- c++ callback  ---
248         $self instvar idleHandler_ srcList_ menu_ tipsAsDrawn_ \
249                         browsePage_ mgr_
250         if {$src != {}} {
251                 $srcList_ hilit $src
252                 if {$idleHandler_=={}} {
253                         set idleHandler_ [after idle $self refresh]
254                 }
255         }
256         if { ($canv != {}) && $tipsAsDrawn_ && $id!=0} {
257                 $canv show_owner $id 0
258         }
259         if { ($page_id != {}) && [$menu_ followActivePage] == 1 \
260                         && $browsePage_ == {}} {
261                 [$mgr_ page_manager] switch_page_later $page_id
262         }
263 }
264 
265 #
266 MBUI instproc notify_currPage {src page_id} {
267         $self instvar mgr_
268         mtrace trcVerbose "notify currpage $page_id"
269         set pageMgr [$mgr_ page_manager]
270         if {[$pageMgr current_page] != $page_id} {
271                 $pageMgr switch_page_later $page_id
272         }
273 }
274 
275 #
276 # executed when idle, does some background refreshing
277 #
278 MBUI instproc refresh {} {
279         $self instvar idleHandler_ mgr_
280 
281         # adjusts size of canvas etc.
282         set pagemgr [$mgr_ page_manager]
283         if {[$pagemgr current_page] != {}} {
284                 [$pagemgr current_canvas] refreshScrReg
285         }
286         set idleHandler_ {}
287 }
288 
289 #
290 # This command will be called by the MediaBoard objects,
291 #   to create a new canvas when a new page has been created
292 #
293 #   - creates new canvas if neccesary
294 #   - updates mapping if needed
295 #
296 
297 # -- c++ callback  --- #
298 MBUI instproc create_canvas {page_id} {
299         $self instvar vis_ mgr_
300         set pageMgr [$mgr_ page_manager]
301 
302         if [$pageMgr has_page $page_id] {
303                 mtrace trcVerbose "returning old value: $pageMgr page2canv $page_id]"
304                 return [$pageMgr page2canv $page_id]
305         }
306         $self instvar canvframe_
307         set fr $canvframe_
308 
309         if ![winfo exists $fr.xs] {
310                 scrollbar $fr.xs -orient horizontal -width 12
311                 scrollbar $fr.ys -orient vertical -width 12
312         }
313 
314         set size [list 0 0]
315 
316         # If there's a total geometry spec, honor that first.
317         if { [$self get_option geometry] != "" } {
318                 set g [split [$self get_option geometry] x]
319                 set canvWidth [expr [lindex $g 0] - 60]
320                 set canvHeight [expr [lindex $g 1] - 90]
321         } else {
322                 set canvWidth [$self get_option canvWidth]
323                 set canvHeight [$self get_option canvHeight]
324         }
325 
326         set size [list [lappend size $canvWidth $canvHeight]]
327 
328         set c [new MBCanvas]
329 
330         $c create_canvas $canvframe_ \
331                     "-scrollregion $size -width $canvWidth \
332                     -height $canvHeight -background white \
333                     -takefocus 1"
334 
335         $c setsize $canvWidth $canvHeight
336 
337         if {[$self get_option showLocalOwnerTip]==0} {
338                 $c omitShowOwner [$mgr_ local_src]
339         }
340 
341         $pageMgr add_page $page_id $c
342 
343         if {[$pageMgr current_page]=={}} {
344                 after idle "$self pack_first_canvas $c"
345         }
346         mtrace trcVerbose "created new page: $page_id"
347 
348         set w [$c get_win]
349         $self instvar toolbar_
350         set textTool [$toolbar_ tool text]
351         # for people without B2
352         bind $w <Shift-Button-1> \
353                     "$textTool paste $c \[$c canvasxy %x %y\]; break"
354         # common binding for paste
355         bind $w <Button-2> [bind $w <Shift-Button-1>]
356         bind $w <Control-v> "$textTool paste $c \[$c pointerxy\]; break"
357         bind $w <Control-y> [bind $w <Control-v>]
358         bind $w <Shift-Insert> [bind $w <Control-v>]
359         bind $w <Button-3> "[$toolbar_ tool erase] erase_last \[$pageMgr current_page\]"
360 
361         # we want to be able to insert tabs into the canvas, but per window
362         # focus seems to be broken...
363         bind $w <Tab> "break"
364 
365         return $c
366 }
367 
368 #
369 MBUI instproc pack_first_canvas {c} {
370         $self instvar vis_ canvframe_ mgr_ menu_
371         set pageMgr [$mgr_ page_manager]
372 
373         if {[$pageMgr current_page]!={}} {
374                 return
375         }
376         $c configure -xscrollcommand [list $canvframe_.xs set] \
377                         -yscrollcommand [list $canvframe_.ys set]
378 
379         $pageMgr switch_page_later [$pageMgr canv2page $c]
380         if {$vis_} {
381                 after idle "$self pack_panels"
382         }
383         pack $canvframe_.xs -side bottom -fill x -expand false \
384                         -anchor n \
385                         -padx 1 -pady 1
386         pack $canvframe_.ys -side left -fill y -expand false \
387                         -anchor w \
388                         -pady 1 -padx 1
389         $canvframe_.xs configure -command \
390                         "\[$pageMgr current_canvas\] xview"
391         $canvframe_.ys configure -command \
392                         "\[$pageMgr current_canvas\] yview"
393 }
394 
395 #
396 MBUI instproc draw_navPanel {fr args} {
397         $self instvar mgr_ pageNavPanel_ canvframe_
398         if [$self set vis_ ] {
399                 set pageNavPanel_ [new MBPageNavPanel $fr [$mgr_ page_manager]]
400                 $pageNavPanel_ build_widgets {pagelist next prev zoom}
401                 $pageNavPanel_ pack -side right -fill y -anchor se -padx 2
402 
403                 # update the zoom value when resizing the canvas
404                 bind $canvframe_ <Configure> "update idletasks; $pageNavPanel_ update_zoomscale"
405 
406         }
407         return [$pageNavPanel_ set path_]
408 }
409 
410 # returns current selected property of a tool
411 MBUI instproc property {tool} {
412         return [[$self set props_] property $tool]
413 }
414 
415 #
416 # Callback from toolbar when the tool has changed
417 #
418 MBUI instproc tool_changed {newtool} {
419         eval [$self set props_] refresh_panel $newtool
420 }
421 
422 #
423 # Callback when a page has been changed
424 MBUI instproc switch_page {page_id} {
425         $self instvar toolbar_ menu_
426         if {[$toolbar_ current_tool] == {}} {
427                 $toolbar_ select_tool freehand
428         } else {
429                 $toolbar_ select_tool [$toolbar_ current_tool]
430         }
431         $menu_ tkvar browseTime_
432         if {$browseTime_ == 1}  {
433                 # release previous page
434                 set browseTime_ 0
435                 $self browseTime browseTime_
436                 # browse new page
437                 set browseTime_ 1
438                 $self browseTime browseTime_
439         }
440 }
441 
442 # when tipping is 1, the owner tip will be displayed when there items
443 # are being created
444 MBUI instproc enable_tip_as_drawn {tipping} {
445         $self set tipsAsDrawn_ $tipping
446 }
447 
448 # -----------------------------------------------------------------------
449 
450 # Class MBProps --
451 #    Manages the properties of the different objects can be created
452 #    Also manages the ui that displays/changes the properties
453 Class MBProps
454 
455 #
456 MBProps instproc init_fonts {} {
457         set o [$self options]
458 
459         # use unix lfd's for now so that older mb's will not break
460 if 1 {
461         $o add_default font1 \
462                         -*-helvetica-bold-r-normal--*-120-75-75-*-*-*-*
463         $o add_default font2 \
464                         -*-helvetica-bold-r-normal--*-140-75-75-*-*-*-*
465         $o add_default font3 \
466                         -*-helvetica-bold-r-normal--*-180-75-75-*-*-*-*
467         $o add_default font4 \
468                         -*-helvetica-bold-r-normal--*-240-75-75-*-*-*-*
469         $o add_default font5 \
470                         -*-times-bold-r-normal--*-120-75-75-*-*-*-*
471         $o add_default font6 \
472                         -*-times-bold-r-normal--*-140-75-75-*-*-*-*
473         $o add_default font7 \
474                         -*-times-bold-r-normal--*-180-75-75-*-*-*-*
475         $o add_default font8 \
476                         -*-times-bold-r-normal--*-240-75-75-*-*-*-*
477         $o add_default font9 \
478                         -*-helvetica-bold-r-normal--*-360-*-*-*-*-*-*
479         $o add_default font10 \
480                         -*-helvetica-bold-r-normal--*-480-*-*-*-*-*-*
481         return
482 }
483         # below not used for now
484         $self add_default font1 {helvetica -12 bold}
485         $self add_default font2 {helvetica -14 bold}
486         $self add_default font3 [$o get_option helv18b]
487         $self add_default font4 [$o get_option helv24b]
488         $self add_default font5 [$o get_option times12b]
489         $self add_default font6 [$o get_option times14b]
490         $self add_default font7 [$o get_option times18b]
491         $self add_default font8 [$o get_option times24b]
492 }
493 
494 #
495 MBProps instproc init {} {
496         $self tkvar props_
497 
498         $self init_fonts
499 
500         # format: {[-<label> <prop>]*}
501         set props_(line) {-fill color -arrow arrow -width width}
502         set props_(freehand) {-fill color -width width}
503         set props_(plainline) $props_(freehand)
504         set props_(rectangle) {-fill fill -outline outline -width width}
505         set props_(oval) $props_(rectangle)
506         set props_(text) {-fill color -font font}
507 
508         set props_(move) {}
509         set props_(copy) {}
510         set props_(erase) {}
511         set props_(all)  {fill arrow outline color width font}
512 
513         # the following specfies the format of properties
514         # see MBOptionMenu::init
515         set props_(all,fill)  \
516                         {colors 2 "custom" "" "none" "" White White \
517                         Black Black Red Red \
518                         Orange Orange Yellow Yellow Green Green Blue Blue \
519                         Magenta Magenta Violet Violet}
520         set props_(all,outline) \
521                         {colors 2 "custom" "" Black Black Red Red \
522                         Orange Orange Yellow Yellow \
523                         Green Green Blue Blue Magenta Magenta Violet Violet}
524         set props_(all,color) \
525                         {colors 2 "custom" "" Black Black Red Red \
526                         Orange Orange Yellow Yellow \
527                         Green Green Blue Blue Magenta Magenta Violet Violet}
528         set props_(all,arrow) \
529                         {text 1 "at the end" last "both ends" \
530                         both "beginning" first "none" none}
531         set props_(all,font) {font 1}
532         set i 1
533         while {""!=[set font [$self get_option font$i]]} {
534                 lappend props_(all,font) font$i
535                 lappend props_(all,font) $font
536                 incr i
537         }
538         set props_(all,width)  \
539                         {text 2 1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 9 9 10 10}
540 }
541 
542 #
543 # Refresh the properties-options panel
544 # Alert: props_(set) is of form {[-<label> <prop>]*}
545 #       so lsearch below will work since we use -exact => won't confuse
546 #       values of <label> and <props>
547 #
548 MBProps instproc refresh_panel {currentset} {
549         $self instvar panel_
550         $self tkvar props_
551 
552         if [info exists props_($currentset)] {
553                 set currProps $props_($currentset)
554         } else {
555                 set currProps {}
556         }
557         if {[llength $currProps] == 0} {
558                 pack forget $panel_
559                 return
560         }
561         if ![winfo ismapped $panel_] {
562                 pack $panel_ -side left -expand FALSE -fill both
563         }
564         foreach elt $props_(all) {
565                 if {-1 == [lsearch -exact $currProps $elt]} {
566                         pack forget $panel_.$elt
567                 } else {
568                         pack $panel_.$elt -side left -padx 1 -pady 1
569                 }
570         }
571 }
572 
573 #
574 # Returns the current list of properties given the list of properties
575 #   to fill in, return format is suitable to append to a 'create'
576 #   or 'itemconfig' command
577 #
578 MBProps instproc property {prop_set} {
579         $self tkvar props_
580 
581         set prop_list $props_($prop_set)
582         set newprop ""
583         foreach {param property} $prop_list {
584                 if {$props_($property)!=""} {
585                         append newprop " $param "
586                         append newprop [list $props_($property)]
587                 }
588         }
589         #DbgOut "newprop=$newprop"
590         return $newprop
591 }
592 
593 #
594 # Draws the properties-options panel
595 #
596 MBProps instproc draw_panel {fr args} {
597         $self tkvar props_
598         $self instvar panel_ vis_
599 
600         set font [[Application instance] resource medfont]
601         set panel_ [eval frame $fr.op1 $args]
602         set propsName [$self tkvarname props_]
603         foreach elt $props_(all) {
604                 frame $panel_.$elt
605                 set str "$elt:"
606                 set label [string toupper \
607                                 [string index $str 0]][string range $str 1 end]
608                 label $panel_.$elt.label -text $label -font $font
609                 new MBOptionMenu $panel_.$elt.menu \
610                                 [set propsName]($elt) \
611                                 [set propsName]($elt,currLabel) \
612                                 $props_(all,$elt)
613                 pack $panel_.$elt.label -side left -expand FALSE
614                 pack $panel_.$elt.menu -side left -expand FALSE
615         }
616         $self refresh_panel freehand
617 }
618 
619 #
620 MBUI instproc show_timepanel {on} {
621         $self instvar timepanel_ mainframe_
622         # turn into readonly mode when browsing
623 #puts "show_timepanel $on"
624         $self readonly $on
625 
626         if ![info exists timepanel_] {
627                 $self instvar menu_
628                 set timepanel_ [new MBTimeBrowser $mainframe_ \
629                                 [$menu_ tkvarname browseTime_]]
630                 $timepanel_ update_callBack "$self set_time"
631                 $timepanel_ stop_callBack "$self stopBrowseTime"
632         }
633         if {$on} {
634                 $timepanel_ pack -side bottom -fill x -expand 0
635         } else {
636                 $timepanel_ unpack
637         }
638 }
639 
640 #
641 MBUI instproc show_toolbar {on} {
642         $self instvar toolbar_ canvframe_
643 #puts "show_toolbar $on"
644         if {$on} {
645                 $toolbar_ pack -before $canvframe_ \
646                                 -side right -expand false -anchor e
647         } else {
648                 $toolbar_ unpack
649         }
650 }
651 
652 #
653 MBUI instproc readonly {on} {
654         $self show_toolbar [expr {$on ? 0 : 1}]
655         [$self set menu_] readonly $on
656 }
657 
658 #
659 MBUI instproc browseTime {varname} {
660         upvar $varname browseOnVar
661         $self instvar browsePage_ mgr_
662         mtrace trcVerbose "$class browseTime $browseOnVar"
663         set pageMgr [$mgr_ page_manager]
664         if {$browseOnVar} {
665                 $self instvar timepanel_
666                 set curr_page [$pageMgr current_page]
667                 set range [$mgr_ time_range $curr_page]
668                 set retry 0
669                 # FIXME: wait for a while
670                 while {($range  == {}) && ($retry < 10)} {
671                         update
672                         incr retry
673                         set range [$mgr_ time_range $curr_page]
674                 }
675                 if {$range == {}} {
676                         set browseOnVar 0
677                         Dialog transient MessageBox -title "Empty Page" \
678                                         -text "This page is currently empty. Reverting to normal mode." -type ok
679                 }
680         }
681         $self show_timepanel $browseOnVar
682         if {$browseOnVar} {
683                 # set min and max to be slight over the boundary so that
684                 # we can browse the full range
685                 set mintime [lindex $range 0]
686                 set maxtime [lindex $range 1]
687                 $timepanel_ min_time [expr {$mintime - 1}]
688                 $timepanel_ max_time [expr {$maxtime + 1}]
689                 $timepanel_ goto [expr {$maxtime + 1}]
690                 set browsePage_ [$pageMgr current_page]
691                 $self set_time $maxtime
692         } else {
693                 if {$browsePage_ != {}} {
694                         $mgr_ release_time $browsePage_
695                 }
696                 set browsePage_ {}
697         }
698 }
699 
700 #
701 MBUI instproc stopBrowseTime {} {
702         $self instvar menu_
703         $menu_ tkvar browseTime_
704         set browseTime_ 0
705         $self browseTime browseTime_
706 }
707 
708 #
709 MBUI instproc set_time {newtime} {
710 #       puts "warping to [list [$self set timepanel_] format $newtime]"
711         $self instvar mgr_ browsePage_
712         $mgr_ warp_time $browsePage_ $newtime
713 }
714 
715 #
716 # Track this $src if $trackIt is 1, untrack it if 0
717 #  When a source is being tracked, and it switches page, we will follow
718 #
719 # NOTE: right now we only handle one source at a time
720 MBUI instproc track {src trackIt} {
721         $self instvar srcToTrack_ mgr_
722         if {$trackIt} {
723                 set srcToTrack_ $src
724         } else {
725                 set srcToTrack_ {}
726         }
727         $mgr_ track $src $trackIt
728 }
729 
730 
731 MBUI instproc source_list { } {
732         return [$self set srcList_]
733 }
734 

~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~ [ freetext search ] ~ [ file search ] ~

This page was automatically generated by the LXR engine.
Visit the LXR main site for more information.