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

Last change on this file since 44 was 44, checked in by mmc, 17 years ago

Fixed the MainWin? to honor "-anchor fill" in "web" mode. This
causes the main window to fill all available screen real estate.
Had to fix the scroller to make this work properly. I think
this also fixes problems with scrolled forms not expanding into
available real estate.

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