Tk Library Source Code

View Ticket
Login
Ticket UUID: 3324610
Title: ListBox bindImage is broken
Type: Bug Version: None
Submitter: takatsuki Created on: 2011-06-22 17:09:35
Subsystem: bwidget Assigned To: oehhar
Priority: 5 Medium Severity:
Status: Closed Last Modified: 2011-06-23 16:20:10
Resolution: Accepted Closed By: oehhar
    Closed on: 2011-06-23 08:30:58
Description:
The node name of the item returned when triggering the event is incorrectly constructed. To reproduce it:

# Taken from a snippet from FW in http://wiki.tcl.tk/1434,  
proc generate_data {} {  
    set data [list]
    for {set x 0} {$x < 5} {incr x} {    
        set row [list]           
        for {set y 0} {$y < 5} {incr y} {
            lappend row [format "#%02x%02x%02x" [random_byte] [random_byte] [random_byte]] 
        }         
      lappend data $row  
    }  
   return $data       
}    

proc random_byte {} { 
    return [expr {int(rand() * 256)}]             
}    

set image [image create photo]                              
$image put [generate_data]                                                
           
pack [ListBox .l -selectmode single]                       
.l insert end list:#auto -text 111 -image $image 
.l insert end list:#auto -text 222 -image $image
.l insert end list:#auto -text 333 -image $image
.l configure -width 10

proc printNode {args} {
   puts "Returned $args"
} 

.l bindText <Button-1> [list printNode Text]
.l bindImage <Button-1> [list printNode Image] 
vwait forever

Clicking on the text returns:

Returned Text list:0
Returned Text list:1
Returned Text list:2

But on the image, the result is:

Returned Image gbind
Returned Image gbind
Returned Image gbind

The problem is the code in listbox.tcl returns as the node:
 [string range [lindex $t 1] 2 end]

Where $t (the tags) are:

img imgbind i:list:1 current

I believe the bug was introduced in  Bug 3000293, adding the additional tag imgbind in the place where the code expects to find the node

Attached is a possible patch
User Comments: oehhar added on 2011-06-23 16:20:10:
Ok, no problem, committed.
Commodo syntax checker showed it too ;-)

takatsuki added on 2011-06-23 16:04:27:
Sorry, I just found a copy-paste error in my patch. In:

proc ListBox::_init_drag_cmd { path X Y top } {
 set path [winfo parent $path]
  set ltags [$path.c gettags current]
 set item [lindex $ltags 0]
 if { [string equal $item "item"] ||
    [string equal $item "img"] ||
    [string equal $item "win"] } {
        set item [ListBox::_get_node_name $path $id]

$id is not defined, it should be 

set item [ListBox::_get_node_name $path]

Or 

set item [ListBox::_get_node_name $path current]

Sorry for that.

oehhar added on 2011-06-23 15:30:58:
Good one - I introduced the issue and you fixed it.
Committed.

takatsuki added on 2011-06-23 00:09:41:

File Added - 415641: listbox.patch

Attachments: