Bwidget Source Code
Check-in [834cfffa2b]
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.

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 | trunk
Files: files | file ages | folders
SHA1: 834cfffa2bc171941311056976611121c6b1d551
User & Date: oehhar 2010-05-12 08:28:56
Context
2010-05-31
14:56
* listbox.html Reflected patch 2010-05-12 in documentation. The selection may not be disabled any more by binding button 1. check-in: d16ef303ec user: oehhar tags: trunk
2010-05-12
08:28
* listbox.tcl(ListBox::bindText and ListBox::bindImage) Method bindText and bindImage overwrote internal selection bindings [Bug 3000293] reported by Robert Karen. check-in: 834cfffa2b user: oehhar tags: trunk
08:24
* 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. check-in: 17f103959e user: oehhar tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.

1
2
3
4
5






6
7
8
9
10
11
12
# ------------------------------------------------------------------------------
#  ChangeLog
#  This file is part of Unifix BWidget Toolkit
#  $Id: ChangeLog,v 1.216 2010/05/12 08:24:53 oehhar Exp $
# ------------------------------------------------------------------------------







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.



|

>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
# ------------------------------------------------------------------------------
#  ChangeLog
#  This file is part of Unifix BWidget Toolkit
#  $Id: ChangeLog,v 1.217 2010/05/12 08:28:56 oehhar Exp $
# ------------------------------------------------------------------------------

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.

Changes to listbox.tcl.

1
2
3
4
5
6
7
8
9
10
11
...
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
...
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
...
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.32 2010/05/12 08:24:53 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
...
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
...
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
...
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
507
508
509
510
511
512
513
514
515
516
517
518
....
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
....
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
# ----------------------------------------------------------------------------
#  listbox.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: listbox.tcl,v 1.33 2010/05/12 08:28:56 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