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