Bwidget Source Code
Check-in [2a71e54fcc]
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 Fix of Bug 3000293 broke listbox tags. The bindImage subcommand did not report right tag. Patch by ryotakatsuki [Bug 3324610]
Timelines: family | ancestors | descendants | both | bwidget
Files: files | file ages | folders
SHA1: 2a71e54fcc98e313f684784b50c62db9eefe6d54
User & Date: oehhar 2011-06-23 08:30:13
Context
2011-06-23
09:17
listbox.tcl (listbox::generate_data) fixed last patch by ryotakatsuki [Bug 3324610] check-in: b3a9aeca7a user: oehhar tags: bwidget
08:30
listbox.tcl Fix of Bug 3000293 broke listbox tags. The bindImage subcommand did not report right tag. Patch by ryotakatsuki [Bug 3324610] check-in: 2a71e54fcc user: oehhar tags: bwidget
08:28
listbox.tcl, tree.tcl (_update_scrollregion) the linewise scrolling did not always scroll up to the end on windows. Report and patch by Wojciech Kocjan, review and modification by Koen Danckaert [Bug 3317772] check-in: ba2aa7db4d user: oehhar tags: bwidget
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.







1
2
3
4
5
6
7





2011-06-23 Harald Oehlmann <[email protected]>

	* listbox.tcl, tree.tcl (_update_scrollregion) the linewise
	scrolling did not always scroll up to the end on windows 7.
	Report and patch by Wojciech Kocjan, review and modification
	by Koen Danckaert [Bug 3317772]

>
>
>
>
>
>







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

	* listbox.tcl Fix of Bug 3000293 broke listbox tags.
	The bindImage subcommand did not report right tag.
	Patch by ryotakatsuki [Bug 3324610]

2011-06-23 Harald Oehlmann <[email protected]>

	* listbox.tcl, tree.tcl (_update_scrollregion) the linewise
	scrolling did not always scroll up to the end on windows 7.
	Report and patch by Wojciech Kocjan, review and modification
	by Koen Danckaert [Bug 3317772]

Changes to listbox.tcl.

1
2
3
4
5
6
7
8
9
10
11
...
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
....
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
....
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
....
1626
1627
1628
1629
1630
1631
1632
1633
1634












1635

1636









1637
1638
1639
1640
1641
1642
1643
# ----------------------------------------------------------------------------
#  listbox.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: listbox.tcl,v 1.29.2.4 2011/06/23 08:28:03 oehhar Exp $
# ----------------------------------------------------------------------------
#  Index of commands:
#     - ListBox::create
#     - ListBox::configure
#     - ListBox::cget
#     - ListBox::insert
#     - ListBox::itemconfigure
................................................................................
            foreach id [$path.c find overlapping $xi $y $xs $y] {
                set ltags [$path.c gettags $id]
                set item  [lindex $ltags 0]
                if { [string equal $item "item"] ||
                     [string equal $item "img"]  ||
                     [string equal $item "win"] } {
                    # item is the label or image/window of the node
                    set item [string range [lindex $ltags 1] 2 end]
                    set found 1
                    break
                }
            }
            break
        }
        set  xi  $xs
................................................................................
    upvar 0  $path data

    set selbg   [Widget::getoption $path -selectbackground]
    set selfg   [Widget::getoption $path -selectforeground]
    set selfill [Widget::getoption $path -selectfill]
    set multi   [Widget::getoption $path -multicolumn]
    foreach id [$path.c find withtag sel] {
        set item [string range [lindex [$path.c gettags $id] 1] 2 end]
        if {-1 == [lsearch -exact $data(upd,delete) $item]} {
            $path.c itemconfigure "n:$item" \
                -fill [_getoption $path $item -foreground]
        }
    }
    $path.c delete sel
    if {$selfill && !$multi} {
................................................................................
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 [string range [lindex $ltags 1] 2 end]
        if {[llength [set cmd [Widget::getoption $path -draginitcmd]]]} {
            return [uplevel \#0 $cmd [list $path $item $top]]
        }
        if { [set type [Widget::getoption $path -dragtype]] == "" } {
            set type "LISTBOX_ITEM"
        }
        if { [set img [Widget::getoption $path.$item -image]] != "" } {
................................................................................
    switch -- $cmd {
        "add" - "clear" - "remove" - "set" {
            event generate $path <<ListboxSelect>>
        }
    }
}


proc ListBox::_get_current { path } {












    set t [$path.c gettags current]

    return [string range [lindex $t 1] 2 end]









}


# ListBox::_drag_and_drop --
#
#	A default command to handle drag-and-drop functions local to this
#       listbox.  With this as the default -dropcmd, the user can simply


|







 







|







 







|







 







|







 








|
>
>
>
>
>
>
>
>
>
>
>
>
|
>
|
>
>
>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
...
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
....
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
....
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
....
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
# ----------------------------------------------------------------------------
#  listbox.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: listbox.tcl,v 1.29.2.5 2011/06/23 08:30:13 oehhar Exp $
# ----------------------------------------------------------------------------
#  Index of commands:
#     - ListBox::create
#     - ListBox::configure
#     - ListBox::cget
#     - ListBox::insert
#     - ListBox::itemconfigure
................................................................................
            foreach id [$path.c find overlapping $xi $y $xs $y] {
                set ltags [$path.c gettags $id]
                set item  [lindex $ltags 0]
                if { [string equal $item "item"] ||
                     [string equal $item "img"]  ||
                     [string equal $item "win"] } {
                    # item is the label or image/window of the node
                    set item [ListBox::_get_node_name $path $id]
                    set found 1
                    break
                }
            }
            break
        }
        set  xi  $xs
................................................................................
    upvar 0  $path data

    set selbg   [Widget::getoption $path -selectbackground]
    set selfg   [Widget::getoption $path -selectforeground]
    set selfill [Widget::getoption $path -selectfill]
    set multi   [Widget::getoption $path -multicolumn]
    foreach id [$path.c find withtag sel] {
        set item [ListBox::_get_node_name $path $id]
        if {-1 == [lsearch -exact $data(upd,delete) $item]} {
            $path.c itemconfigure "n:$item" \
                -fill [_getoption $path $item -foreground]
        }
    }
    $path.c delete sel
    if {$selfill && !$multi} {
................................................................................
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]
        if {[llength [set cmd [Widget::getoption $path -draginitcmd]]]} {
            return [uplevel \#0 $cmd [list $path $item $top]]
        }
        if { [set type [Widget::getoption $path -dragtype]] == "" } {
            set type "LISTBOX_ITEM"
        }
        if { [set img [Widget::getoption $path.$item -image]] != "" } {
................................................................................
    switch -- $cmd {
        "add" - "clear" - "remove" - "set" {
            event generate $path <<ListboxSelect>>
        }
    }
}


# ListBox::_get_node_name --
#
#	Given a listbox item, get the name of the node represented by that
#	item.
#
# Arguments:
#	path		listbox to query
#	item		Optional item to examine; if omitted, 
#			defaults to "current"
#
# Results:
#	node	name of the listbox node.
proc ListBox::_get_node_name {path {item current}} {
    set tags [$path.c gettags $item]
    if {[lindex $tags 0] == "img"} {
        set node [string range [lindex $tags 2] 2 end]
    } else {
        set node [string range [lindex $tags 1] 2 end]
    }
    return $node
}


proc ListBox::_get_current { path } {
    return [ListBox::_get_node_name $path]
}


# ListBox::_drag_and_drop --
#
#	A default command to handle drag-and-drop functions local to this
#       listbox.  With this as the default -dropcmd, the user can simply