tree.tcl 3.1 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889
  1. # tree.tcl --
  2. #
  3. # This demonstration script creates a toplevel window containing a Ttk
  4. # tree widget.
  5. if {![info exists widgetDemo]} {
  6. error "This script should be run from the \"widget\" demo."
  7. }
  8. package require Tk
  9. set w .tree
  10. catch {destroy $w}
  11. toplevel $w
  12. wm title $w "Directory Browser"
  13. wm iconname $w "tree"
  14. positionWindow $w
  15. ## Explanatory text
  16. ttk::label $w.msg -font $font -wraplength 4i -justify left -anchor n -padding {10 2 10 6} -text "Ttk is the new Tk themed widget set. One of the widgets it includes is a tree widget, which allows the user to browse a hierarchical data-set such as a filesystem. The tree widget not only allows for the tree part itself, but it also supports an arbitrary number of additional columns which can show additional data (in this case, the size of the files found in your filesystem). You can also change the width of the columns by dragging the boundary between them."
  17. pack $w.msg -fill x
  18. ## See Code / Dismiss
  19. pack [addSeeDismiss $w.seeDismiss $w] -side bottom -fill x
  20. ## Code to populate the roots of the tree (can be more than one on Windows)
  21. proc populateRoots {tree} {
  22. foreach dir [lsort -dictionary [file volumes]] {
  23. populateTree $tree [$tree insert {} end -text $dir \
  24. -values [list $dir directory]]
  25. }
  26. }
  27. ## Code to populate a node of the tree
  28. proc populateTree {tree node} {
  29. if {[$tree set $node type] ne "directory"} {
  30. return
  31. }
  32. set path [$tree set $node fullpath]
  33. $tree delete [$tree children $node]
  34. foreach f [lsort -dictionary [glob -nocomplain -dir $path *]] {
  35. set f [file normalize $f]
  36. set type [file type $f]
  37. set id [$tree insert $node end -text [file tail $f] \
  38. -values [list $f $type]]
  39. if {$type eq "directory"} {
  40. ## Make it so that this node is openable
  41. $tree insert $id 0 -text dummy ;# a dummy
  42. $tree item $id -text [file tail $f]/
  43. } elseif {$type eq "file"} {
  44. set size [file size $f]
  45. ## Format the file size nicely
  46. if {$size >= 1024*1024*1024} {
  47. set size [format %.1f\ GB [expr {$size/1024/1024/1024.}]]
  48. } elseif {$size >= 1024*1024} {
  49. set size [format %.1f\ MB [expr {$size/1024/1024.}]]
  50. } elseif {$size >= 1024} {
  51. set size [format %.1f\ kB [expr {$size/1024.}]]
  52. } else {
  53. append size " bytes"
  54. }
  55. $tree set $id size $size
  56. }
  57. }
  58. # Stop this code from rerunning on the current node
  59. $tree set $node type processedDirectory
  60. }
  61. ## Create the tree and set it up
  62. ttk::treeview $w.tree -columns {fullpath type size} -displaycolumns {size} \
  63. -yscroll "$w.vsb set" -xscroll "$w.hsb set"
  64. ttk::scrollbar $w.vsb -orient vertical -command "$w.tree yview"
  65. ttk::scrollbar $w.hsb -orient horizontal -command "$w.tree xview"
  66. $w.tree heading \#0 -text "Directory Structure"
  67. $w.tree heading size -text "File Size"
  68. $w.tree column size -width 70
  69. populateRoots $w.tree
  70. bind $w.tree <<TreeviewOpen>> {populateTree %W [%W focus]}
  71. ## Arrange the tree and its scrollbars in the toplevel
  72. lower [ttk::frame $w.dummy]
  73. pack $w.dummy -fill both -expand 1
  74. grid $w.tree $w.vsb -sticky nsew -in $w.dummy
  75. grid $w.hsb -sticky nsew -in $w.dummy
  76. grid columnconfigure $w.dummy 0 -weight 1
  77. grid rowconfigure $w.dummy 0 -weight 1