summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tkEntry.c97
-rw-r--r--tests/entry.test21
-rw-r--r--tests/spinbox.test16
3 files changed, 101 insertions, 33 deletions
diff --git a/generic/tkEntry.c b/generic/tkEntry.c
index f6ff9b9..dd753f0 100644
--- a/generic/tkEntry.c
+++ b/generic/tkEntry.c
@@ -391,7 +391,7 @@ static const char *selElementNames[] = {
static int ConfigureEntry(Tcl_Interp *interp, Entry *entryPtr,
int objc, Tcl_Obj *const objv[], int flags);
-static void DeleteChars(Entry *entryPtr, int index, int count);
+static int DeleteChars(Entry *entryPtr, int index, int count);
static void DestroyEntry(char *memPtr);
static void DisplayEntry(ClientData clientData);
static void EntryBlinkProc(ClientData clientData);
@@ -417,7 +417,7 @@ static int EntryValidateChange(Entry *entryPtr, char *change,
static void ExpandPercents(Entry *entryPtr, const char *before,
const char *change, const char *newStr, int index,
int type, Tcl_DString *dsPtr);
-static void EntryValueChanged(Entry *entryPtr,
+static int EntryValueChanged(Entry *entryPtr,
const char *newValue);
static void EntryVisibleRange(Entry *entryPtr,
double *firstPtr, double *lastPtr);
@@ -427,7 +427,7 @@ static int EntryWidgetObjCmd(ClientData clientData,
static void EntryWorldChanged(ClientData instanceData);
static int GetEntryIndex(Tcl_Interp *interp, Entry *entryPtr,
char *string, int *indexPtr);
-static void InsertChars(Entry *entryPtr, int index, char *string);
+static int InsertChars(Entry *entryPtr, int index, char *string);
/*
* These forward declarations are the spinbox specific ones:
@@ -663,7 +663,7 @@ EntryWidgetObjCmd(
break;
case COMMAND_DELETE: {
- int first, last;
+ int first, last, code;
if ((objc < 3) || (objc > 4)) {
Tcl_WrongNumArgs(interp, 2, objv, "firstIndex ?lastIndex?");
@@ -680,7 +680,10 @@ EntryWidgetObjCmd(
goto error;
}
if ((last >= first) && (entryPtr->state == STATE_NORMAL)) {
- DeleteChars(entryPtr, first, last - first);
+ code = DeleteChars(entryPtr, first, last - first);
+ if (code != TCL_OK) {
+ goto error;
+ }
}
break;
}
@@ -721,7 +724,7 @@ EntryWidgetObjCmd(
}
case COMMAND_INSERT: {
- int index;
+ int index, code;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "index text");
@@ -732,7 +735,10 @@ EntryWidgetObjCmd(
goto error;
}
if (entryPtr->state == STATE_NORMAL) {
- InsertChars(entryPtr, index, Tcl_GetString(objv[3]));
+ code = InsertChars(entryPtr, index, Tcl_GetString(objv[3]));
+ if (code != TCL_OK) {
+ goto error;
+ }
}
break;
}
@@ -1291,6 +1297,9 @@ ConfigureEntry(
/*
* If the entry is tied to the value of a variable, create the variable if
* it doesn't exist, and set the entry's value from the variable's value.
+ * No checking of the return value of EntryValueChanged is needed since it
+ * can only return TCL_ERROR if there is a trace on the textvariable and
+ * since any existing trace on it was eliminated above.
*/
if (entryPtr->textVarName != NULL) {
@@ -1990,7 +1999,8 @@ EntryComputeGeometry(
* Add new characters to an entry widget.
*
* Results:
- * None.
+ * A standard Tcl result. If an error occurred then an error message is
+ * left in the interp's result.
*
* Side effects:
* New information gets added to entryPtr; it will be redisplayed soon,
@@ -1999,7 +2009,7 @@ EntryComputeGeometry(
*----------------------------------------------------------------------
*/
-static void
+static int
InsertChars(
Entry *entryPtr, /* Entry that is to get the new elements. */
int index, /* Add the new elements before this character
@@ -2017,7 +2027,7 @@ InsertChars(
byteIndex = Tcl_UtfAtIndex(string, index) - string;
byteCount = strlen(value);
if (byteCount == 0) {
- return;
+ return TCL_OK;
}
newByteCount = entryPtr->numBytes + byteCount + 1;
@@ -2031,7 +2041,7 @@ InsertChars(
EntryValidateChange(entryPtr, value, newStr, index,
VALIDATE_INSERT) != TCL_OK) {
ckfree(newStr);
- return;
+ return TCL_OK;
}
ckfree((char *)string);
@@ -2079,7 +2089,7 @@ InsertChars(
if (entryPtr->insertPos >= index) {
entryPtr->insertPos += charsAdded;
}
- EntryValueChanged(entryPtr, NULL);
+ return EntryValueChanged(entryPtr, NULL);
}
/*
@@ -2090,7 +2100,8 @@ InsertChars(
* Remove one or more characters from an entry widget.
*
* Results:
- * None.
+ * A standard Tcl result. If an error occurred then an error message is
+ * left in the interp's result.
*
* Side effects:
* Memory gets freed, the entry gets modified and (eventually)
@@ -2099,7 +2110,7 @@ InsertChars(
*----------------------------------------------------------------------
*/
-static void
+static int
DeleteChars(
Entry *entryPtr, /* Entry widget to modify. */
int index, /* Index of first character to delete. */
@@ -2113,7 +2124,7 @@ DeleteChars(
count = entryPtr->numChars - index;
}
if (count <= 0) {
- return;
+ return TCL_OK;
}
string = entryPtr->string;
@@ -2135,7 +2146,7 @@ DeleteChars(
VALIDATE_DELETE) != TCL_OK) {
ckfree(newStr);
ckfree(toDelete);
- return;
+ return TCL_OK;
}
ckfree(toDelete);
@@ -2194,7 +2205,7 @@ DeleteChars(
entryPtr->insertPos = index;
}
}
- EntryValueChanged(entryPtr, NULL);
+ return EntryValueChanged(entryPtr, NULL);
}
/*
@@ -2207,7 +2218,8 @@ DeleteChars(
* is one, and does other bookkeeping such as arranging for redisplay.
*
* Results:
- * None.
+ * A standard Tcl result. If an error occurred then an error message is
+ * left in the interp's result.
*
* Side effects:
* None.
@@ -2215,7 +2227,7 @@ DeleteChars(
*----------------------------------------------------------------------
*/
-static void
+static int
EntryValueChanged(
Entry *entryPtr, /* Entry whose value just changed. */
const char *newValue) /* If this value is not NULL, we first force
@@ -2229,7 +2241,7 @@ EntryValueChanged(
newValue = NULL;
} else {
newValue = Tcl_SetVar(entryPtr->interp, entryPtr->textVarName,
- entryPtr->string, TCL_GLOBAL_ONLY);
+ entryPtr->string, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
}
if ((newValue != NULL) && (strcmp(newValue, entryPtr->string) != 0)) {
@@ -2251,6 +2263,17 @@ EntryValueChanged(
EntryComputeGeometry(entryPtr);
EventuallyRedraw(entryPtr);
}
+
+ /*
+ * An error may have happened when setting the textvariable in case there
+ * is a trace on that variable and the trace proc triggered an error.
+ * Signal this error.
+ */
+
+ if ((entryPtr->textVarName != NULL) && (newValue == NULL)) {
+ return TCL_ERROR;
+ }
+ return TCL_OK;
}
/*
@@ -3703,7 +3726,7 @@ SpinboxWidgetObjCmd(
break;
case SB_CMD_DELETE: {
- int first, last;
+ int first, last, code;
if ((objc < 3) || (objc > 4)) {
Tcl_WrongNumArgs(interp, 2, objv, "firstIndex ?lastIndex?");
@@ -3722,7 +3745,10 @@ SpinboxWidgetObjCmd(
}
}
if ((last >= first) && (entryPtr->state == STATE_NORMAL)) {
- DeleteChars(entryPtr, first, last - first);
+ code = DeleteChars(entryPtr, first, last - first);
+ if (code != TCL_OK) {
+ goto error;
+ }
}
break;
}
@@ -3782,7 +3808,7 @@ SpinboxWidgetObjCmd(
}
case SB_CMD_INSERT: {
- int index;
+ int index, code;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "index text");
@@ -3793,7 +3819,10 @@ SpinboxWidgetObjCmd(
goto error;
}
if (entryPtr->state == STATE_NORMAL) {
- InsertChars(entryPtr, index, Tcl_GetString(objv[3]));
+ code = InsertChars(entryPtr, index, Tcl_GetString(objv[3]));
+ if (code != TCL_OK) {
+ goto error;
+ }
}
break;
}
@@ -4001,16 +4030,22 @@ SpinboxWidgetObjCmd(
break;
}
- case SB_CMD_SET:
+ case SB_CMD_SET: {
+ int code = TCL_OK;
+
if (objc > 3) {
Tcl_WrongNumArgs(interp, 2, objv, "?string?");
goto error;
}
if (objc == 3) {
- EntryValueChanged(entryPtr, Tcl_GetString(objv[2]));
+ code = EntryValueChanged(entryPtr, Tcl_GetString(objv[2]));
+ if (code != TCL_OK) {
+ goto error;
+ }
}
Tcl_SetStringObj(Tcl_GetObjResult(interp), entryPtr->string, -1);
break;
+ }
case SB_CMD_VALIDATE: {
int code;
@@ -4151,7 +4186,7 @@ GetSpinboxElement(
* TCL_OK.
*
* Side effects:
- * An background error condition may arise when invoking the callback.
+ * A background error condition may arise when invoking the callback.
* The widget value may change.
*
*--------------------------------------------------------------
@@ -4182,6 +4217,7 @@ SpinboxInvoke(
return TCL_OK;
}
+ code = TCL_OK;
if (fabs(sbPtr->increment) > MIN_DBL_VAL) {
if (sbPtr->listObj != NULL) {
Tcl_Obj *objPtr;
@@ -4227,7 +4263,7 @@ SpinboxInvoke(
}
}
Tcl_ListObjIndex(interp, sbPtr->listObj, sbPtr->eIndex, &objPtr);
- EntryValueChanged(entryPtr, Tcl_GetString(objPtr));
+ code = EntryValueChanged(entryPtr, Tcl_GetString(objPtr));
} else if (!DOUBLES_EQ(sbPtr->fromValue, sbPtr->toValue)) {
double dvalue;
@@ -4274,9 +4310,12 @@ SpinboxInvoke(
}
}
sprintf(sbPtr->formatBuf, sbPtr->valueFormat, dvalue);
- EntryValueChanged(entryPtr, sbPtr->formatBuf);
+ code = EntryValueChanged(entryPtr, sbPtr->formatBuf);
}
}
+ if (code != TCL_OK) {
+ return TCL_ERROR;
+ }
if (sbPtr->command != NULL) {
Tcl_DStringInit(&script);
diff --git a/tests/entry.test b/tests/entry.test
index 27acfc1..da8f280 100644
--- a/tests/entry.test
+++ b/tests/entry.test
@@ -1621,13 +1621,26 @@ test entry-22.1 {lost namespaced textvar} {
namespace eval test { variable foo {a b} }
entry .e -textvariable ::test::foo
namespace delete test
- .e insert end "more stuff"
- .e delete 5 end
- catch {set ::test::foo} result
- list [.e get] [.e cget -textvar] $result
+ catch {.e insert end "more stuff"} result1
+ catch {.e delete 5 end} result2
+ catch {set ::test::foo} result3
+ list [.e get] [.e cget -textvar] $result1 $result2 $result3
} [list "a bmo" ::test::foo \
+ {can't set "::test::foo": parent namespace doesn't exist} \
+ {can't set "::test::foo": parent namespace doesn't exist} \
{can't read "::test::foo": no such variable}]
+test entry-23.1 {error in trace proc attached to the textvariable} {
+ destroy .e
+ trace variable myvar w traceit
+ proc traceit args {error "Intentional error here!"}
+ entry .e -textvariable myvar
+ catch {.e insert end mystring} result1
+ catch {.e delete 0} result2
+ list $result1 $result2
+} [list {can't set "myvar": Intentional error here!} \
+ {can't set "myvar": Intentional error here!}]
+
destroy .e
# XXX Still need to write tests for EntryBlinkProc, EntryFocusProc,
diff --git a/tests/spinbox.test b/tests/spinbox.test
index 0661635..5fba390 100644
--- a/tests/spinbox.test
+++ b/tests/spinbox.test
@@ -1583,6 +1583,22 @@ test spinbox-23.1 {selection present while disabled, bug 637828} {
} {1 1 345}
destroy .e
+
+test spinbox-24.1 {error in trace proc attached to the textvariable} {
+ destroy .s
+ trace variable myvar w traceit
+ proc traceit args {error "Intentional error here!"}
+ spinbox .s -textvariable myvar -from 1 -to 10
+ catch {.s set mystring} result1
+ catch {.s insert 0 mystring} result2
+ catch {.s delete 0} result3
+ catch {.s invoke buttonup} result4
+ list $result1 $result2 $result3 $result4
+} [list {can't set "myvar": Intentional error here!} \
+ {can't set "myvar": Intentional error here!} \
+ {can't set "myvar": Intentional error here!} \
+ {can't set "myvar": Intentional error here!}]
+
catch {unset ::e ::vVals}
##
generated by cgit v0.12 at 2024-11-24 04:42:22 (GMT)