Bryan Oakley writes: Ahhh, memory lane! I wrote a similar widget in Motif ten or fifteen years ago. I was quite proud of that, given the amount of effort it took back then. Like WJG, I've not ever needed them since. This Tk implementation is many orders of magnitude less complex than the equivalent C/Motif if memory serves. I got the idea from UIM/X, an X11 GUI builder I had access to at the time. Amazingly, UIM/X is still around and appears to use collapsible frames to this day.
WJG (17 May 2007) This code example was modified for use with Perl-Tk as published in the in Mastering Perl/Tk by Stephen Lidie and Nancy Walsh, published by O'Reilly.Links: http://www.oreilly.com/catalog/mastperltk/#top
or http://safari.oreilly.com/1565927168/mastperltk-APP-C?
############################################
#
# CollapsableFrame.tcl
# ------------------------
#
# Copyright (C) 2005 William J Giddings
# email: giddings@freeuk.com
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Library General Public License for more details.
#
# You should have received a copy of the GNU Library General Public
# License along with this library; if not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
#
############################################
#
# Description:
# -----------
# Provide a collapsable labeled frame widget.
#
# Creation:
# --------
# CollapsableFrame pathName ?option value...?
#
# Standard Options:
# ----------------
# -text Text to dispay in frame.
# -width Width of frame.
# -borderwidth Width of displayed frame border.
# -height Maximum height of the frame.
#
# Widget Specific Options:
# -----------------------
# none
#
# Returns:
# --------
# Pathname of the frame container.
#
# Widget Commands:
# --------
# pathName open Open/expand frame to reveal contents.
# pathName close Close/collapse frame to hide contents.
# pathName toggle Flip state.
# pathName getframe Returns path to the widget container.
# pathName title string Set title to new value.
#
# Bindings:
# -----------------------------------#
# Arrow Button-1 Open/Close frame.
#
# Example:
# -------
# This module includes a demo proceedure. Delete and/or comment out as required.
#
# Note:
# ----
# Work still in progress.
# As always, programming is an art. Like a painting, it is never finished.
# Good programmers and artists have one critical faculty in common: knowing when to stop!
#
# When adding new widgets to the container, ensure that the maximum height of the
# frame is sufficient to accomodate all items.
#
# Use the place geometry manager to explicitly position child widgets.
#
# Future enhancements:
# -------------------
#
############################################
#!/bin/sh \
exec tclsh "$0" "$@"
package require Tk
package provide CollapsableFrame 1.0
namespace eval CollapsableFrame {}
proc CollapsableFrame {base args} {
#-------
# set some defaults
#-------
set text $base
set height 47
set width 125
set borderwidt 2
set labelheight 16
#-------
# parges args
#-------
foreach {arg val} $args {
switch -- $arg {
-text -
-width -
-borderwidth -
-height { set [string trimleft $arg -] $val}
}
}
#-------
# create button icons
#-------
image create photo im_Open -data R0lGODlhEAAQAKIAAP///9TQyICAgEBAQAAAAAAAAAAAAAAAACwAAAAAEAAQAAADNhi63BMgyinFAy0HC3Xj2EJoIEOM32WeaSeeqFK+say+2azUi+5ttx/QJeQIjshkcsBsOp/MBAA7
image create photo im_Close -data R0lGODlhEAAQAKIAAP///9TQyICAgEBAQAAAAAAAAAAAAAAAACwAAAAAEAAQAAADMxi63BMgyinFAy0HC3XjmLeA4ngpRKoSZoeuDLmo38mwtVvKu93rIo5gSCwWB8ikcolMAAA7
#-------
# create container
#-------
frame $base \
-height $height \
-width $width
#-------
# visible frame
#-------
frame $base.fra1 \
-borderwidth $borderwidt \
-height $labelheight \
-relief ridge \
-width $width
pack $base.fra1 \
-in $base \
-anchor center \
-expand 1 \
-fill x \
-pady 7 \
-side left
#-------
# toggle arrow
#-------
label $base.lab1 \
-borderwidth 0 \
-image im_Open \
-relief raised \
-text $height
place $base.lab1 \
-x 5 \
-y -1 \
-width 21 \
-height 21 \
-anchor nw \
-bordermode ignore
#-------
# arrow bindings
#-------
bind $base.lab1 <Button-1> {
set a [%W cget -image]
if { $a == "im_Open" } {
%W configure -image im_Close
[winfo parent %W].fra1 configure -height [%W cget -text]
} else {
%W configure -image im_Open
[winfo parent %W].fra1 configure -height 16
}
}
#-------
# frame title
#-------
label $base.lab2 \
-anchor w \
-borderwidth 1 \
-text $text
place $base.lab2 \
-x 23 \
-y 3 \
-height 12 \
-anchor nw \
-bordermode ignore
#-------
# Here comes the overloaded widget proc:
#-------
rename $base _$base ;# keep the original widget command
proc $base {cmd args} {
set self [lindex [info level 0] 0] ;# get name I was called with
switch -- $cmd {
open {eval CollapsableFrame::open $self $args}
close {eval CollapsableFrame::close $self $args}
toggle {eval CollapsableFrame::toggle $self $args}
getframe {eval CollapsableFrame::getframe $self $args}
default {uplevel 1 _$self $cmd $args}
}
}
return $base.fra1
}
#-------
# Check the current widget state then reverse it.
#-------
proc CollapsableFrame::toggle {w} {
set a [$w.lab1 cget -image]
if { $a == "im_Open" } {
$w.lab1 configure -image im_Close
[winfo parent $w.lab1].fra1 configure -height [$w.lab1 cget -text]
} else {
$w.lab1 configure -image im_Open
[winfo parent $w.lab1].fra1 configure -height 16
}
}
#-------
# Collapse the widget, display the 'can be opened' icon.
#-------
proc CollapsableFrame::close {w} {
$w.lab1 configure -image im_Open
[winfo parent $w.lab1].fra1 configure -height 16
}
#-----------------------------------------------------------
# Open the widget, display the 'can be closed' icon.
#-----------------------------------------------------------
proc CollapsableFrame::open {w} {
$w.lab1 configure -image im_Close
[winfo parent $w.lab1].fra1 configure -height [$w.lab1 cget -text]
}
#-------
# get path to display area
#-------
proc CollapsableFrame::getframe {w} {
return $w.fra1
}
#-------
# demo block
#-------
proc demo {} {
CollapsableFrame .cf1 \
-text "Frame1 " \
-height 80
pack .cf1 \
-in [winfo parent .cf1] \
-anchor center \
-expand 0 \
-fill x \
-side top
CollapsableFrame .cf2 \
-text "Frame2 " \
-height 80
pack .cf2 \
-in [winfo parent .cf2] \
-anchor center \
-expand 0 \
-fill x \
-side top
#-------
# place child widgets inside the container
#-------
place [button [.cf1 getframe].but1 -text BUTTON(A,1)] -x 10 -y 15
place [button [.cf1 getframe].but2 -text BUTTON(A,2)] -x 10 -y 45
place [button [.cf2 getframe].but1 -text BUTTON(B,1)] -x 10 -y 15
place [button [.cf2 getframe].but2 -text BUTTON(B,2)] -x 10 -y 45
}
demo
Gustav IvanovicThe above widget is cute ! I modified the code written by William J Giddings above. package require Tk
package require img::png
package require Img
package require math
package provide CollapsibleFrame 1.0
namespace eval CollapsibleFrame {
variable manageCF {}
proc verticalFrame {w args} {
set text $w
set height 50
set width 200
set borderwidth 2
set labelheight 16
foreach {arg val} $args {
switch -- $arg {
-text -
-width -
-borderwidth -
-height { set [string trimleft $arg -] $val}
}
}
image create photo iconeOpen -format png -data iVBORw0KGgoAAAANSUhEUgAAABAAAAAOCAIAAAHeSjtLAAAABGdBTUEAAYagMeiWXwAAAKBJREFUCJmlUCESxCAMXJiIPqfyJOJEn8WTIpGRJxEInoKoOAGTo6X05uZ2EGw2ySYxZS8ALICcoqmMcooATNlL/QEgAMyhkpbXFM1hDhYdSAs+3db1oaEYX8yBlOCIJpwqzvaK7bnZnOJCS//qcGcP7WnHPl+Ei6nagt77MV1EDne8B3MQEVI+uij6e9FMmDWabjfDHwWX84xx45z7yeENMlJR1s8KWugAAAAASUVORK5CYII=
image create photo iconeClose -format png -data iVBORw0KGgoAAAANSUhEUgAAABAAAAAOCAIAAAHeSjtLAAAABGdBTUEAAYagMeiWXwAAAIxJ\REFUCJm1kKEWgCAMRR+efRDRSDD4WXzSInHRSDD4KQSDYZwdFQgGb2E729vbcOUsACYAx56d\ZnTsGYArZ9EIAAFgTprUvlqxHuY04QaZ4D3NeEsecn28nzXIeevYG+uyUmugDD2+F8ZbxRjb\dhHpX96FOYnI0HvE/wK6J3a7YZ/QF7TlFhdC+LTSBRLsQ4zCXbJiAAAAAElFTkSuQmCC
frame $w -width $width
frame $w.containerFrame -borderwidth $borderwidth -height $labelheight -relief ridge -width $width
pack $w.containerFrame -in $w -anchor center -expand 1 -fill x -pady 7 -side left
label $w.iconLabel -borderwidth 0 -image iconeOpen -relief raised -text $height
place $w.iconLabel -x 3 -y -1 -width 21 -height 21 -anchor nw -bordermode ignore
bind $w.iconLabel <Button-1> {CollapsibleFrame::toggle [winfo parent %W]}
label $w.captionLabel -anchor w -borderwidth 1 -text $text
place $w.captionLabel -x 23 -y 3 -height 12 -anchor nw -bordermode ignore
rename $w _$w ;# keep the original widget command
proc ::$w {cmd args} {
set self [lindex [info level 0] 0] ;# get name I was called with
switch -- $cmd {
getframe {eval CollapsibleFrame::getframe $self $args}
open {eval CollapsibleFrame::open $self $args}
close {eval CollapsibleFrame::close $self $args}
manage {eval CollapsibleFrame::manage $self $args}
toggle {eval CollapsibleFrame::toggle $self $args}
default {uplevel 1 _$self $cmd $args}
}
}
return $w
}
proc close {w args} {
for {set i [winfo height $w.containerFrame]} {$i > 26} {incr i -10} {
$w.containerFrame configure -height $i
update
}
$w.containerFrame configure -height 16
$w.iconLabel configure -image iconeOpen
update
return $w
}
proc open {w args} {
set totalHeight -1000
set ymin 1000
foreach child [winfo children $w.containerFrame] {
set totalHeight [::math::max [expr {[winfo height $child] + [winfo y $child]}] $totalHeight]
set ymin [::math::min [winfo y $child] $ymin]
}
set totalHeight [::math::max [expr {$totalHeight + [expr {$ymin * 0.5}]}] 16]
for {set i 16} {$i <= $totalHeight} {incr i 10} {
$w.containerFrame configure -height $i
update
}
$w.containerFrame configure -height $totalHeight
$w.iconLabel configure -image iconeClose
update
CloseOthers $w
return $w
}
proc toggle {w args} {
set a [$w.iconLabel cget -image]
if { $a == "iconeOpen" } {
$w open
} else {
$w close
}
return $w
}
proc getframe {w args} {
return $w.containerFrame
}
proc manage {args} {
variable manageCF
eval lappend manageCF $args
}
proc CloseOthers {w} {
variable manageCF
foreach i $manageCF {
if {$i != {}} {
if {$i != $w && [winfo parent $w] == [winfo parent $i]} {
close $i
}
}
}
}
}
#-------
# demo block
#-------
proc demo {} {
wm geometry . 400x800+0+0
CollapsibleFrame::verticalFrame .cf1 \
-text "Frame1"
pack .cf1 \
-in [winfo parent .cf1] \
-anchor center \
-expand 0 \
-fill x \
-side top
CollapsibleFrame::verticalFrame .cf2 \
-text "Frame2 "
pack .cf2 \
-in [winfo parent .cf2] \
-anchor center \
-expand 0 \
-fill x \
-side top
CollapsibleFrame::verticalFrame .cf3 \
-text "Void Frame "
pack .cf3 \
-in [winfo parent .cf3] \
-anchor center \
-expand 0 \
-fill x \
-side top
CollapsibleFrame::verticalFrame .cf4\
-text "Last Frame "
pack .cf4 \
-in [winfo parent .cf4] \
-anchor center \
-expand 0 \
-fill x \
-side top
#-------
# place child widgets inside the container
#-------
for {set i 0} {$i < 10} {incr i} {
place [button [.cf1 getframe].but$i -text BUTTON(A,$i)] -x 10 -y [expr {15 + $i * 30}]
}
for {set i 0} {$i < 8} {incr i} {
place [label [.cf2 getframe].but$i -bg red -text LABEL(A,$i)] -x 10 -y [expr {15 + $i * 30}]
}
for {set i 0} {$i < 10} {incr i} {
place [button [.cf4 getframe].but$i -bg blue -text BUTTON(A,$i)] -x 10 -y [expr {15 + $i * 30}]
}
update
# you can manage the frames if you wish
CollapsibleFrame::manage .cf1 .cf2 .cf3 .cf4
.cf1 open
.cf2 open
.cf1 close
.cf2 close
.cf1 toggle
.cf1 toggle
.cf1 toggle
.cf1 toggle
.cf1 toggle
.cf1 close
.cf2 close
}
demoSee also panedwindow
mzgcoco (11-14-2008)See also wrapframe
See also accordion
Zipguy 2014/05/19 - I took a copy of this program and messed around with it a little, because it looked good. I replaced the icons used, which seemed kind of outdated, into more sexy ones, and added another frame, and messed around with the place command. This is what I had:
I like how it looks, and what it does. But what I'd like to have is a program that has it in the labelframe code, where you could have a 'collapsible' (sp?) labelframe. I don't like how it just uses place, instead of grid or pack as the manager.I'm not sure whom to ask, when there are not so many maintainers, to request an enhancement, especially when I don't yet know all the options in lableframe.