154 lines
4.8 KiB
Text
154 lines
4.8 KiB
Text
# ----------------------------------------------------------------------
|
|
# 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}
|