← Back to branch summary

~ubuntu-branches/ubuntu/wily/grass/wily

« back to all changes in this revision

Viewing changes to lib/external/bwidget/tree.tcl

Tags: 7.0.0~rc1+ds1-1~exp1
http://bugs.debian.org/776349
* New upstream release candidate.
* Repack upstream tarball, remove precompiled Python objects.
* Add upstream metadata.
* Update gbp.conf and Vcs-Git URL to use the experimental branch.
* Update watch file for GRASS 7.0.
* Drop build dependencies for Tcl/Tk, add build dependencies:
  python-numpy, libnetcdf-dev, netcdf-bin, libblas-dev, liblapack-dev
* Update Vcs-Browser URL to use cgit instead of gitweb.
* Update paths to use grass70.
* Add configure options: --with-netcdf, --with-blas, --with-lapack,
  remove --with-tcltk-includes.
* Update patches for GRASS 7.
* Update copyright file, changes:
  - Update copyright years
  - Group files by license
  - Remove unused license sections
* Add patches for various typos.
* Fix desktop file with patch instead of d/rules.
* Use minimal dh rules.
* Bump Standards-Version to 3.9.6, no changes.
* Use dpkg-maintscript-helper to replace directories with symlinks.
  (closes: #776349)
* Update my email to use @debian.org address.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/external/bwidget/tree.tcl
1
 
# ------------------------------------------------------------------------------
2
 
#  tree.tcl
3
 
#  This file is part of Unifix BWidget Toolkit
4
 
#  $Id: tree.tcl 10192 2002-01-24 19:25:32Z radim $
5
 
# ------------------------------------------------------------------------------
6
 
#  Index of commands:
7
 
#     - Tree::create
8
 
#     - Tree::configure
9
 
#     - Tree::cget
10
 
#     - Tree::insert
11
 
#     - Tree::itemconfigure
12
 
#     - Tree::itemcget
13
 
#     - Tree::bindText
14
 
#     - Tree::bindImage
15
 
#     - Tree::delete
16
 
#     - Tree::move
17
 
#     - Tree::reorder
18
 
#     - Tree::selection
19
 
#     - Tree::exists
20
 
#     - Tree::parent
21
 
#     - Tree::index
22
 
#     - Tree::nodes
23
 
#     - Tree::see
24
 
#     - Tree::opentree
25
 
#     - Tree::closetree
26
 
#     - Tree::edit
27
 
#     - Tree::xview
28
 
#     - Tree::yview
29
 
#     - Tree::_update_edit_size
30
 
#     - Tree::_destroy
31
 
#     - Tree::_see
32
 
#     - Tree::_recexpand
33
 
#     - Tree::_subdelete
34
 
#     - Tree::_update_scrollregion
35
 
#     - Tree::_cross_event
36
 
#     - Tree::_draw_node
37
 
#     - Tree::_draw_subnodes
38
 
#     - Tree::_update_nodes
39
 
#     - Tree::_draw_tree
40
 
#     - Tree::_redraw_tree
41
 
#     - Tree::_redraw_selection
42
 
#     - Tree::_redraw_idle
43
 
#     - Tree::_drag_cmd
44
 
#     - Tree::_drop_cmd
45
 
#     - Tree::_over_cmd
46
 
#     - Tree::_auto_scroll
47
 
#     - Tree::_scroll
48
 
# ------------------------------------------------------------------------------
49
 
 
50
 
namespace eval Tree {
51
 
    namespace eval Node {
52
 
        Widget::declare Tree::Node {
53
 
            {-text       String     ""      0}
54
 
            {-font       TkResource ""      0 listbox}
55
 
            {-image      TkResource ""      0 label}
56
 
            {-window     String     ""      0}
57
 
            {-fill       TkResource black   0 {listbox -foreground}}
58
 
            {-data       String     ""      0}
59
 
            {-open       Boolean    0       0}
60
 
            {-drawcross  Enum       auto    0 {auto allways never}}
61
 
        }
62
 
    }
63
 
 
64
 
    Widget::tkinclude Tree canvas :cmd \
65
 
        remove     {-insertwidth -insertbackground -insertborderwidth -insertofftime \
66
 
                        -insertontime -selectborderwidth -closeenough -confine -scrollregion \
67
 
                        -xscrollincrement -yscrollincrement -width -height} \
68
 
        initialize {-relief sunken -borderwidth 2 -takefocus 1 \
69
 
                        -highlightthickness 1 -width 200}
70
 
 
71
 
    Widget::declare Tree {
72
 
        {-deltax           Int 10 0 {=0 ""}}
73
 
        {-deltay           Int 15 0 {=0 ""}}
74
 
        {-padx             Int 20 0 {=0 ""}}
75
 
        {-background       TkResource "" 0 listbox}
76
 
        {-selectbackground TkResource "" 0 listbox}
77
 
        {-selectforeground TkResource "" 0 listbox}
78
 
        {-width            TkResource "" 0 listbox}
79
 
        {-height           TkResource "" 0 listbox}
80
 
        {-showlines        Boolean 1  0}
81
 
        {-linesfill        TkResource black  0 {frame -background}}
82
 
        {-linestipple      TkResource ""     0 {label -bitmap}}
83
 
        {-redraw           Boolean 1  0}
84
 
        {-opencmd          String  "" 0}
85
 
        {-closecmd         String  "" 0}
86
 
        {-dropovermode     Flag    "wpn" 0 "wpn"}
87
 
        {-bg               Synonym -background}
88
 
    }
89
 
    DragSite::include Tree "TREE_NODE" 1
90
 
    DropSite::include Tree {
91
 
        TREE_NODE {copy {} move {}}
92
 
    }
93
 
 
94
 
    Widget::addmap Tree "" :cmd {-deltay -yscrollincrement}
95
 
 
96
 
    proc ::Tree { path args } { return [eval Tree::create $path $args] }
97
 
    proc use {} {}
98
 
 
99
 
    variable _edit
100
 
}
101
 
 
102
 
 
103
 
# ------------------------------------------------------------------------------
104
 
#  Command Tree::create
105
 
# ------------------------------------------------------------------------------
106
 
proc Tree::create { path args } {
107
 
    variable $path
108
 
    upvar 0  $path data
109
 
 
110
 
    Widget::init Tree $path $args
111
 
 
112
 
    set data(root)         {{}}
113
 
    set data(selnodes)     {}
114
 
    set data(upd,level)    0
115
 
    set data(upd,nodes)    {}
116
 
    set data(upd,afterid)  ""
117
 
    set data(dnd,scroll)   ""
118
 
    set data(dnd,afterid)  ""
119
 
    set data(dnd,selnodes) {}
120
 
    set data(dnd,node)     ""
121
 
 
122
 
    set path [eval canvas $path [Widget::subcget $path :cmd] \
123
 
                  -width  [expr {[Widget::getoption $path -width]*8}] \
124
 
                  -height [expr {[Widget::getoption $path -height]*[Widget::getoption $path -deltay]}] \
125
 
                  -xscrollincrement 8]
126
 
 
127
 
    $path bind cross <ButtonPress-1> {Tree::_cross_event %W}
128
 
    bind $path <Configure> "Tree::_update_scrollregion $path"
129
 
    bind $path <Destroy>   "Tree::_destroy $path"
130
 
 
131
 
    DragSite::setdrag $path $path Tree::_init_drag_cmd [Widget::getoption $path -dragendcmd] 1
132
 
    DropSite::setdrop $path $path Tree::_over_cmd Tree::_drop_cmd 1
133
 
 
134
 
    rename $path ::$path:cmd
135
 
    proc ::$path { cmd args } "return \[eval Tree::\$cmd $path \$args\]"
136
 
 
137
 
    return $path
138
 
}
139
 
 
140
 
 
141
 
# ------------------------------------------------------------------------------
142
 
#  Command Tree::configure
143
 
# ------------------------------------------------------------------------------
144
 
proc Tree::configure { path args } {
145
 
    variable $path
146
 
    upvar 0  $path data
147
 
 
148
 
    set res [Widget::configure $path $args]
149
 
 
150
 
    set ch1 [expr {[Widget::hasChanged $path -deltax val] |
151
 
                   [Widget::hasChanged $path -deltay dy]  |
152
 
                   [Widget::hasChanged $path -padx val]   |
153
 
                   [Widget::hasChanged $path -showlines val]}]
154
 
 
155
 
    set ch2 [expr {[Widget::hasChanged $path -selectbackground val] |
156
 
                   [Widget::hasChanged $path -selectforeground val]}]
157
 
 
158
 
    if { [Widget::hasChanged $path -linesfill   fill] |
159
 
         [Widget::hasChanged $path -linestipple stipple] } {
160
 
        $path:cmd itemconfigure line  -fill $fill -stipple $stipple
161
 
        $path:cmd itemconfigure cross -foreground $fill
162
 
    }
163
 
 
164
 
    if { $ch1 } {
165
 
        _redraw_idle $path 3
166
 
    } elseif { $ch2 } {
167
 
        _redraw_idle $path 1
168
 
    }
169
 
 
170
 
    if { [Widget::hasChanged $path -height h] } {
171
 
        $path:cmd configure -height [expr {$h*$dy}]
172
 
    }
173
 
    if { [Widget::hasChanged $path -width w] } {
174
 
        $path:cmd configure -width [expr {$w*8}]
175
 
    }
176
 
 
177
 
    if { [Widget::hasChanged $path -redraw bool] && $bool } {
178
 
        set upd $data(upd,level)
179
 
        set data(upd,level) 0
180
 
        _redraw_idle $path $upd
181
 
    }
182
 
 
183
 
    set force [Widget::hasChanged $path -dragendcmd dragend]
184
 
    DragSite::setdrag $path $path Tree::_init_drag_cmd $dragend $force
185
 
    DropSite::setdrop $path $path Tree::_over_cmd Tree::_drop_cmd
186
 
 
187
 
    return $res
188
 
}
189
 
 
190
 
 
191
 
# ------------------------------------------------------------------------------
192
 
#  Command Tree::cget
193
 
# ------------------------------------------------------------------------------
194
 
proc Tree::cget { path option } {
195
 
    return [Widget::cget $path $option]
196
 
}
197
 
 
198
 
 
199
 
# ------------------------------------------------------------------------------
200
 
#  Command Tree::insert
201
 
# ------------------------------------------------------------------------------
202
 
proc Tree::insert { path index parent node args } {
203
 
    variable $path
204
 
    upvar 0  $path data
205
 
 
206
 
    if { [info exists data($node)] } {
207
 
        return -code error "node \"$node\" already exists"
208
 
    }
209
 
    if { ![info exists data($parent)] } {
210
 
        return -code error "node \"$parent\" does not exist"
211
 
    }
212
 
 
213
 
    Widget::init Tree::Node $path.$node $args
214
 
    if { ![string compare $index "end"] } {
215
 
        lappend data($parent) $node
216
 
    } else {
217
 
        incr index
218
 
        set data($parent) [linsert $data($parent) $index $node]
219
 
    }
220
 
    set data($node) [list $parent]
221
 
 
222
 
    if { ![string compare $parent "root"] } {
223
 
        _redraw_idle $path 3
224
 
    } elseif { [visible $path $parent] } {
225
 
        # parent is visible...
226
 
        if { [Widget::getoption $path.$parent -open] } {
227
 
            # ...and opened -> redraw whole
228
 
            _redraw_idle $path 3
229
 
        } else {
230
 
            # ...and closed -> redraw cross
231
 
            lappend data(upd,nodes) $parent 8
232
 
            _redraw_idle $path 2
233
 
        }
234
 
    }
235
 
    return $node
236
 
}
237
 
 
238
 
 
239
 
# ------------------------------------------------------------------------------
240
 
#  Command Tree::itemconfigure
241
 
# ------------------------------------------------------------------------------
242
 
proc Tree::itemconfigure { path node args } {
243
 
    variable $path
244
 
    upvar 0  $path data
245
 
 
246
 
    if { ![string compare $node "root"] || ![info exists data($node)] } {
247
 
        return -code error "node \"$node\" does not exist"
248
 
    }
249
 
 
250
 
    set result [Widget::configure $path.$node $args]
251
 
    if { [visible $path $node] } {
252
 
        set lopt   {}
253
 
        set flag   0
254
 
        foreach opt {-window -image -drawcross -font -text -fill} {
255
 
            set flag [expr {$flag << 1}]
256
 
            if { [Widget::hasChanged $path.$node $opt val] } {
257
 
                set flag [expr {$flag | 1}]
258
 
            }
259
 
        }
260
 
 
261
 
        if { [Widget::hasChanged $path.$node -open val] } {
262
 
            _redraw_idle $path 3
263
 
        } elseif { $data(upd,level) < 3 && $flag } {
264
 
            if { [set idx [lsearch $data(upd,nodes) $node]] == -1 } {
265
 
                lappend data(upd,nodes) $node $flag
266
 
            } else {
267
 
                incr idx
268
 
                set flag [expr {[lindex $data(upd,nodes) $idx] | $flag}]
269
 
                set data(upd,nodes) [lreplace $data(upd,nodes) $idx $idx $flag]
270
 
            }
271
 
            _redraw_idle $path 2
272
 
        }
273
 
    }
274
 
    return $result
275
 
}
276
 
 
277
 
 
278
 
# ------------------------------------------------------------------------------
279
 
#  Command Tree::itemcget
280
 
# ------------------------------------------------------------------------------
281
 
proc Tree::itemcget { path node option } {
282
 
    variable $path
283
 
    upvar 0  $path data
284
 
 
285
 
    if { ![string compare $node "root"] || ![info exists data($node)] } {
286
 
        return -code error "node \"$node\" does not exist"
287
 
    }
288
 
 
289
 
    return [Widget::cget $path.$node $option]
290
 
}
291
 
 
292
 
 
293
 
# ------------------------------------------------------------------------------
294
 
#  Command Tree::bindText
295
 
# ------------------------------------------------------------------------------
296
 
proc Tree::bindText { path event script } {
297
 
    if { $script != "" } {
298
 
        $path:cmd bind "node" $event \
299
 
            "$script \[string range \[lindex \[$path:cmd gettags current\] 1\] 2 end\]"
300
 
    } else {
301
 
        $path:cmd bind "node" $event {}
302
 
    }
303
 
}
304
 
 
305
 
 
306
 
# ------------------------------------------------------------------------------
307
 
#  Command Tree::bindImage
308
 
# ------------------------------------------------------------------------------
309
 
proc Tree::bindImage { path event script } {
310
 
    if { $script != "" } {
311
 
        $path:cmd bind "img" $event \
312
 
            "$script \[string range \[lindex \[$path:cmd gettags current\] 1\] 2 end\]"
313
 
    } else {
314
 
        $path:cmd bind "img" $event {}
315
 
    }
316
 
}
317
 
 
318
 
 
319
 
# ------------------------------------------------------------------------------
320
 
#  Command Tree::delete
321
 
# ------------------------------------------------------------------------------
322
 
proc Tree::delete { path args } {
323
 
    variable $path
324
 
    upvar 0  $path data
325
 
 
326
 
    foreach lnodes $args {
327
 
        foreach node $lnodes {
328
 
            if { [string compare $node "root"] && [info exists data($node)] } {
329
 
                set parent [lindex $data($node) 0]
330
 
                set idx    [lsearch $data($parent) $node]
331
 
                set data($parent) [lreplace $data($parent) $idx $idx]
332
 
                _subdelete $path [list $node]
333
 
            }
334
 
        }
335
 
    }
336
 
 
337
 
    set sel $data(selnodes)
338
 
    set data(selnodes) {}
339
 
    eval selection $path set $sel
340
 
    _redraw_idle $path 3
341
 
}
342
 
 
343
 
 
344
 
# ------------------------------------------------------------------------------
345
 
#  Command Tree::move
346
 
# ------------------------------------------------------------------------------
347
 
proc Tree::move { path parent node index } {
348
 
    variable $path
349
 
    upvar 0  $path data
350
 
 
351
 
    if { ![string compare $node "root"] || ![info exists data($node)] } {
352
 
        return -code error "node \"$node\" does not exist"
353
 
    }
354
 
    if { ![info exists data($parent)] } {
355
 
        return -code error "node \"$parent\" does not exist"
356
 
    }
357
 
    set p $parent
358
 
    while { [string compare $p "root"] } {
359
 
        if { ![string compare $p $node] } {
360
 
            return -code error "node \"$parent\" is a descendant of \"$node\""
361
 
        }
362
 
        set p [parent $path $p]
363
 
    }
364
 
 
365
 
    set oldp        [lindex $data($node) 0]
366
 
    set idx         [lsearch $data($oldp) $node]
367
 
    set data($oldp) [lreplace $data($oldp) $idx $idx]
368
 
    set data($node) [concat [list $parent] [lrange $data($node) 1 end]]
369
 
    if { ![string compare $index "end"] } {
370
 
        lappend data($parent) $node
371
 
    } else {
372
 
        incr index
373
 
        set data($parent) [linsert $data($parent) $index $node]
374
 
    }
375
 
    if { (![string compare $oldp "root"] ||
376
 
          ([visible $path $oldp] && [Widget::getoption $path.$oldp   -open])) ||
377
 
         (![string compare $parent "root"] ||
378
 
          ([visible $path $parent] && [Widget::getoption $path.$parent -open])) } {
379
 
        _redraw_idle $path 3
380
 
    }
381
 
}
382
 
 
383
 
 
384
 
# ------------------------------------------------------------------------------
385
 
#  Command Tree::reorder
386
 
# ------------------------------------------------------------------------------
387
 
proc Tree::reorder { path node neworder } {
388
 
    variable $path
389
 
    upvar 0  $path data
390
 
 
391
 
    if { ![info exists data($node)] } {
392
 
        return -code error "node \"$node\" does not exist"
393
 
    }
394
 
    set children [lrange $data($node) 1 end]
395
 
    if { [llength $children] } {
396
 
        set children [BWidget::lreorder $children $neworder]
397
 
        set data($node) [linsert $children 0 [lindex $data($node) 0]]
398
 
        if { [visible $path $node] && [Widget::getoption $path.$node -open] } {
399
 
            _redraw_idle $path 3
400
 
        }
401
 
    }
402
 
}
403
 
 
404
 
 
405
 
# ------------------------------------------------------------------------------
406
 
#  Command Tree::selection
407
 
# ------------------------------------------------------------------------------
408
 
proc Tree::selection { path cmd args } {
409
 
    variable $path
410
 
    upvar 0  $path data
411
 
 
412
 
    switch -- $cmd {
413
 
        set {
414
 
            set data(selnodes) {}
415
 
            foreach node $args {
416
 
                if { [info exists data($node)] } {
417
 
                    if { [lsearch $data(selnodes) $node] == -1 } {
418
 
                        lappend data(selnodes) $node
419
 
                    }
420
 
                }
421
 
            }
422
 
        }
423
 
        add {
424
 
            foreach node $args {
425
 
                if { [info exists data($node)] } {
426
 
                    if { [lsearch $data(selnodes) $node] == -1 } {
427
 
                        lappend data(selnodes) $node
428
 
                    }
429
 
                }
430
 
            }
431
 
        }
432
 
        remove {
433
 
            foreach node $args {
434
 
                if { [set idx [lsearch $data(selnodes) $node]] != -1 } {
435
 
                    set data(selnodes) [lreplace $data(selnodes) $idx $idx]
436
 
                }
437
 
            }
438
 
        }
439
 
        clear {
440
 
            set data(selnodes) {}
441
 
        }
442
 
        get {
443
 
            return $data(selnodes)
444
 
        }
445
 
        default {
446
 
            return
447
 
        }
448
 
    }
449
 
    _redraw_idle $path 1
450
 
}
451
 
 
452
 
 
453
 
# ------------------------------------------------------------------------------
454
 
#  Command Tree::exists
455
 
# ------------------------------------------------------------------------------
456
 
proc Tree::exists { path node } {
457
 
    variable $path
458
 
    upvar 0  $path data
459
 
 
460
 
    return [info exists data($node)]
461
 
}
462
 
 
463
 
 
464
 
# ------------------------------------------------------------------------------
465
 
#  Command Tree::visible
466
 
# ------------------------------------------------------------------------------
467
 
proc Tree::visible { path node } {
468
 
    set idn [$path:cmd find withtag n:$node]
469
 
    return [llength $idn]
470
 
}
471
 
 
472
 
 
473
 
# ------------------------------------------------------------------------------
474
 
#  Command Tree::parent
475
 
# ------------------------------------------------------------------------------
476
 
proc Tree::parent { path node } {
477
 
    variable $path
478
 
    upvar 0  $path data
479
 
 
480
 
    if { ![info exists data($node)] } {
481
 
        return -code error "node \"$node\" does not exist"
482
 
    }
483
 
    return [lindex $data($node) 0]
484
 
}
485
 
 
486
 
 
487
 
# ------------------------------------------------------------------------------
488
 
#  Command Tree::index
489
 
# ------------------------------------------------------------------------------
490
 
proc Tree::index { path node } {
491
 
    variable $path
492
 
    upvar 0  $path data
493
 
 
494
 
    if { ![string compare $node "root"] || ![info exists data($node)] } {
495
 
        return -code error "node \"$node\" does not exist"
496
 
    }
497
 
    set parent [lindex $data($node) 0]
498
 
    return [expr {[lsearch $data($parent) $node] - 1}]
499
 
}
500
 
 
501
 
 
502
 
# ------------------------------------------------------------------------------
503
 
#  Command Tree::nodes
504
 
# ------------------------------------------------------------------------------
505
 
proc Tree::nodes { path node {first ""} {last ""} } {
506
 
    variable $path
507
 
    upvar 0  $path data
508
 
 
509
 
    if { ![info exists data($node)] } {
510
 
        return -code error "node \"$node\" does not exist"
511
 
    }
512
 
 
513
 
    if { ![string length $first] } {
514
 
        return [lrange $data($node) 1 end]
515
 
    }
516
 
 
517
 
    if { ![string length $last] } {
518
 
        return [lindex [lrange $data($node) 1 end] $first]
519
 
    } else {
520
 
        return [lrange [lrange $data($node) 1 end] $first $last]
521
 
    }
522
 
}
523
 
 
524
 
 
525
 
# ------------------------------------------------------------------------------
526
 
#  Command Tree::see
527
 
# ------------------------------------------------------------------------------
528
 
proc Tree::see { path node } {
529
 
    variable $path
530
 
    upvar 0  $path data
531
 
 
532
 
    if { [Widget::getoption $path -redraw] && $data(upd,afterid) != "" } {
533
 
        after cancel $data(upd,afterid)
534
 
        _redraw_tree $path
535
 
    }
536
 
    set idn [$path:cmd find withtag n:$node]
537
 
    if { $idn != "" } {
538
 
        Tree::_see $path $idn right
539
 
        Tree::_see $path $idn left
540
 
    }
541
 
}
542
 
 
543
 
 
544
 
# ------------------------------------------------------------------------------
545
 
#  Command Tree::opentree
546
 
# ------------------------------------------------------------------------------
547
 
proc Tree::opentree { path node } {
548
 
    variable $path
549
 
    upvar 0  $path data
550
 
 
551
 
    if { ![string compare $node "root"] || ![info exists data($node)] } {
552
 
        return -code error "node \"$node\" does not exist"
553
 
    }
554
 
 
555
 
    _recexpand $path $node 1 [Widget::getoption $path -opencmd]
556
 
    _redraw_idle $path 3
557
 
}
558
 
 
559
 
 
560
 
# ------------------------------------------------------------------------------
561
 
#  Command Tree::closetree
562
 
# ------------------------------------------------------------------------------
563
 
proc Tree::closetree { path node } {
564
 
    variable $path
565
 
    upvar 0  $path data
566
 
 
567
 
    if { ![string compare $node "root"] || ![info exists data($node)] } {
568
 
        return -code error "node \"$node\" does not exist"
569
 
    }
570
 
 
571
 
    _recexpand $path $node 0 [Widget::getoption $path -closecmd]
572
 
    _redraw_idle $path 3
573
 
}
574
 
 
575
 
 
576
 
# ------------------------------------------------------------------------------
577
 
#  Command Tree::edit
578
 
# ------------------------------------------------------------------------------
579
 
proc Tree::edit { path node text {verifycmd ""} {clickres 0} {select 1}} {
580
 
    variable _edit
581
 
    variable $path
582
 
    upvar 0  $path data
583
 
 
584
 
    if { [Widget::getoption $path -redraw] && $data(upd,afterid) != "" } {
585
 
        after cancel $data(upd,afterid)
586
 
        _redraw_tree $path
587
 
    }
588
 
    set idn [$path:cmd find withtag n:$node]
589
 
    if { $idn != "" } {
590
 
        Tree::_see $path $idn right
591
 
        Tree::_see $path $idn left
592
 
 
593
 
        set oldfg  [$path:cmd itemcget $idn -fill]
594
 
        set sbg    [Widget::getoption $path -selectbackground]
595
 
        set coords [$path:cmd coords $idn]
596
 
        set x      [lindex $coords 0]
597
 
        set y      [lindex $coords 1]
598
 
        set bd     [expr {[$path:cmd cget -borderwidth]+[$path:cmd cget -highlightthickness]}]
599
 
        set w      [expr {[winfo width $path] - 2*$bd}]
600
 
        set wmax   [expr {[$path:cmd canvasx $w]-$x}]
601
 
 
602
 
        set _edit(text) $text
603
 
        set _edit(wait) 0
604
 
 
605
 
        $path:cmd itemconfigure $idn    -fill [Widget::getoption $path -background]
606
 
        $path:cmd itemconfigure s:$node -fill {} -outline {}
607
 
 
608
 
        set frame  [frame $path.edit \
609
 
                        -relief flat -borderwidth 0 -highlightthickness 0 \
610
 
                        -background [Widget::getoption $path -background]]
611
 
        set ent    [entry $frame.edit \
612
 
                        -width              0     \
613
 
                        -relief             solid \
614
 
                        -borderwidth        1     \
615
 
                        -highlightthickness 0     \
616
 
                        -foreground         [Widget::getoption $path.$node -fill] \
617
 
                        -background         [Widget::getoption $path -background] \
618
 
                        -selectforeground   [Widget::getoption $path -selectforeground] \
619
 
                        -selectbackground   $sbg  \
620
 
                        -font               [Widget::getoption $path.$node -font] \
621
 
                        -textvariable       Tree::_edit(text)]
622
 
        pack $ent -ipadx 8 -anchor w
623
 
 
624
 
        set idw [$path:cmd create window $x $y -window $frame -anchor w]
625
 
        trace variable Tree::_edit(text) w "Tree::_update_edit_size $path $ent $idw $wmax"
626
 
        tkwait visibility $ent
627
 
        grab  $frame
628
 
        BWidget::focus set $ent
629
 
 
630
 
        _update_edit_size $path $ent $idw $wmax
631
 
        update
632
 
        if { $select } {
633
 
            $ent selection range 0 end
634
 
            $ent icursor end
635
 
            $ent xview end
636
 
        }
637
 
 
638
 
        bind $ent <Escape> {set Tree::_edit(wait) 0}
639
 
        bind $ent <Return> {set Tree::_edit(wait) 1}
640
 
        if { $clickres == 0 || $clickres == 1 } {
641
 
            bind $frame <Button>  "set Tree::_edit(wait) $clickres"
642
 
        }
643
 
 
644
 
        set ok 0
645
 
        while { !$ok } {
646
 
            tkwait variable Tree::_edit(wait)
647
 
            if { !$_edit(wait) || $verifycmd == "" ||
648
 
                 [uplevel \#0 $verifycmd [list $_edit(text)]] } {
649
 
                set ok 1
650
 
            }
651
 
        }
652
 
 
653
 
        trace vdelete Tree::_edit(text) w "Tree::_update_edit_size $path $ent $idw $wmax"
654
 
        grab release $frame
655
 
        BWidget::focus release $ent
656
 
        destroy $frame
657
 
        $path:cmd delete $idw
658
 
        $path:cmd itemconfigure $idn    -fill $oldfg
659
 
        $path:cmd itemconfigure s:$node -fill $sbg -outline $sbg
660
 
 
661
 
        if { $_edit(wait) } {
662
 
            return $_edit(text)
663
 
        }
664
 
    }
665
 
    return ""
666
 
}
667
 
 
668
 
 
669
 
# ------------------------------------------------------------------------------
670
 
#  Command Tree::xview
671
 
# ------------------------------------------------------------------------------
672
 
proc Tree::xview { path args } {
673
 
    return [eval $path:cmd xview $args]
674
 
}
675
 
 
676
 
 
677
 
# ------------------------------------------------------------------------------
678
 
#  Command Tree::yview
679
 
# ------------------------------------------------------------------------------
680
 
proc Tree::yview { path args } {
681
 
    return [eval $path:cmd yview $args]
682
 
}
683
 
 
684
 
 
685
 
# ------------------------------------------------------------------------------
686
 
#  Command Tree::_update_edit_size
687
 
# ------------------------------------------------------------------------------
688
 
proc Tree::_update_edit_size { path entry idw wmax args } {
689
 
    set entw [winfo reqwidth $entry]
690
 
    if { $entw+8 >= $wmax } {
691
 
        $path:cmd itemconfigure $idw -width $wmax
692
 
    } else {
693
 
        $path:cmd itemconfigure $idw -width 0
694
 
    }
695
 
}
696
 
 
697
 
 
698
 
# ------------------------------------------------------------------------------
699
 
#  Command Tree::_destroy
700
 
# ------------------------------------------------------------------------------
701
 
proc Tree::_destroy { path } {
702
 
    variable $path
703
 
    upvar 0  $path data
704
 
 
705
 
    if { $data(upd,afterid) != "" } {
706
 
        after cancel $data(upd,afterid)
707
 
    }
708
 
    if { $data(dnd,afterid) != "" } {
709
 
        after cancel $data(dnd,afterid)
710
 
    }
711
 
    _subdelete $path [lrange $data(root) 1 end]
712
 
    Widget::destroy $path
713
 
    unset data
714
 
    rename $path {}
715
 
}
716
 
 
717
 
 
718
 
# ------------------------------------------------------------------------------
719
 
#  Command Tree::_see
720
 
# ------------------------------------------------------------------------------
721
 
proc Tree::_see { path idn side } {
722
 
    set bbox [$path:cmd bbox $idn]
723
 
    set scrl [$path:cmd cget -scrollregion]
724
 
 
725
 
    set ymax [lindex $scrl 3]
726
 
    set dy   [$path:cmd cget -yscrollincrement]
727
 
    set yv   [$path yview]
728
 
    set yv0  [expr {round([lindex $yv 0]*$ymax/$dy)}]
729
 
    set yv1  [expr {round([lindex $yv 1]*$ymax/$dy)}]
730
 
    set y    [expr {int([lindex [$path:cmd coords $idn] 1]/$dy)}]
731
 
    if { $y < $yv0 } {
732
 
        $path:cmd yview scroll [expr {$y-$yv0}] units
733
 
    } elseif { $y >= $yv1 } {
734
 
        $path:cmd yview scroll [expr {$y-$yv1+1}] units
735
 
    }
736
 
 
737
 
    set xmax [lindex $scrl 2]
738
 
    set dx   [$path:cmd cget -xscrollincrement]
739
 
    set xv   [$path xview]
740
 
    if { ![string compare $side "right"] } {
741
 
        set xv1 [expr {round([lindex $xv 1]*$xmax/$dx)}]
742
 
        set x1  [expr {int([lindex $bbox 2]/$dx)}]
743
 
        if { $x1 >= $xv1 } {
744
 
            $path:cmd xview scroll [expr {$x1-$xv1+1}] units
745
 
        }
746
 
    } else {
747
 
        set xv0 [expr {round([lindex $xv 0]*$xmax/$dx)}]
748
 
        set x0  [expr {int([lindex $bbox 0]/$dx)}]
749
 
        if { $x0 < $xv0 } {
750
 
            $path:cmd xview scroll [expr {$x0-$xv0}] units
751
 
        }
752
 
    }
753
 
}
754
 
 
755
 
 
756
 
# ------------------------------------------------------------------------------
757
 
#  Command Tree::_recexpand
758
 
# ------------------------------------------------------------------------------
759
 
proc Tree::_recexpand { path node expand cmd } {
760
 
    variable $path
761
 
    upvar 0  $path data
762
 
 
763
 
    if { [Widget::getoption $path.$node -open] != $expand } {
764
 
        Widget::setoption $path.$node -open $expand
765
 
        if { $cmd != "" } {
766
 
            uplevel \#0 $cmd $node
767
 
        }
768
 
    }
769
 
 
770
 
    foreach subnode [lrange $data($node) 1 end] {
771
 
        _recexpand $path $subnode $expand $cmd
772
 
    }
773
 
}
774
 
 
775
 
 
776
 
# ------------------------------------------------------------------------------
777
 
#  Command Tree::_subdelete
778
 
# ------------------------------------------------------------------------------
779
 
proc Tree::_subdelete { path lnodes } {
780
 
    variable $path
781
 
    upvar 0  $path data
782
 
 
783
 
    while { [llength $lnodes] } {
784
 
        set lsubnodes [list]
785
 
        foreach node $lnodes {
786
 
            foreach subnode [lrange $data($node) 1 end] {
787
 
                lappend lsubnodes $subnode
788
 
            }
789
 
            unset data($node)
790
 
            if { [set win [Widget::getoption $path.$node -window]] != "" } {
791
 
                destroy $win
792
 
            }
793
 
            Widget::destroy $path.$node
794
 
        }
795
 
        set lnodes $lsubnodes
796
 
    }
797
 
}
798
 
 
799
 
 
800
 
# ------------------------------------------------------------------------------
801
 
#  Command Tree::_update_scrollregion
802
 
# ------------------------------------------------------------------------------
803
 
proc Tree::_update_scrollregion { path } {
804
 
    set bd   [expr {2*([$path:cmd cget -borderwidth]+[$path:cmd cget -highlightthickness])}]
805
 
    set w    [expr {[winfo width  $path] - $bd}]
806
 
    set h    [expr {[winfo height $path] - $bd}]
807
 
    set xinc [$path:cmd cget -xscrollincrement]
808
 
    set yinc [$path:cmd cget -yscrollincrement]
809
 
    set bbox [$path:cmd bbox all]
810
 
    if { [llength $bbox] } {
811
 
        set xs [lindex $bbox 2]
812
 
        set ys [lindex $bbox 3]
813
 
 
814
 
        if { $w < $xs } {
815
 
            set w [expr {int($xs)}]
816
 
            if { [set r [expr {$w % $xinc}]] } {
817
 
                set w [expr {$w+$xinc-$r}]
818
 
            }
819
 
        }
820
 
        if { $h < $ys } {
821
 
            set h [expr {int($ys)}]
822
 
            if { [set r [expr {$h % $yinc}]] } {
823
 
                set h [expr {$h+$yinc-$r}]
824
 
            }
825
 
        }
826
 
    }
827
 
 
828
 
    $path:cmd configure -scrollregion [list 0 0 $w $h]
829
 
}
830
 
 
831
 
 
832
 
# ------------------------------------------------------------------------------
833
 
#  Command Tree::_cross_event
834
 
# ------------------------------------------------------------------------------
835
 
proc Tree::_cross_event { path } {
836
 
    variable $path
837
 
    upvar 0  $path data
838
 
 
839
 
    set node [string range [lindex [$path:cmd gettags current] 1] 2 end]
840
 
    if { [Widget::getoption $path.$node -open] } {
841
 
        if { [set cmd [Widget::getoption $path -closecmd]] != "" } {
842
 
            uplevel \#0 $cmd $node
843
 
        }
844
 
        Widget::setoption $path.$node -open 0
845
 
    } else {
846
 
        if { [set cmd [Widget::getoption $path -opencmd]] != "" } {
847
 
            uplevel \#0 $cmd $node
848
 
        }
849
 
        Widget::setoption $path.$node -open 1
850
 
    }
851
 
    _redraw_idle $path 3
852
 
}
853
 
 
854
 
 
855
 
# ------------------------------------------------------------------------------
856
 
#  Command Tree::_draw_node
857
 
# ------------------------------------------------------------------------------
858
 
proc Tree::_draw_node { path node x0 y0 deltax deltay padx showlines } {
859
 
    global   env
860
 
    variable $path
861
 
    upvar 0  $path data
862
 
 
863
 
    set x1 [expr {$x0+$deltax+5}]
864
 
    set y1 $y0
865
 
    if { $showlines } {
866
 
        $path:cmd create line $x0 $y0 $x1 $y0 \
867
 
            -fill    [Widget::getoption $path -linesfill]   \
868
 
            -stipple [Widget::getoption $path -linestipple] \
869
 
            -tags    line
870
 
    }
871
 
    $path:cmd create text [expr {$x1+$padx}] $y0 \
872
 
        -text   [Widget::getoption $path.$node -text] \
873
 
        -fill   [Widget::getoption $path.$node -fill] \
874
 
        -font   [Widget::getoption $path.$node -font] \
875
 
        -anchor w \
876
 
        -tags   "node n:$node"
877
 
    set len [expr {[llength $data($node)] > 1}]
878
 
    set dc  [Widget::getoption $path.$node -drawcross]
879
 
    set exp [Widget::getoption $path.$node -open]
880
 
 
881
 
    if { $len && $exp } {
882
 
        set y1 [_draw_subnodes $path [lrange $data($node) 1 end] \
883
 
                    [expr {$x0+$deltax}] $y0 $deltax $deltay $padx $showlines]
884
 
    }
885
 
 
886
 
    if { [string compare $dc "never"] && ($len || ![string compare $dc "allways"]) } {
887
 
        if { $exp } {
888
 
            set bmp [file join $env(BWIDGET_LIBRARY) "images" "minus.xbm"]
889
 
        } else {
890
 
            set bmp [file join $env(BWIDGET_LIBRARY) "images" "plus.xbm"]
891
 
        }
892
 
        $path:cmd create bitmap $x0 $y0 \
893
 
            -bitmap     @$bmp \
894
 
            -background [$path:cmd cget -background] \
895
 
            -foreground [Widget::getoption $path -linesfill] \
896
 
            -tags       "cross c:$node" -anchor c
897
 
    }
898
 
 
899
 
    if { [set win [Widget::getoption $path.$node -window]] != "" } {
900
 
        $path:cmd create window $x1 $y0 -window $win -anchor w -tags "win i:$node"
901
 
    } elseif { [set img [Widget::getoption $path.$node -image]] != "" } {
902
 
        $path:cmd create image $x1 $y0 -image $img -anchor w -tags "img i:$node"
903
 
    }
904
 
    return $y1
905
 
}
906
 
 
907
 
 
908
 
# ------------------------------------------------------------------------------
909
 
#  Command Tree::_draw_subnodes
910
 
# ------------------------------------------------------------------------------
911
 
proc Tree::_draw_subnodes { path nodes x0 y0 deltax deltay padx showlines } {
912
 
    set y1 $y0
913
 
    foreach node $nodes {
914
 
        set yp $y1
915
 
        set y1 [_draw_node $path $node $x0 [expr {$y1+$deltay}] $deltax $deltay $padx $showlines]
916
 
    }
917
 
    if { $showlines && [llength $nodes] } {
918
 
        set id [$path:cmd create line $x0 $y0 $x0 [expr {$yp+$deltay}] \
919
 
                    -fill    [Widget::getoption $path -linesfill]   \
920
 
                    -stipple [Widget::getoption $path -linestipple] \
921
 
                    -tags    line]
922
 
 
923
 
        $path:cmd lower $id
924
 
    }
925
 
    return $y1
926
 
}
927
 
 
928
 
 
929
 
# ------------------------------------------------------------------------------
930
 
#  Command Tree::_update_nodes
931
 
# ------------------------------------------------------------------------------
932
 
proc Tree::_update_nodes { path } {
933
 
    global   env
934
 
    variable $path
935
 
    upvar 0  $path data
936
 
 
937
 
    set deltax [Widget::getoption $path -deltax]
938
 
    set padx   [Widget::getoption $path -padx]
939
 
    foreach {node flag} $data(upd,nodes) {
940
 
        set idn [$path:cmd find withtag "n:$node"]
941
 
        if { $idn == "" } {
942
 
            continue
943
 
        }
944
 
        set c  [$path:cmd coords $idn]
945
 
        set x0 [expr {[lindex $c 0]-$padx}]
946
 
        set y0 [lindex $c 1]
947
 
        if { $flag & 48 } {
948
 
            # -window or -image modified
949
 
            set win  [Widget::getoption $path.$node -window]
950
 
            set img  [Widget::getoption $path.$node -image]
951
 
            set idi  [$path:cmd find withtag i:$node]
952
 
            set type [lindex [$path:cmd gettags $idi] 0]
953
 
            if { [string length $win] } {
954
 
                if { ![string compare $type "win"] } {
955
 
                    $path:cmd itemconfigure $idi -window $win
956
 
                } else {
957
 
                    $path:cmd delete $idi
958
 
                    $path:cmd create window $x0 $y0 -window $win -anchor w -tags "win i:$node"
959
 
                }
960
 
            } elseif { [string length $img] } {
961
 
                if { ![string compare $type "img"] } {
962
 
                    $path:cmd itemconfigure $idi -image $img
963
 
                } else {
964
 
                    $path:cmd delete $idi
965
 
                    $path:cmd create image $x0 $y0 -image $img -anchor w -tags "img i:$node"
966
 
                }
967
 
            } else {
968
 
                $path:cmd delete $idi
969
 
            }
970
 
        }
971
 
 
972
 
        if { $flag & 8 } {
973
 
            # -drawcross modified
974
 
            set len [expr {[llength $data($node)] > 1}]
975
 
            set dc  [Widget::getoption $path.$node -drawcross]
976
 
            set exp [Widget::getoption $path.$node -open]
977
 
            set idc [$path:cmd find withtag c:$node]
978
 
 
979
 
            if { [string compare $dc "never"] && ($len || ![string compare $dc "allways"]) } {
980
 
                if { $exp } {
981
 
                    set bmp [file join $env(BWIDGET_LIBRARY) "images" "minus.xbm"]
982
 
                } else {
983
 
                    set bmp [file join $env(BWIDGET_LIBRARY) "images" "plus.xbm"]
984
 
                }
985
 
                if { $idc == "" } {
986
 
                    $path:cmd create bitmap [expr {$x0-$deltax-5}] $y0 \
987
 
                        -bitmap     @$bmp \
988
 
                        -background [$path:cmd cget -background] \
989
 
                        -foreground [Widget::getoption $path -linesfill] \
990
 
                        -tags       "cross c:$node" -anchor c
991
 
                } else {
992
 
                    $path:cmd itemconfigure $idc -bitmap @$bmp
993
 
                }
994
 
            } else {
995
 
                $path:cmd delete $idc
996
 
            }
997
 
        }
998
 
 
999
 
        if { $flag & 7 } {
1000
 
            # -font, -text or -fill modified
1001
 
            $path:cmd itemconfigure $idn \
1002
 
                -text [Widget::getoption $path.$node -text] \
1003
 
                -fill [Widget::getoption $path.$node -fill] \
1004
 
                -font [Widget::getoption $path.$node -font]
1005
 
        }
1006
 
    }
1007
 
}
1008
 
 
1009
 
 
1010
 
# ------------------------------------------------------------------------------
1011
 
#  Command Tree::_draw_tree
1012
 
# ------------------------------------------------------------------------------
1013
 
proc Tree::_draw_tree { path } {
1014
 
    variable $path
1015
 
    upvar 0  $path data
1016
 
 
1017
 
    $path:cmd delete all
1018
 
    $path:cmd configure -cursor watch
1019
 
    _draw_subnodes $path [lrange $data(root) 1 end] 8 \
1020
 
        [expr {-[Widget::getoption $path -deltay]/2}] \
1021
 
        [Widget::getoption $path -deltax] \
1022
 
        [Widget::getoption $path -deltay] \
1023
 
        [Widget::getoption $path -padx]   \
1024
 
        [Widget::getoption $path -showlines]
1025
 
    $path:cmd configure -cursor [Widget::getoption $path -cursor]
1026
 
}
1027
 
 
1028
 
 
1029
 
# ------------------------------------------------------------------------------
1030
 
#  Command Tree::_redraw_tree
1031
 
# ------------------------------------------------------------------------------
1032
 
proc Tree::_redraw_tree { path } {
1033
 
    variable $path
1034
 
    upvar 0  $path data
1035
 
 
1036
 
    if { [Widget::getoption $path -redraw] } {
1037
 
        if { $data(upd,level) == 2 } {
1038
 
            _update_nodes $path
1039
 
        } elseif { $data(upd,level) == 3 } {
1040
 
            _draw_tree $path
1041
 
        }
1042
 
        _redraw_selection $path
1043
 
        _update_scrollregion $path
1044
 
        set data(upd,nodes)   {}
1045
 
        set data(upd,level)   0
1046
 
        set data(upd,afterid) ""
1047
 
    }
1048
 
}
1049
 
 
1050
 
 
1051
 
# ------------------------------------------------------------------------------
1052
 
#  Command Tree::_redraw_selection
1053
 
# ------------------------------------------------------------------------------
1054
 
proc Tree::_redraw_selection { path } {
1055
 
    variable $path
1056
 
    upvar 0  $path data
1057
 
 
1058
 
    set selbg [Widget::getoption $path -selectbackground]
1059
 
    set selfg [Widget::getoption $path -selectforeground]
1060
 
    foreach id [$path:cmd find withtag sel] {
1061
 
        set node [string range [lindex [$path:cmd gettags $id] 1] 2 end]
1062
 
        $path:cmd itemconfigure "n:$node" -fill [Widget::getoption $path.$node -fill]
1063
 
    }
1064
 
    $path:cmd delete sel
1065
 
    foreach node $data(selnodes) {
1066
 
        set bbox [$path:cmd bbox "n:$node"]
1067
 
        if { [llength $bbox] } {
1068
 
            set id [eval $path:cmd create rectangle $bbox -fill $selbg -outline $selbg -tags [list "sel s:$node"]]
1069
 
            $path:cmd itemconfigure "n:$node" -fill $selfg
1070
 
            $path:cmd lower $id
1071
 
        }
1072
 
    }
1073
 
}
1074
 
 
1075
 
 
1076
 
# ------------------------------------------------------------------------------
1077
 
#  Command Tree::_redraw_idle
1078
 
# ------------------------------------------------------------------------------
1079
 
proc Tree::_redraw_idle { path level } {
1080
 
    variable $path
1081
 
    upvar 0  $path data
1082
 
 
1083
 
    if { [Widget::getoption $path -redraw] && $data(upd,afterid) == "" } {
1084
 
        set data(upd,afterid) [after idle Tree::_redraw_tree $path]
1085
 
    }
1086
 
    if { $level > $data(upd,level) } {
1087
 
        set data(upd,level) $level
1088
 
    }
1089
 
    return ""
1090
 
}
1091
 
 
1092
 
 
1093
 
# --------------------------------------------------------------------------------------------
1094
 
# Commandes pour le Drag and Drop
1095
 
 
1096
 
 
1097
 
# ------------------------------------------------------------------------------
1098
 
#  Command Tree::_init_drag_cmd
1099
 
# ------------------------------------------------------------------------------
1100
 
proc Tree::_init_drag_cmd { path X Y top } {
1101
 
    set ltags [$path:cmd gettags current]
1102
 
    set item  [lindex $ltags 0]
1103
 
    if { ![string compare $item "node"] ||
1104
 
         ![string compare $item "img"]  ||
1105
 
         ![string compare $item "win"] } {
1106
 
        set node [string range [lindex $ltags 1] 2 end]
1107
 
        if { [set cmd [Widget::getoption $path -draginitcmd]] != "" } {
1108
 
            return [uplevel \#0 $cmd [list $path $node $top]]
1109
 
        }
1110
 
        if { [set type [Widget::getoption $path -dragtype]] == "" } {
1111
 
            set type "TREE_NODE"
1112
 
        }
1113
 
        if { [set img [Widget::getoption $path.$node -image]] != "" } {
1114
 
            pack [label $top.l -image $img -padx 0 -pady 0]
1115
 
        }
1116
 
        return [list $type {copy move link} $node]
1117
 
    }
1118
 
    return {}
1119
 
}
1120
 
 
1121
 
 
1122
 
# ------------------------------------------------------------------------------
1123
 
#  Command Tree::_drop_cmd
1124
 
# ------------------------------------------------------------------------------
1125
 
proc Tree::_drop_cmd { path source X Y op type dnddata } {
1126
 
    variable $path
1127
 
    upvar 0  $path data
1128
 
 
1129
 
    $path:cmd delete drop
1130
 
    if { [string length $data(dnd,afterid)] } {
1131
 
        after cancel $data(dnd,afterid)
1132
 
        set data(dnd,afterid) ""
1133
 
    }
1134
 
    set data(dnd,scroll) ""
1135
 
    if { [llength $data(dnd,node)] } {
1136
 
        if { [set cmd [Widget::getoption $path -dropcmd]] != "" } {
1137
 
            return [uplevel \#0 $cmd [list $path $source $data(dnd,node) $op $type $dnddata]]
1138
 
        }
1139
 
    }
1140
 
    return 0
1141
 
}
1142
 
 
1143
 
 
1144
 
# ------------------------------------------------------------------------------
1145
 
#  Command Tree::_over_cmd
1146
 
# ------------------------------------------------------------------------------
1147
 
proc Tree::_over_cmd { path source event X Y op type dnddata } {
1148
 
    variable $path
1149
 
    upvar 0  $path data
1150
 
 
1151
 
    if { ![string compare $event "leave"] } {
1152
 
        # we leave the window tree
1153
 
        $path:cmd delete drop
1154
 
        if { [string length $data(dnd,afterid)] } {
1155
 
            after cancel $data(dnd,afterid)
1156
 
            set data(dnd,afterid) ""
1157
 
        }
1158
 
        set data(dnd,scroll) ""
1159
 
        return 0
1160
 
    }
1161
 
 
1162
 
    if { ![string compare $event "enter"] } {
1163
 
        # we enter the window tree - dnd data initialization
1164
 
        set mode [Widget::getoption $path -dropovermode]
1165
 
        set data(dnd,mode) 0
1166
 
        foreach c {w p n} {
1167
 
            set data(dnd,mode) [expr {($data(dnd,mode) << 1) | ([string first $c $mode] != -1)}]
1168
 
        }
1169
 
        set bbox [$path:cmd bbox all]
1170
 
        if { [llength $bbox] } {
1171
 
            set data(dnd,xs) [lindex $bbox 2]
1172
 
        } else {
1173
 
            set data(dnd,xs) 0
1174
 
        }
1175
 
        set data(dnd,node) {}
1176
 
    }
1177
 
 
1178
 
    set x [expr {$X-[winfo rootx $path]}]
1179
 
    set y [expr {$Y-[winfo rooty $path]}]
1180
 
    $path:cmd delete drop
1181
 
    set data(dnd,node) {}
1182
 
 
1183
 
    # test for auto-scroll unless mode is widget only
1184
 
    if { $data(dnd,mode) != 4 && [_auto_scroll $path $x $y] != "" } {
1185
 
        return 2
1186
 
    }
1187
 
 
1188
 
    if { $data(dnd,mode) & 4 } {
1189
 
        # dropovermode includes widget
1190
 
        set target [list widget]
1191
 
        set vmode  4
1192
 
    } else {
1193
 
        set target [list ""]
1194
 
        set vmode  0
1195
 
    }
1196
 
 
1197
 
    set xc [$path:cmd canvasx $x]
1198
 
    set xs $data(dnd,xs)
1199
 
    if { $xc <= $xs } {
1200
 
        set yc   [$path:cmd canvasy $y]
1201
 
        set dy   [$path:cmd cget -yscrollincrement]
1202
 
        set line [expr {int($yc/$dy)}]
1203
 
        set xi   0
1204
 
        set yi   [expr {$line*$dy}]
1205
 
        set ys   [expr {$yi+$dy}]
1206
 
        foreach id [$path:cmd find overlapping $xi $yi $xs $ys] {
1207
 
            set ltags [$path:cmd gettags $id]
1208
 
            set item  [lindex $ltags 0]
1209
 
            if { ![string compare $item "node"] ||
1210
 
                 ![string compare $item "img"]  ||
1211
 
                 ![string compare $item "win"] } {
1212
 
                # item is the label or image/window of the node
1213
 
                set node [string range [lindex $ltags 1] 2 end]
1214
 
                set xi   [expr {[lindex [$path:cmd coords n:$node] 0]-[Widget::getoption $path -padx]}]
1215
 
 
1216
 
                if { $data(dnd,mode) & 1 } {
1217
 
                    # dropovermode includes node
1218
 
                    lappend target $node
1219
 
                    set vmode [expr {$vmode | 1}]
1220
 
                } else {
1221
 
                    lappend target ""
1222
 
                }
1223
 
 
1224
 
                if { $data(dnd,mode) & 2 } {
1225
 
                    # dropovermode includes position
1226
 
                    if { $yc >= $yi+$dy/2 } {
1227
 
                        # position is after $node
1228
 
                        if { [Widget::getoption $path.$node -open] &&
1229
 
                             [llength $data($node)] > 1 } {
1230
 
                            # $node is open and have subnodes
1231
 
                            # drop position is 0 in children of $node
1232
 
                            set parent $node
1233
 
                            set index  0
1234
 
                            set xli    [expr {$xi-5}]
1235
 
                        } else {
1236
 
                            # $node is not open and doesn't have subnodes
1237
 
                            # drop position is after $node in children of parent of $node
1238
 
                            set parent [lindex $data($node) 0]
1239
 
                            set index  [lsearch $data($parent) $node]
1240
 
                            set xli    [expr {$xi-[Widget::getoption $path -deltax]-5}]
1241
 
                        }
1242
 
                        set yl $ys
1243
 
                    } else {
1244
 
                        # position is before $node
1245
 
                        # drop position is before $node in children of parent of $node
1246
 
                        set parent [lindex $data($node) 0]
1247
 
                        set index  [expr {[lsearch $data($parent) $node] - 1}]
1248
 
                        set xli    [expr {$xi-[Widget::getoption $path -deltax]-5}]
1249
 
                        set yl     $yi
1250
 
                    }
1251
 
                    lappend target [list $parent $index]
1252
 
                    set vmode  [expr {$vmode | 2}]
1253
 
                } else {
1254
 
                    lappend target {}
1255
 
                }
1256
 
 
1257
 
                if { ($vmode & 3) == 3 } {
1258
 
                    # result have both node and position
1259
 
                    # we compute what is the preferred method
1260
 
                    if { $yc-$yi <= 3 || $ys-$yc <= 3 } {
1261
 
                        lappend target "position"
1262
 
                    } else {
1263
 
                        lappend target "node"
1264
 
                    }
1265
 
                }
1266
 
                break
1267
 
            }
1268
 
        }
1269
 
    }
1270
 
 
1271
 
    if { $vmode && [set cmd [Widget::getoption $path -dropovercmd]] != "" } {
1272
 
        # user-defined dropover command
1273
 
        set res     [uplevel \#0 $cmd [list $path $source $target $op $type $dnddata]]
1274
 
        set code    [lindex $res 0]
1275
 
        set newmode 0
1276
 
        if { $code & 1 } {
1277
 
            # update vmode
1278
 
            set mode [lindex $res 1]
1279
 
            if { ($vmode & 1) && ![string compare $mode "node"] } {
1280
 
                set newmode 1
1281
 
            } elseif { ($vmode & 2) && ![string compare $mode "position"] } {
1282
 
                set newmode 2
1283
 
            } elseif { ($vmode & 4) && ![string compare $mode "widget"] } {
1284
 
                set newmode 4
1285
 
            }
1286
 
        }
1287
 
        set vmode $newmode
1288
 
    } else {
1289
 
        if { ($vmode & 3) == 3 } {
1290
 
            # result have both item and position
1291
 
            # we choose the preferred method
1292
 
            if { ![string compare [lindex $target 3] "position"] } {
1293
 
                set vmode [expr {$vmode & ~1}]
1294
 
            } else {
1295
 
                set vmode [expr {$vmode & ~2}]
1296
 
            }
1297
 
        }
1298
 
 
1299
 
        if { $data(dnd,mode) == 4 || $data(dnd,mode) == 0 } {
1300
 
            # dropovermode is widget or empty - recall is not necessary
1301
 
            set code 1
1302
 
        } else {
1303
 
            set code 3
1304
 
        }
1305
 
    }
1306
 
 
1307
 
    # draw dnd visual following vmode
1308
 
    if { $vmode & 1 } {
1309
 
        set data(dnd,node) [list "node" [lindex $target 1]]
1310
 
        $path:cmd create rectangle $xi $yi $xs $ys -tags drop
1311
 
    } elseif { $vmode & 2 } {
1312
 
        set data(dnd,node) [concat "position" [lindex $target 2]]
1313
 
        $path:cmd create line $xli [expr {$yl-$dy/2}] $xli $yl $xs $yl -tags drop
1314
 
    } elseif { $vmode & 4 } {
1315
 
        set data(dnd,node) [list "widget"]
1316
 
    } else {
1317
 
        set code [expr {$code & 2}]
1318
 
    }
1319
 
 
1320
 
    if { $code & 1 } {
1321
 
        DropSite::setcursor based_arrow_down
1322
 
    } else {
1323
 
        DropSite::setcursor dot
1324
 
    }
1325
 
    return $code
1326
 
}
1327
 
 
1328
 
 
1329
 
# ------------------------------------------------------------------------------
1330
 
#  Command Tree::_auto_scroll
1331
 
# ------------------------------------------------------------------------------
1332
 
proc Tree::_auto_scroll { path x y } {
1333
 
    variable $path
1334
 
    upvar 0  $path data
1335
 
 
1336
 
    set xmax   [winfo width  $path]
1337
 
    set ymax   [winfo height $path]
1338
 
    set scroll {}
1339
 
    if { $y <= 6 } {
1340
 
        if { [lindex [$path:cmd yview] 0] > 0 } {
1341
 
            set scroll [list yview -1]
1342
 
            DropSite::setcursor sb_up_arrow
1343
 
        }
1344
 
    } elseif { $y >= $ymax-6 } {
1345
 
        if { [lindex [$path:cmd yview] 1] < 1 } {
1346
 
            set scroll [list yview 1]
1347
 
            DropSite::setcursor sb_down_arrow
1348
 
        }
1349
 
    } elseif { $x <= 6 } {
1350
 
        if { [lindex [$path:cmd xview] 0] > 0 } {
1351
 
            set scroll [list xview -1]
1352
 
            DropSite::setcursor sb_left_arrow
1353
 
        }
1354
 
    } elseif { $x >= $xmax-6 } {
1355
 
        if { [lindex [$path:cmd xview] 1] < 1 } {
1356
 
            set scroll [list xview 1]
1357
 
            DropSite::setcursor sb_right_arrow
1358
 
        }
1359
 
    }
1360
 
 
1361
 
    if { [string length $data(dnd,afterid)] && [string compare $data(dnd,scroll) $scroll] } {
1362
 
        after cancel $data(dnd,afterid)
1363
 
        set data(dnd,afterid) ""
1364
 
    }
1365
 
 
1366
 
    set data(dnd,scroll) $scroll
1367
 
    if { [string length $scroll] && ![string length $data(dnd,afterid)] } {
1368
 
        set data(dnd,afterid) [after 200 Tree::_scroll $path $scroll]
1369
 
    }
1370
 
    return $data(dnd,afterid)
1371
 
}
1372
 
 
1373
 
 
1374
 
# ------------------------------------------------------------------------------
1375
 
#  Command Tree::_scroll
1376
 
# ------------------------------------------------------------------------------
1377
 
proc Tree::_scroll { path cmd dir } {
1378
 
    variable $path
1379
 
    upvar 0  $path data
1380
 
 
1381
 
    if { ($dir == -1 && [lindex [$path:cmd $cmd] 0] > 0) ||
1382
 
         ($dir == 1  && [lindex [$path:cmd $cmd] 1] < 1) } {
1383
 
        $path:cmd $cmd scroll $dir units
1384
 
        set data(dnd,afterid) [after 100 Tree::_scroll $path $cmd $dir]
1385
 
    } else {
1386
 
        set data(dnd,afterid) ""
1387
 
        DropSite::setcursor dot
1388
 
    }
1389
 
}