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!
#!/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