diff options
| -rw-r--r-- | generic/tkConfig.c | 2 | ||||
| -rw-r--r-- | generic/tkDecls.h | 5 | ||||
| -rw-r--r-- | generic/tkStubInit.c | 12 | ||||
| -rw-r--r-- | generic/tkStyle.c | 66 |
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; } |