[WJG] (17 Jan 2005) A few years back I posted out a first attempt at a collapsable frame. Here is a more refined version. It was originally inspired by the collapsing frames that I encounterd whilst using the now defunct Wavefront Dynamtion/Kinemation animation systems. The idea was that if an interactive task has heaps (and with Dynamation that meant dozens) of adjustable variables then a screen is not just cluttered but unnavigable. Folding up those frames certainly can make a lot of space. Try packing a bunch of folding frames into a scrolling canvas -magick! Once made however, I've never needed it once! [Vince] once contributed the 'collapsablewidget' to Iwidgets. I'm not sure what ever happened to it, however. ---- [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? [http://www.geocities.ws/thezipguy//tcl/misc/collapable_frame_orig.png] ====== ############################################ # # 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 { 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 Ivanovic] The 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 {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 } demo ====== ---- See 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: [http://www.geocities.ws/thezipguy/tcl/misc/collapable_frame_under_construction2.png] 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. <> Widget