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!
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.
#!/usr/bin/wish ############################################ # # CollapsableFrame.tcl # ------------------------ # # Copyright (C) 2005 William J Giddings # email: [email protected] # # 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: # ------------------- # ############################################ 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