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