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 / BWidgets / tree.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  7.8 KB  |  255 lines
  1.  
  2. namespace eval DemoTree {
  3.     variable count
  4.     variable dblclick
  5. }
  6.  
  7.  
  8. proc DemoTree::create { nb } {
  9.     set frame [$nb insert end demoTree -text "Tree"]
  10.     set pw    [PanedWindow $frame.pw -side top]
  11.  
  12.     set pane  [$pw add -weight 1]
  13.     set title [TitleFrame $pane.lf -text "Directory tree"]
  14.     set sw    [ScrolledWindow [$title getframe].sw \
  15.                   -relief sunken -borderwidth 2]
  16.     set tree  [Tree $sw.tree \
  17.                    -relief flat -borderwidth 0 -width 15 -highlightthickness 0\
  18.            -redraw 0 -dropenabled 1 -dragenabled 1 \
  19.                    -dragevent 3 \
  20.                    -droptypes {
  21.                        TREE_NODE    {copy {} move {} link {}}
  22.                        LISTBOX_ITEM {copy {} move {} link {}}
  23.                    } \
  24.                    -opencmd   "DemoTree::moddir 1 $sw.tree" \
  25.                    -closecmd  "DemoTree::moddir 0 $sw.tree"]
  26.     $sw setwidget $tree
  27.  
  28.     pack $sw    -side top  -expand yes -fill both
  29.     pack $title -fill both -expand yes
  30.  
  31.     set pane [$pw add -weight 2]
  32.     set lf   [TitleFrame $pane.lf -text "Content"]
  33.     set sw   [ScrolledWindow [$lf getframe].sw \
  34.                   -scrollbar horizontal -auto none -relief sunken -borderwidth 2]
  35.     set list [ListBox::create $sw.lb \
  36.                   -relief flat -borderwidth 0 \
  37.                   -dragevent 3 \
  38.                   -dropenabled 1 -dragenabled 1 \
  39.                   -width 20 -highlightthickness 0 -multicolumn true \
  40.                   -redraw 0 -dragenabled 1 \
  41.                   -droptypes {
  42.                       TREE_NODE    {copy {} move {} link {}}
  43.                       LISTBOX_ITEM {copy {} move {} link {}}}]
  44.     $sw setwidget $list
  45.  
  46.     pack $sw $lf -fill both -expand yes
  47.  
  48.     pack $pw -fill both -expand yes
  49.  
  50.     $tree bindText  <ButtonPress-1>        "DemoTree::select tree 1 $tree $list"
  51.     $tree bindText  <Double-ButtonPress-1> "DemoTree::select tree 2 $tree $list"
  52.     $list bindText  <ButtonPress-1>        "DemoTree::select list 1 $tree $list"
  53.     $list bindText  <Double-ButtonPress-1> "DemoTree::select list 2 $tree $list"
  54.     $list bindImage <Double-ButtonPress-1> "DemoTree::select list 2 $tree $list"
  55.  
  56.     $nb itemconfigure demoTree \
  57.         -createcmd "DemoTree::init $tree $list" \
  58.         -raisecmd  {
  59.             regexp {[0-9]+x[0-9]+([+-][0-9]+)([+-][0-9]+)} [wm geom .] \
  60.                 global_foo global_w global_h
  61.             BWidget::place .top 0 0 at [expr {$global_w-[winfo screenwidth .]}] $global_h
  62.             wm deiconify .top
  63.             bind . <Unmap> {wm withdraw .top}
  64.             bind . <Map>   {wm deiconify .top}
  65.             bind . <Configure> {
  66.                 if { ![string compare %W "."] } {
  67.                     regexp {[0-9]+x[0-9]+([+-][0-9]+)([+-][0-9]+)} [wm geom .] \
  68.                         global_foo global_w global_h
  69.                     BWidget::place .top 0 0 at [expr {$global_w-[winfo screenwidth .]}] $global_h
  70.                 }
  71.             }
  72.         } \
  73.         -leavecmd {
  74.             wm withdraw .top
  75.             bind . <Unmap> {}
  76.             bind . <Map>   {}
  77.             bind . <Configure> {}
  78.             return 1
  79.         }
  80. }
  81.  
  82.  
  83. proc DemoTree::init { tree list args } {
  84.     global   tcl_platform
  85.     variable count
  86.  
  87.     set count 0
  88.     if { $tcl_platform(platform) == "unix" } {
  89.         set rootdir [glob "~"]
  90.     } else {
  91.         set rootdir "c:\\"
  92.     }
  93.     $tree insert end root home -text $rootdir -data $rootdir -open 1 \
  94.         -image [Bitmap::get openfold]
  95.     getdir $tree home $rootdir
  96.     DemoTree::select tree 1 $tree $list home
  97.     $tree configure -redraw 1
  98.     $list configure -redraw 1
  99.  
  100.     # ScrollView
  101.     toplevel .top -relief raised -borderwidth 2
  102.     wm protocol .top WM_DELETE_WINDOW {
  103.         # don't kill me
  104.     }
  105.     wm overrideredirect .top 1
  106.     wm withdraw .top
  107.     wm transient .top .
  108.     ScrollView .top.sv -window $tree -fill black
  109.     pack .top.sv -fill both -expand yes
  110. }
  111.  
  112.  
  113. proc DemoTree::getdir { tree node path } {
  114.     variable count
  115.  
  116.     set lentries [glob -nocomplain [file join $path "*"]]
  117.     set lfiles   {}
  118.     foreach f $lentries {
  119.         set tail [file tail $f]
  120.         if { [file isdirectory $f] } {
  121.             $tree insert end $node n:$count \
  122.                 -text      $tail \
  123.                 -image     [Bitmap::get folder] \
  124.                 -drawcross allways \
  125.                 -data      $f
  126.             incr count
  127.         } else {
  128.             lappend lfiles $tail
  129.         }
  130.     }
  131.     $tree itemconfigure $node -drawcross auto -data $lfiles
  132. }
  133.  
  134.  
  135. proc DemoTree::moddir { idx tree node } {
  136.     if { $idx && [$tree itemcget $node -drawcross] == "allways" } {
  137.         getdir $tree $node [$tree itemcget $node -data]
  138.         if { [llength [$tree nodes $node]] } {
  139.             $tree itemconfigure $node -image [Bitmap::get openfold]
  140.         } else {
  141.             $tree itemconfigure $node -image [Bitmap::get folder]
  142.         }
  143.     } else {
  144.         $tree itemconfigure $node -image [Bitmap::get [lindex {folder openfold} $idx]]
  145.     }
  146. }
  147.  
  148.  
  149. proc DemoTree::select { where num tree list node } {
  150.     variable dblclick
  151.  
  152.     set dblclick 1
  153.     if { $num == 1 } {
  154.         if { $where == "tree" && [lsearch [$tree selection get] $node] != -1 } {
  155.             unset dblclick
  156.             after 500 "DemoTree::edit tree $tree $list $node"
  157.             return
  158.         }
  159.         if { $where == "list" && [lsearch [$list selection get] $node] != -1 } {
  160.             unset dblclick
  161.             after 500 "DemoTree::edit list $tree $list $node"
  162.             return
  163.         }
  164.         if { $where == "tree" } {
  165.             select_node $tree $list $node
  166.         } else {
  167.             $list selection set $node
  168.         }
  169.     } elseif { $where == "list" && [$tree exists $node] } {
  170.     set parent [$tree parent $node]
  171.     while { $parent != "root" } {
  172.         $tree itemconfigure $parent -open 1
  173.         set parent [$tree parent $parent]
  174.     }
  175.     select_node $tree $list $node
  176.     }
  177. }
  178.  
  179.  
  180. proc DemoTree::select_node { tree list node } {
  181.     $tree selection set $node
  182.     update
  183.     eval $list delete [$list item 0 end]
  184.  
  185.     set dir [$tree itemcget $node -data]
  186.     if { [$tree itemcget $node -drawcross] == "allways" } {
  187.         getdir $tree $node $dir
  188.         set dir [$tree itemcget $node -data]
  189.     }
  190.  
  191.     foreach subnode [$tree nodes $node] {
  192.         $list insert end $subnode \
  193.             -text  [$tree itemcget $subnode -text] \
  194.             -image [Bitmap::get folder]
  195.     }
  196.     set num 0
  197.     foreach f $dir {
  198.         $list insert end f:$num \
  199.             -text  $f \
  200.             -image [Bitmap::get file]
  201.         incr num
  202.     }
  203. }
  204.  
  205.  
  206. proc DemoTree::edit { where tree list node } {
  207.     variable dblclick
  208.  
  209.     if { [info exists dblclick] } {
  210.         return
  211.     }
  212.  
  213.     if { $where == "tree" && [lsearch [$tree selection get] $node] != -1 } {
  214.         set res [$tree edit $node [$tree itemcget $node -text]]
  215.         if { $res != "" } {
  216.             $tree itemconfigure $node -text $res
  217.             if { [$list exists $node] } {
  218.                 $list itemconfigure $node -text $res
  219.             }
  220.             $tree selection set $node
  221.         }
  222.         return
  223.     }
  224.  
  225.     if { $where == "list" } {
  226.         set res [$list edit $node [$list itemcget $node -text]]
  227.         if { $res != "" } {
  228.             $list itemconfigure $node -text $res
  229.             if { [$tree exists $node] } {
  230.                 $tree itemconfigure $node -text $res
  231.             } else {
  232.                 set cursel [$tree selection get]
  233.                 set index  [expr {[$list index $node]-[llength [$tree nodes $cursel]]}]
  234.                 set data   [$tree itemcget $cursel -data]
  235.                 set data   [lreplace $data $index $index $res]
  236.                 $tree itemconfigure $cursel -data $data
  237.             }
  238.             $list selection set $node
  239.         }
  240.     }
  241. }
  242.  
  243.  
  244. proc DemoTree::expand { tree but } {
  245.     if { [set cur [$tree selection get]] != "" } {
  246.         if { $but == 0 } {
  247.             $tree opentree $cur
  248.         } else {
  249.             $tree closetree $cur
  250.         }
  251.     }
  252. }
  253.  
  254.  
  255.