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