summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog26
-rw-r--r--generic/tkListbox.c58
-rw-r--r--tests/listbox.test159
3 files changed, 212 insertions, 31 deletions
diff --git a/ChangeLog b/ChangeLog
index f19d3bc..36f29f1 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,29 @@
+1999-11-17 Eric Melski <ericm@scriptics.com>
+
+ * tests/listbox.test: New tests for -listvar functionality, and an
+ odd extra case that wasn't covered before.
+
+ * generic/tkListbox.c: Tests exposed some bugs, now fixed.
+
+1999-11-16 Eric Melski <ericm@scriptics.com>
+
+ * tests/listbox.test: Fixed tests to comply with new objectified
+ error messages. No -listvar specific tests yet.
+
+ * win/tkWinDefault.h:
+ * unix/tkUnixDefault.h:
+ * mac/tkMacDefault.h: Added default value for -listvar option.
+
+ * generic/tkWindow.c: Changed "listbox" mapping from old-school to
+ new-school objectified command.
+
+ * generic/tkListbox.c: Objectified listbox; added support for
+ -listvar option. Converted internal structure to use a Tcl list
+ object to store the data.
+
+ * generic/tkInt.h: Changed reference to Tk_ListboxCmd to
+ Tk_ListboxObjCmd.
+
1999-11-09 Jeff Hobbs <hobbs@scriptics.com>
* generic/tkGrid.c: changed Tcl_Alloc to ckalloc
diff --git a/generic/tkListbox.c b/generic/tkListbox.c
index 04b540a..99c4350 100644
--- a/generic/tkListbox.c
+++ b/generic/tkListbox.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tkListbox.c,v 1.5 1999/11/17 02:38:28 ericm Exp $
+ * RCS: @(#) $Id: tkListbox.c,v 1.6 1999/11/17 21:56:37 ericm Exp $
*/
#include "tkPort.h"
@@ -1259,7 +1259,7 @@ ConfigureListbox(interp, listPtr, objc, objv, flags)
int flags; /* Flags to pass to Tk_ConfigureWidget. */
{
Tk_SavedOptions savedOptions;
- Tcl_Obj *oldListVarObj = NULL;
+ Tcl_Obj *oldListObj = NULL;
int oldExport;
oldExport = listPtr->exportSelection;
@@ -1267,8 +1267,6 @@ ConfigureListbox(interp, listPtr, objc, objv, flags)
Tcl_UntraceVar(interp, listPtr->listVarName,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
ListboxListVarProc, (ClientData) listPtr);
- oldListVarObj = Tcl_GetVar2Ex(interp, listPtr->listVarName,
- (char *)NULL, TCL_GLOBAL_ONLY);
}
if (Tk_SetOptions(interp, (char *)listPtr,
@@ -1319,50 +1317,37 @@ ConfigureListbox(interp, listPtr, objc, objv, flags)
*
* no listvar | no listvar | no special action
*/
+ oldListObj = listPtr->listObj;
if (listPtr->listVarName != NULL) {
- /* We now have a listvar */
if (Tcl_GetVar2(interp, listPtr->listVarName, (char *)NULL,
TCL_GLOBAL_ONLY) == NULL) {
- /* New listvar DOES NOT exist */
Tcl_Obj *listVarObj;
- /* Use internal list obj if we have one; else, create an object */
if (listPtr->listObj != NULL) {
listVarObj = listPtr->listObj;
} else {
listVarObj = Tcl_NewObj();
- Tcl_IncrRefCount(listVarObj);
}
- if (Tcl_SetVar2Ex(interp, listPtr->listVarName,
- (char *)NULL, listVarObj, TCL_GLOBAL_ONLY) == NULL) {
+ if (Tcl_SetVar2Ex(interp, listPtr->listVarName, (char *)NULL,
+ listVarObj, TCL_GLOBAL_ONLY) == NULL) {
Tcl_DecrRefCount(listVarObj);
return TCL_ERROR;
}
}
listPtr->listObj = Tcl_GetVar2Ex(interp, listPtr->listVarName,
(char *)NULL, TCL_GLOBAL_ONLY);
- Tcl_TraceVar(listPtr->interp, listPtr->listVarName,
+ Tcl_TraceVar(listPtr->interp, listPtr->listVarName,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
ListboxListVarProc, (ClientData) listPtr);
} else {
- /* We do not now have a listvar */
- if (oldListVarObj != NULL) {
- /* We used to have a list var */
- if (listPtr->listObj != NULL) {
- Tcl_DecrRefCount(listPtr->listObj);
- listPtr->listObj = NULL;
- }
- /* Copy the old listvar's content to the internal list obj */
- listPtr->listObj = Tcl_DuplicateObj(oldListVarObj);
- Tcl_IncrRefCount(listPtr->listObj);
- } else {
- /* We didn't have a listvar before */
- if (listPtr->listObj == NULL) {
- /* If we don't have an internal list obj, create one */
- listPtr->listObj = Tcl_NewObj();
- Tcl_IncrRefCount(listPtr->listObj);
- }
+ if (listPtr->listObj == NULL) {
+ listPtr->listObj = Tcl_NewObj();
}
}
+ Tcl_IncrRefCount(listPtr->listObj);
+ if (oldListObj != NULL) {
+ Tcl_DecrRefCount(oldListObj);
+ }
+
/* Make sure that the list length is correct */
Tcl_ListObjLength(listPtr->interp, listPtr->listObj, &listPtr->nElements);
@@ -2810,6 +2795,9 @@ ListboxListVarProc(clientData, interp, name1, name2, flags)
{
Listbox *listPtr = (Listbox *)clientData;
Tcl_Obj *oldListObj;
+ int oldLength;
+ int i;
+ Tcl_HashEntry *entry;
/* Bwah hahahaha -- puny mortal, you can't unset a -listvar'd variable! */
if (flags & TCL_TRACE_UNSETS) {
@@ -2832,9 +2820,21 @@ ListboxListVarProc(clientData, interp, name1, name2, flags)
Tcl_DecrRefCount(oldListObj);
}
- /* Get the list length */
+ /* If the list length has decreased, then we should clean up the selection
+ * from elements past the end of the new list
+ */
+ oldLength = listPtr->nElements;
Tcl_ListObjLength(listPtr->interp, listPtr->listObj, &listPtr->nElements);
+ if (listPtr->nElements < oldLength) {
+ for (i = listPtr->nElements; i < oldLength; i++) {
+ entry = Tcl_FindHashEntry(listPtr->selection, (char *)i);
+ if (entry != NULL) {
+ Tcl_DeleteHashEntry(entry);
+ }
+ }
+ }
+
/*
* The computed maxWidth may have changed as a result of this operation.
* However, we don't want to recompute it every time this trace fires
diff --git a/tests/listbox.test b/tests/listbox.test
index 3c3abd7..b5efd58 100644
--- a/tests/listbox.test
+++ b/tests/listbox.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: listbox.test,v 1.4 1999/11/17 02:40:55 ericm Exp $
+# RCS: @(#) $Id: listbox.test,v 1.5 1999/11/17 21:56:37 ericm Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
source [file join [pwd] [file dirname [info script]] defs.tcl]
@@ -866,7 +866,74 @@ test listbox-4.8 {ConfigureListbox procedure} {
update
set log
} {{y 0 1} {x 0 1}}
-
+test listbox-4.9 {ConfigureListbox procedure, -listvar} {
+ catch {destroy .l}
+ set x [list a b c d]
+ listbox .l -listvar x
+ .l get 0 end
+} [list a b c d]
+test listbox-4.10 {ConfigureListbox, no listvar -> existing listvar} {
+ catch {destroy .l}
+ set x [list a b c d]
+ listbox .l
+ .l insert end 1 2 3 4
+ .l configure -listvar x
+ .l get 0 end
+} [list a b c d]
+test listbox-4.11 {ConfigureListbox procedure, listvar -> no listvar} {
+ catch {destroy .l}
+ set x [list a b c d]
+ listbox .l -listvar x
+ .l configure -listvar {}
+ .l insert end 1 2 3 4
+ list $x [.l get 0 end]
+} [list [list a b c d] [list a b c d 1 2 3 4]]
+test listbox-4.12 {ConfigureListbox procedure, listvar -> different listvar} {
+ catch {destroy .l}
+ set x [list a b c d]
+ set y [list 1 2 3 4]
+ listbox .l
+ .l configure -listvar x
+ .l configure -listvar y
+ .l insert end 5 6 7 8
+ list $x $y
+} [list [list a b c d] [list 1 2 3 4 5 6 7 8]]
+test listbox-4.13 {ConfigureListbox, no listvar -> non-existant listvar} {
+ catch {destroy .l}
+ catch {unset x}
+ listbox .l
+ .l insert end a b c d
+ .l configure -listvar x
+ set x
+} [list a b c d]
+test listbox-4.14 {ConfigureListbox, non-existant listvar} {
+ catch {destroy .l}
+ catch {unset x}
+ listbox .l -listvar x
+ list [info exists x] $x
+} [list 1 {}]
+test listbox-4.15 {ConfigureListbox, listvar -> non-existant listvar} {
+ catch {destroy .l}
+ catch {unset y}
+ set x [list a b c d]
+ listbox .l -listvar x
+ .l configure -listvar y
+ list [info exists y] $y
+} [list 1 [list a b c d]]
+test listbox-4.16 {ConfigureListbox, listvar -> same listvar} {
+ catch {destroy .l}
+ set x [list a b c d]
+ listbox .l -listvar x
+ .l configure -listvar x
+ set x
+} [list a b c d]
+test listbox-4.17 {ConfigureListbox, no listvar -> no listvar} {
+ catch {destroy .l}
+ listbox .l
+ .l insert end a b c d
+ .l configure -listvar {}
+ .l get 0 end
+} [list a b c d]
# No tests for DisplayListbox: I don't know how to test this procedure.
test listbox-5.1 {ListboxComputeGeometry procedure} {fonts} {
@@ -1008,6 +1075,22 @@ test listbox-6.12 {InsertEls procedure} {fonts} {
.l2 insert 0 "much longer entry"
lappend x [winfo reqwidth .l2] [winfo reqheight .l2]
} {80 93 122 110}
+test listbox-6.13 {InsertEls procedure, check -listvar update} {
+ catch {destroy .l2}
+ set x [list a b c d]
+ listbox .l2 -listvar x
+ .l2 insert 0 1 2 3 4
+ set x
+} [list 1 2 3 4 a b c d]
+test listbox-6.14 {InsertEls procedure, check selection update} {
+ catch {destroy .l2}
+ listbox .l2
+ .l2 insert 0 0 1 2 3 4
+ .l2 selection set 2 4
+ .l2 insert 0 a
+ .l2 curselection
+} [list 3 4 5]
+
test listbox-7.1 {DeleteEls procedure} {
.l delete 0 end
@@ -1164,6 +1247,13 @@ test listbox-7.20 {DeleteEls procedure} {fonts} {
lappend x [winfo reqwidth .l2] [winfo reqheight .l2]
} {80 144 17 93}
catch {destroy .l2}
+test listbox-7.21 {DeleteEls procedure, check -listvar update} {
+ catch {destroy .l2}
+ set x [list a b c d]
+ listbox .l2 -listvar x
+ .l2 delete 0 1
+ set x
+} [list c d]
test listbox-8.1 {ListboxEventProc procedure} {fonts} {
catch {destroy .l}
@@ -1650,6 +1740,71 @@ test listbox-20.1 {listbox vs hidden commands} {
list [winfo children .] [interp hidden]
} [list {} $l]
+# tests for ListboxListVarProc
+test listbox-21.1 {ListboxListVarProc} {
+ catch {destroy .l}
+ catch {unset x}
+ listbox .l -listvar x
+ set x [list a b c d]
+ .l get 0 end
+} [list a b c d]
+test listbox-21.2 {ListboxListVarProc} {
+ catch {destroy .l}
+ set x [list a b c d]
+ listbox .l -listvar x
+ unset x
+ set x
+} [list a b c d]
+test listbox-21.3 {ListboxListVarProc} {
+ catch {destroy .l}
+ set x [list a b c d]
+ listbox .l -listvar x
+ .l configure -listvar {}
+ unset x
+ info exists x
+} 0
+test listbox-21.4 {ListboxListVarProc} {
+ catch {destroy .l}
+ set x [list a b c d]
+ listbox .l -listvar x
+ lappend x e f g
+ .l size
+} 7
+test listbox-21.5 {ListboxListVarProc, test selection after listvar mod} {
+ catch {destroy .l}
+ set x [list a b c d e f g]
+ listbox .l -listvar x
+ .l selection set end
+ set x [list a b c d]
+ set x [list 0 1 2 3 4 5 6]
+ .l curselection
+} {}
+test listbox-21.6 {ListboxListVarProc, test selection after listvar mod} {
+ catch {destroy .l}
+ set x [list a b c d]
+ listbox .l -listvar x
+ .l selection set 3
+ lappend x e f g
+ .l curselection
+} 3
+test listbox-21.7 {ListboxListVarProc, test selection after listvar mod} {
+ catch {destroy .l}
+ set x [list a b c d]
+ listbox .l -listvar x
+ .l selection set 0
+ set x [linsert $x 0 1 2 3 4]
+ .l curselection
+} 0
+test listbox-21.8 {ListboxListVarProc, test selection after listvar mod} {
+ catch {destroy .l}
+ set x [list a b c d]
+ listbox .l -listvar x
+ .l selection set 2
+ set x [list a b c]
+ .l curselection
+} 2
+
+
resetGridInfo
catch {destroy .l2}
catch {destroy .t}