Tk Source Code

    char *oldValues = NULL;	/* lint initialization */
    char *oldFormat = NULL;	/* lint initialization */
    int error;
    int oldExport = 0;		/* lint initialization */
    int valuesChanged = 0;	/* lint initialization */
    double oldFrom = 0.0;	/* lint initialization */
    double oldTo = 0.0;		/* lint initialization */
    int code;

    /*
     * Eliminate any existing trace on a variable monitored by the entry.
     */

    if ((entryPtr->textVarName != NULL)
	    && (entryPtr->flags & ENTRY_VAR_TRACED)) {

    if (!error) {
	Tk_FreeSavedOptions(&savedOptions);
    }

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



     */

    if (entryPtr->textVarName != NULL) {
	const char *value;

	value = Tcl_GetVar(interp, entryPtr->textVarName, TCL_GLOBAL_ONLY);
	if (value == NULL) {

            /*
             * Since any trace on the textvariable was eliminated above,
             * the only possible reason for EntryValueChanged to return
             * an error is that the textvariable lives in a namespace
             * that does not (yet) exist. Indeed, namespaces are not
             * automatically created as needed. Don't trap this error
             * here, better do it below when attempting to trace the
             * variable.
             */

	    EntryValueChanged(entryPtr, NULL);
	} else {
	    EntrySetValue(entryPtr, value);
	}
    }

    if (entryPtr->type == TK_SPINBOX) {
	ComputeFormat(sbPtr);

	if (valuesChanged > 0) {
	    Tcl_Obj *objPtr;

	    /*
	     * No check for error return, because there shouldn't be one given
	     * the check for valid list above.
	     */

	    Tcl_ListObjIndex(interp, sbPtr->listObj, 0, &objPtr);

            /*
	     * No check for error return here as well, because any possible
	     * error will be trapped below when attempting tracing.
	     */

            EntryValueChanged(entryPtr, Tcl_GetString(objPtr));
	} else if ((sbPtr->valueStr == NULL)
		&& !DOUBLES_EQ(sbPtr->fromValue, sbPtr->toValue)
		&& (!DOUBLES_EQ(sbPtr->fromValue, oldFrom)
			|| !DOUBLES_EQ(sbPtr->toValue, oldTo))) {
	    /*
	     * If the valueStr is empty and -from && -to are specified, check
	     * to see if the current string is within the range. If not, it

		if (dvalue > sbPtr->toValue) {
		    dvalue = sbPtr->toValue;
		} else if (dvalue < sbPtr->fromValue) {
		    dvalue = sbPtr->fromValue;
		}
	    }
	    sprintf(sbPtr->formatBuf, sbPtr->valueFormat, dvalue);

            /*
	     * No check for error return here as well, because any possible
	     * error will be trapped below when attempting tracing.
	     */

	    EntryValueChanged(entryPtr, sbPtr->formatBuf);
	}
    }

    /*
     * Set up a trace on the variable's value after we've possibly constrained
     * the value according to new -from/-to values.
     */

    if ((entryPtr->textVarName != NULL)
	    && !(entryPtr->flags & ENTRY_VAR_TRACED)) {
	code = Tcl_TraceVar(interp, entryPtr->textVarName,
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		EntryTextVarProc, (ClientData) entryPtr);
        if (code != TCL_OK) {
            return TCL_ERROR;
        }
        entryPtr->flags |= ENTRY_VAR_TRACED;
    }

    EntryWorldChanged((ClientData) entryPtr);
    if (error) {
	Tcl_SetObjResult(interp, errorResult);
	Tcl_DecrRefCount(errorResult);
	return TCL_ERROR;

	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.
     * Another possibility is that the textvariable is in a namespace that
     * does not (yet) exist.
     * Signal this error.
     */

    if ((entryPtr->textVarName != NULL) && (newValue == NULL)) {
        return TCL_ERROR;
    }
    return TCL_OK;

    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!}]

test entry-24.1 {textvariable lives in a non-existing namespace} {
    destroy .e
    catch {entry .e -textvariable thisnsdoesntexist::myvar} result1
    set result1
} {can't trace "thisnsdoesntexist::myvar": parent namespace doesn't exist}

destroy .e

# XXX Still need to write tests for EntryBlinkProc, EntryFocusProc,
# and EntryTextVarProc.

option clear

    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!}]

test spinbox-25.1 {textvariable lives in a non-existing namespace} {
    destroy .s
    catch {spinbox .s -textvariable thisnsdoesntexist::myvar} result1
    set result1
} {can't trace "thisnsdoesntexist::myvar": parent namespace doesn't exist}

catch {unset ::e ::vVals}

##
## End validation tests
##

# XXX Still need to write tests for SpinboxBlinkProc, SpinboxFocusProc,