1# RCS: @(#) $Id: random.tcl,v 1.27 2010/03/08 16:59:31 treectrl Exp $ 2 3set RandomN 500 4set RandomDepth 5 5 6# 7# Demo: random N items 8# 9proc DemoRandom {} { 10 11 set T [DemoList] 12 13 InitPics folder-* small-* 14 15 set height [font metrics [$T cget -font] -linespace] 16 if {$height < 18} { 17 set height 18 18 } 19 20 # 21 # Configure the treectrl widget 22 # 23 24 $T configure -itemheight $height -selectmode extended \ 25 -showroot yes -showrootbutton yes -showbuttons yes -showlines $::ShowLines \ 26 -scrollmargin 16 -xscrolldelay "500 50" -yscrolldelay "500 50" 27 28 # 29 # Create columns 30 # 31 32 $T column create -expand yes -weight 4 -text Item -itembackground {#e0e8f0 {}} \ 33 -tags colItem 34 $T column create -text Parent -justify center -itembackground {gray90 {}} \ 35 -uniform a -expand yes -tags colParent 36 $T column create -text Depth -justify center -itembackground {linen {}} \ 37 -uniform a -expand yes -tags colDepth 38 39 $T configure -treecolumn colItem 40 41 # 42 # Create elements 43 # 44 45 $T element create elemImgFolder image -image {folder-open {open} folder-closed {}} 46 $T element create elemImgFile image -image small-file 47 $T element create elemTxtName text -wrap none \ 48 -fill [list $::SystemHighlightText {selected focus}] 49 $T element create elemTxtCount text -fill blue 50 $T element create elemTxtAny text 51 $T element create elemRectSel rect -showfocus yes \ 52 -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] 53 54 # 55 # Create styles using the elements 56 # 57 58 set S [$T style create styFolder] 59 $T style elements $S {elemRectSel elemImgFolder elemTxtName elemTxtCount} 60 $T style layout $S elemImgFolder -padx {0 4} -expand ns 61 $T style layout $S elemTxtName -minwidth 12 -padx {0 4} -expand ns -squeeze x 62 $T style layout $S elemTxtCount -padx {0 6} -expand ns 63 $T style layout $S elemRectSel -union [list elemTxtName] -iexpand ns -ipadx 2 64 65 set S [$T style create styFile] 66 $T style elements $S {elemRectSel elemImgFile elemTxtName} 67 $T style layout $S elemImgFile -padx {0 4} -expand ns 68 $T style layout $S elemTxtName -minwidth 12 -padx {0 4} -expand ns -squeeze x 69 $T style layout $S elemRectSel -union [list elemTxtName] -iexpand ns -ipadx 2 70 71 set S [$T style create styAny] 72 $T style elements $S {elemTxtAny} 73 $T style layout $S elemTxtAny -padx 6 -expand ns 74 75 TreeCtrl::SetSensitive $T { 76 {colItem styFolder elemRectSel elemImgFolder elemTxtName} 77 {colItem styFile elemRectSel elemImgFile elemTxtName} 78 } 79 TreeCtrl::SetDragImage $T { 80 {colItem styFolder elemImgFolder elemTxtName} 81 {colItem styFile elemImgFile elemTxtName} 82 } 83 84 # 85 # Create items and assign styles 86 # 87 88 set clicks [clock clicks] 89 $T item configure root -button auto 90 set items [$T item create -count [expr {$::RandomN - 1}] -button auto] 91 set added root 92 foreach itemi $items { 93 set j [expr {int(rand() * [llength $added])}] 94 set itemj [lindex $added $j] 95 if {[$T depth $itemj] < $::RandomDepth - 1} { 96 lappend added $itemi 97 } 98 if {rand() * 2 > 1} { 99 $T item collapse $itemi 100 } 101 if {rand() * 2 > 1} { 102 $T item lastchild $itemj $itemi 103 } else { 104 $T item firstchild $itemj $itemi 105 } 106 } 107 puts "created $::RandomN-1 items in [expr [clock clicks] - $clicks] clicks" 108 109 set clicks [clock clicks] 110 lappend items [$T item id root] 111 foreach item $items { 112 set numChildren [$T item numchildren $item] 113 if {$numChildren} { 114 $T item style set $item colItem styFolder colParent styAny colDepth styAny 115 $T item element configure $item \ 116 colItem elemTxtName -text "Item $item" + elemTxtCount -text "($numChildren)" , \ 117 colParent elemTxtAny -text "[$T item parent $item]" , \ 118 colDepth elemTxtAny -text "[$T depth $item]" 119 } else { 120 $T item style set $item colItem styFile colParent styAny colDepth styAny 121 $T item element configure $item \ 122 colItem elemTxtName -text "Item $item" , \ 123 colParent elemTxtAny -text "[$T item parent $item]" , \ 124 colDepth elemTxtAny -text "[$T depth $item]" 125 } 126 } 127 puts "configured $::RandomN items in [expr [clock clicks] - $clicks] clicks" 128 129 bind DemoRandom <Double-ButtonPress-1> { 130 TreeCtrl::DoubleButton1 %W %x %y 131 break 132 } 133 bind DemoRandom <Control-ButtonPress-1> { 134 set TreeCtrl::Priv(selectMode) toggle 135 RandomButton1 %W %x %y 136 break 137 } 138 bind DemoRandom <Shift-ButtonPress-1> { 139 set TreeCtrl::Priv(selectMode) add 140 RandomButton1 %W %x %y 141 break 142 } 143 bind DemoRandom <ButtonPress-1> { 144 set TreeCtrl::Priv(selectMode) set 145 RandomButton1 %W %x %y 146 break 147 } 148 bind DemoRandom <Button1-Motion> { 149 RandomMotion1 %W %x %y 150 break 151 } 152 bind DemoRandom <ButtonRelease-1> { 153 RandomRelease1 %W %x %y 154 break 155 } 156 157 bindtags $T [list $T DemoRandom TreeCtrl [winfo toplevel $T] all] 158 159 return 160} 161 162proc RandomButton1 {T x y} { 163 variable TreeCtrl::Priv 164 focus $T 165 set id [$T identify $x $y] 166 set Priv(buttonMode) "" 167 168 # Click outside any item 169 if {$id eq ""} { 170 $T selection clear 171 172 # Click in header 173 } elseif {[lindex $id 0] eq "header"} { 174 TreeCtrl::ButtonPress1 $T $x $y 175 176 # Click in item 177 } else { 178 lassign $id where item arg1 arg2 arg3 arg4 179 switch $arg1 { 180 button { 181 $T item toggle $item 182 } 183 line { 184 $T item toggle $arg2 185 } 186 column { 187 if {![TreeCtrl::IsSensitive $T $x $y]} { 188 $T selection clear 189 return 190 } 191 192 set Priv(drag,motion) 0 193 set Priv(drag,click,x) $x 194 set Priv(drag,click,y) $y 195 set Priv(drag,x) [$T canvasx $x] 196 set Priv(drag,y) [$T canvasy $y] 197 set Priv(drop) "" 198 199 if {$Priv(selectMode) eq "add"} { 200 TreeCtrl::BeginExtend $T $item 201 } elseif {$Priv(selectMode) eq "toggle"} { 202 TreeCtrl::BeginToggle $T $item 203 } elseif {![$T selection includes $item]} { 204 TreeCtrl::BeginSelect $T $item 205 } 206 $T activate $item 207 208 if {[$T selection includes $item]} { 209 set Priv(buttonMode) drag 210 } 211 } 212 } 213 } 214 return 215} 216 217proc RandomMotion1 {T x y} { 218 variable TreeCtrl::Priv 219 if {![info exists Priv(buttonMode)]} return 220 switch $Priv(buttonMode) { 221 "drag" { 222 set Priv(autoscan,command,$T) {RandomMotion %T %x %y} 223 TreeCtrl::AutoScanCheck $T $x $y 224 RandomMotion $T $x $y 225 } 226 default { 227 TreeCtrl::Motion1 $T $x $y 228 } 229 } 230 return 231} 232 233proc RandomMotion {T x y} { 234 variable TreeCtrl::Priv 235 switch $Priv(buttonMode) { 236 "drag" { 237 if {!$Priv(drag,motion)} { 238 # Detect initial mouse movement 239 if {(abs($x - $Priv(drag,click,x)) <= 4) && 240 (abs($y - $Priv(drag,click,y)) <= 4)} return 241 242 set Priv(selection) [$T selection get] 243 set Priv(drop) "" 244 $T dragimage clear 245 # For each selected item, add 2nd and 3rd elements of 246 # column "item" to the dragimage 247 foreach I $Priv(selection) { 248 foreach list $Priv(dragimage,$T) { 249 set C [lindex $list 0] 250 set S [lindex $list 1] 251 if {[$T item style set $I $C] eq $S} { 252 eval $T dragimage add $I $C [lrange $list 2 end] 253 } 254 } 255 } 256 set Priv(drag,motion) 1 257 } 258 259 # Find the item under the cursor 260 set cursor X_cursor 261 set drop "" 262 set id [$T identify $x $y] 263 if {[TreeCtrl::IsSensitive $T $x $y]} { 264 set item [lindex $id 1] 265 # If the item is not in the pre-drag selection 266 # (i.e. not being dragged) see if we can drop on it 267 if {[lsearch -exact $Priv(selection) $item] == -1} { 268 set drop $item 269 # We can drop if dragged item isn't an ancestor 270 foreach item2 $Priv(selection) { 271 if {[$T item isancestor $item2 $item]} { 272 set drop "" 273 break 274 } 275 } 276 if {$drop ne ""} { 277 scan [$T item bbox $drop] "%d %d %d %d" x1 y1 x2 y2 278 if {$y < $y1 + 3} { 279 set cursor top_side 280 set Priv(drop,pos) prevsibling 281 } elseif {$y >= $y2 - 3} { 282 set cursor bottom_side 283 set Priv(drop,pos) nextsibling 284 } else { 285 set cursor "" 286 set Priv(drop,pos) lastchild 287 } 288 } 289 } 290 } 291 292 if {[$T cget -cursor] ne $cursor} { 293 $T configure -cursor $cursor 294 } 295 296 # Select the item under the cursor (if any) and deselect 297 # the previous drop-item (if any) 298 $T selection modify $drop $Priv(drop) 299 set Priv(drop) $drop 300 301 # Show the dragimage in its new position 302 set x [expr {[$T canvasx $x] - $Priv(drag,x)}] 303 set y [expr {[$T canvasy $y] - $Priv(drag,y)}] 304 $T dragimage offset $x $y 305 $T dragimage configure -visible yes 306 } 307 default { 308 TreeCtrl::Motion1 $T $x $y 309 } 310 } 311 return 312} 313 314proc RandomRelease1 {T x y} { 315 variable TreeCtrl::Priv 316if {![info exists Priv(buttonMode)]} return 317 switch $Priv(buttonMode) { 318 "drag" { 319 TreeCtrl::AutoScanCancel $T 320 $T dragimage configure -visible no 321 $T selection modify {} $Priv(drop) 322 $T configure -cursor "" 323 if {$Priv(drop) ne ""} { 324 RandomDrop $T $Priv(drop) $Priv(selection) $Priv(drop,pos) 325 } 326 unset Priv(buttonMode) 327 } 328 default { 329 TreeCtrl::Release1 $T $x $y 330 } 331 } 332 return 333} 334 335proc RandomDrop {T target source pos} { 336 set parentList {} 337 switch -- $pos { 338 lastchild { set parent $target } 339 prevsibling { set parent [$T item parent $target] } 340 nextsibling { set parent [$T item parent $target] } 341 } 342 foreach item $source { 343 344 # Ignore any item whose ancestor is also selected 345 set ignore 0 346 foreach ancestor [$T item ancestors $item] { 347 if {[lsearch -exact $source $ancestor] != -1} { 348 set ignore 1 349 break 350 } 351 } 352 if {$ignore} continue 353 354 # Update the old parent of this moved item later 355 if {[lsearch -exact $parentList $item] == -1} { 356 lappend parentList [$T item parent $item] 357 } 358 359 # Add to target 360 $T item $pos $target $item 361 362 # Update text: parent 363 $T item element configure $item colParent elemTxtAny -text $parent 364 365 # Update text: depth 366 $T item element configure $item colDepth elemTxtAny -text [$T depth $item] 367 368 # Recursively update text: depth 369 foreach item [$T item descendants $item] { 370 $T item element configure $item colDepth elemTxtAny -text [$T depth $item] 371 } 372 } 373 374 # Update items that lost some children 375 foreach item $parentList { 376 set numChildren [$T item numchildren $item] 377 if {$numChildren == 0} { 378 $T item style map $item colItem styFile {elemTxtName elemTxtName} 379 } else { 380 $T item element configure $item colItem elemTxtCount -text "($numChildren)" 381 } 382 } 383 384 # Update the target that gained some children 385 if {[$T item style set $parent colItem] ne "styFolder"} { 386 $T item style map $parent colItem styFolder {elemTxtName elemTxtName} 387 } 388 set numChildren [$T item numchildren $parent] 389 $T item element configure $parent colItem elemTxtCount -text "($numChildren)" 390 return 391} 392 393# 394# Demo: random N items, button images 395# 396proc DemoRandom2 {} { 397 398 set T [DemoList] 399 400 DemoRandom 401 402 InitPics mac-* 403 404 $T configure -buttonimage {mac-collapse open mac-expand {}} \ 405 -showlines no 406 407 return 408} 409 410