Bwidget Source Code
Check-in [dfcc0d0cba]
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:* listbox.tcl(ListBox::bindText and ListBox::bindImage) Method bindText and bindImage overwrote internal selection bindings [Bug 3000293] reported by Robert Karen.
Timelines: family | ancestors | descendants | both | bwidget
Files: files | file ages | folders
SHA1: dfcc0d0cba21fe680c51d8ae2c40165034ddf8df
User & Date: oehhar 2010-05-12 08:12:34
Context
2010-05-31
14:55
* listbox.html Reflected patch 2010-05-12 in documentation. The selection may not be disabled any more by binding button 1. check-in: 977402fa6e user: oehhar tags: bwidget
2010-05-12
08:12
* listbox.tcl(ListBox::bindText and ListBox::bindImage) Method bindText and bindImage overwrote internal selection bindings [Bug 3000293] reported by Robert Karen. check-in: dfcc0d0cba user: oehhar tags: bwidget
08:07
* listbox.tcl(ListBox::_configureSelectmode) Drag modifies multiple selection [Bug 2995969] reported by Robert Karen. Bound events on ButtonRelease-1 instead Button-1 for multiple selections to avoid bug. * listbox.tcl(ListBox::_drag_and_drop) The default drag and drop routine only handled single drag and drop. It was extended to handle also drag and drop of multiple entries. check-in: fb29756c0e user: oehhar tags: bwidget
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.







1
2
3
4
5
6
7





2010-05-11 Harald Oehlmann < [email protected]>

	* listbox.tcl(ListBox::see) Method see shifts image out of
	view. Showed up, by a selection click on a long item with icon
	[Bug 2999764] reported by Robert Karen.

2010-05-05 Harald Oehlmann < [email protected]>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
2010-05-12 Harald Oehlmann < [email protected]>

	* listbox.tcl(ListBox::bindText and ListBox::bindImage)
	Method bindText and bindImage overwrote internal selection
	bindings [Bug 3000293] reported by Robert Karen.

2010-05-11 Harald Oehlmann < [email protected]>

	* listbox.tcl(ListBox::see) Method see shifts image out of
	view. Showed up, by a selection click on a long item with icon
	[Bug 2999764] reported by Robert Karen.

2010-05-05 Harald Oehlmann < [email protected]>

Changes to listbox.tcl.

1
2
3
4
5
6
7
8
9
10
11
...
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
...
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
...
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474





475

476
477
478
479
480
481
482
483
484
485
486
487






488
489
490
491
492
493
494
...
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
....
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
# ----------------------------------------------------------------------------
#  listbox.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: listbox.tcl,v 1.29.2.2 2010/05/12 08:07:39 oehhar Exp $
# ----------------------------------------------------------------------------
#  Index of commands:
#     - ListBox::create
#     - ListBox::configure
#     - ListBox::cget
#     - ListBox::insert
#     - ListBox::itemconfigure
................................................................................
#  Command ListBox::_configureSelectmode
# ----------------------------------------------------------------------------
# Configure the selectmode
proc ListBox::_configureSelectmode { path selectmode {previous none} } {
    # clear current binding
    switch -exact -- $previous {
        single {
            $path bindText  <Button-1> ""
            $path bindImage <Button-1> ""
        }
        multiple {
            $path bindText <ButtonRelease-1>          ""
            $path bindText <Shift-ButtonRelease-1>    ""
            $path bindText <Control-ButtonRelease-1>  ""

            $path bindImage <ButtonRelease-1>         ""
            $path bindImage <Shift-ButtonRelease-1>   ""
            $path bindImage <Control-ButtonRelease-1> ""
        }
    }
    # set new bindings
    switch -exact -- $selectmode {
        single {
            $path bindText  <Button-1> [list ListBox::_mouse_select $path set]
            $path bindImage <Button-1> [list ListBox::_mouse_select $path set]
            if {1 < [llength [ListBox::selection $path get]]} {
                ListBox::selection $path clear
            }
        }
        multiple {
            set cmd ListBox::_multiple_select
            $path bindText <ButtonRelease-1>          [list $cmd $path n %x %y]
            $path bindText <Shift-ButtonRelease-1>    [list $cmd $path s %x %y]
            $path bindText <Control-ButtonRelease-1>  [list $cmd $path c %x %y]

            $path bindImage <ButtonRelease-1>         [list $cmd $path n %x %y]
            $path bindImage <Shift-ButtonRelease-1>   [list $cmd $path s %x %y]
            $path bindImage <Control-ButtonRelease-1> [list $cmd $path c %x %y]
        }
        default {
            if {0 < [llength [ListBox::selection $path get]]} {
                ListBox::selection $path clear
            }
        }
    }
................................................................................
            }
        } elseif { [string length $img] } {
            if { [string equal $type "img"] } {
                $path.c itemconfigure $idi -image $img
            } else {
                $path.c delete $idi
                $path.c create image $x0 $y0 -image $img -anchor w \
		    -tags [list img i:$item]
            }
        } else {
            $path.c delete $idi
        }
    }

    if { $cht || $chf || $chfg } {
................................................................................
# ----------------------------------------------------------------------------
proc ListBox::itemcget { path item option } {
    return [Widget::cget $path.$item $option]
}


# ----------------------------------------------------------------------------
#  Command ListBox::bindText
# ----------------------------------------------------------------------------
proc ListBox::bindText { path event script } {
    if { $script != "" } {
        set map [list %W $path]
        set script [string map $map $script]
	append script " \[ListBox::_get_current [list $path]\]"
    }
    $path.c bind "click" $event $script
}








# ----------------------------------------------------------------------------
#  Command ListBox::bindImage
# ----------------------------------------------------------------------------
proc ListBox::bindImage { path event script } {
    if { $script != "" } {
        set map [list %W $path]
        set script [string map $map $script]
	append script " \[ListBox::_get_current [list $path]\]"
    }
    $path.c bind "img" $event $script
}








# ----------------------------------------------------------------------------
#  Command ListBox::delete
# ----------------------------------------------------------------------------
proc ListBox::delete { path args } {
    variable $path
    upvar 0  $path data
................................................................................
proc ListBox::_draw_item {path item x0 x1 y bg selfill multi ww} {
    set indent  [Widget::getoption $path.$item -indent]
    set i [$path.c create text [expr {$x1+$indent}] $y \
        -text   [Widget::getoption $path.$item -text] \
        -fill   [_getoption        $path $item -foreground] \
        -font   [_getoption        $path $item -font] \
        -anchor w \
        -tags   [list item n:$item click]]

    if { $selfill && !$multi } {
        set bbox  [$path.c bbox n:$item]
        set bbox  [list 0 [lindex $bbox 1] $ww [lindex $bbox 3]]
        set tags  [list box b:$item click]
        $path.c create rect $bbox -fill $bg -width 0 -tags $tags
        $path.c raise $i
    }

    if { [set win [Widget::getoption $path.$item -window]] != "" } {
        $path.c create window [expr {$x0+$indent}] $y \
            -window $win -anchor w -tags [list win i:$item]
    } elseif { [set img [Widget::getoption $path.$item -image]] != "" } {
        $path.c create image [expr {$x0+$indent}] $y \
            -image $img -anchor w -tags [list img i:$item]
    }

    _set_help $path $item
}


# ----------------------------------------------------------------------------
................................................................................
    foreach item $data(selitems) {
        set bbox [$path.c bbox "n:$item"]
        if { [llength $bbox] } {
	    if { $selfill && !$multi } {
		# With -selectfill, make box occupy full width of widget
		set bbox [list 0 [lindex $bbox 1] $width [lindex $bbox 3]]
	    }
            set tags [list sel s:$item click]
            set id [$path.c create rectangle $bbox \
                -fill $selbg -outline $selbg -tags $tags]
	    if {$selfg != ""} {
		# Don't allow an empty fill - that would be transparent
		$path.c itemconfigure "n:$item" -fill $selfg
	    }
            $path.c lower $id


|







 







|
|


|
|
|

|
|
|





|
|






|
|
|

|
|
|







 







|







 







|

|





|


>
>
>
>
>
|
>

|

|





|


>
>
>
>
>
>







 







|




|









|







 







|







1
2
3
4
5
6
7
8
9
10
11
...
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
...
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
...
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
....
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
....
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
# ----------------------------------------------------------------------------
#  listbox.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: listbox.tcl,v 1.29.2.3 2010/05/12 08:12:34 oehhar Exp $
# ----------------------------------------------------------------------------
#  Index of commands:
#     - ListBox::create
#     - ListBox::configure
#     - ListBox::cget
#     - ListBox::insert
#     - ListBox::itemconfigure
................................................................................
#  Command ListBox::_configureSelectmode
# ----------------------------------------------------------------------------
# Configure the selectmode
proc ListBox::_configureSelectmode { path selectmode {previous none} } {
    # clear current binding
    switch -exact -- $previous {
        single {
            $path _bindText  <Button-1> ""
            $path _bindImage <Button-1> ""
        }
        multiple {
            $path _bindText <ButtonRelease-1>          ""
            $path _bindText <Shift-ButtonRelease-1>    ""
            $path _bindText <Control-ButtonRelease-1>  ""

            $path _bindImage <ButtonRelease-1>         ""
            $path _bindImage <Shift-ButtonRelease-1>   ""
            $path _bindImage <Control-ButtonRelease-1> ""
        }
    }
    # set new bindings
    switch -exact -- $selectmode {
        single {
            $path _bindText  <Button-1> [list ListBox::_mouse_select $path set]
            $path _bindImage <Button-1> [list ListBox::_mouse_select $path set]
            if {1 < [llength [ListBox::selection $path get]]} {
                ListBox::selection $path clear
            }
        }
        multiple {
            set cmd ListBox::_multiple_select
            $path _bindText <ButtonRelease-1>          [list $cmd $path n %x %y]
            $path _bindText <Shift-ButtonRelease-1>    [list $cmd $path s %x %y]
            $path _bindText <Control-ButtonRelease-1>  [list $cmd $path c %x %y]

            $path _bindImage <ButtonRelease-1>         [list $cmd $path n %x %y]
            $path _bindImage <Shift-ButtonRelease-1>   [list $cmd $path s %x %y]
            $path _bindImage <Control-ButtonRelease-1> [list $cmd $path c %x %y]
        }
        default {
            if {0 < [llength [ListBox::selection $path get]]} {
                ListBox::selection $path clear
            }
        }
    }
................................................................................
            }
        } elseif { [string length $img] } {
            if { [string equal $type "img"] } {
                $path.c itemconfigure $idi -image $img
            } else {
                $path.c delete $idi
                $path.c create image $x0 $y0 -image $img -anchor w \
		    -tags [list img imgbind i:$item]
            }
        } else {
            $path.c delete $idi
        }
    }

    if { $cht || $chf || $chfg } {
................................................................................
# ----------------------------------------------------------------------------
proc ListBox::itemcget { path item option } {
    return [Widget::cget $path.$item $option]
}


# ----------------------------------------------------------------------------
#  Command ListBox::_bindText
# ----------------------------------------------------------------------------
proc ListBox::_bindText { path event script {tag click} } {
    if { $script != "" } {
        set map [list %W $path]
        set script [string map $map $script]
	append script " \[ListBox::_get_current [list $path]\]"
    }
    $path.c bind $tag $event $script
}

# ----------------------------------------------------------------------------
#  Command ListBox::bindText
# ----------------------------------------------------------------------------
proc ListBox::bindText { path event script } {
    _bindText $path $event $script clickbind
}

# ----------------------------------------------------------------------------
#  Command ListBox::_bindImage
# ----------------------------------------------------------------------------
proc ListBox::_bindImage { path event script {tag img} } {
    if { $script != "" } {
        set map [list %W $path]
        set script [string map $map $script]
	append script " \[ListBox::_get_current [list $path]\]"
    }
    $path.c bind $tag $event $script
}

# ----------------------------------------------------------------------------
#  Command ListBox::bindImage
# ----------------------------------------------------------------------------
proc ListBox::bindImage { path event script } {
    _bindImage $path $event $script imgbind
}

# ----------------------------------------------------------------------------
#  Command ListBox::delete
# ----------------------------------------------------------------------------
proc ListBox::delete { path args } {
    variable $path
    upvar 0  $path data
................................................................................
proc ListBox::_draw_item {path item x0 x1 y bg selfill multi ww} {
    set indent  [Widget::getoption $path.$item -indent]
    set i [$path.c create text [expr {$x1+$indent}] $y \
        -text   [Widget::getoption $path.$item -text] \
        -fill   [_getoption        $path $item -foreground] \
        -font   [_getoption        $path $item -font] \
        -anchor w \
        -tags   [list item n:$item click clickbind]]

    if { $selfill && !$multi } {
        set bbox  [$path.c bbox n:$item]
        set bbox  [list 0 [lindex $bbox 1] $ww [lindex $bbox 3]]
        set tags  [list box b:$item click clickbind]
        $path.c create rect $bbox -fill $bg -width 0 -tags $tags
        $path.c raise $i
    }

    if { [set win [Widget::getoption $path.$item -window]] != "" } {
        $path.c create window [expr {$x0+$indent}] $y \
            -window $win -anchor w -tags [list win i:$item]
    } elseif { [set img [Widget::getoption $path.$item -image]] != "" } {
        $path.c create image [expr {$x0+$indent}] $y \
            -image $img -anchor w -tags [list img imgbind i:$item]
    }

    _set_help $path $item
}


# ----------------------------------------------------------------------------
................................................................................
    foreach item $data(selitems) {
        set bbox [$path.c bbox "n:$item"]
        if { [llength $bbox] } {
	    if { $selfill && !$multi } {
		# With -selectfill, make box occupy full width of widget
		set bbox [list 0 [lindex $bbox 1] $width [lindex $bbox 3]]
	    }
            set tags [list sel s:$item click clickbind]
            set id [$path.c create rectangle $bbox \
                -fill $selbg -outline $selbg -tags $tags]
	    if {$selfg != ""} {
		# Don't allow an empty fill - that would be transparent
		$path.c itemconfigure "n:$item" -fill $selfg
	    }
            $path.c lower $id