Subversion Repositories or1k_old

#!/bin/sh

# ----------------------------------------------------------------------

#  DEMO: buttonbox in [incr Widgets]

# ----------------------------------------------------------------------

#\

exec itkwish "$0" ${1+"$@"}

package require Iwidgets 3.0

#

# Demo script for the Hierarchy class.

#

# This demo displays a users file system starting at thier HOME

# directory.  You can change the starting directory by setting the

# environment variable SHOWDIR.

#

if {![info exists env(SHOWDIR)]} {

    set env(SHOWDIR) $env(HOME)

}

# ----------------------------------------------------------------------

# PROC: get_files file

#

# Used as the -querycommand for the hierarchy viewer.  Returns the

# list of files under a particular directory.  If the file is "",

# then the SHOWDIR is used as the directory.  Otherwise, the node itself

# is treated as a directory.  The procedure returns a unique id and

# the text to be displayed for each file.  The unique id is the complete

# path name and the text is the file name.

# ----------------------------------------------------------------------

proc get_files {file} {

    global env

    if {$file == ""} {

        set dir $env(SHOWDIR)

    } else {

        set dir $file

    }

    if {[catch {cd $dir}] != 0} {

        return ""

    }

    set rlist ""

    foreach file [lsort [glob -nocomplain *]] {

        lappend rlist [list [file join $dir $file] $file]

    }

    return $rlist

}

# ----------------------------------------------------------------------

# PROC: select_node tags status

#

# Select/Deselect the node given the tags and current selection status.

# The unique id which is the complete file path name is mixed in with

# all the tags for the node.  So, we'll find it by searching for our

# SHOWDIR and then doing the selection or deselection.

# ----------------------------------------------------------------------

proc select_node {tags status} {

    global env

    set uid [lindex $tags [lsearch -regexp $tags $env(SHOWDIR)]]

    if {$status} {

        .h selection remove $uid

    } else {

        .h selection add $uid

    }

}

# ----------------------------------------------------------------------

# PROC: expand_node tags

#

# Expand the node given the tags.  The unique id which is the complete

# file path name is mixed in with all the tags for the node.  So, we'll

# find it by searching for our SHOWDIR and then doing the expansion.

# ----------------------------------------------------------------------

proc expand_node {tags} {

    global env

    set uid [lindex $tags [lsearch -regexp $tags $env(SHOWDIR)]]

    .h expand $uid

}

# ----------------------------------------------------------------------

# PROC: collapse_node tags

#

# Collapse the node given the tags.  The unique id which is the complete

# file path name is mixed in with all the tags for the node.  So, we'll

# find it by searching for our SHOWDIR and then doing the collapse.

# ----------------------------------------------------------------------

proc collapse_node {tags} {

    global env

    set uid [lindex $tags [lsearch -regexp $tags $env(SHOWDIR)]]

    .h collapse $uid

}

# ----------------------------------------------------------------------

# PROC: expand_recursive

#

# Recursively expand all the file nodes in the hierarchy.

# ----------------------------------------------------------------------

proc expand_recursive {node} {

    set files [get_files $node]

    foreach tagset $files {

        set uid [lindex $tagset 0]

        .h expand $uid

        if {[get_files $uid] != {}} {

            expand_recursive $uid

        }

    }

}

# ----------------------------------------------------------------------

# PROC: expand_all

#

# Expand all the file nodes in the hierarchy.

# ----------------------------------------------------------------------

proc expand_all {} {

    expand_recursive ""

}

# ----------------------------------------------------------------------

# PROC: collapse_all

#

# Collapse all the nodes in the hierarchy.

# ----------------------------------------------------------------------

proc collapse_all {} {

    .h configure -querycommand "get_files %n"

}

#

# Create the hierarchy mega-widget, adding commands to both the item

# and background popup menus.

#

iwidgets::hierarchy .h -querycommand "get_files %n" -visibleitems 30x15 \

    -labeltext $env(SHOWDIR) -selectcommand "select_node %n %s"

pack .h -side left -expand yes -fill both

.h component itemMenu add command -label "Select" \

    -command {select_node [.h current] 0}

.h component itemMenu add command -label "Deselect" \

    -command {select_node [.h current] 1}

.h component itemMenu add separator

.h component itemMenu add command -label "Expand" \

    -command {expand_node [.h current]}

.h component itemMenu add command -label "Collapse" \

    -command {collapse_node [.h current]}

.h component bgMenu add command -label "Expand All" -command expand_all

.h component bgMenu add command -label "Collapse All" -command collapse_all

.h component bgMenu add command -label "Clear Selections" \

    -command {.h selection clear}