source: trunk/gui/scripts/scroller.tcl @ 168

Last change on this file since 168 was 168, checked in by mmc, 16 years ago
  • Fixed the license terms to comply with the official open source license from Purdue's OTC office.
  • Fixed the scroller to handle scrollbars properly. They weren't always popping up when needed. Sometimes you had to scroll a little first. Better now.
  • Fixed the DeviceEditor? to pack its internal widgets better, so images within a DeviceViewer1D structure can change size and will show up properly.
  • Fixed the analyzer to take down the progress bar properly when there's an error during execution.
  • Fixed the Rappture::exec command to initialize execctl properly, in case there's an error during execution.
File size: 12.2 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: scroller - adds scrollbars to any standard Tk widget
3#
4#  This widget provides automatic scrollbars for any standard Tk
5#  widget.  The scrolled widget should be created as a child of this
6#  widget, and is connected by calling the "contents" method.  Calling
7#  contents with the keyword "frame" creates an internal frame that
8#  allows any collection of widgets to be scrolled.
9# ======================================================================
10#  AUTHOR:  Michael McLennan, Purdue University
11#  Copyright (c) 2004-2005  Purdue Research Foundation
12#
13#  See the file "license.terms" for information on usage and
14#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
15# ======================================================================
16package require Itk
17
18option add *Scroller.xScrollMode off widgetDefault
19option add *Scroller.yScrollMode auto widgetDefault
20option add *Scroller.width 0 widgetDefault
21option add *Scroller.height 0 widgetDefault
22
23itcl::class Rappture::Scroller {
24    inherit itk::Widget
25
26    itk_option define -xscrollmode xScrollMode XScrollMode ""
27    itk_option define -yscrollmode yScrollMode YScrollMode ""
28    itk_option define -width width Width 0
29    itk_option define -height height Height 0
30
31    constructor {args} { # defined below }
32
33    public method contents {{frame "!@#query"}}
34
35    protected method _widget2sbar {which args}
36    protected method _fixsbar {which {state ""}}
37    protected method _fixframe {which}
38    protected method _fixsize {}
39    protected method _lock {option which}
40
41    private variable _dispatcher "" ;# dispatcher for !events
42    private variable _contents ""   ;# widget being controlled
43    private variable _frame ""      ;# for "contents frame" calls
44    private variable _lock          ;# for _lock on x/y scrollbar
45}
46                                                                               
47itk::usual Scroller {
48    keep -background -activebackground -activerelief
49    keep -cursor
50    keep -highlightcolor -highlightthickness
51    keep -troughcolor
52}
53
54# ----------------------------------------------------------------------
55# CONSTRUCTOR
56# ----------------------------------------------------------------------
57itcl::body Rappture::Scroller::constructor {args} {
58    array set _lock { x 0 y 0 }
59
60    Rappture::dispatcher _dispatcher
61
62    $_dispatcher register !fixframe-inner
63    $_dispatcher dispatch $this !fixframe-inner \
64        "[itcl::code $this _fixframe inner]; list"
65
66    $_dispatcher register !fixframe-outer
67    $_dispatcher dispatch $this !fixframe-outer \
68        "[itcl::code $this _fixframe outer]; list"
69
70    $_dispatcher register !fixsize
71    $_dispatcher dispatch $this !fixsize \
72        "[itcl::code $this _fixsize]; list"
73
74    itk_component add xsbar {
75        scrollbar $itk_interior.xsbar -orient horizontal
76    }
77    itk_component add ysbar {
78        scrollbar $itk_interior.ysbar -orient vertical
79    }
80
81    # we don't fix scrollbars when window is withdrawn, so
82    # fix them whenever a window pops up
83    bind $itk_component(hull) <Map> "
84        [itcl::code $this _fixsbar x]
85        [itcl::code $this _fixsbar y]
86    "
87
88    grid rowconfigure $itk_component(hull) 0 -weight 1
89    grid columnconfigure $itk_component(hull) 0 -weight 1
90
91    eval itk_initialize $args
92}
93
94# ----------------------------------------------------------------------
95# USAGE: contents ?<widget>|frame?
96#
97# Used to get/set the widget that is being scrolled.  With no args,
98# it returns the name of the widget currently connected to the
99# scrollbars.  Otherwise, the argument specifies a widget to be
100# controlled by the scrollbar.  If the argument is the keyword
101# "frame", then this method creates its own internal frame, which
102# can be packed with other widgets, and returns its name.
103# ----------------------------------------------------------------------
104itcl::body Rappture::Scroller::contents {{widget "!@#query"}} {
105    if {$widget == "!@#query"} {
106        return $_contents
107    }
108
109    #
110    # If the widget is "", then unhook any existing widget.
111    #
112    if {$widget == ""} {
113        if {$_contents != ""} {
114            $_contents configure -xscrollcommand "" -yscrollcommand ""
115            grid forget $_contents
116        }
117        $itk_component(xsbar) configure -command ""
118        $itk_component(ysbar) configure -command ""
119        set _contents ""
120
121        return ""
122    }
123
124    #
125    # For the "frame" keyword, create a canvas that can be scrolled
126    # and return it as the frame being scrolled.
127    #
128    if {$widget == "frame"} {
129        if {$_frame == ""} {
130            set _frame [canvas $itk_component(hull).ifr -highlightthickness 0]
131            frame $_frame.f
132            $_frame create window 0 0 -anchor nw -window $_frame.f -tags frame
133            bind $_frame.f <Configure> \
134                [itcl::code $_dispatcher event -idle !fixframe-inner]
135            bind $_frame <Configure> \
136                [itcl::code $_dispatcher event -idle !fixframe-outer]
137        }
138        set widget $_frame
139    }
140
141    #
142    # Plug the specified widget into the scrollbars for this widget.
143    #
144    contents ""
145    grid $widget -row 0 -column 0 -sticky nsew
146    $widget configure \
147        -xscrollcommand [itcl::code $this _widget2sbar x] \
148        -yscrollcommand [itcl::code $this _widget2sbar y]
149
150    $itk_component(xsbar) configure -command [list $widget xview]
151    $itk_component(ysbar) configure -command [list $widget yview]
152    set _contents $widget
153
154    if {$widget == $_frame} {
155        return $_frame.f
156    }
157    return $widget
158}
159
160# ----------------------------------------------------------------------
161# USAGE: _widget2sbar <which> ?args...?
162#
163# Used internally to handle communication from the widget to the
164# scrollbar.  If the scrollbars are in "auto" mode, this provides a
165# hook where we can fix their display.
166# ----------------------------------------------------------------------
167itcl::body Rappture::Scroller::_widget2sbar {which args} {
168    if {$itk_option(-xscrollmode) == "auto"} {
169        _fixsbar x
170    }
171    if {$itk_option(-yscrollmode) == "auto"} {
172        _fixsbar y
173    }
174    eval $itk_component(${which}sbar) set $args
175}
176
177# ----------------------------------------------------------------------
178# USAGE: _fixsbar <which> ?<state>?
179#
180# Used internally to show/hide the scrollbar in the <which> direction,
181# which is either "x" or "y".  If the scrollbar is "on", then it is
182# always displayed.  If "off", never displayed.  And if "auto", then
183# it is displayed if needed for the current view.
184# ----------------------------------------------------------------------
185itcl::body Rappture::Scroller::_fixsbar {which {state ""}} {
186    if {![winfo ismapped $itk_component(hull)]} {
187        #
188        # If we're not on yet screen, bail out!  This keeps bad
189        # numbers (from an empty or partially constructed widget)
190        # from prematurely influencing the scrollbar.
191        #
192        return
193    }
194
195    if {$state == ""} {
196        switch -- [string tolower $itk_option(-${which}scrollmode)] {
197            on - 1 - true - yes  { set state 1 }
198            off - 0 - false - no { set state 0 }
199            auto {
200                set state 0
201                if {$_contents != ""} {
202                    set lims [$_contents ${which}view]
203                    if {[lindex $lims 0] != 0 || [lindex $lims 1] != 1} {
204                        set state 1
205                    }
206                }
207            }
208            default {
209                set state 0
210            }
211        }
212    }
213
214    # show/hide the scrollbar depending on the desired state
215    switch -- $which {
216        x {
217            if {$state} {
218                if {![_lock active x]} {
219                    grid $itk_component(xsbar) -row 1 -column 0 -sticky ew
220                }
221            } else {
222                grid forget $itk_component(xsbar)
223                _lock set x
224            }
225        }
226        y {
227            if {$state} {
228                if {![_lock active y]} {
229                    grid $itk_component(ysbar) -row 0 -column 1 -sticky ns
230                }
231            } else {
232                grid forget $itk_component(ysbar)
233                _lock set y
234            }
235        }
236    }
237}
238
239# ----------------------------------------------------------------------
240# USAGE: _fixframe <which>
241#
242# Invoked automatically whenever the canvas representing the "frame"
243# keyword is resized.  Updates the scrolling limits for the canvas
244# to the new size.
245# ----------------------------------------------------------------------
246itcl::body Rappture::Scroller::_fixframe {which} {
247    switch -- $which {
248        inner {
249            $_frame configure -scrollregion [$_frame bbox all]
250            $_dispatcher event -idle !fixsize
251        }
252        outer {
253            $_frame itemconfigure frame -width [winfo width $_frame]
254            if {[winfo height $_frame] > [winfo reqheight $_frame.f]} {
255                $_frame itemconfigure frame -height [winfo height $_frame]
256            } else {
257                $_frame itemconfigure frame -height 0
258            }
259        }
260    }
261}
262
263# ----------------------------------------------------------------------
264# USAGE: _fixsize
265#
266# Used internally to update the size options for the widget
267# whenever the -width/-height options change.
268# ----------------------------------------------------------------------
269itcl::body Rappture::Scroller::_fixsize {} {
270    if {$itk_option(-width) == "0" && $itk_option(-height) == "0"} {
271        # for default size, let the frame being controlled set the size
272        grid propagate $itk_component(hull) yes
273        if {$_frame == "$itk_component(hull).ifr"} {
274            set w [winfo reqwidth $_frame.f]
275            set h [winfo reqheight $_frame.f]
276            $_frame configure -width $w -height $h
277        }
278    } else {
279        # for specific size, set the overall size of the widget
280        grid propagate $itk_component(hull) no
281        set w $itk_option(-width); if {$w == "0"} { set w 1i }
282        set h $itk_option(-height); if {$h == "0"} { set h 1i }
283        component hull configure -width $w -height $h
284    }
285}
286
287# ----------------------------------------------------------------------
288# USAGE: _lock set <which>
289# USAGE: _lock reset <which>
290# USAGE: _lock active <which>
291#
292# Used internally to lock out vibrations when the x-scrollbar pops
293# into view.  When the x-scrollbar pops up, it reduces the space
294# available for the widget.  For some widgets (e.g., text widget)
295# this changes the view.  A long line may fall off screen, and the
296# x-scrollbar will no longer be necessary.  If the x-scrollbar just
297# appeared, then its lock is active, signalling that it should stay
298# up.
299# ----------------------------------------------------------------------
300itcl::body Rappture::Scroller::_lock {option which} {
301    switch -- $option {
302        set {
303            set _lock($which) 1
304            after cancel [itcl::code $this _lock reset $which]
305            after 50 [itcl::code $this _lock reset $which]
306        }
307        reset {
308            set _lock($which) 0
309        }
310        active {
311            return $_lock($which)
312        }
313        default {
314            error "bad option \"$option\": should be set, reset, active"
315        }
316    }
317}
318
319# ----------------------------------------------------------------------
320# OPTION: -xscrollmode
321# ----------------------------------------------------------------------
322itcl::configbody Rappture::Scroller::xscrollmode {
323    _fixsbar x
324}
325
326# ----------------------------------------------------------------------
327# OPTION: -yscrollmode
328# ----------------------------------------------------------------------
329itcl::configbody Rappture::Scroller::yscrollmode {
330    _fixsbar y
331}
332
333# ----------------------------------------------------------------------
334# OPTION: -width
335# ----------------------------------------------------------------------
336itcl::configbody Rappture::Scroller::width {
337    # check for proper value
338    winfo pixels $itk_component(hull) $itk_option(-width)
339
340    $_dispatcher event -idle !fixsize
341}
342
343# ----------------------------------------------------------------------
344# OPTION: -height
345# ----------------------------------------------------------------------
346itcl::configbody Rappture::Scroller::height {
347    # check for proper value
348    winfo pixels $itk_component(hull) $itk_option(-height)
349
350    $_dispatcher event -idle !fixsize
351}
Note: See TracBrowser for help on using the repository browser.