share/iwidgets4.0.1/demos/hierarchy

# ----------------------------------------------------------------------
#  DEMO: hierarchy in [incr Widgets]
# ----------------------------------------------------------------------
package require Iwidgets 4.0

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