1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
|
#!/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}
|
