~ubuntu-branches/ubuntu/vivid/grass/vivid-proposed

« back to all changes in this revision

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

  • Committer: Package Import Robot
  • Author(s): Bas Couwenberg
  • Date: 2015-02-20 23:12:08 UTC
  • mfrom: (8.2.6 experimental)
  • Revision ID: package-import@ubuntu.com-20150220231208-1u6qvqm84v430b10
Tags: 7.0.0-1~exp1
* New upstream release.
* Update python-ctypes-ternary.patch to use if/else instead of and/or.
* Drop check4dev patch, rely on upstream check.
* Add build dependency on libpq-dev to grass-dev for libpq-fe.h.
* Drop patches applied upstream, refresh remaining patches.
* Update symlinks for images switched from jpg to png.

Show diffs side-by-side

added added

removed removed

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