summaryrefslogtreecommitdiffstats
path: root/generic/ttk
diff options
context:
space:
mode:
Diffstat (limited to 'generic/ttk')
-rw-r--r--generic/ttk/ttk.decls124
-rw-r--r--generic/ttk/ttkBlink.c4
-rw-r--r--generic/ttk/ttkCache.c8
-rw-r--r--generic/ttk/ttkDecls.h36
-rw-r--r--generic/ttk/ttkDefaultTheme.c4
-rw-r--r--generic/ttk/ttkEntry.c36
-rw-r--r--generic/ttk/ttkFrame.c7
-rw-r--r--generic/ttk/ttkGenStubs.tcl175
-rw-r--r--generic/ttk/ttkImage.c41
-rw-r--r--generic/ttk/ttkInit.c25
-rw-r--r--generic/ttk/ttkLabel.c2
-rw-r--r--generic/ttk/ttkLayout.c65
-rw-r--r--generic/ttk/ttkManager.c45
-rw-r--r--generic/ttk/ttkNotebook.c25
-rw-r--r--generic/ttk/ttkPanedwindow.c21
-rw-r--r--generic/ttk/ttkScroll.c18
-rw-r--r--generic/ttk/ttkState.c18
-rw-r--r--generic/ttk/ttkTagSet.c20
-rw-r--r--generic/ttk/ttkTheme.c81
-rw-r--r--generic/ttk/ttkTrace.c12
-rw-r--r--generic/ttk/ttkTrack.c2
-rw-r--r--generic/ttk/ttkTreeview.c131
-rw-r--r--generic/ttk/ttkWidget.c18
23 files changed, 496 insertions, 422 deletions
diff --git a/generic/ttk/ttk.decls b/generic/ttk/ttk.decls
index 8b2b50b..e668a2a 100644
--- a/generic/ttk/ttk.decls
+++ b/generic/ttk/ttk.decls
@@ -3,148 +3,148 @@ interface ttk
epoch 0
scspec TTKAPI
-declare 0 current {
- Ttk_Theme Ttk_GetTheme(Tcl_Interp *interp, const char *name);
+declare 0 {
+ Ttk_Theme Ttk_GetTheme(Tcl_Interp *interp, const char *name)
}
-declare 1 current {
- Ttk_Theme Ttk_GetDefaultTheme(Tcl_Interp *interp);
+declare 1 {
+ Ttk_Theme Ttk_GetDefaultTheme(Tcl_Interp *interp)
}
-declare 2 current {
- Ttk_Theme Ttk_GetCurrentTheme(Tcl_Interp *interp);
+declare 2 {
+ Ttk_Theme Ttk_GetCurrentTheme(Tcl_Interp *interp)
}
-declare 3 current {
+declare 3 {
Ttk_Theme Ttk_CreateTheme(
- Tcl_Interp *interp, const char *name, Ttk_Theme parent);
+ Tcl_Interp *interp, const char *name, Ttk_Theme parent)
}
-declare 4 current {
+declare 4 {
void Ttk_RegisterCleanup(
- Tcl_Interp *interp, void *deleteData, Ttk_CleanupProc *cleanupProc);
+ Tcl_Interp *interp, void *deleteData, Ttk_CleanupProc *cleanupProc)
}
-declare 5 current {
+declare 5 {
int Ttk_RegisterElementSpec(
Ttk_Theme theme,
const char *elementName,
Ttk_ElementSpec *elementSpec,
- void *clientData);
+ void *clientData)
}
-declare 6 current {
+declare 6 {
Ttk_ElementClass *Ttk_RegisterElement(
Tcl_Interp *interp,
Ttk_Theme theme,
const char *elementName,
Ttk_ElementSpec *elementSpec,
- void *clientData);
+ void *clientData)
}
-declare 7 current {
+declare 7 {
int Ttk_RegisterElementFactory(
Tcl_Interp *interp,
const char *name,
Ttk_ElementFactory factoryProc,
- void *clientData);
+ void *clientData)
}
-declare 8 current {
+declare 8 {
void Ttk_RegisterLayout(
- Ttk_Theme theme, const char *className, Ttk_LayoutSpec layoutSpec);
+ Ttk_Theme theme, const char *className, Ttk_LayoutSpec layoutSpec)
}
#
# State maps.
#
-declare 10 current {
+declare 10 {
int Ttk_GetStateSpecFromObj(
- Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_StateSpec *spec_rtn);
+ Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_StateSpec *spec_rtn)
}
-declare 11 current {
+declare 11 {
Tcl_Obj *Ttk_NewStateSpecObj(
- unsigned int onbits, unsigned int offbits);
+ unsigned int onbits, unsigned int offbits)
}
-declare 12 current {
+declare 12 {
Ttk_StateMap Ttk_GetStateMapFromObj(
- Tcl_Interp *interp, Tcl_Obj *objPtr);
+ Tcl_Interp *interp, Tcl_Obj *objPtr)
}
-declare 13 current {
+declare 13 {
Tcl_Obj *Ttk_StateMapLookup(
- Tcl_Interp *interp, Ttk_StateMap map, Ttk_State state);
+ Tcl_Interp *interp, Ttk_StateMap map, Ttk_State state)
}
-declare 14 current {
+declare 14 {
int Ttk_StateTableLookup(
- Ttk_StateTable map[], Ttk_State state);
+ Ttk_StateTable map[], Ttk_State state)
}
#
# Low-level geometry utilities.
#
-declare 20 current {
+declare 20 {
int Ttk_GetPaddingFromObj(
Tcl_Interp *interp,
Tk_Window tkwin,
Tcl_Obj *objPtr,
- Ttk_Padding *pad_rtn);
+ Ttk_Padding *pad_rtn)
}
-declare 21 current {
+declare 21 {
int Ttk_GetBorderFromObj(
Tcl_Interp *interp,
Tcl_Obj *objPtr,
- Ttk_Padding *pad_rtn);
+ Ttk_Padding *pad_rtn)
}
-declare 22 current {
+declare 22 {
int Ttk_GetStickyFromObj(
- Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_Sticky *sticky_rtn);
+ Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_Sticky *sticky_rtn)
}
-declare 23 current {
+declare 23 {
Ttk_Padding Ttk_MakePadding(
- short l, short t, short r, short b);
+ short l, short t, short r, short b)
}
-declare 24 current {
+declare 24 {
Ttk_Padding Ttk_UniformPadding(
- short borderWidth);
+ short borderWidth)
}
-declare 25 current {
- Ttk_Padding Ttk_AddPadding(Ttk_Padding pad1, Ttk_Padding pad2);
+declare 25 {
+ Ttk_Padding Ttk_AddPadding(Ttk_Padding pad1, Ttk_Padding pad2)
}
-declare 26 current {
+declare 26 {
Ttk_Padding Ttk_RelievePadding(
- Ttk_Padding padding, int relief, int n);
+ Ttk_Padding padding, int relief, int n)
}
-declare 27 current {
- Ttk_Box Ttk_MakeBox(int x, int y, int width, int height);
+declare 27 {
+ Ttk_Box Ttk_MakeBox(int x, int y, int width, int height)
}
-declare 28 current {
- int Ttk_BoxContains(Ttk_Box box, int x, int y);
+declare 28 {
+ int Ttk_BoxContains(Ttk_Box box, int x, int y)
}
-declare 29 current {
- Ttk_Box Ttk_PackBox(Ttk_Box *cavity, int w, int h, Ttk_Side side);
+declare 29 {
+ Ttk_Box Ttk_PackBox(Ttk_Box *cavity, int w, int h, Ttk_Side side)
}
-declare 30 current {
- Ttk_Box Ttk_StickBox(Ttk_Box parcel, int w, int h, Ttk_Sticky sticky);
+declare 30 {
+ Ttk_Box Ttk_StickBox(Ttk_Box parcel, int w, int h, Ttk_Sticky sticky)
}
-declare 31 current {
- Ttk_Box Ttk_AnchorBox(Ttk_Box parcel, int w, int h, Tk_Anchor anchor);
+declare 31 {
+ Ttk_Box Ttk_AnchorBox(Ttk_Box parcel, int w, int h, Tk_Anchor anchor)
}
-declare 32 current {
- Ttk_Box Ttk_PadBox(Ttk_Box b, Ttk_Padding p);
+declare 32 {
+ Ttk_Box Ttk_PadBox(Ttk_Box b, Ttk_Padding p)
}
-declare 33 current {
- Ttk_Box Ttk_ExpandBox(Ttk_Box b, Ttk_Padding p);
+declare 33 {
+ Ttk_Box Ttk_ExpandBox(Ttk_Box b, Ttk_Padding p)
}
-declare 34 current {
+declare 34 {
Ttk_Box Ttk_PlaceBox(
- Ttk_Box *cavity, int w, int h, Ttk_Side side, Ttk_Sticky sticky);
+ Ttk_Box *cavity, int w, int h, Ttk_Side side, Ttk_Sticky sticky)
}
-declare 35 current {
- Tcl_Obj *Ttk_NewBoxObj(Ttk_Box box);
+declare 35 {
+ Tcl_Obj *Ttk_NewBoxObj(Ttk_Box box)
}
#
# Utilities.
#
-declare 40 current {
- int Ttk_GetOrientFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *orient);
+declare 40 {
+ int Ttk_GetOrientFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *orient)
}
diff --git a/generic/ttk/ttkBlink.c b/generic/ttk/ttkBlink.c
index 7e46fac..706a871 100644
--- a/generic/ttk/ttkBlink.c
+++ b/generic/ttk/ttkBlink.c
@@ -49,10 +49,10 @@ static void CursorManagerDeleteProc(ClientData clientData, Tcl_Interp *interp)
static CursorManager *GetCursorManager(Tcl_Interp *interp)
{
static const char *cm_key = "ttk::CursorManager";
- CursorManager *cm = (CursorManager *) Tcl_GetAssocData(interp, cm_key,0);
+ CursorManager *cm = Tcl_GetAssocData(interp, cm_key,0);
if (!cm) {
- cm = (CursorManager*)ckalloc(sizeof(*cm));
+ cm = ckalloc(sizeof(*cm));
cm->timer = 0;
cm->owner = 0;
cm->onTime = DEF_CURSOR_ON_TIME;
diff --git a/generic/ttk/ttkCache.c b/generic/ttk/ttkCache.c
index e3aeaba..0ae2372 100644
--- a/generic/ttk/ttkCache.c
+++ b/generic/ttk/ttkCache.c
@@ -49,7 +49,7 @@ struct Ttk_ResourceCache_ {
*/
Ttk_ResourceCache Ttk_CreateResourceCache(Tcl_Interp *interp)
{
- Ttk_ResourceCache cache = (Ttk_ResourceCache)ckalloc(sizeof(*cache));
+ Ttk_ResourceCache cache = ckalloc(sizeof(*cache));
cache->tkwin = NULL; /* initialized later */
cache->interp = interp;
@@ -160,7 +160,7 @@ void Ttk_FreeResourceCache(Ttk_ResourceCache cache)
}
Tcl_DeleteHashTable(&cache->namedColors);
- ckfree((ClientData)cache);
+ ckfree(cache);
}
/*
@@ -270,7 +270,7 @@ static Tcl_Obj *Ttk_Use(
} else {
Tcl_DecrRefCount(cacheObj);
Tcl_SetHashValue(entryPtr, NULL);
- Tcl_BackgroundError(interp);
+ Tcl_BackgroundException(interp, TCL_ERROR);
return NULL;
}
}
@@ -341,7 +341,7 @@ Tk_Image Ttk_UseImage(Ttk_ResourceCache cache, Tk_Window tkwin, Tcl_Obj *objPtr)
Tcl_SetHashValue(entryPtr, image);
if (!image) {
- Tcl_BackgroundError(cache->interp);
+ Tcl_BackgroundException(cache->interp, TCL_ERROR);
}
return image;
diff --git a/generic/ttk/ttkDecls.h b/generic/ttk/ttkDecls.h
index ee679b7..b7c8de4 100644
--- a/generic/ttk/ttkDecls.h
+++ b/generic/ttk/ttkDecls.h
@@ -28,36 +28,36 @@ extern const char *TtkInitializeStubs(
*/
/* 0 */
-TTKAPI Ttk_Theme Ttk_GetTheme(Tcl_Interp *interp, CONST char *name);
+TTKAPI Ttk_Theme Ttk_GetTheme(Tcl_Interp *interp, const char *name);
/* 1 */
TTKAPI Ttk_Theme Ttk_GetDefaultTheme(Tcl_Interp *interp);
/* 2 */
TTKAPI Ttk_Theme Ttk_GetCurrentTheme(Tcl_Interp *interp);
/* 3 */
-TTKAPI Ttk_Theme Ttk_CreateTheme(Tcl_Interp *interp, CONST char *name,
+TTKAPI Ttk_Theme Ttk_CreateTheme(Tcl_Interp *interp, const char *name,
Ttk_Theme parent);
/* 4 */
TTKAPI void Ttk_RegisterCleanup(Tcl_Interp *interp,
- VOID *deleteData,
+ void *deleteData,
Ttk_CleanupProc *cleanupProc);
/* 5 */
TTKAPI int Ttk_RegisterElementSpec(Ttk_Theme theme,
- CONST char *elementName,
+ const char *elementName,
Ttk_ElementSpec *elementSpec,
- VOID *clientData);
+ void *clientData);
/* 6 */
TTKAPI Ttk_ElementClass * Ttk_RegisterElement(Tcl_Interp *interp,
- Ttk_Theme theme, CONST char *elementName,
+ Ttk_Theme theme, const char *elementName,
Ttk_ElementSpec *elementSpec,
- VOID *clientData);
+ void *clientData);
/* 7 */
TTKAPI int Ttk_RegisterElementFactory(Tcl_Interp *interp,
- CONST char *name,
+ const char *name,
Ttk_ElementFactory factoryProc,
- VOID *clientData);
+ void *clientData);
/* 8 */
TTKAPI void Ttk_RegisterLayout(Ttk_Theme theme,
- CONST char *className,
+ const char *className,
Ttk_LayoutSpec layoutSpec);
/* Slot 9 is reserved */
/* 10 */
@@ -133,17 +133,17 @@ typedef struct TtkStubs {
int magic;
int epoch;
int revision;
- const struct TtkStubHooks *hooks;
+ void *hooks;
- Ttk_Theme (*ttk_GetTheme) (Tcl_Interp *interp, CONST char *name); /* 0 */
+ Ttk_Theme (*ttk_GetTheme) (Tcl_Interp *interp, const char *name); /* 0 */
Ttk_Theme (*ttk_GetDefaultTheme) (Tcl_Interp *interp); /* 1 */
Ttk_Theme (*ttk_GetCurrentTheme) (Tcl_Interp *interp); /* 2 */
- Ttk_Theme (*ttk_CreateTheme) (Tcl_Interp *interp, CONST char *name, Ttk_Theme parent); /* 3 */
- void (*ttk_RegisterCleanup) (Tcl_Interp *interp, VOID *deleteData, Ttk_CleanupProc *cleanupProc); /* 4 */
- int (*ttk_RegisterElementSpec) (Ttk_Theme theme, CONST char *elementName, Ttk_ElementSpec *elementSpec, VOID *clientData); /* 5 */
- Ttk_ElementClass * (*ttk_RegisterElement) (Tcl_Interp *interp, Ttk_Theme theme, CONST char *elementName, Ttk_ElementSpec *elementSpec, VOID *clientData); /* 6 */
- int (*ttk_RegisterElementFactory) (Tcl_Interp *interp, CONST char *name, Ttk_ElementFactory factoryProc, VOID *clientData); /* 7 */
- void (*ttk_RegisterLayout) (Ttk_Theme theme, CONST char *className, Ttk_LayoutSpec layoutSpec); /* 8 */
+ Ttk_Theme (*ttk_CreateTheme) (Tcl_Interp *interp, const char *name, Ttk_Theme parent); /* 3 */
+ void (*ttk_RegisterCleanup) (Tcl_Interp *interp, void *deleteData, Ttk_CleanupProc *cleanupProc); /* 4 */
+ int (*ttk_RegisterElementSpec) (Ttk_Theme theme, const char *elementName, Ttk_ElementSpec *elementSpec, void *clientData); /* 5 */
+ Ttk_ElementClass * (*ttk_RegisterElement) (Tcl_Interp *interp, Ttk_Theme theme, const char *elementName, Ttk_ElementSpec *elementSpec, void *clientData); /* 6 */
+ int (*ttk_RegisterElementFactory) (Tcl_Interp *interp, const char *name, Ttk_ElementFactory factoryProc, void *clientData); /* 7 */
+ void (*ttk_RegisterLayout) (Ttk_Theme theme, const char *className, Ttk_LayoutSpec layoutSpec); /* 8 */
void (*reserved9)(void);
int (*ttk_GetStateSpecFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_StateSpec *spec_rtn); /* 10 */
Tcl_Obj * (*ttk_NewStateSpecObj) (unsigned int onbits, unsigned int offbits); /* 11 */
diff --git a/generic/ttk/ttkDefaultTheme.c b/generic/ttk/ttkDefaultTheme.c
index d2deee8..0c55651 100644
--- a/generic/ttk/ttkDefaultTheme.c
+++ b/generic/ttk/ttkDefaultTheme.c
@@ -722,8 +722,8 @@ static void MenubuttonArrowElementDraw(
int width = 0, height = 0;
Tk_GetPixelsFromObj(NULL, tkwin, arrow->sizeObj, &size);
- Tcl_GetIndexFromObj(NULL, arrow->directionObj, directionStrings,
- ""/*message*/, 0/*flags*/, &postDirection);
+ Tcl_GetIndexFromObjStruct(NULL, arrow->directionObj, directionStrings,
+ sizeof(char *), ""/*message*/, 0/*flags*/, &postDirection);
/* ... this might not be such a great idea ... */
switch (postDirection) {
diff --git a/generic/ttk/ttkEntry.c b/generic/ttk/ttkEntry.c
index 5c280e4..62a2720 100644
--- a/generic/ttk/ttkEntry.c
+++ b/generic/ttk/ttkEntry.c
@@ -652,7 +652,7 @@ static void EntryRevalidateBG(Entry *entryPtr, VREASON reason)
{
Tcl_Interp *interp = entryPtr->core.interp;
if (EntryRevalidate(interp, entryPtr, reason) == TCL_ERROR) {
- Tcl_BackgroundError(interp);
+ Tcl_BackgroundException(interp, TCL_ERROR);
}
}
@@ -758,8 +758,8 @@ static int EntrySetValue(Entry *entryPtr, const char *value)
Tcl_GetString(entryPtr->entry.textVariableObj);
if (textVarName && *textVarName) {
entryPtr->core.flags |= SYNCING_VARIABLE;
- value = Tcl_SetVar(entryPtr->core.interp, textVarName,
- value, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
+ value = Tcl_SetVar2(entryPtr->core.interp, textVarName,
+ NULL, value, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
entryPtr->core.flags &= ~SYNCING_VARIABLE;
if (!value || WidgetDestroyed(&entryPtr->core)) {
return TCL_ERROR;
@@ -786,7 +786,7 @@ static void EntryTextVariableTrace(void *recordPtr, const char *value)
}
if (entryPtr->core.flags & SYNCING_VARIABLE) {
- /* Trace was fired due to Tcl_SetVar call in EntrySetValue.
+ /* Trace was fired due to Tcl_SetVar2 call in EntrySetValue.
* Don't do anything.
*/
return;
@@ -1179,13 +1179,13 @@ static void EntryDisplay(void *clientData, Drawable d)
textarea = Ttk_ClientRegion(entryPtr->core.layout, "textarea");
showCursor =
- (entryPtr->core.flags & CURSOR_ON) != 0
+ (entryPtr->core.flags & CURSOR_ON)
&& EntryEditable(entryPtr)
&& entryPtr->entry.insertPos >= leftIndex
&& entryPtr->entry.insertPos <= rightIndex
;
showSelection =
- (entryPtr->core.state & TTK_STATE_DISABLED) == 0
+ !(entryPtr->core.state & TTK_STATE_DISABLED)
&& selFirst > -1
&& selLast > leftIndex
&& selFirst <= rightIndex
@@ -1314,8 +1314,8 @@ EntryIndex(
int *indexPtr) /* Return value */
{
# define EntryWidth(e) (Tk_Width(entryPtr->core.tkwin)) /* Not Right */
- int length;
- const char *string = Tcl_GetStringFromObj(indexObj, &length);
+ const char *string = Tcl_GetString(indexObj);
+ size_t length = indexObj->length;
if (strncmp(string, "end", length) == 0) {
*indexPtr = entryPtr->entry.numChars;
@@ -1327,9 +1327,10 @@ EntryIndex(
*indexPtr = entryPtr->entry.xscroll.last;
} else if (strncmp(string, "sel.", 4) == 0) {
if (entryPtr->entry.selectFirst < 0) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "selection isn't in widget ",
- Tk_PathName(entryPtr->core.tkwin), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "selection isn't in widget %s",
+ Tk_PathName(entryPtr->core.tkwin)));
+ Tcl_SetErrorCode(interp, "TTK", "ENTRY", "NO_SELECTION", NULL);
return TCL_ERROR;
}
if (strncmp(string, "sel.first", length) == 0) {
@@ -1381,8 +1382,9 @@ EntryIndex(
return TCL_OK;
badIndex:
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad entry index \"", string, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad entry index \"%s\"", string));
+ Tcl_SetErrorCode(interp, "TTK", "ENTRY", "INDEX", NULL);
return TCL_ERROR;
}
@@ -1457,7 +1459,7 @@ EntryGetCommand(
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
- Tcl_SetResult(interp, entryPtr->entry.string, TCL_VOLATILE);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(entryPtr->entry.string, -1));
return TCL_OK;
}
@@ -1787,9 +1789,9 @@ static int ComboboxCurrentCommand(
return TCL_ERROR;
}
if (currentIndex < 0 || currentIndex >= nValues) {
- Tcl_AppendResult(interp,
- "Index ", Tcl_GetString(objv[2]), " out of range",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Index %s out of range", Tcl_GetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TTK", "COMBOBOX", "IDX_RANGE", NULL);
return TCL_ERROR;
}
diff --git a/generic/ttk/ttkFrame.c b/generic/ttk/ttkFrame.c
index 7860024..3e50a7f 100644
--- a/generic/ttk/ttkFrame.c
+++ b/generic/ttk/ttkFrame.c
@@ -206,10 +206,9 @@ int TtkGetLabelAnchorFromObj(
error:
if (interp) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp,
- "Bad label anchor specification ", Tcl_GetString(objPtr),
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Bad label anchor specification %s", Tcl_GetString(objPtr)));
+ Tcl_SetErrorCode(interp, "TTK", "LABEL", "ANCHOR", NULL);
}
return TCL_ERROR;
}
diff --git a/generic/ttk/ttkGenStubs.tcl b/generic/ttk/ttkGenStubs.tcl
index 90dea25..d8e9a8a 100644
--- a/generic/ttk/ttkGenStubs.tcl
+++ b/generic/ttk/ttkGenStubs.tcl
@@ -5,26 +5,20 @@
#
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
+#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# SOURCE: tcl/tools/genStubs.tcl, revision 1.20
+# SOURCE: tcl/tools/genStubs.tcl, revision 1.44
#
-# CHANGES:
-# + Remove xxx_TCL_DECLARED #ifdeffery
-# + Use application-defined storage class specifier instead of "EXTERN"
-# + Add "epoch" and "revision" fields to stubs table record
-# + Remove dead code related to USE_*_STUB_PROCS (emitStubs, makeStub)
+# CHANGES:
# + Second argument to "declare" is used as a status guard
# instead of a platform guard.
-# + Use void (*reserved$i)(void) = 0 instead of void *reserved$i = NULL
-# for unused stub entries, in case pointer-to-function and
-# pointer-to-object are different sizes.
# + Allow trailing semicolon in function declarations
-# + stubs table is const-qualified
#
-package require Tcl 8
+package require Tcl 8.4
namespace eval genStubs {
# libraryName --
@@ -50,9 +44,9 @@ namespace eval genStubs {
# scspec --
#
# Storage class specifier for external function declarations.
- # Normally "extern", may be set to something like XYZAPI
+ # Normally "EXTERN", may be set to something like XYZAPI
#
- variable scspec "extern"
+ variable scspec "EXTERN"
# epoch, revision --
#
@@ -60,7 +54,7 @@ namespace eval genStubs {
# (@@@TODO: should be an array mapping interface names -> numbers)
#
- variable epoch 0
+ variable epoch {}
variable revision 0
# hooks --
@@ -181,13 +175,15 @@ proc genStubs::hooks {names} {
# decl The C function declaration, or {} for an undefined
# entry.
#
+# Results:
+# None.
+
proc genStubs::declare {args} {
variable stubs
variable curName
variable revision
incr revision
-
if {[llength $args] == 2} {
lassign $args index decl
set status current
@@ -204,7 +200,6 @@ proc genStubs::declare {args} {
if {[info exists stubs($curName,decl,$index)]} {
puts stderr "Duplicate entry: $index"
}
- regsub -all const $decl CONST decl
regsub -all "\[ \t\n\]+" [string trim $decl] " " decl
set decl [parseDecl $decl]
@@ -214,7 +209,25 @@ proc genStubs::declare {args} {
if {$index > $stubs($curName,lastNum)} {
set stubs($curName,lastNum) $index
}
+ return
+}
+
+# genStubs::export --
+#
+# This function is used in the declarations file to declare a symbol
+# that is exported from the library but is not in the stubs table.
+#
+# Arguments:
+# decl The C function declaration, or {} for an undefined
+# entry.
+#
+# Results:
+# None.
+proc genStubs::export {args} {
+ if {[llength $args] != 1} {
+ puts stderr "wrong # args: export $args"
+ }
return
}
@@ -273,22 +286,48 @@ proc genStubs::rewriteFile {file text} {
# Results:
# Returns the original text inside an appropriate #ifdef.
-proc genStubs::addPlatformGuard {plat text} {
+proc genStubs::addPlatformGuard {plat iftxt {eltxt {}}} {
+ set text ""
switch $plat {
win {
- return "#ifdef __WIN32__\n${text}#endif /* __WIN32__ */\n"
+ append text "#ifdef __WIN32__ /* WIN */\n${iftxt}"
+ if {$eltxt ne ""} {
+ append text "#else /* WIN */\n${eltxt}"
+ }
+ append text "#endif /* WIN */\n"
}
unix {
- return "#if !defined(__WIN32__) /* UNIX */\n${text}#endif /* UNIX */\n"
+ append text "#if !defined(__WIN32__) && !defined(MAC_OSX_TCL)\
+ /* UNIX */\n${iftxt}"
+ if {$eltxt ne ""} {
+ append text "#else /* UNIX */\n${eltxt}"
+ }
+ append text "#endif /* UNIX */\n"
}
macosx {
- return "#ifdef MAC_OSX_TCL\n${text}#endif /* MAC_OSX_TCL */\n"
+ append text "#ifdef MAC_OSX_TCL /* MACOSX */\n${iftxt}"
+ if {$eltxt ne ""} {
+ append text "#else /* MACOSX */\n${eltxt}"
+ }
+ append text "#endif /* MACOSX */\n"
}
aqua {
- return "#ifdef MAC_OSX_TK\n${text}#endif /* MAC_OSX_TK */\n"
+ append text "#ifdef MAC_OSX_TK /* AQUA */\n${iftxt}"
+ if {$eltxt ne ""} {
+ append text "#else /* AQUA */\n${eltxt}"
+ }
+ append text "#endif /* AQUA */\n"
}
x11 {
- return "#if !(defined(__WIN32__) || defined(MAC_OSX_TK)) /* X11 */\n${text}#endif /* X11 */\n"
+ append text "#if !(defined(__WIN32__) || defined(MAC_OSX_TK))\
+ /* X11 */\n${iftxt}"
+ if {$eltxt ne ""} {
+ append text "#else /* X11 */\n${eltxt}"
+ }
+ append text "#endif /* X11 */\n"
+ }
+ default {
+ append text "${iftxt}${eltxt}"
}
}
return $text
@@ -296,7 +335,9 @@ proc genStubs::addPlatformGuard {plat text} {
# genStubs::emitSlots --
#
-# Generate the stub table slots for the given interface.
+# Generate the stub table slots for the given interface. If there
+# are no generic slots, then one table is generated for each
+# platform, otherwise one table is generated for all platforms.
#
# Arguments:
# name The name of the interface being emitted.
@@ -307,6 +348,7 @@ proc genStubs::addPlatformGuard {plat text} {
proc genStubs::emitSlots {name textVar} {
upvar $textVar text
+
forAllStubs $name makeSlot noGuard text {" void (*reserved$i)(void);\n"}
return
}
@@ -335,7 +377,7 @@ proc genStubs::parseDecl {decl} {
return
}
set rtype [string trim $rtype]
- if {$args == ""} {
+ if {$args eq ""} {
return [list $rtype $fname {}]
}
foreach arg [split $args ,] {
@@ -383,14 +425,14 @@ proc genStubs::parseDecl {decl} {
proc genStubs::parseArg {arg} {
if {![regexp {^(.+[ ][*]*)([^][ *]+)(\[\])?$} $arg all type name array]} {
- if {$arg == "void"} {
+ if {$arg eq "void"} {
return $arg
} else {
return
}
}
set result [list [string trim $type] $name]
- if {$array != ""} {
+ if {$array ne ""} {
lappend result $array
}
return $result
@@ -410,13 +452,9 @@ proc genStubs::parseArg {arg} {
proc genStubs::makeDecl {name decl index} {
variable scspec
-
lassign $decl rtype fname args
append text "/* $index */\n"
- if {$rtype != "void"} {
- regsub -all void $rtype VOID rtype
- }
set line "$scspec $rtype"
set count [expr {2 - ([string length $line] / 8)}]
append line [string range "\t\t\t" 0 $count]
@@ -425,7 +463,7 @@ proc genStubs::makeDecl {name decl index} {
append line " "
set pad 0
}
- if {$args == ""} {
+ if {$args eq ""} {
append line $fname
append text $line
append text ";\n"
@@ -433,10 +471,9 @@ proc genStubs::makeDecl {name decl index} {
}
append line $fname
- regsub -all void $args VOID args
set arg1 [lindex $args 0]
switch -exact $arg1 {
- VOID {
+ void {
append line "(void)"
}
TCL_VARARGS {
@@ -504,7 +541,7 @@ proc genStubs::makeMacro {name decl index} {
append lfname [string range $fname 1 end]
set text "#define $fname \\\n\t("
- if {$args == ""} {
+ if {$args eq ""} {
append text "*"
}
append text "${name}StubsPtr->$lfname)"
@@ -531,19 +568,18 @@ proc genStubs::makeSlot {name decl index} {
append lfname [string range $fname 1 end]
set text " "
- if {$rtype != "void"} {
- regsub -all void $rtype VOID rtype
- }
- if {$args == ""} {
+ if {$args eq ""} {
append text $rtype " *" $lfname "; /* $index */\n"
return $text
}
- append text $rtype " (*" $lfname ") "
-
- regsub -all void $args VOID args
+ if {[string range $rtype end-8 end] eq "__stdcall"} {
+ append text [string trim [string range $rtype 0 end-9]] " (__stdcall *" $lfname ") "
+ } else {
+ append text $rtype " (*" $lfname ") "
+ }
set arg1 [lindex $args 0]
switch -exact $arg1 {
- VOID {
+ void {
append text "(void)"
}
TCL_VARARGS {
@@ -589,7 +625,7 @@ proc genStubs::makeSlot {name decl index} {
# Returns the formatted declaration string.
proc genStubs::makeInit {name decl index} {
- if {[lindex $decl 2] == ""} {
+ if {[lindex $decl 2] eq ""} {
append text " &" [lindex $decl 1] ", /* " $index " */\n"
} else {
append text " " [lindex $decl 1] ", /* " $index " */\n"
@@ -619,7 +655,7 @@ proc genStubs::makeInit {name decl index} {
# None.
proc genStubs::forAllStubs {name slotProc guardProc textVar
- {skipString {"/* Slot $i is reserved */\n"}}} {
+ {skipString {"/* Slot $i is reserved */\n"}}} {
variable stubs
upvar $textVar text
@@ -642,7 +678,7 @@ proc genStubs::addGuard {status text} {
set upName [string toupper $libraryName]
switch -- $status {
- current {
+ current {
# No change
}
deprecated {
@@ -655,7 +691,7 @@ proc genStubs::addGuard {status text} {
puts stderr "Unrecognized status code $status"
}
}
- return $text
+ return $text
}
proc genStubs::ifdeffed {macro text} {
@@ -726,15 +762,17 @@ proc genStubs::emitHeader {name} {
set capName [string toupper [string index $name 0]]
append capName [string range $name 1 end]
- set CAPName [string toupper $name]
- append text "\n"
- append text "#define ${CAPName}_STUBS_EPOCH $epoch\n"
- append text "#define ${CAPName}_STUBS_REVISION $revision\n"
+ if {$epoch ne ""} {
+ set CAPName [string toupper $name]
+ append text "\n"
+ append text "#define ${CAPName}_STUBS_EPOCH $epoch\n"
+ append text "#define ${CAPName}_STUBS_REVISION $revision\n"
+ }
emitDeclarations $name text
if {[info exists hooks($name)]} {
- append text "\ntypedef struct ${capName}StubHooks {\n"
+ append text "\ntypedef struct {\n"
foreach hook $hooks($name) {
set capHook [string toupper [string index $hook 0]]
append capHook [string range $hook 1 end]
@@ -744,9 +782,15 @@ proc genStubs::emitHeader {name} {
}
append text "\ntypedef struct ${capName}Stubs {\n"
append text " int magic;\n"
- append text " int epoch;\n"
- append text " int revision;\n"
- append text " const struct ${capName}StubHooks *hooks;\n\n"
+ if {$epoch ne ""} {
+ append text " int epoch;\n"
+ append text " int revision;\n"
+ }
+ if {[info exists hooks($name)]} {
+ append text " const ${capName}StubHooks *hooks;\n\n"
+ } else {
+ append text " void *hooks;\n\n"
+ }
emitSlots $name text
@@ -777,14 +821,11 @@ proc genStubs::emitInit {name textVar} {
variable hooks
variable interfaces
variable epoch
- variable revision
-
upvar $textVar text
set root 1
set capName [string toupper [string index $name 0]]
append capName [string range $name 1 end]
- set CAPName [string toupper $name]
if {[info exists hooks($name)]} {
append text "\nstatic const ${capName}StubHooks ${name}StubHooks = \{\n"
@@ -797,21 +838,23 @@ proc genStubs::emitInit {name textVar} {
}
foreach intf [array names interfaces] {
if {[info exists hooks($intf)]} {
- if {0<=[lsearch -exact $hooks($intf) $name]} {
+ if {[lsearch -exact $hooks($intf) $name] >= 0} {
set root 0
- break;
+ break
}
}
}
- if {$root} {
- append text "\nconst ${capName}Stubs ${name}Stubs = \{\n"
- } else {
- append text "\nstatic const ${capName}Stubs ${name}Stubs = \{\n"
+ append text "\n"
+ if {!$root} {
+ append text "static "
+ }
+ append text "const ${capName}Stubs ${name}Stubs = \{\n TCL_STUB_MAGIC,\n"
+ if {$epoch ne ""} {
+ set CAPName [string toupper $name]
+ append text " ${CAPName}_STUBS_EPOCH,\n"
+ append text " ${CAPName}_STUBS_REVISION,\n"
}
- append text " TCL_STUB_MAGIC,\n"
- append text " ${CAPName}_STUBS_EPOCH,\n"
- append text " ${CAPName}_STUBS_REVISION,\n"
if {[info exists hooks($name)]} {
append text " &${name}StubHooks,\n"
} else {
diff --git a/generic/ttk/ttkImage.c b/generic/ttk/ttkImage.c
index 2b12864..a5a3a52 100644
--- a/generic/ttk/ttkImage.c
+++ b/generic/ttk/ttkImage.c
@@ -36,7 +36,7 @@ static void NullImageChanged(ClientData clientData,
/* TtkGetImageSpec --
* Constructs a Ttk_ImageSpec * from a Tcl_Obj *.
- * Result must be released using TtkFreeImageSpec.
+ * Result must be released using TtkFreeImageSpec.
*
* TODO: Need a variant of this that takes a user-specified ImageChanged proc
*/
@@ -47,7 +47,7 @@ TtkGetImageSpec(Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr)
int i = 0, n = 0, objc;
Tcl_Obj **objv;
- imageSpec = (Ttk_ImageSpec *)ckalloc(sizeof(*imageSpec));
+ imageSpec = ckalloc(sizeof(*imageSpec));
imageSpec->baseImage = 0;
imageSpec->mapCount = 0;
imageSpec->states = 0;
@@ -59,16 +59,17 @@ TtkGetImageSpec(Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr)
if ((objc % 2) != 1) {
if (interp) {
- Tcl_SetResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"image specification must contain an odd number of elements",
- TCL_STATIC);
+ -1));
+ Tcl_SetErrorCode(interp, "TTK", "IMAGE", "SPEC", NULL);
}
goto error;
}
n = (objc - 1) / 2;
- imageSpec->states = (Ttk_StateSpec*)ckalloc(n * sizeof(Ttk_StateSpec));
- imageSpec->images = (Tk_Image*)ckalloc(n * sizeof(Tk_Image *));
+ imageSpec->states = ckalloc(n * sizeof(Ttk_StateSpec));
+ imageSpec->images = ckalloc(n * sizeof(Tk_Image *));
/* Get base image:
*/
@@ -117,10 +118,10 @@ void TtkFreeImageSpec(Ttk_ImageSpec *imageSpec)
}
if (imageSpec->baseImage) { Tk_FreeImage(imageSpec->baseImage); }
- if (imageSpec->states) { ckfree((ClientData)imageSpec->states); }
- if (imageSpec->images) { ckfree((ClientData)imageSpec->images); }
+ if (imageSpec->states) { ckfree(imageSpec->states); }
+ if (imageSpec->images) { ckfree(imageSpec->images); }
- ckfree((ClientData)imageSpec);
+ ckfree(imageSpec);
}
/* TtkSelectImage --
@@ -324,7 +325,9 @@ Ttk_CreateImageElement(
int i;
if (objc <= 0) {
- Tcl_AppendResult(interp, "Must supply a base image", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "Must supply a base image", -1));
+ Tcl_SetErrorCode(interp, "TTK", "IMAGE", "BASE", NULL);
return TCL_ERROR;
}
@@ -333,7 +336,7 @@ Ttk_CreateImageElement(
return TCL_ERROR;
}
- imageData = (ImageData*)ckalloc(sizeof(*imageData));
+ imageData = ckalloc(sizeof(*imageData));
imageData->imageSpec = imageSpec;
imageData->minWidth = imageData->minHeight = -1;
imageData->sticky = TTK_FILL_BOTH;
@@ -347,9 +350,9 @@ Ttk_CreateImageElement(
int option;
if (i == objc - 1) {
- Tcl_AppendResult(interp,
- "Value for ", Tcl_GetString(objv[i]), " missing",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Value for %s missing", Tcl_GetString(objv[i])));
+ Tcl_SetErrorCode(interp, "TTK", "IMAGE", "VALUE", NULL);
goto error;
}
@@ -361,13 +364,17 @@ Ttk_CreateImageElement(
}
#endif
- if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings,
- "option", 0, &option) != TCL_OK) { goto error; }
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], optionStrings,
+ sizeof(char *), "option", 0, &option) != TCL_OK) {
+ goto error;
+ }
switch (option) {
case O_BORDER:
if (Ttk_GetBorderFromObj(interp, objv[i+1], &imageData->border)
- != TCL_OK) { goto error; }
+ != TCL_OK) {
+ goto error;
+ }
if (!padding_specified) {
imageData->padding = imageData->border;
}
diff --git a/generic/ttk/ttkInit.c b/generic/ttk/ttkInit.c
index 78676c6..dc6e994 100644
--- a/generic/ttk/ttkInit.c
+++ b/generic/ttk/ttkInit.c
@@ -21,8 +21,8 @@ int Ttk_GetButtonDefaultStateFromObj(
Tcl_Interp *interp, Tcl_Obj *objPtr, int *statePtr)
{
*statePtr = TTK_BUTTON_DEFAULT_DISABLED;
- return Tcl_GetIndexFromObj(interp, objPtr,
- ttkDefaultStrings, "default state", 0, statePtr);
+ return Tcl_GetIndexFromObjStruct(interp, objPtr, ttkDefaultStrings,
+ sizeof(char *), "default state", 0, statePtr);
}
/*
@@ -38,8 +38,8 @@ int Ttk_GetCompoundFromObj(
Tcl_Interp *interp, Tcl_Obj *objPtr, int *statePtr)
{
*statePtr = TTK_COMPOUND_NONE;
- return Tcl_GetIndexFromObj(interp, objPtr,
- ttkCompoundStrings, "compound layout", 0, statePtr);
+ return Tcl_GetIndexFromObjStruct(interp, objPtr, ttkCompoundStrings,
+ sizeof(char *), "compound layout", 0, statePtr);
}
/*
@@ -54,8 +54,8 @@ int Ttk_GetOrientFromObj(
Tcl_Interp *interp, Tcl_Obj *objPtr, int *resultPtr)
{
*resultPtr = TTK_ORIENT_HORIZONTAL;
- return Tcl_GetIndexFromObj(interp, objPtr,
- ttkOrientStrings, "orientation", 0, resultPtr);
+ return Tcl_GetIndexFromObjStruct(interp, objPtr, ttkOrientStrings,
+ sizeof(char *), "orientation", 0, resultPtr);
}
/*
@@ -65,18 +65,18 @@ int Ttk_GetOrientFromObj(
static const char *ttkStateStrings[] = {
"normal", "readonly", "disabled", "active", NULL
};
-enum {
+enum {
TTK_COMPAT_STATE_NORMAL,
TTK_COMPAT_STATE_READONLY,
TTK_COMPAT_STATE_DISABLED,
TTK_COMPAT_STATE_ACTIVE
};
-/* TtkCheckStateOption --
+/* TtkCheckStateOption --
* Handle -state compatibility option.
*
- * NOTE: setting -state disabled / -state enabled affects the
- * widget state, but the internal widget state does *not* affect
+ * NOTE: setting -state disabled / -state enabled affects the
+ * widget state, but the internal widget state does *not* affect
* the value of the -state option.
* This option is present for compatibility only.
*/
@@ -86,7 +86,8 @@ void TtkCheckStateOption(WidgetCore *corePtr, Tcl_Obj *objPtr)
unsigned all = TTK_STATE_DISABLED|TTK_STATE_READONLY|TTK_STATE_ACTIVE;
# define SETFLAGS(f) TtkWidgetChangeState(corePtr, f, all^f)
- (void)Tcl_GetIndexFromObj(NULL,objPtr,ttkStateStrings,"",0,&stateOption);
+ (void)Tcl_GetIndexFromObjStruct(NULL, objPtr, ttkStateStrings,
+ sizeof(char *), "", 0, &stateOption);
switch (stateOption) {
case TTK_COMPAT_STATE_NORMAL:
default:
@@ -174,7 +175,7 @@ int TtkGetOptionValue(
* type name dbName dbClass default objOffset intOffset flags clientData mask
*/
-/* public */
+/* public */
Tk_OptionSpec ttkCoreOptionSpecs[] =
{
{TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor", NULL,
diff --git a/generic/ttk/ttkLabel.c b/generic/ttk/ttkLabel.c
index 597682f..0f71970 100644
--- a/generic/ttk/ttkLabel.c
+++ b/generic/ttk/ttkLabel.c
@@ -347,6 +347,8 @@ static void ImageDraw(
* Do not stipple at all under Aqua, just draw the image: it shows up
* as a white rectangle otherwise.
*/
+
+
if (state & TTK_STATE_DISABLED) {
if (TtkSelectImage(image->imageSpec, 0ul) == image->tkimg) {
#ifndef MAC_OSX_TK
diff --git a/generic/ttk/ttkLayout.c b/generic/ttk/ttkLayout.c
index 58c99eb..ba24589 100644
--- a/generic/ttk/ttkLayout.c
+++ b/generic/ttk/ttkLayout.c
@@ -326,8 +326,9 @@ int Ttk_GetPaddingFromObj(
if (padc > 4) {
if (interp) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "Wrong #elements in padding spec", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "Wrong #elements in padding spec", -1));
+ Tcl_SetErrorCode(interp, "TTK", "VALUE", "PADDING", NULL);
}
goto error;
}
@@ -363,8 +364,9 @@ int Ttk_GetBorderFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_Padding *pad)
if (padc > 4) {
if (interp) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "Wrong #elements in border spec", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "Wrong #elements in padding spec", -1));
+ Tcl_SetErrorCode(interp, "TTK", "VALUE", "BORDER", NULL);
}
goto error;
}
@@ -476,11 +478,10 @@ int Ttk_GetStickyFromObj(
case 's': case 'S': sticky |= TTK_STICK_S; break;
default:
if (interp) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp,
- "Bad -sticky specification ",
- Tcl_GetString(objPtr),
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Bad -sticky specification %s",
+ Tcl_GetString(objPtr)));
+ Tcl_SetErrorCode(interp, "TTK", "VALUE", "STICKY", NULL);
}
return TCL_ERROR;
}
@@ -524,7 +525,7 @@ struct Ttk_LayoutNode_
static Ttk_LayoutNode *Ttk_NewLayoutNode(
unsigned flags, Ttk_ElementClass *elementClass)
{
- Ttk_LayoutNode *node = (Ttk_LayoutNode*)ckalloc(sizeof(*node));
+ Ttk_LayoutNode *node = ckalloc(sizeof(*node));
node->flags = flags;
node->eclass = elementClass;
@@ -540,7 +541,7 @@ static void Ttk_FreeLayoutNode(Ttk_LayoutNode *node)
while (node) {
Ttk_LayoutNode *next = node->next;
Ttk_FreeLayoutNode(node->child);
- ckfree((ClientData)node);
+ ckfree(node);
node = next;
}
}
@@ -557,7 +558,7 @@ struct Ttk_TemplateNode_ {
static Ttk_TemplateNode *Ttk_NewTemplateNode(const char *name, unsigned flags)
{
- Ttk_TemplateNode *op = (Ttk_TemplateNode*)ckalloc(sizeof(*op));
+ Ttk_TemplateNode *op = ckalloc(sizeof(*op));
op->name = ckalloc(strlen(name) + 1); strcpy(op->name, name);
op->flags = flags;
op->next = op->child = 0;
@@ -570,7 +571,7 @@ void Ttk_FreeLayoutTemplate(Ttk_LayoutTemplate op)
Ttk_LayoutTemplate next = op->next;
Ttk_FreeLayoutTemplate(op->child);
ckfree(op->name);
- ckfree((ClientData)op);
+ ckfree(op);
op = next;
}
}
@@ -635,25 +636,25 @@ Ttk_LayoutTemplate Ttk_ParseLayoutTemplate(Tcl_Interp *interp, Tcl_Obj *objPtr)
if (optName[0] != '-')
break;
- if (Tcl_GetIndexFromObj(
- interp, objv[i], optStrings, "option", 0, &option)
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], optStrings,
+ sizeof(char *), "option", 0, &option)
!= TCL_OK)
{
goto error;
}
if (++i >= objc) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp,
- "Missing value for option ",Tcl_GetString(objv[i-1]),
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Missing value for option %s",
+ Tcl_GetString(objv[i-1])));
+ Tcl_SetErrorCode(interp, "TTK", "VALUE", "LAYOUT", NULL);
goto error;
}
switch (option) {
case OP_SIDE: /* <<NOTE-PACKSIDE>> */
- if (Tcl_GetIndexFromObj(interp, objv[i], packSideStrings,
- "side", 0, &value) != TCL_OK)
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], packSideStrings,
+ sizeof(char *), "side", 0, &value) != TCL_OK)
{
goto error;
}
@@ -790,7 +791,7 @@ Tcl_Obj *Ttk_UnparseLayoutTemplate(Ttk_TemplateNode *node)
int side = 0;
unsigned sideFlags = flags & _TTK_MASK_PACK;
- while ((sideFlags & TTK_PACK_LEFT) == 0) {
+ while (!(sideFlags & TTK_PACK_LEFT)) {
++side;
sideFlags >>= 1;
}
@@ -799,9 +800,11 @@ Tcl_Obj *Ttk_UnparseLayoutTemplate(Ttk_TemplateNode *node)
}
}
- /* In Ttk_ParseLayoutTemplate, default -sticky is "nsew",
- * so always include this even if no sticky bits are set.
+ /*
+ * In Ttk_ParseLayoutTemplate, default -sticky is "nsew", so always
+ * include this even if no sticky bits are set.
*/
+
APPENDSTR("-sticky");
APPENDOBJ(Ttk_NewStickyObj(flags & _TTK_MASK_STICK));
@@ -839,7 +842,7 @@ static Ttk_Layout TTKNewLayout(
void *recordPtr,Tk_OptionTable optionTable, Tk_Window tkwin,
Ttk_LayoutNode *root)
{
- Ttk_Layout layout = (Ttk_Layout)ckalloc(sizeof(*layout));
+ Ttk_Layout layout = ckalloc(sizeof(*layout));
layout->style = style;
layout->recordPtr = recordPtr;
layout->optionTable = optionTable;
@@ -851,7 +854,7 @@ static Ttk_Layout TTKNewLayout(
void Ttk_FreeLayout(Ttk_Layout layout)
{
Ttk_FreeLayoutNode(layout->root);
- ckfree((ClientData)layout);
+ ckfree(layout);
}
/*
@@ -875,8 +878,9 @@ Ttk_Layout Ttk_CreateLayout(
Ttk_LayoutNode *bgnode;
if (!layoutTemplate) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "Layout ", styleName, " not found", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Layout %s not found", styleName));
+ Tcl_SetErrorCode(interp, "TTK", "LOOKUP", "LAYOUT", styleName, NULL);
return 0;
}
@@ -915,8 +919,9 @@ Ttk_CreateSublayout(
layoutTemplate = Ttk_FindLayoutTemplate(themePtr, styleName);
if (!layoutTemplate) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "Layout ", styleName, " not found", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Layout %s not found", styleName));
+ Tcl_SetErrorCode(interp, "TTK", "LOOKUP", "LAYOUT", styleName, NULL);
return 0;
}
diff --git a/generic/ttk/ttkManager.c b/generic/ttk/ttkManager.c
index 2fcb190..24a0fb1 100644
--- a/generic/ttk/ttkManager.c
+++ b/generic/ttk/ttkManager.c
@@ -188,7 +188,7 @@ static void SlaveEventHandler(ClientData clientData, XEvent *eventPtr)
static Ttk_Slave *NewSlave(
Ttk_Manager *mgr, Tk_Window slaveWindow, void *slaveData)
{
- Ttk_Slave *slave = (Ttk_Slave*)ckalloc(sizeof(*slave));
+ Ttk_Slave *slave = ckalloc(sizeof(*slave));
slave->slaveWindow = slaveWindow;
slave->manager = mgr;
@@ -200,7 +200,7 @@ static Ttk_Slave *NewSlave(
static void DeleteSlave(Ttk_Slave *slave)
{
- ckfree((ClientData)slave);
+ ckfree(slave);
}
/*------------------------------------------------------------------------
@@ -210,7 +210,7 @@ static void DeleteSlave(Ttk_Slave *slave)
Ttk_Manager *Ttk_CreateManager(
Ttk_ManagerSpec *managerSpec, void *managerData, Tk_Window masterWindow)
{
- Ttk_Manager *mgr = (Ttk_Manager*)ckalloc(sizeof(*mgr));
+ Ttk_Manager *mgr = ckalloc(sizeof(*mgr));
mgr->managerSpec = managerSpec;
mgr->managerData = managerData;
@@ -234,12 +234,12 @@ void Ttk_DeleteManager(Ttk_Manager *mgr)
Ttk_ForgetSlave(mgr, mgr->nSlaves - 1);
}
if (mgr->slaves) {
- ckfree((ClientData)mgr->slaves);
+ ckfree(mgr->slaves);
}
Tcl_CancelIdleCall(ManagerIdleProc, mgr);
- ckfree((ClientData)mgr);
+ ckfree(mgr);
}
/*------------------------------------------------------------------------
@@ -252,8 +252,7 @@ void Ttk_DeleteManager(Ttk_Manager *mgr)
static void InsertSlave(Ttk_Manager *mgr, Ttk_Slave *slave, int index)
{
int endIndex = mgr->nSlaves++;
- mgr->slaves = (Ttk_Slave**)ckrealloc(
- (ClientData)mgr->slaves, mgr->nSlaves * sizeof(Ttk_Slave *));
+ mgr->slaves = ckrealloc(mgr->slaves, mgr->nSlaves * sizeof(Ttk_Slave *));
while (endIndex > index) {
mgr->slaves[endIndex] = mgr->slaves[endIndex - 1];
@@ -456,10 +455,9 @@ int Ttk_GetSlaveIndexFromObj(
*/
if (Tcl_GetIntFromObj(NULL, objPtr, &slaveIndex) == TCL_OK) {
if (slaveIndex < 0 || slaveIndex >= mgr->nSlaves) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp,
- "Slave index ", Tcl_GetString(objPtr), " out of bounds",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Slave index %d out of bounds", slaveIndex));
+ Tcl_SetErrorCode(interp, "TTK", "SLAVE", "INDEX", NULL);
return TCL_ERROR;
}
*indexPtr = slaveIndex;
@@ -468,23 +466,23 @@ int Ttk_GetSlaveIndexFromObj(
/* Try interpreting as a slave window name;
*/
- if ( (*string == '.')
- && (tkwin = Tk_NameToWindow(interp, string, mgr->masterWindow)))
- {
+ if ((*string == '.') &&
+ (tkwin = Tk_NameToWindow(interp, string, mgr->masterWindow))) {
slaveIndex = Ttk_SlaveIndex(mgr, tkwin);
if (slaveIndex < 0) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp,
- string, " is not managed by ", Tk_PathName(mgr->masterWindow),
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s is not managed by %s", string,
+ Tk_PathName(mgr->masterWindow)));
+ Tcl_SetErrorCode(interp, "TTK", "SLAVE", "MANAGER", NULL);
return TCL_ERROR;
}
*indexPtr = slaveIndex;
return TCL_OK;
}
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "Invalid slave specification ", string, NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Invalid slave specification %s", string));
+ Tcl_SetErrorCode(interp, "TTK", "SLAVE", "SPEC", NULL);
return TCL_ERROR;
}
@@ -543,10 +541,9 @@ int Ttk_Maintainable(Tcl_Interp *interp, Tk_Window slave, Tk_Window master)
return 1;
badWindow:
- Tcl_AppendResult(interp,
- "can't add ", Tk_PathName(slave),
- " as slave of ", Tk_PathName(master),
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("can't add %s as slave of %s",
+ Tk_PathName(slave), Tk_PathName(master)));
+ Tcl_SetErrorCode(interp, "TTK", "GEOMETRY", "MAINTAINABLE", NULL);
return 0;
}
diff --git a/generic/ttk/ttkNotebook.c b/generic/ttk/ttkNotebook.c
index 551f4a6..16a8bfe 100644
--- a/generic/ttk/ttkNotebook.c
+++ b/generic/ttk/ttkNotebook.c
@@ -727,9 +727,9 @@ static int AddTab(
}
#if 0 /* can't happen */
if (Ttk_SlaveIndex(nb->notebook.mgr, slaveWindow) >= 0) {
- Tcl_AppendResult(interp,
- Tk_PathName(slaveWindow), " already added",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s already added",
+ Tk_PathName(slaveWindow)));
+ Tcl_SetErrorCode(interp, "TTK", "NOTEBOOK", "PRESENT", NULL);
return TCL_ERROR;
}
#endif
@@ -859,10 +859,9 @@ static int GetTabIndex(
int status = FindTabIndex(interp, nb, objPtr, index_rtn);
if (status == TCL_OK && *index_rtn < 0) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp,
- "tab '", Tcl_GetString(objPtr), "' not found",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "tab '%s' not found", Tcl_GetString(objPtr)));
+ Tcl_SetErrorCode(interp, "TTK", "NOTEBOOK", "TAB", NULL);
status = TCL_ERROR;
}
return status;
@@ -1059,9 +1058,8 @@ static int NotebookIdentifyCommand(
if ( Tcl_GetIntFromObj(interp, objv[objc-2], &x) != TCL_OK
|| Tcl_GetIntFromObj(interp, objv[objc-1], &y) != TCL_OK
- || (objc == 5 &&
- Tcl_GetIndexFromObj(interp, objv[2], whatTable, "option", 0, &what)
- != TCL_OK)
+ || (objc == 5 && Tcl_GetIndexFromObjStruct(interp, objv[2], whatTable,
+ sizeof(char *), "option", 0, &what) != TCL_OK)
) {
return TCL_ERROR;
}
@@ -1082,7 +1080,8 @@ static int NotebookIdentifyCommand(
case IDENTIFY_ELEMENT:
if (element) {
const char *elementName = Ttk_ElementName(element);
- Tcl_SetObjResult(interp,Tcl_NewStringObj(elementName,-1));
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(elementName, -1));
}
break;
case IDENTIFY_TAB:
@@ -1173,10 +1172,10 @@ static int NotebookTabsCommand(
result = Tcl_NewListObj(0, NULL);
for (i = 0; i < Ttk_NumberSlaves(mgr); ++i) {
const char *pathName = Tk_PathName(Ttk_SlaveWindow(mgr,i));
- Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(pathName,-1));
+
+ Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(pathName,-1));
}
Tcl_SetObjResult(interp, result);
-
return TCL_OK;
}
diff --git a/generic/ttk/ttkPanedwindow.c b/generic/ttk/ttkPanedwindow.c
index b301372..adc2aef 100644
--- a/generic/ttk/ttkPanedwindow.c
+++ b/generic/ttk/ttkPanedwindow.c
@@ -157,7 +157,9 @@ static int ConfigurePane(
/* Sanity-check:
*/
if (pane->weight < 0) {
- Tcl_AppendResult(interp, "-weight must be nonnegative", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "-weight must be nonnegative", -1));
+ Tcl_SetErrorCode(interp, "TTK", "PANE", "WEIGHT", NULL);
goto error;
}
@@ -419,9 +421,9 @@ static int AddPane(
return TCL_ERROR;
}
if (Ttk_SlaveIndex(pw->paned.mgr, slaveWindow) >= 0) {
- Tcl_AppendResult(interp,
- Tk_PathName(slaveWindow), " already added",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s already added", Tk_PathName(slaveWindow)));
+ Tcl_SetErrorCode(interp, "TTK", "PANE", "PRESENT", NULL);
return TCL_ERROR;
}
@@ -729,9 +731,8 @@ static int PanedIdentifyCommand(
if ( Tcl_GetIntFromObj(interp, objv[objc-2], &x) != TCL_OK
|| Tcl_GetIntFromObj(interp, objv[objc-1], &y) != TCL_OK
- || (objc == 5 &&
- Tcl_GetIndexFromObj(interp, objv[2], whatTable, "option", 0, &what)
- != TCL_OK)
+ || (objc == 5 && Tcl_GetIndexFromObjStruct(interp, objv[2], whatTable,
+ sizeof(char *), "option", 0, &what) != TCL_OK)
) {
return TCL_ERROR;
}
@@ -844,9 +845,9 @@ static int PanedSashposCommand(
return TCL_ERROR;
}
if (sashIndex < 0 || sashIndex >= Ttk_NumberSlaves(pw->paned.mgr) - 1) {
- Tcl_AppendResult(interp,
- "sash index ", Tcl_GetString(objv[2]), " out of range",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "sash index %d out of range", sashIndex));
+ Tcl_SetErrorCode(interp, "TTK", "PANE", "SASH_INDEX", NULL);
return TCL_ERROR;
}
diff --git a/generic/ttk/ttkScroll.c b/generic/ttk/ttkScroll.c
index b670540..7ac4f14 100644
--- a/generic/ttk/ttkScroll.c
+++ b/generic/ttk/ttkScroll.c
@@ -7,7 +7,7 @@
*
* Scrollable interface:
*
- * + 'first' is controlled by [xy]view widget command
+ * + 'first' is controlled by [xy]view widget command
* and other scrolling commands like 'see';
* + 'total' depends on widget contents;
* + 'last' depends on first, total, and widget size.
@@ -16,15 +16,15 @@
*
* 1. User adjusts scrollbar, scrollbar widget calls its -command
* 2. Scrollbar -command invokes the scrollee [xy]view widget method
- * 3. TtkScrollviewCommand calls TtkScrollTo(), which updates
+ * 3. TtkScrollviewCommand calls TtkScrollTo(), which updates
* 'first' and schedules a redisplay.
- * 4. Once the scrollee knows 'total' and 'last' (typically in
- * the LayoutProc), call TtkScrolled(h,first,last,total) to
+ * 4. Once the scrollee knows 'total' and 'last' (typically in
+ * the LayoutProc), call TtkScrolled(h,first,last,total) to
* synchronize the scrollbar.
* 5. The scrollee -[xy]scrollcommand is called (in an idle callback)
* 6. Which calls the scrollbar 'set' method and redisplays the scrollbar.
*
- * If the scrollee has internal scrolling (e.g., a 'see' method),
+ * If the scrollee has internal scrolling (e.g., a 'see' method),
* it should TtkScrollTo() directly (step 2).
*
* If the widget value changes, it should call TtkScrolled() (step 4).
@@ -55,7 +55,7 @@ struct ScrollHandleRec
*/
ScrollHandle TtkCreateScrollHandle(WidgetCore *corePtr, Scrollable *scrollPtr)
{
- ScrollHandle h = (ScrollHandle)ckalloc(sizeof(*h));
+ ScrollHandle h = ckalloc(sizeof(*h));
h->flags = 0;
h->corePtr = corePtr;
@@ -130,7 +130,7 @@ static void UpdateScrollbarBG(ClientData clientData)
Tcl_Preserve((ClientData) interp);
code = UpdateScrollbar(interp, h);
if (code == TCL_ERROR && !Tcl_InterpDeleted(interp)) {
- Tcl_BackgroundError(interp);
+ Tcl_BackgroundException(interp, code);
}
Tcl_Release((ClientData) interp);
}
@@ -141,7 +141,7 @@ static void UpdateScrollbarBG(ClientData clientData)
void TtkScrolled(ScrollHandle h, int first, int last, int total)
{
Scrollable *s = h->scrollPtr;
-
+
/* Sanity-check inputs:
*/
if (total <= 0) {
@@ -253,6 +253,6 @@ void TtkFreeScrollHandle(ScrollHandle h)
if (h->flags & SCROLL_UPDATE_PENDING) {
Tcl_CancelIdleCall(UpdateScrollbarBG, (ClientData)h);
}
- ckfree((ClientData)h);
+ ckfree(h);
}
diff --git a/generic/ttk/ttkState.c b/generic/ttk/ttkState.c
index a71ae21..c34b900 100644
--- a/generic/ttk/ttkState.c
+++ b/generic/ttk/ttkState.c
@@ -98,8 +98,9 @@ static int StateSpecSetFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr)
if (stateNames[j] == 0) {
if (interp) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "Invalid state name ", stateName,NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Invalid state name %s", stateName));
+ Tcl_SetErrorCode(interp, "TTK", "VALUE", "STATE", NULL);
}
return TCL_ERROR;
}
@@ -216,8 +217,8 @@ Tcl_Obj *Ttk_StateMapLookup(
return specs[j+1];
}
if (interp) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "No match in state map", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("No match in state map", -1));
+ Tcl_SetErrorCode(interp, "TTK", "STATE", "UNMATCHED", NULL);
}
return NULL;
}
@@ -240,10 +241,11 @@ Ttk_StateMap Ttk_GetStateMapFromObj(
return NULL;
if (nSpecs % 2 != 0) {
- if (interp)
- Tcl_SetResult(interp,
- "State map must have an even number of elements",
- TCL_STATIC);
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "State map must have an even number of elements", -1));
+ Tcl_SetErrorCode(interp, "TTK", "VALUE", "STATEMAP", NULL);
+ }
return 0;
}
diff --git a/generic/ttk/ttkTagSet.c b/generic/ttk/ttkTagSet.c
index 9f2a87b..f2108b9 100644
--- a/generic/ttk/ttkTagSet.c
+++ b/generic/ttk/ttkTagSet.c
@@ -34,7 +34,7 @@ struct TtkTagTable {
*/
static Ttk_Tag NewTag(Ttk_TagTable tagTable, const char *tagName)
{
- Ttk_Tag tag = (Ttk_Tag)ckalloc(sizeof(*tag));
+ Ttk_Tag tag = ckalloc(sizeof(*tag));
tag->tagRecord = ckalloc(tagTable->recordSize);
memset(tag->tagRecord, 0, tagTable->recordSize);
/* Don't need Tk_InitOptions() here, all defaults should be NULL. */
@@ -47,7 +47,7 @@ static void DeleteTag(Ttk_TagTable tagTable, Ttk_Tag tag)
{
Tk_FreeConfigOptions(tag->tagRecord,tagTable->optionTable,tagTable->tkwin);
ckfree(tag->tagRecord);
- ckfree((void*)tag);
+ ckfree(tag);
}
/*------------------------------------------------------------------------
@@ -58,7 +58,7 @@ Ttk_TagTable Ttk_CreateTagTable(
Tcl_Interp *interp, Tk_Window tkwin,
Tk_OptionSpec optionSpecs[], int recordSize)
{
- Ttk_TagTable tagTable = (Ttk_TagTable)ckalloc(sizeof(*tagTable));
+ Ttk_TagTable tagTable = ckalloc(sizeof(*tagTable));
tagTable->tkwin = tkwin;
tagTable->optionSpecs = optionSpecs;
tagTable->optionTable = Tk_CreateOptionTable(interp, optionSpecs);
@@ -80,7 +80,7 @@ void Ttk_DeleteTagTable(Ttk_TagTable tagTable)
}
Tcl_DeleteHashTable(&tagTable->tags);
- ckfree((void*)tagTable);
+ ckfree(tagTable);
}
Ttk_Tag Ttk_GetTag(Ttk_TagTable tagTable, const char *tagName)
@@ -116,7 +116,7 @@ Ttk_Tag Ttk_GetTagFromObj(Ttk_TagTable tagTable, Tcl_Obj *objPtr)
Ttk_TagSet Ttk_GetTagSetFromObj(
Tcl_Interp *interp, Ttk_TagTable tagTable, Tcl_Obj *objPtr)
{
- Ttk_TagSet tagset = (Ttk_TagSet)(ckalloc(sizeof *tagset));
+ Ttk_TagSet tagset = ckalloc(sizeof(*tagset));
Tcl_Obj **objv;
int i, objc;
@@ -127,11 +127,11 @@ Ttk_TagSet Ttk_GetTagSetFromObj(
}
if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
- ckfree((ClientData)tagset);
+ ckfree(tagset);
return NULL;
}
- tagset->tags = (Ttk_Tag*)ckalloc((objc+1) * sizeof(Ttk_Tag));
+ tagset->tags = ckalloc((objc+1) * sizeof(Ttk_Tag));
for (i=0; i<objc; ++i) {
tagset->tags[i] = Ttk_GetTagFromObj(tagTable, objv[i]);
}
@@ -158,8 +158,8 @@ Tcl_Obj *Ttk_NewTagSetObj(Ttk_TagSet tagset)
void Ttk_FreeTagSet(Ttk_TagSet tagset)
{
- ckfree((ClientData)tagset->tags);
- ckfree((ClientData)tagset);
+ ckfree(tagset->tags);
+ ckfree(tagset);
}
/* Ttk_TagSetContains -- test if tag set contains a tag.
@@ -188,7 +188,7 @@ int Ttk_TagSetAdd(Ttk_TagSet tagset, Ttk_Tag tag)
return 0;
}
}
- tagset->tags = (void*)ckrealloc((void*)tagset->tags,
+ tagset->tags = ckrealloc(tagset->tags,
(tagset->nTags+1)*sizeof(tagset->tags[0]));
tagset->tags[tagset->nTags++] = tag;
return 1;
diff --git a/generic/ttk/ttkTheme.c b/generic/ttk/ttkTheme.c
index a2c51c0..2f95962 100644
--- a/generic/ttk/ttkTheme.c
+++ b/generic/ttk/ttkTheme.c
@@ -40,7 +40,7 @@ typedef struct Ttk_Style_
static Style *NewStyle()
{
- Style *stylePtr = (Style*)ckalloc(sizeof(Style));
+ Style *stylePtr = ckalloc(sizeof(Style));
stylePtr->styleName = NULL;
stylePtr->parentStyle = NULL;
@@ -75,7 +75,7 @@ static void FreeStyle(Style *stylePtr)
Ttk_FreeLayoutTemplate(stylePtr->layoutTemplate);
- ckfree((ClientData)stylePtr);
+ ckfree(stylePtr);
}
/*
@@ -179,7 +179,7 @@ static const Tk_OptionSpec *TTKGetOptionSpec(
static OptionMap
BuildOptionMap(Ttk_ElementClass *elementClass, Tk_OptionTable optionTable)
{
- OptionMap optionMap = (OptionMap)ckalloc(
+ OptionMap optionMap = ckalloc(
sizeof(const Tk_OptionSpec) * elementClass->nResources + 1);
int i;
@@ -221,8 +221,7 @@ GetOptionMap(Ttk_ElementClass *elementClass, Tk_OptionTable optionTable)
static Ttk_ElementClass *
NewElementClass(const char *name, Ttk_ElementSpec *specPtr,void *clientData)
{
- Ttk_ElementClass *elementClass =
- (Ttk_ElementClass*)ckalloc(sizeof(Ttk_ElementClass));
+ Ttk_ElementClass *elementClass = ckalloc(sizeof(Ttk_ElementClass));
int i;
elementClass->name = name;
@@ -238,7 +237,7 @@ NewElementClass(const char *name, Ttk_ElementSpec *specPtr,void *clientData)
/* Initialize default values:
*/
- elementClass->defaultValues = (Tcl_Obj**)
+ elementClass->defaultValues =
ckalloc(elementClass->nResources * sizeof(Tcl_Obj *) + 1);
for (i=0; i < elementClass->nResources; ++i) {
const char *defaultValue = specPtr->options[i].defaultValue;
@@ -275,7 +274,7 @@ static void FreeElementClass(Ttk_ElementClass *elementClass)
Tcl_DecrRefCount(elementClass->defaultValues[i]);
}
}
- ckfree((ClientData)elementClass->defaultValues);
+ ckfree(elementClass->defaultValues);
/*
* Free option map cache:
@@ -288,7 +287,7 @@ static void FreeElementClass(Ttk_ElementClass *elementClass)
Tcl_DeleteHashTable(&elementClass->optMapCache);
ckfree(elementClass->elementRecord);
- ckfree((ClientData)elementClass);
+ ckfree(elementClass);
}
/*------------------------------------------------------------------------
@@ -311,7 +310,7 @@ typedef struct Ttk_Theme_
static Theme *NewTheme(Ttk_ResourceCache cache, Ttk_Theme parent)
{
- Theme *themePtr = (Theme*)ckalloc(sizeof(Theme));
+ Theme *themePtr = ckalloc(sizeof(Theme));
Tcl_HashEntry *entryPtr;
int unused;
@@ -365,7 +364,7 @@ static void FreeTheme(Theme *themePtr)
/*
* Free theme record:
*/
- ckfree((ClientData)themePtr);
+ ckfree(themePtr);
return;
}
@@ -454,11 +453,11 @@ static void Ttk_StylePkgFree(ClientData clientData, Tcl_Interp *interp)
while (cleanup) {
Cleanup *next = cleanup->next;
cleanup->cleanupProc(cleanup->clientData);
- ckfree((ClientData)cleanup);
+ ckfree(cleanup);
cleanup = next;
}
- ckfree((ClientData)pkgPtr);
+ ckfree(pkgPtr);
}
/*
@@ -484,7 +483,7 @@ void Ttk_RegisterCleanup(
Tcl_Interp *interp, ClientData clientData, Ttk_CleanupProc *cleanupProc)
{
StylePackageData *pkgPtr = GetStylePackageData(interp);
- Cleanup *cleanup = (Cleanup*)ckalloc(sizeof(*cleanup));
+ Cleanup *cleanup = ckalloc(sizeof(*cleanup));
cleanup->clientData = clientData;
cleanup->cleanupProc = cleanupProc;
@@ -509,8 +508,9 @@ static void ThemeChangedProc(ClientData clientData)
static char ThemeChangedScript[] = "ttk::ThemeChanged";
StylePackageData *pkgPtr = clientData;
- if (Tcl_EvalEx(pkgPtr->interp, ThemeChangedScript, -1, TCL_EVAL_GLOBAL) != TCL_OK) {
- Tcl_BackgroundError(pkgPtr->interp);
+ int code = Tcl_EvalEx(pkgPtr->interp, ThemeChangedScript, -1, TCL_EVAL_GLOBAL);
+ if (code != TCL_OK) {
+ Tcl_BackgroundException(pkgPtr->interp, code);
}
pkgPtr->themeChangePending = 0;
}
@@ -549,8 +549,9 @@ Ttk_CreateTheme(
entryPtr = Tcl_CreateHashEntry(&pkgPtr->themeTable, name, &newEntry);
if (!newEntry) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "Theme ", name, " already exists", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Theme %s already exists", name));
+ Tcl_SetErrorCode(interp, "TTK", "THEME", "EXISTS", NULL);
return NULL;
}
@@ -592,8 +593,9 @@ static Ttk_Theme LookupTheme(
entryPtr = Tcl_FindHashEntry(&pkgPtr->themeTable, name);
if (!entryPtr) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "theme \"", name, "\" doesn't exist", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "theme \"%s\" doesn't exist", name));
+ Tcl_SetErrorCode(interp, "TTK", "LOOKUP", "THEME", name, NULL);
return NULL;
}
@@ -800,7 +802,7 @@ int Ttk_RegisterElementFactory(
Ttk_ElementFactory factory, void *clientData)
{
StylePackageData *pkgPtr = GetStylePackageData(interp);
- FactoryRec *recPtr = (FactoryRec*)ckalloc(sizeof(*recPtr));
+ FactoryRec *recPtr = ckalloc(sizeof(*recPtr));
Tcl_HashEntry *entryPtr;
int newEntry;
@@ -876,9 +878,10 @@ Ttk_ElementClass *Ttk_RegisterElement(
if (specPtr->version != TK_STYLE_VERSION_2) {
/* Version mismatch */
if (interp) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "Internal error: Ttk_RegisterElement (",
- name, "): invalid version",
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Internal error: Ttk_RegisterElement (%s): invalid version",
+ name));
+ Tcl_SetErrorCode(interp, "TTK", "REGISTER_ELEMENT", "VERSION",
NULL);
}
return 0;
@@ -888,7 +891,9 @@ Ttk_ElementClass *Ttk_RegisterElement(
if (!newEntry) {
if (interp) {
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "Duplicate element ", name, NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Duplicate element %s", name));
+ Tcl_SetErrorCode(interp, "TTK", "REGISTER_ELEMENT", "DUPE", NULL);
}
return 0;
}
@@ -1356,8 +1361,9 @@ static int StyleThemeCurrentCmd(
}
if (name == NULL) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("error: failed to get theme name", -1));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "error: failed to get theme name", -1));
+ Tcl_SetErrorCode(interp, "TTK", "THEME", "NAMELESS", NULL);
return TCL_ERROR;
}
@@ -1388,8 +1394,8 @@ static int StyleThemeCreateCmd(
for (i=4; i < objc; i +=2) {
int option;
- if (Tcl_GetIndexFromObj(
- interp, objv[i], optStrings, "option", 0, &option) != TCL_OK)
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], optStrings,
+ sizeof(char *), "option", 0, &option) != TCL_OK)
{
return TCL_ERROR;
}
@@ -1492,7 +1498,10 @@ static int StyleElementCreateCmd(
entryPtr = Tcl_FindHashEntry(&pkgPtr->factoryTable, factoryName);
if (!entryPtr) {
- Tcl_AppendResult(interp, "No such element type ", factoryName, NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "No such element type %s", factoryName));
+ Tcl_SetErrorCode(interp, "TTK", "LOOKUP", "ELEMENT_TYPE", factoryName,
+ NULL);
return TCL_ERROR;
}
@@ -1551,7 +1560,9 @@ static int StyleElementOptionsCmd(
return TCL_OK;
}
- Tcl_AppendResult(interp, "element ", elementName, " not found", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "element %s not found", elementName));
+ Tcl_SetErrorCode(interp, "TTK", "LOOKUP", "ELEMENT", elementName, NULL);
return TCL_ERROR;
}
@@ -1575,7 +1586,10 @@ static int StyleLayoutCmd(
if (objc == 3) {
layoutTemplate = Ttk_FindLayoutTemplate(theme, layoutName);
if (!layoutTemplate) {
- Tcl_AppendResult(interp, "Layout ", layoutName, " not found", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Layout %s not found", layoutName));
+ Tcl_SetErrorCode(interp, "TTK", "LOOKUP", "LAYOUT", layoutName,
+ NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Ttk_UnparseLayoutTemplate(layoutTemplate));
@@ -1660,7 +1674,7 @@ StyleObjCmd(
return Ttk_InvokeEnsemble(StyleEnsemble, 1, clientData,interp,objc,objv);
}
-MODULE_SCOPE
+MODULE_SCOPE
int Ttk_InvokeEnsemble( /* Run an ensemble command */
const Ttk_Ensemble *ensemble, int cmdIndex,
void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
@@ -1695,8 +1709,7 @@ void Ttk_StylePkgInit(Tcl_Interp *interp)
{
Tcl_Namespace *nsPtr;
- StylePackageData *pkgPtr = (StylePackageData *)
- ckalloc(sizeof(StylePackageData));
+ StylePackageData *pkgPtr = ckalloc(sizeof(StylePackageData));
pkgPtr->interp = interp;
Tcl_InitHashTable(&pkgPtr->themeTable, TCL_STRING_KEYS);
diff --git a/generic/ttk/ttkTrace.c b/generic/ttk/ttkTrace.c
index 8bc8519..6cd6061 100644
--- a/generic/ttk/ttkTrace.c
+++ b/generic/ttk/ttkTrace.c
@@ -54,7 +54,7 @@ VarTraceProc(
ckfree((ClientData)tracePtr);
return NULL;
}
- Tcl_TraceVar(interp, name,
+ Tcl_TraceVar2(interp, name, NULL,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
VarTraceProc, clientData);
tracePtr->callback(tracePtr->clientData, NULL);
@@ -85,7 +85,7 @@ Ttk_TraceHandle *Ttk_TraceVariable(
Ttk_TraceProc callback,
void *clientData)
{
- Ttk_TraceHandle *h = (Ttk_TraceHandle*)ckalloc(sizeof(*h));
+ Ttk_TraceHandle *h = ckalloc(sizeof(*h));
int status;
h->interp = interp;
@@ -94,13 +94,13 @@ Ttk_TraceHandle *Ttk_TraceVariable(
h->clientData = clientData;
h->callback = callback;
- status = Tcl_TraceVar(interp, Tcl_GetString(varnameObj),
- TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ status = Tcl_TraceVar2(interp, Tcl_GetString(varnameObj),
+ NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
VarTraceProc, (ClientData)h);
if (status != TCL_OK) {
Tcl_DecrRefCount(h->varnameObj);
- ckfree((ClientData)h);
+ ckfree(h);
return NULL;
}
@@ -154,7 +154,7 @@ void Ttk_UntraceVariable(Ttk_TraceHandle *h)
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
VarTraceProc, (ClientData)h);
Tcl_DecrRefCount(h->varnameObj);
- ckfree((ClientData)h);
+ ckfree(h);
}
}
diff --git a/generic/ttk/ttkTrack.c b/generic/ttk/ttkTrack.c
index 9cf8267..396b073 100644
--- a/generic/ttk/ttkTrack.c
+++ b/generic/ttk/ttkTrack.c
@@ -173,7 +173,7 @@ ElementStateEventProc(ClientData clientData, XEvent *ev)
void TtkTrackElementState(WidgetCore *corePtr)
{
- ElementStateTracker *es = (ElementStateTracker*)ckalloc(sizeof(*es));
+ ElementStateTracker *es = ckalloc(sizeof(*es));
es->corePtr = corePtr;
es->tracking = 0;
es->activeElement = es->pressedElement = 0;
diff --git a/generic/ttk/ttkTreeview.c b/generic/ttk/ttkTreeview.c
index 862c7f6..c1ecf38 100644
--- a/generic/ttk/ttkTreeview.c
+++ b/generic/ttk/ttkTreeview.c
@@ -86,7 +86,7 @@ static Tk_OptionSpec ItemOptionSpecs[] = {
*/
static TreeItem *NewItem(void)
{
- TreeItem *item = (TreeItem*)ckalloc(sizeof(*item));
+ TreeItem *item = ckalloc(sizeof(*item));
item->entryPtr = 0;
item->parent = item->children = item->next = item->prev = NULL;
@@ -118,7 +118,7 @@ static void FreeItem(TreeItem *item)
if (item->tagset) { Ttk_FreeTagSet(item->tagset); }
if (item->imagespec) { TtkFreeImageSpec(item->imagespec); }
- ckfree((ClientData)item);
+ ckfree(item);
}
static void FreeItemCB(void *clientData) { FreeItem(clientData); }
@@ -340,8 +340,8 @@ static int GetEnumSetFromObj(
for (i = 0; i < objc; ++i) {
int index;
- if (TCL_OK != Tcl_GetIndexFromObj(
- interp, objv[i], table, "value", TCL_EXACT, &index))
+ if (TCL_OK != Tcl_GetIndexFromObjStruct(interp, objv[i], table,
+ sizeof(char *), "value", TCL_EXACT, &index))
{
return TCL_ERROR;
}
@@ -534,21 +534,18 @@ static TreeColumn *GetColumn(
*/
if (Tcl_GetIntFromObj(NULL, columnIDObj, &columnIndex) == TCL_OK) {
if (columnIndex < 0 || columnIndex >= tv->tree.nColumns) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp,
- "Column index ",
- Tcl_GetString(columnIDObj),
- " out of bounds",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Column index %s out of bounds",
+ Tcl_GetString(columnIDObj)));
+ Tcl_SetErrorCode(interp, "TTK", "TREE", "COLBOUND", NULL);
return NULL;
}
return tv->tree.columns + columnIndex;
}
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp,
- "Invalid column index ", Tcl_GetString(columnIDObj),
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Invalid column index %s", Tcl_GetString(columnIDObj)));
+ Tcl_SetErrorCode(interp, "TTK", "TREE", "COLUMN", NULL);
return NULL;
}
@@ -566,10 +563,9 @@ static TreeColumn *FindColumn(
return tv->tree.displayColumns[colno];
}
/* else */
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp,
- "Column ", Tcl_GetString(columnIDObj), " out of range",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Column %s out of range", Tcl_GetString(columnIDObj)));
+ Tcl_SetErrorCode(interp, "TTK", "TREE", "COLUMN", NULL);
return NULL;
}
@@ -587,8 +583,9 @@ static TreeItem *FindItem(
Tcl_HashEntry *entryPtr = Tcl_FindHashEntry(&tv->tree.items, itemName);
if (!entryPtr) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "Item ", itemName, " not found", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Item %s not found", itemName));
+ Tcl_SetErrorCode(interp, "TTK", "TREE", "ITEM", NULL);
return 0;
}
return Tcl_GetHashValue(entryPtr);
@@ -612,11 +609,11 @@ static TreeItem **GetItemListFromObj(
return NULL;
}
- items = (TreeItem**)ckalloc((nElements + 1)*sizeof(TreeItem*));
+ items = ckalloc((nElements + 1)*sizeof(TreeItem*));
for (i = 0; i < nElements; ++i) {
items[i] = FindItem(interp, tv, elements[i]);
if (!items[i]) {
- ckfree((ClientData)items);
+ ckfree(items);
return NULL;
}
}
@@ -658,7 +655,7 @@ static void TreeviewFreeColumns(Treeview *tv)
if (tv->tree.columns) {
for (i = 0; i < tv->tree.nColumns; ++i)
FreeColumn(tv->tree.columns + i);
- ckfree((ClientData)tv->tree.columns);
+ ckfree(tv->tree.columns);
tv->tree.columns = 0;
}
}
@@ -687,8 +684,7 @@ static int TreeviewInitColumns(Tcl_Interp *interp, Treeview *tv)
* Initialize columns array and columnNames hash table:
*/
tv->tree.nColumns = ncols;
- tv->tree.columns =
- (TreeColumn*)ckalloc(tv->tree.nColumns * sizeof(TreeColumn));
+ tv->tree.columns = ckalloc(tv->tree.nColumns * sizeof(TreeColumn));
for (i = 0; i < ncols; ++i) {
int isNew;
@@ -733,16 +729,16 @@ static int TreeviewInitDisplayColumns(Tcl_Interp *interp, Treeview *tv)
if (!strcmp(Tcl_GetString(tv->tree.displayColumnsObj), "#all")) {
ndcols = tv->tree.nColumns;
- displayColumns = (TreeColumn**)ckalloc((ndcols+1)*sizeof(TreeColumn*));
+ displayColumns = ckalloc((ndcols+1) * sizeof(TreeColumn*));
for (index = 0; index < ndcols; ++index) {
displayColumns[index+1] = tv->tree.columns + index;
}
} else {
- displayColumns = (TreeColumn**)ckalloc((ndcols+1)*sizeof(TreeColumn*));
+ displayColumns = ckalloc((ndcols+1) * sizeof(TreeColumn*));
for (index = 0; index < ndcols; ++index) {
displayColumns[index+1] = GetColumn(interp, tv, dcolumns[index]);
if (!displayColumns[index+1]) {
- ckfree((ClientData)displayColumns);
+ ckfree(displayColumns);
return TCL_ERROR;
}
}
@@ -750,7 +746,7 @@ static int TreeviewInitDisplayColumns(Tcl_Interp *interp, Treeview *tv)
displayColumns[0] = &tv->tree.column0;
if (tv->tree.displayColumns)
- ckfree((ClientData)tv->tree.displayColumns);
+ ckfree(tv->tree.displayColumns);
tv->tree.displayColumns = displayColumns;
tv->tree.nDisplayColumns = ndcols + 1;
@@ -1223,8 +1219,9 @@ static int ConfigureColumn(
}
if (mask & READONLY_OPTION) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "Attempt to change read-only option", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "Attempt to change read-only option", -1));
+ Tcl_SetErrorCode(interp, "TTK", "TREE", "READONLY", NULL);
goto error;
}
@@ -1913,11 +1910,10 @@ static int AncestryCheck(
TreeItem *p = parent;
while (p) {
if (p == item) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp,
- "Cannot insert ", ItemName(tv, item),
- " as a descendant of ", ItemName(tv, parent),
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Cannot insert %s as descendant of %s",
+ ItemName(tv, item), ItemName(tv, parent)));
+ Tcl_SetErrorCode(interp, "TTK", "TREE", "ANCESTRY", NULL);
return 0;
}
p = p->parent;
@@ -1986,7 +1982,7 @@ static int TreeviewChildrenCommand(
*/
for (i=0; newChildren[i]; ++i) {
if (!AncestryCheck(interp, tv, newChildren[i], item)) {
- ckfree((ClientData)newChildren);
+ ckfree(newChildren);
return TCL_ERROR;
}
}
@@ -2022,7 +2018,7 @@ static int TreeviewChildrenCommand(
child = newChildren[i];
}
- ckfree((ClientData)newChildren);
+ ckfree(newChildren);
TtkRedisplayWidget(&tv->core);
}
@@ -2291,8 +2287,8 @@ static int TreeviewIdentifyCommand(
return TCL_ERROR;
}
- if ( Tcl_GetIndexFromObj(interp, objv[2],
- submethodStrings, "command", TCL_EXACT, &submethod) != TCL_OK
+ if (Tcl_GetIndexFromObjStruct(interp, objv[2], submethodStrings,
+ sizeof(char *), "command", TCL_EXACT, &submethod) != TCL_OK
|| Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK
|| Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK
) {
@@ -2319,9 +2315,7 @@ static int TreeviewIdentifyCommand(
case I_COLUMN :
if (colno >= 0) {
- char dcolbuf[16];
- sprintf(dcolbuf, "#%d", colno);
- Tcl_SetObjResult(interp, Tcl_NewStringObj(dcolbuf, -1));
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("#%d", colno));
}
break;
@@ -2489,9 +2483,9 @@ static int TreeviewSetCommand(
for (columnNumber=0; columnNumber<tv->tree.nColumns; ++columnNumber) {
Tcl_ListObjIndex(interp, item->valuesObj, columnNumber, &value);
if (value) {
- Tcl_ListObjAppendElement(interp, result,
+ Tcl_ListObjAppendElement(NULL, result,
tv->tree.columns[columnNumber].idObj);
- Tcl_ListObjAppendElement(interp, result, value);
+ Tcl_ListObjAppendElement(NULL, result, value);
}
}
Tcl_SetObjResult(interp, result);
@@ -2505,7 +2499,9 @@ static int TreeviewSetCommand(
if (column == &tv->tree.column0) {
/* @@@ Maybe set -text here instead? */
- Tcl_AppendResult(interp, "Display column #0 cannot be set", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "Display column #0 cannot be set", -1));
+ Tcl_SetErrorCode(interp, "TTK", "TREE", "COLUMN_0", NULL);
return TCL_ERROR;
}
@@ -2588,9 +2584,12 @@ static int TreeviewInsertCommand(
objc -= 4; objv += 4;
if (objc >= 2 && !strcmp("-id", Tcl_GetString(objv[0]))) {
const char *itemName = Tcl_GetString(objv[1]);
+
entryPtr = Tcl_CreateHashEntry(&tv->tree.items, itemName, &isNew);
if (!isNew) {
- Tcl_AppendResult(interp, "Item ",itemName," already exists",NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Item %s already exists", itemName));
+ Tcl_SetErrorCode(interp, "TTK", "TREE", "ITEM_EXISTS", NULL);
return TCL_ERROR;
}
objc -= 2; objv += 2;
@@ -2647,8 +2646,10 @@ static int TreeviewDetachCommand(
/* Sanity-check */
for (i = 0; items[i]; ++i) {
if (items[i] == tv->tree.root) {
- Tcl_AppendResult(interp, "Cannot detach root item", NULL);
- ckfree((ClientData)items);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "Cannot detach root item", -1));
+ Tcl_SetErrorCode(interp, "TTK", "TREE", "ROOT", NULL);
+ ckfree(items);
return TCL_ERROR;
}
}
@@ -2658,7 +2659,7 @@ static int TreeviewDetachCommand(
}
TtkRedisplayWidget(&tv->core);
- ckfree((ClientData)items);
+ ckfree(items);
return TCL_OK;
}
@@ -2694,8 +2695,10 @@ static int TreeviewDeleteCommand(
*/
for (i=0; items[i]; ++i) {
if (items[i] == tv->tree.root) {
- ckfree((ClientData)items);
- Tcl_AppendResult(interp, "Cannot delete root item", NULL);
+ ckfree(items);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "Cannot delete root item", -1));
+ Tcl_SetErrorCode(interp, "TTK", "TREE", "ROOT", NULL);
return TCL_ERROR;
}
}
@@ -2719,7 +2722,7 @@ static int TreeviewDeleteCommand(
delq = next;
}
- ckfree((ClientData)items);
+ ckfree(items);
TtkRedisplayWidget(&tv->core);
return TCL_OK;
}
@@ -2886,10 +2889,9 @@ static int TreeviewDragCommand(
left = right;
}
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp,
- "column ", Tcl_GetString(objv[2]), " is not displayed",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "column %s is not displayed", Tcl_GetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TTK", "TREE", "COLUMN_INVISIBLE", NULL);
return TCL_ERROR;
}
@@ -2953,9 +2955,8 @@ static int TreeviewSelectionCommand(
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[2], selopStrings,
- "selection operation", 0, &selop) != TCL_OK)
- {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[2], selopStrings,
+ sizeof(char *), "selection operation", 0, &selop) != TCL_OK) {
return TCL_ERROR;
}
@@ -2988,7 +2989,7 @@ static int TreeviewSelectionCommand(
break;
}
- ckfree((ClientData)items);
+ ckfree(items);
TtkSendVirtualEvent(tv->core.tkwin, "TreeviewSelect");
TtkRedisplayWidget(&tv->core);
@@ -3041,10 +3042,10 @@ static int TreeviewTagBindCommand(
*/
if (mask & (~TreeviewBindEventMask)) {
Tk_DeleteBinding(interp, bindingTable, tag, sequence);
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "unsupported event ", sequence,
- "\nonly key, button, motion, and virtual events supported",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unsupported event %s\nonly key, button, motion, and"
+ " virtual events supported", sequence));
+ Tcl_SetErrorCode(interp, "TTK", "TREE", "BIND_EVENTS", NULL);
return TCL_ERROR;
}
}
diff --git a/generic/ttk/ttkWidget.c b/generic/ttk/ttkWidget.c
index d5e0484..c50efc5 100644
--- a/generic/ttk/ttkWidget.c
+++ b/generic/ttk/ttkWidget.c
@@ -198,7 +198,7 @@ WidgetInstanceObjCmdDeleted(ClientData clientData)
* Final cleanup for widget; called via Tcl_EventuallyFree().
*/
static void
-FreeWidget(char *memPtr)
+FreeWidget(void *memPtr)
{
ckfree(memPtr);
}
@@ -231,7 +231,7 @@ DestroyWidget(WidgetCore *corePtr)
/* NB: this can reenter the interpreter via a command traces */
Tcl_DeleteCommandFromToken(corePtr->interp, cmd);
}
- Tcl_EventuallyFree(corePtr, FreeWidget);
+ Tcl_EventuallyFree(corePtr, (Tcl_FreeProc *) FreeWidget);
}
/*
@@ -440,7 +440,8 @@ int TtkWidgetConstructorObjCmd(
error:
if (WidgetDestroyed(corePtr)) {
- Tcl_SetResult(interp, "Widget has been destroyed", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "widget has been destroyed", -1));
} else {
Tk_DestroyWindow(tkwin);
}
@@ -634,8 +635,8 @@ int TtkWidgetConfigureCommand(
return status;
if (mask & READONLY_OPTION) {
- Tcl_SetResult(interp,
- "Attempt to change read-only option", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to change read-only option", -1));
Tk_RestoreSavedOptions(&savedOptions);
return TCL_ERROR;
}
@@ -649,7 +650,8 @@ int TtkWidgetConfigureCommand(
status = corePtr->widgetSpec->postConfigureProc(interp,recordPtr,mask);
if (WidgetDestroyed(corePtr)) {
- Tcl_SetResult(interp, "Widget has been destroyed", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "widget has been destroyed", -1));
status = TCL_ERROR;
}
if (status != TCL_OK) {
@@ -764,8 +766,8 @@ int TtkWidgetIdentifyCommand(
}
if (objc == 5) {
/* $w identify element $x $y */
- if (Tcl_GetIndexFromObj(interp,objv[2],whatTable,"option",0,&what)
- != TCL_OK)
+ if (Tcl_GetIndexFromObjStruct(interp, objv[2], whatTable,
+ sizeof(char *), "option", 0, &what) != TCL_OK)
{
return TCL_ERROR;
}
generated by cgit v0.12 at 2024-11-18 16:03:18 (GMT)