A Multi-Column Listbox
Check-in [4fd183edb4]
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: * mclistbox.tcl: Added 'FirstVisibleColumn' to retrieve the id of the first non-hidden column. Using this procedure in some place which have trouble to compute a sensible value for a hidden column (pointer location to row index for example). This fixes bug [455732].
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 4fd183edb4f2448044a9e87c56e66d45580e20d6
User & Date: andreas_kupries 2001-09-07 16:59:48
Context
2002-09-25
22:56
better DESTDIR/libdir support (steffen) check-in: 371ff5c9a5 user: hobbs tags: trunk
2001-09-07
16:59
* mclistbox.tcl: Added 'FirstVisibleColumn' to retrieve the id of the first non-hidden column. Using this procedure in some place which have trouble to compute a sensible value for a hidden column (pointer location to row index for example). This fixes bug [455732]. check-in: 4fd183edb4 user: andreas_kupries tags: trunk
2000-09-25
05:08
* mclistbox.tcl: Added a column field to the mclistbox '-dropcmd' callback so that special things can be done based on both the column as well as the row. check-in: d6c465a29b user: kuchler tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.








1
2
3
4
5
6
7







2000-09-24  Dan Kuchler  <[email protected]>

        * mclistbox.tcl: Added a column field to the mclistbox
        '-dropcmd' callback so that special things can be done
        based on both the column as well as the row.

>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
2001-09-07  Andreas Kupries  <[email protected]>

	* mclistbox.tcl: Added 'FirstVisibleColumn' to retrieve the id of
	  the first non-hidden column. Using this procedure in some place
	  which have trouble to compute a sensible value for a hidden
	  column (pointer location to row index for example). This fixes
	  bug [455732].

2000-09-24  Dan Kuchler  <[email protected]>

        * mclistbox.tcl: Added a column field to the mclistbox
        '-dropcmd' callback so that special things can be done
        based on both the column as well as the row.

Changes to mclistbox.tcl.

1197
1198
1199
1200
1201
1202
1203























1204
1205
1206
1207
1208
1209
1210
....
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
....
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
....
1578
1579
1580
1581
1582
1583
1584
1585
1586





1587
1588
1589
1590
1591
1592
1593
....
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
    # brings tears to my eyes.
    if {[string compare [winfo class $w] "Mclistbox"] == 0} {
	namespace delete ::mclistbox::$w
	rename $w {}
    }

}
























# ::mclistbox::MassageIndex --
#
#    this proc massages indicies of the form @x,y such that 
#    the coordinates are relative to the first listbox rather 
#    than relative to the topmost frame. 
#
................................................................................
#    may be used directly by an internal listbox.

proc ::mclistbox::MassageIndex {w index} {
    upvar ::mclistbox::${w}::widgets   widgets
    upvar ::mclistbox::${w}::misc      misc

    if {[regexp {@([0-9]+),([0-9]+)} $index matchvar x y]} {
	set id [lindex $misc(columns) 0]
	
	incr y -[winfo y $widgets(listbox$id)]
	incr y -[winfo y $widgets(frame$id)]
	incr x [winfo x $widgets(listbox$id)]
	incr x [winfo x $widgets(frame$id)]

	set index @${x},${y}
................................................................................
	    if {[llength $args] != 1} {
		error "wrong \# of args: should be $w bbox index"
	    }
	    # get a real index. This will adjust @x,y indicies
	    # to account for the label, if any.
	    set index [::mclistbox::MassageIndex $w [lindex $args 0]]

	    set id [lindex $misc(columns) 0]

	    # we can get the x, y, and height from the first 
	    # column.
	    set bbox [$widgets(listbox$id) bbox $index]
	    if {[string length $bbox] == 0} {return ""}

	    foreach {x y width h} $bbox {}
................................................................................
	index {

	    if {[llength $args] != 1} {
		error "wrong \# of args: should be $w index index"
	    }

	    set index [::mclistbox::MassageIndex $w [lindex $args 0]]
	    set id [lindex $misc(columns) 0]






	    set result [$widgets(listbox$id) index $index]
	}

	insert {
	    if {[llength $args] < 1} {
		error "wrong \# of args: should be $w insert ?element \
		      element...?"
................................................................................
	    set prefix "wrong \# of args: should be $w"
	    switch $subcommand {
		includes {
		    if {[llength $args] != 1} {
			error "$prefix selection $subcommand index"
		    }
		    set index [::mclistbox::MassageIndex $w [lindex $args 0]]
		    set id [lindex $misc(columns) 0]
		    set result [$widgets(listbox$id) selection includes $index]
		}

		set {
		    switch [llength $args] {
			1 {
			    set index1 [::mclistbox::MassageIndex $w \






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|







 







|







 







<

>
>
>
>
>







 







|







1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
....
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
....
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
....
1601
1602
1603
1604
1605
1606
1607

1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
....
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
    # brings tears to my eyes.
    if {[string compare [winfo class $w] "Mclistbox"] == 0} {
	namespace delete ::mclistbox::$w
	rename $w {}
    }

}

# ::mclistbox::FirstVisibleColumn --
#
#    this proc returns the id of the first visible column.
#
# Arguments:
#
#    w       widget pathname
#
# Results:
#
#    a string

proc ::mclistbox::FirstVisibleColumn {w} {
    upvar ::mclistbox::${w}::misc      misc
    upvar ::mclistbox::${w}::options      options

    foreach id $misc(columns) {
	if {$options($id:-visible)} {break}
    }

    return $id
}

# ::mclistbox::MassageIndex --
#
#    this proc massages indicies of the form @x,y such that 
#    the coordinates are relative to the first listbox rather 
#    than relative to the topmost frame. 
#
................................................................................
#    may be used directly by an internal listbox.

proc ::mclistbox::MassageIndex {w index} {
    upvar ::mclistbox::${w}::widgets   widgets
    upvar ::mclistbox::${w}::misc      misc

    if {[regexp {@([0-9]+),([0-9]+)} $index matchvar x y]} {
	set id [FirstVisibleColumn $w]
	
	incr y -[winfo y $widgets(listbox$id)]
	incr y -[winfo y $widgets(frame$id)]
	incr x [winfo x $widgets(listbox$id)]
	incr x [winfo x $widgets(frame$id)]

	set index @${x},${y}
................................................................................
	    if {[llength $args] != 1} {
		error "wrong \# of args: should be $w bbox index"
	    }
	    # get a real index. This will adjust @x,y indicies
	    # to account for the label, if any.
	    set index [::mclistbox::MassageIndex $w [lindex $args 0]]

	    set id [FirstVisibleColumn $w]

	    # we can get the x, y, and height from the first 
	    # column.
	    set bbox [$widgets(listbox$id) bbox $index]
	    if {[string length $bbox] == 0} {return ""}

	    foreach {x y width h} $bbox {}
................................................................................
	index {

	    if {[llength $args] != 1} {
		error "wrong \# of args: should be $w index index"
	    }

	    set index [::mclistbox::MassageIndex $w [lindex $args 0]]


	    # Select a visible column to convert the screen location
	    # into row ... Invisible columns are not mapped and can't
	    # do this. They always returns row 0.

	    set id     [FirstVisibleColumn $w]
	    set result [$widgets(listbox$id) index $index]
	}

	insert {
	    if {[llength $args] < 1} {
		error "wrong \# of args: should be $w insert ?element \
		      element...?"
................................................................................
	    set prefix "wrong \# of args: should be $w"
	    switch $subcommand {
		includes {
		    if {[llength $args] != 1} {
			error "$prefix selection $subcommand index"
		    }
		    set index [::mclistbox::MassageIndex $w [lindex $args 0]]
		    set id [FirstVisibleColumn $w]
		    set result [$widgets(listbox$id) selection includes $index]
		}

		set {
		    switch [llength $args] {
			1 {
			    set index1 [::mclistbox::MassageIndex $w \