* 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.

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}