neingeist
/
arduinisten
Archived
1
0
Fork 0
You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
This repo is archived. You can view files and clone it, but cannot push or open issues/pull-requests.

155 lines
4.8 KiB
Plaintext

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