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

Last change on this file since 5092 was 3642, checked in by mmc, 11 years ago

Fixes for nanoHUB ticket #258058 and #258045 -- note within a group tab
doesn't fill out the area properly. Should work better now. Also fixed
tabs to contain the window, instead of floating above the cotents as they
have for a long time.

Fixed boolean controls to have a more obvious on/off switch instead of a
checkbox. Fixed integers and spinners to use larger +/- buttons that are
easier to press on an iPad. Fixed numbers and other gauges to have the
same relief style as entries and other widgets.

Added new layout styles to groups: horizontal, vertical, tabs, and sentence.
You can now explicitly make a layout vertical instead of tabs by setting
the layout to "vertical" instead of throwing in a separator. Updated the
zoo/groups example to show off new horizontal and sentence types.

Fixed the "drawing" example in the zoo to gray out the trapezoid top when
it is disabled.

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