Version 6 of Scroll bars that appear only when needed
Updated 2003-07-28 06:42:10Purpose: Present code for scrollbars that appear and disappear according to whether they are needed.
KBK: Here's a little hack that I've been using for a couple of years but never bothered to post. Given a scrollbar that's managed by the grid command, it arranges for it to appear and disappear when the content of the widget being scrolled demands it.
Following the script is a demo script that uses it. Try launching it and then resizing the window.
#----------------------------------------------------------------------
#
# 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]]
}As promised, here's a demo script:
# remove the following line if autoscroll is on the package path
source autoscroll.tcl
package require autoscroll
namespace import ::autoscroll::autoscroll
text .t -width 40 -height 24 \
-yscrollcommand [list .y set] -xscrollcommand [list .x set] \
-font {Courier 12} -wrap none
scrollbar .y -orient vertical -command [list .t yview]
scrollbar .x -orient horizontal -command [list .t xview]
grid .t -row 0 -column 1 -sticky nsew
grid .y -row 0 -sticky ns \
-column 2; # change to -column 0 for left-handers
grid .x -row 1 -column 1 -sticky ew
grid columnconfigure . 1 -weight 1
grid rowconfigure . 0 -weight 1
autoscroll .x
autoscroll .y
for { set i 0 } { $i < 26 } { incr i } {
.t insert end {This widget contains a lot of text, doesn't it?}
.t insert end \n
}Also check out BWidget's ScrolledWindow. It works wonderfully for if-needed scrollbars.
See also: Scrolledtext, ScrolledFrame, and ScrolledCanvas
Category Command, a part of tklib, a set of tk-related extension/widgets.