diff options
-rw-r--r-- | ChangeLog | 10 | ||||
-rw-r--r-- | generic/tkListbox.c | 45 | ||||
-rw-r--r-- | tests/listbox.test | 21 |
3 files changed, 60 insertions, 16 deletions
@@ -1,5 +1,15 @@ 1999-11-17 Eric Melski <ericm@scriptics.com> + * tests/listbox.test: Added tests for bad -listvar's. + + * generic/tkListbox.c: Added handlers for bad -listvar's (ie, bad + lists) + + * tests/listbox.test: Added tests for ListboxUpdateHScrollbar. + + * generic/tkListbox.c: Changed some old static buffers to base + size on TCL_DOUBLLE_SPACE instead of (completely) hardcoding the size. + * tests/listbox.test: New tests for -listvar functionality, and an odd extra case that wasn't covered before. diff --git a/generic/tkListbox.c b/generic/tkListbox.c index 9d75cd7..36dbf76 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.7 1999/11/17 22:13:02 ericm Exp $ + * RCS: @(#) $Id: tkListbox.c,v 1.8 1999/11/18 01:47:07 ericm Exp $ */ #include "tkPort.h" @@ -1276,8 +1276,6 @@ ConfigureListbox(interp, listPtr, objc, objv, flags) return TCL_ERROR; } - Tk_FreeSavedOptions(&savedOptions); - /* * A few options need special processing, such as setting the * background from a 3-D border. @@ -1319,9 +1317,10 @@ ConfigureListbox(interp, listPtr, objc, objv, flags) */ oldListObj = listPtr->listObj; if (listPtr->listVarName != NULL) { - if (Tcl_GetVar2(interp, listPtr->listVarName, (char *)NULL, - TCL_GLOBAL_ONLY) == NULL) { - Tcl_Obj *listVarObj; + Tcl_Obj *listVarObj = Tcl_GetVar2Ex(interp, listPtr->listVarName, + (char *)NULL, TCL_GLOBAL_ONLY); + int dummy; + if (listVarObj == NULL) { if (listPtr->listObj != NULL) { listVarObj = listPtr->listObj; } else { @@ -1330,11 +1329,17 @@ ConfigureListbox(interp, listPtr, objc, objv, flags) if (Tcl_SetVar2Ex(interp, listPtr->listVarName, (char *)NULL, listVarObj, TCL_GLOBAL_ONLY) == NULL) { Tcl_DecrRefCount(listVarObj); + Tk_RestoreSavedOptions(&savedOptions); return TCL_ERROR; } } - listPtr->listObj = Tcl_GetVar2Ex(interp, listPtr->listVarName, - (char *)NULL, TCL_GLOBAL_ONLY); + /* Make sure the object is a good list object */ + if (Tcl_ListObjLength(listPtr->interp, listVarObj, &dummy) != TCL_OK) { + Tk_RestoreSavedOptions(&savedOptions); + return TCL_ERROR; + } + + listPtr->listObj = listVarObj; Tcl_TraceVar(listPtr->interp, listPtr->listVarName, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, ListboxListVarProc, (ClientData) listPtr); @@ -1351,6 +1356,7 @@ ConfigureListbox(interp, listPtr, objc, objv, flags) /* Make sure that the list length is correct */ Tcl_ListObjLength(listPtr->interp, listPtr->listObj, &listPtr->nElements); + Tk_FreeSavedOptions(&savedOptions); ListboxWorldChanged((ClientData) listPtr); return TCL_OK; } @@ -2794,7 +2800,7 @@ ListboxListVarProc(clientData, interp, name1, name2, flags) int flags; /* Information about what happened. */ { Listbox *listPtr = (Listbox *)clientData; - Tcl_Obj *oldListObj; + Tcl_Obj *oldListObj, *varListObj; int oldLength; int i; Tcl_HashEntry *entry; @@ -2811,16 +2817,28 @@ ListboxListVarProc(clientData, interp, name1, name2, flags) } } else { oldListObj = listPtr->listObj; - /* Make sure the internal pointer points to the correct object */ - listPtr->listObj = Tcl_GetVar2Ex(listPtr->interp, listPtr->listVarName, + varListObj = Tcl_GetVar2Ex(listPtr->interp, listPtr->listVarName, (char *)NULL, TCL_GLOBAL_ONLY); + /* + * Make sure the new value is a good list; if it's not, disallow + * the change -- the fact that it is a listvar means that it must + * always be a valid list + */ + if (Tcl_ListObjLength(listPtr->interp, varListObj, &i) != TCL_OK) { + Tcl_SetVar2Ex(interp, listPtr->listVarName, (char *)NULL, + oldListObj, TCL_GLOBAL_ONLY); + varListObj = oldListObj; + } + + listPtr->listObj = varListObj; /* Incr the obj ref count so it doesn't vanish if the var is unset */ Tcl_IncrRefCount(listPtr->listObj); /* Clean up the ref to our old list obj */ Tcl_DecrRefCount(oldListObj); } - /* If the list length has decreased, then we should clean up the selection + /* + * 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; @@ -2834,7 +2852,6 @@ ListboxListVarProc(clientData, interp, name1, name2, flags) } } - /* * 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 @@ -2844,7 +2861,7 @@ ListboxListVarProc(clientData, interp, name1, name2, flags) */ listPtr->flags |= MAXWIDTH_IS_STALE; - EventuallyRedrawRange(clientData, 0, listPtr->nElements-1); + EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1); return (char*)NULL; } diff --git a/tests/listbox.test b/tests/listbox.test index d753251..5f3a683 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.6 1999/11/17 22:13:03 ericm Exp $ +# RCS: @(#) $Id: listbox.test,v 1.7 1999/11/18 01:47:08 ericm Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -934,6 +934,15 @@ test listbox-4.17 {ConfigureListbox, no listvar -> no listvar} { .l configure -listvar {} .l get 0 end } [list a b c d] +test listbox-4.18 {ConfigureListbox, no listvar -> bad listvar} { + catch {destroy .l} + listbox .l + .l insert end a b c d + set x {this is a " bad list} + catch {.l configure -listvar x} result + list [.l get 0 end] [.l cget -listvar] $result +} [list [list a b c d] {} "unmatched open quote in list"] + # No tests for DisplayListbox: I don't know how to test this procedure. test listbox-5.1 {ListboxComputeGeometry procedure} {fonts} { @@ -1831,7 +1840,15 @@ test listbox-21.10 {ListboxListVarProc, test hscrollbar after listvar mod} { update set log } [list {x 0 1} {x 0 1} {x 0 0.5} {x 0 1}] - +test listbox-21.11 {ListboxListVarProc, bad list} { + catch {destroy .l} + catch {unset x} + listbox .l -listvar x + set x [list a b c d] + set x {this is a " bad list} + set x +} [list a b c d] + # UpdateHScrollbar test listbox-22.1 {UpdateHScrollbar} { catch {destroy .l} |