Fix shimmering in the "style" Tcl_ObjType: If a Tk_Style cannot be found, don't convert the Tcl_Obj to a styleObjType, but handle the error-situation as other objTypes do.

Also convert Tk_GetStyleFromObj() and Tk_FreeStyleFromObj() to macro's (but keep the entries in the stub table).

4 files changed, 28 insertions, 57 deletions

diff --git a/generic/tkConfig.c b/generic/tkConfig.c
index 093bd35..96b0b9b 100644
--- a/generic/tkConfig.c
+++ b/generic/tkConfig.c
@@ -1642,8 +1642,6 @@ FreeResources(
 	if (internalFormExists) {
 	    Tk_FreeStyle(*((Tk_Style *) internalPtr));
 	    *((Tk_Style *) internalPtr) = NULL;
-	} else if (objPtr != NULL) {
-	    Tk_FreeStyleFromObj(objPtr);
 	}
 	break;
     case TK_OPTION_BITMAP:
diff --git a/generic/tkDecls.h b/generic/tkDecls.h
index 8ba2f44..2e498af 100644
--- a/generic/tkDecls.h
+++ b/generic/tkDecls.h
@@ -1738,6 +1738,11 @@ extern const TkStubs *tkStubsPtr;
 
 #undef Tk_FreeXId
 #define Tk_FreeXId(display,xid)
+#undef Tk_GetStyleFromObj
+#undef Tk_FreeStyleFromObj
+#define Tk_GetStyleFromObj(obj) Tk_AllocStyleFromObj(NULL, obj)
+#define Tk_FreeStyleFromObj(obj) /* no-op */
+
 
 #if defined(_WIN32) && defined(UNICODE)
 #   define Tk_MainEx Tk_MainExW
diff --git a/generic/tkStubInit.c b/generic/tkStubInit.c
index f1faf27..82d2511 100644
--- a/generic/tkStubInit.c
+++ b/generic/tkStubInit.c
@@ -39,10 +39,15 @@ MODULE_SCOPE const TkStubs tkStubs;
 
 #undef Tk_MainEx
 #undef Tk_FreeXId
+#undef Tk_FreeStyleFromObj
+#undef Tk_GetStyleFromObj
 
 
 #ifdef TK_NO_DEPRECATED
+#define Tk_MainEx 0
 #define Tk_FreeXId 0
+#define Tk_FreeStyleFromObj 0
+#define Tk_GetStyleFromObj 0
 #define Tk_PhotoPutBlock_NoComposite 0
 #define Tk_PhotoPutZoomedBlock_NoComposite 0
 #define Tk_PhotoExpand_Panic 0
@@ -55,8 +60,13 @@ doNothing(void)
 {
     /* dummy implementation, no need to do anything */
 }
-
 #define Tk_FreeXId ((void (*)(Display *, XID)) doNothing)
+#define Tk_FreeStyleFromObj ((void (*)(Tcl_Obj *)) doNothing)
+#define Tk_GetStyleFromObj getStyleFromObj
+static Tk_Style Tk_GetStyleFromObj(Tcl_Obj *obj)
+{
+	return Tk_AllocStyleFromObj(NULL, obj);
+}
 #endif
 
 #ifdef _WIN32
diff --git a/generic/tkStyle.c b/generic/tkStyle.c
index e7401df..10d2104 100644
--- a/generic/tkStyle.c
+++ b/generic/tkStyle.c
@@ -155,7 +155,7 @@ static const Tcl_ObjType styleObjType = {
     FreeStyleObjProc,		/* freeIntRepProc */
     DupStyleObjProc,		/* dupIntRepProc */
     NULL,			/* updateStringProc */
-    SetStyleFromAny		/* setFromAnyProc */
+    NULL			/* setFromAnyProc */
 };
 
 /*
@@ -1405,62 +1405,15 @@ Tk_AllocStyleFromObj(
     Tcl_Obj *objPtr)		/* Object containing name of the style to
 				 * retrieve. */
 {
-    Style *stylePtr;
-
-    if (objPtr->typePtr != &styleObjType) {
-	SetStyleFromAny(interp, objPtr);
-    }
-    stylePtr = objPtr->internalRep.twoPtrValue.ptr1;
-
-    return (Tk_Style) stylePtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tk_GetStyleFromObj --
- *
- *	Find the style that corresponds to a given object. The style must have
- *	already been created by Tk_CreateStyle.
- *
- * Results:
- *	The return value is a token for the style that matches objPtr, or NULL
- *	if none found.
- *
- * Side effects:
- *	If the object is not already a style ref, the conversion will free any
- *	old internal representation.
- *
- *----------------------------------------------------------------------
- */
-
-Tk_Style
-Tk_GetStyleFromObj(
-    Tcl_Obj *objPtr)		/* The object from which to get the style. */
-{
     if (objPtr->typePtr != &styleObjType) {
-	SetStyleFromAny(NULL, objPtr);
+	if (SetStyleFromAny(interp, objPtr) != TCL_OK) {
+	    return NULL;
+	}
     }
-
     return objPtr->internalRep.twoPtrValue.ptr1;
 }
 
 /*
- *---------------------------------------------------------------------------
- *
- * Tk_FreeStyleFromObj --
- *
- *	No-op. Present only for stubs compatibility.
- *
- *---------------------------------------------------------------------------
- */
-void
-Tk_FreeStyleFromObj(
-    Tcl_Obj *objPtr)
-{
-}
-
-/*
  *----------------------------------------------------------------------
  *
  * SetStyleFromAny --
@@ -1469,8 +1422,8 @@ Tk_FreeStyleFromObj(
  *	internal form.
  *
  * Results:
- *	Always returns TCL_OK. If an error occurs is returned (e.g. the style
- *	doesn't exist), an error message will be left in interp's result.
+ *	If an error occurs is returned (e.g. the style doesn't exist), an
+ *	error message will be left in interp's result and TCL_ERROR is returned.
  *
  * Side effects:
  *	The object is left with its typePtr pointing to styleObjType.
@@ -1485,6 +1438,7 @@ SetStyleFromAny(
 {
     const Tcl_ObjType *typePtr;
     const char *name;
+    Tk_Style style;
 
     /*
      * Free the old internalRep before setting the new one.
@@ -1496,8 +1450,12 @@ SetStyleFromAny(
 	typePtr->freeIntRepProc(objPtr);
     }
 
+    style = Tk_GetStyle(interp, name);
+    if (style == NULL) {
+    	return TCL_ERROR;
+    }
     objPtr->typePtr = &styleObjType;
-    objPtr->internalRep.twoPtrValue.ptr1 = Tk_GetStyle(interp, name);
+    objPtr->internalRep.twoPtrValue.ptr1 = style;
 
     return TCL_OK;
 }