CollapsableFrame -A Toggle Resized Labelled Frame Container

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

 ############################################ 
 #
 # 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:
 # -------------------
 #
 ############################################

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

 demo