← Back to branch summary

~ubuntu-branches/ubuntu/utopic/critcl/utopic

« back to all changes in this revision

Viewing changes to lib/autoscroll/autoscroll.tcl

  • Committer: Package Import Robot
  • Author(s): Andrew Shadura
  • Date: 2013-05-11 00:08:06 UTC
  • Revision ID: package-import@ubuntu.com-20130511000806-7hq1zc3fnn0gat79
Tags: upstream-3.1.9
Import upstream version 3.1.9

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/autoscroll/autoscroll.tcl
 
1
 
 
2
#----------------------------------------------------------------------
 
3
#
 
4
# autoscroll.tcl --
 
5
#
 
6
#       Package to create scroll bars that automatically appear when
 
7
#       a window is too small to display its content.
 
8
#
 
9
#       Author: Kevin Kenny
 
10
#       See http://mini.net/tcl/950.html
 
11
#
 
12
#----------------------------------------------------------------------
 
13
 
 
14
package provide autoscroll 1.0
 
15
 
 
16
namespace eval autoscroll {
 
17
    namespace export autoscroll
 
18
 
 
19
    bind Autoscroll <Delete> [namespace code [list delete %W]]
 
20
    bind Autoscroll <Map> [namespace code [list map %W]]
 
21
}
 
22
 
 
23
#----------------------------------------------------------------------
 
24
#
 
25
# autoscroll::autoscroll --
 
26
#
 
27
#       Create a scroll bar that disappears when it is not needed, and
 
28
#       reappears when it is.
 
29
#
 
30
# Parameters:
 
31
#       w    -- Path name of the scroll bar, which should already
 
32
#               exist and have its geometry managed by the gridder.
 
33
#
 
34
# Results:
 
35
#       None.
 
36
#
 
37
# Side effects:
 
38
#       The widget command is renamed, so that the 'set' command can
 
39
#       be intercepted and determine whether the widget should appear.
 
40
#       In addition, the 'Autoscroll' bind tag is added to the widget,
 
41
#       so that the <Destroy> event can be intercepted.
 
42
#
 
43
# Notes:
 
44
#       It is an error to change the widget's gridding after
 
45
#       calling 'autoscroll' on it.
 
46
#
 
47
#----------------------------------------------------------------------
 
48
 
 
49
proc autoscroll::autoscroll { w } {
 
50
 
 
51
    variable grid
 
52
    variable needed
 
53
 
 
54
    rename $w [namespace current]::renamed$w
 
55
 
 
56
    proc ::$w {args} "
 
57
        return \[eval \[list autoscroll::widgetCommand $w\] \$args\]
 
58
    "
 
59
 
 
60
    set i [grid info $w]
 
61
    if { [string match {} $i] } {
 
62
        error "$w is not gridded"
 
63
    }
 
64
    set grid($w) $i
 
65
    set needed($w) 1
 
66
 
 
67
    bindtags $w [linsert [bindtags $w] 1 Autoscroll]
 
68
 
 
69
    eval [list ::$w set] [renamed$w get]
 
70
 
 
71
    return
 
72
}
 
73
 
 
74
#----------------------------------------------------------------------
 
75
#
 
76
# autoscroll::widgetCommand --
 
77
#
 
78
#       Widget command on an 'autoscroll' scrollbar
 
79
#
 
80
# Parameters:
 
81
#       w       -- Path name of the scroll bar
 
82
#       command -- Widget command being executed
 
83
#       args    -- Arguments to the commane
 
84
#
 
85
# Results:
 
86
#       Returns whatever the widget command returns
 
87
#
 
88
# Side effects:
 
89
#       Has whatever side effects the widget command has.  In
 
90
#       addition, the 'set' widget command is handled specially,
 
91
#       by setting/unsetting the 'needed' flag and gridding/ungridding
 
92
#       the scroll bar according to whether it is required.
 
93
#
 
94
#----------------------------------------------------------------------
 
95
 
 
96
proc autoscroll::widgetCommand { w command args } {
 
97
 
 
98
    variable grid
 
99
    variable needed
 
100
 
 
101
    switch -exact -- $command {
 
102
        set {
 
103
            foreach { min max } $args {}
 
104
            if { $min <= 0 && $max >= 1 } {
 
105
                if { [info exists needed($w)] } {
 
106
                    unset needed($w)
 
107
                    grid forget $w
 
108
                }
 
109
            } else {
 
110
                if { ! [info exists needed($w)] } {
 
111
                    set needed($w) {}
 
112
                    eval [list grid $w] $grid($w)
 
113
                }
 
114
            }
 
115
        }
 
116
    }
 
117
 
 
118
    return [eval [list renamed$w $command] $args]
 
119
}
 
120
 
 
121
#----------------------------------------------------------------------
 
122
#
 
123
# autoscroll::delete --
 
124
#
 
125
#       Delete an automatic scroll bar
 
126
#
 
127
# Parameters:
 
128
#       w -- Path name of the scroll bar
 
129
#
 
130
# Results:
 
131
#       None.
 
132
#
 
133
# Side effects:
 
134
#       Cleans up internal memory.
 
135
#
 
136
#----------------------------------------------------------------------
 
137
 
 
138
proc autoscroll::delete { w } {
 
139
    variable grid
 
140
    variable needed
 
141
 
 
142
    catch { unset grid($w) }
 
143
    catch { unset needed($w) }
 
144
    catch { rename renamed$w {} }
 
145
 
 
146
    return
 
147
}
 
148
 
 
149
#----------------------------------------------------------------------
 
150
#
 
151
# autoscroll::map --
 
152
#
 
153
#       Callback executed when an automatic scroll bar is mapped.
 
154
#
 
155
# Parameters:
 
156
#       w -- Path name of the scroll bar.
 
157
#
 
158
# Results:
 
159
#       None.
 
160
#
 
161
# Side effects:
 
162
#       Geometry of the scroll bar's top-level window is constrained.
 
163
#
 
164
# This procedure keeps the top-level window associated with an
 
165
# automatic scroll bar from being resized automatically after the
 
166
# scroll bar is mapped.  This effect avoids a potential endless loop
 
167
# in the case where the resize of the top-level window resizes the
 
168
# widget being scrolled, causing the scroll bar no longer to be needed.
 
169
#
 
170
#----------------------------------------------------------------------
 
171
 
 
172
proc autoscroll::map { w } {
 
173
    wm geometry [winfo toplevel $w] \
 
174
            [wm geometry [winfo toplevel $w]]
 
175
}