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

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

initial import

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