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

Last change on this file since 115 was 115, checked in by mmc, 16 years ago

Updated all copyright notices.

File size: 11.7 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    grid rowconfigure $itk_component(hull) 0 -weight 1
82    grid columnconfigure $itk_component(hull) 0 -weight 1
83
84    eval itk_initialize $args
85}
86
87# ----------------------------------------------------------------------
88# USAGE: contents ?<widget>|frame?
89#
90# Used to get/set the widget that is being scrolled.  With no args,
91# it returns the name of the widget currently connected to the
92# scrollbars.  Otherwise, the argument specifies a widget to be
93# controlled by the scrollbar.  If the argument is the keyword
94# "frame", then this method creates its own internal frame, which
95# can be packed with other widgets, and returns its name.
96# ----------------------------------------------------------------------
97itcl::body Rappture::Scroller::contents {{widget "!@#query"}} {
98    if {$widget == "!@#query"} {
99        return $_contents
100    }
101
102    #
103    # If the widget is "", then unhook any existing widget.
104    #
105    if {$widget == ""} {
106        if {$_contents != ""} {
107            $_contents configure -xscrollcommand "" -yscrollcommand ""
108            grid forget $_contents
109        }
110        $itk_component(xsbar) configure -command ""
111        $itk_component(ysbar) configure -command ""
112        set _contents ""
113
114        return ""
115    }
116
117    #
118    # For the "frame" keyword, create a canvas that can be scrolled
119    # and return it as the frame being scrolled.
120    #
121    if {$widget == "frame"} {
122        if {$_frame == ""} {
123            set _frame [canvas $itk_component(hull).ifr -highlightthickness 0]
124            frame $_frame.f
125            $_frame create window 0 0 -anchor nw -window $_frame.f -tags frame
126            bind $_frame.f <Configure> \
127                [itcl::code $_dispatcher event -idle !fixframe-inner]
128            bind $_frame <Configure> \
129                [itcl::code $_dispatcher event -idle !fixframe-outer]
130        }
131        set widget $_frame
132    }
133
134    #
135    # Plug the specified widget into the scrollbars for this widget.
136    #
137    contents ""
138    grid $widget -row 0 -column 0 -sticky nsew
139    $widget configure \
140        -xscrollcommand [itcl::code $this _widget2sbar x] \
141        -yscrollcommand [itcl::code $this _widget2sbar y]
142
143    $itk_component(xsbar) configure -command [list $widget xview]
144    $itk_component(ysbar) configure -command [list $widget yview]
145    set _contents $widget
146
147    if {$widget == $_frame} {
148        return $_frame.f
149    }
150    return $widget
151}
152
153# ----------------------------------------------------------------------
154# USAGE: _widget2sbar <which> ?args...?
155#
156# Used internally to handle communication from the widget to the
157# scrollbar.  If the scrollbars are in "auto" mode, this provides a
158# hook where we can fix their display.
159# ----------------------------------------------------------------------
160itcl::body Rappture::Scroller::_widget2sbar {which args} {
161    if {$itk_option(-xscrollmode) == "auto"} {
162        _fixsbar x
163    }
164    if {$itk_option(-yscrollmode) == "auto"} {
165        _fixsbar y
166    }
167    eval $itk_component(${which}sbar) set $args
168}
169
170# ----------------------------------------------------------------------
171# USAGE: _fixsbar <which> ?<state>?
172#
173# Used internally to show/hide the scrollbar in the <which> direction,
174# which is either "x" or "y".  If the scrollbar is "on", then it is
175# always displayed.  If "off", never displayed.  And if "auto", then
176# it is displayed if needed for the current view.
177# ----------------------------------------------------------------------
178itcl::body Rappture::Scroller::_fixsbar {which {state ""}} {
179    if {$state == ""} {
180        switch -- [string tolower $itk_option(-${which}scrollmode)] {
181            on - 1 - true - yes  { set state 1 }
182            off - 0 - false - no { set state 0 }
183            auto {
184                set state 0
185                if {$_contents != ""} {
186                    set lims [$_contents ${which}view]
187                    if {[lindex $lims 0] != 0 || [lindex $lims 1] != 1} {
188                        set state 1
189                    }
190                }
191            }
192            default {
193                set state 0
194            }
195        }
196    }
197
198    # show/hide the scrollbar depending on the desired state
199    switch -- $which {
200        x {
201            if {$state} {
202                if {![_lock active x]} {
203                    grid $itk_component(xsbar) -row 1 -column 0 -sticky ew
204                }
205            } else {
206                grid forget $itk_component(xsbar)
207                _lock set x
208            }
209        }
210        y {
211            if {$state} {
212                if {![_lock active y]} {
213                    grid $itk_component(ysbar) -row 0 -column 1 -sticky ns
214                }
215            } else {
216                grid forget $itk_component(ysbar)
217                _lock set y
218            }
219        }
220    }
221}
222
223# ----------------------------------------------------------------------
224# USAGE: _fixframe <which>
225#
226# Invoked automatically whenever the canvas representing the "frame"
227# keyword is resized.  Updates the scrolling limits for the canvas
228# to the new size.
229# ----------------------------------------------------------------------
230itcl::body Rappture::Scroller::_fixframe {which} {
231    switch -- $which {
232        inner {
233            $_frame configure -scrollregion [$_frame bbox all]
234            $_dispatcher event -idle !fixsize
235        }
236        outer {
237            $_frame itemconfigure frame -width [winfo width $_frame]
238            if {[winfo height $_frame] > [winfo reqheight $_frame.f]} {
239                $_frame itemconfigure frame -height [winfo height $_frame]
240            } else {
241                $_frame itemconfigure frame -height 0
242            }
243        }
244    }
245}
246
247# ----------------------------------------------------------------------
248# USAGE: _fixsize
249#
250# Used internally to update the size options for the widget
251# whenever the -width/-height options change.
252# ----------------------------------------------------------------------
253itcl::body Rappture::Scroller::_fixsize {} {
254    if {$itk_option(-width) == "0" && $itk_option(-height) == "0"} {
255        # for default size, let the frame being controlled set the size
256        grid propagate $itk_component(hull) yes
257        if {$_frame == "$itk_component(hull).ifr"} {
258            set w [winfo reqwidth $_frame.f]
259            set h [winfo reqheight $_frame.f]
260            $_frame configure -width $w -height $h
261        }
262    } else {
263        # for specific size, set the overall size of the widget
264        grid propagate $itk_component(hull) no
265        set w $itk_option(-width); if {$w == "0"} { set w 1i }
266        set h $itk_option(-height); if {$h == "0"} { set h 1i }
267        component hull configure -width $w -height $h
268    }
269}
270
271# ----------------------------------------------------------------------
272# USAGE: _lock set <which>
273# USAGE: _lock reset <which>
274# USAGE: _lock active <which>
275#
276# Used internally to lock out vibrations when the x-scrollbar pops
277# into view.  When the x-scrollbar pops up, it reduces the space
278# available for the widget.  For some widgets (e.g., text widget)
279# this changes the view.  A long line may fall off screen, and the
280# x-scrollbar will no longer be necessary.  If the x-scrollbar just
281# appeared, then its lock is active, signalling that it should stay
282# up.
283# ----------------------------------------------------------------------
284itcl::body Rappture::Scroller::_lock {option which} {
285    switch -- $option {
286        set {
287            set _lock($which) 1
288            after cancel [itcl::code $this _lock reset $which]
289            after 50 [itcl::code $this _lock reset $which]
290        }
291        reset {
292            set _lock($which) 0
293        }
294        active {
295            return $_lock($which)
296        }
297        default {
298            error "bad option \"$option\": should be set, reset, active"
299        }
300    }
301}
302
303# ----------------------------------------------------------------------
304# OPTION: -xscrollmode
305# ----------------------------------------------------------------------
306itcl::configbody Rappture::Scroller::xscrollmode {
307    _fixsbar x
308}
309
310# ----------------------------------------------------------------------
311# OPTION: -yscrollmode
312# ----------------------------------------------------------------------
313itcl::configbody Rappture::Scroller::yscrollmode {
314    _fixsbar y
315}
316
317# ----------------------------------------------------------------------
318# OPTION: -width
319# ----------------------------------------------------------------------
320itcl::configbody Rappture::Scroller::width {
321    # check for proper value
322    winfo pixels $itk_component(hull) $itk_option(-width)
323
324    $_dispatcher event -idle !fixsize
325}
326
327# ----------------------------------------------------------------------
328# OPTION: -height
329# ----------------------------------------------------------------------
330itcl::configbody Rappture::Scroller::height {
331    # check for proper value
332    winfo pixels $itk_component(hull) $itk_option(-height)
333
334    $_dispatcher event -idle !fixsize
335}
Note: See TracBrowser for help on using the repository browser.