home *** CD-ROM | disk | FTP | other *** search
/ PC World 2002 May / PCWorld_2002-05_cd.bin / Software / TemaCD / activetcltk / ActiveTcl8.3.4.1-8.win32-ix86.exe / ActiveTcl8.3.4.1-win32-ix86 / demos / IWidgets / hierarchy < prev    next >
Encoding:
Text File  |  2001-10-22  |  4.8 KB  |  155 lines
  1. # ----------------------------------------------------------------------
  2. #  DEMO: hierarchy in [incr Widgets]
  3. # ----------------------------------------------------------------------
  4. package 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. #
  10. if {![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. # ----------------------------------------------------------------------
  24. proc 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. # ----------------------------------------------------------------------
  54. proc 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. # ----------------------------------------------------------------------
  73. proc 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. # ----------------------------------------------------------------------
  88. proc 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. # ----------------------------------------------------------------------
  101. proc 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. # ----------------------------------------------------------------------
  120. proc expand_all {} {
  121.     expand_recursive ""
  122. }
  123.  
  124. # ----------------------------------------------------------------------
  125. # PROC: collapse_all
  126. #
  127. # Collapse all the nodes in the hierarchy.
  128. # ----------------------------------------------------------------------
  129. proc 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. #
  137. iwidgets::hierarchy .h -querycommand "get_files %n" -visibleitems 30x15 \
  138.     -labeltext $env(SHOWDIR) -selectcommand "select_node %n %s"
  139. pack .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.