1# ----------------------------------------------------------------------
2#  DEMO: hierarchy in [incr Widgets]
3# ----------------------------------------------------------------------
4package require Iwidgets 4.0
5
6# This demo displays a users file system starting at thier HOME
7# directory.  You can change the starting directory by setting the
8# environment variable SHOWDIR.
9#
10if {![info exists env(SHOWDIR)]} {
11    set env(SHOWDIR) $env(HOME)
12}
13
14# ----------------------------------------------------------------------
15# PROC: get_files file
16#
17# Used as the -querycommand for the hierarchy viewer.  Returns the
18# list of files under a particular directory.  If the file is "",
19# then the SHOWDIR is used as the directory.  Otherwise, the node itself
20# is treated as a directory.  The procedure returns a unique id and
21# the text to be displayed for each file.  The unique id is the complete
22# path name and the text is the file name.
23# ----------------------------------------------------------------------
24proc get_files {file} {
25    global env
26
27    if {$file == ""} {
28	set dir $env(SHOWDIR)
29    } else {
30	set dir $file
31    }
32
33    if {[catch {cd $dir}] != 0} {
34	return ""
35    }
36
37    set rlist ""
38
39    foreach file [lsort [glob -nocomplain *]] {
40	lappend rlist [list [file join $dir $file] $file]
41    }
42
43    return $rlist
44}
45
46# ----------------------------------------------------------------------
47# PROC: select_node tags status
48#
49# Select/Deselect the node given the tags and current selection status.
50# The unique id which is the complete file path name is mixed in with
51# all the tags for the node.  So, we'll find it by searching for our
52# SHOWDIR and then doing the selection or deselection.
53# ----------------------------------------------------------------------
54proc select_node {tags status} {
55    global env
56
57    set uid [lindex $tags [lsearch -regexp $tags $env(SHOWDIR)]]
58
59    if {$status} {
60	.h selection remove $uid
61    } else {
62	.h selection add $uid
63    }
64}
65
66# ----------------------------------------------------------------------
67# PROC: expand_node tags
68#
69# Expand the node given the tags.  The unique id which is the complete
70# file path name is mixed in with all the tags for the node.  So, we'll
71# find it by searching for our SHOWDIR and then doing the expansion.
72# ----------------------------------------------------------------------
73proc expand_node {tags} {
74    global env
75
76    set uid [lindex $tags [lsearch -regexp $tags $env(SHOWDIR)]]
77
78    .h expand $uid
79}
80
81# ----------------------------------------------------------------------
82# PROC: collapse_node tags
83#
84# Collapse the node given the tags.  The unique id which is the complete
85# file path name is mixed in with all the tags for the node.  So, we'll
86# find it by searching for our SHOWDIR and then doing the collapse.
87# ----------------------------------------------------------------------
88proc collapse_node {tags} {
89    global env
90
91    set uid [lindex $tags [lsearch -regexp $tags $env(SHOWDIR)]]
92
93    .h collapse $uid
94}
95
96# ----------------------------------------------------------------------
97# PROC: expand_recursive
98#
99# Recursively expand all the file nodes in the hierarchy.
100# ----------------------------------------------------------------------
101proc expand_recursive {node} {
102    set files [get_files $node]
103
104    foreach tagset $files {
105	set uid [lindex $tagset 0]
106
107	.h expand $uid
108
109	if {[get_files $uid] != {}} {
110	    expand_recursive $uid
111	}
112    }
113}
114
115# ----------------------------------------------------------------------
116# PROC: expand_all
117#
118# Expand all the file nodes in the hierarchy.
119# ----------------------------------------------------------------------
120proc expand_all {} {
121    expand_recursive ""
122}
123
124# ----------------------------------------------------------------------
125# PROC: collapse_all
126#
127# Collapse all the nodes in the hierarchy.
128# ----------------------------------------------------------------------
129proc collapse_all {} {
130    .h configure -querycommand "get_files %n"
131}
132
133#
134# Create the hierarchy mega-widget, adding commands to both the item
135# and background popup menus.
136#
137iwidgets::hierarchy .h -querycommand "get_files %n" -visibleitems 30x15 \
138    -labeltext $env(SHOWDIR) -selectcommand "select_node %n %s"
139pack .h -side left -expand yes -fill both
140
141.h component itemMenu add command -label "Select" \
142    -command {select_node [.h current] 0}
143.h component itemMenu add command -label "Deselect" \
144    -command {select_node [.h current] 1}
145.h component itemMenu add separator
146.h component itemMenu add command -label "Expand" \
147    -command {expand_node [.h current]}
148.h component itemMenu add command -label "Collapse" \
149    -command {collapse_node [.h current]}
150
151.h component bgMenu add command -label "Expand All" -command expand_all
152.h component bgMenu add command -label "Collapse All" -command collapse_all
153.h component bgMenu add command -label "Clear Selections" \
154    -command {.h selection clear}
155