diff options
| -rw-r--r-- | ChangeLog | 26 | ||||
| -rw-r--r-- | generic/tkListbox.c | 58 | ||||
| -rw-r--r-- | tests/listbox.test | 159 |
3 files changed, 212 insertions, 31 deletions
@@ -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} |