summaryrefslogtreecommitdiffstats
path: root/generic/tkTest.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tkTest.c')
-rw-r--r--generic/tkTest.c373
1 files changed, 124 insertions, 249 deletions
diff --git a/generic/tkTest.c b/generic/tkTest.c
index 9fe2222..88c50fa 100644
--- a/generic/tkTest.c
+++ b/generic/tkTest.c
@@ -14,6 +14,13 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
+#undef STATIC_BUILD
+#ifndef USE_TCL_STUBS
+# define USE_TCL_STUBS
+#endif
+#ifndef USE_TK_STUBS
+# define USE_TK_STUBS
+#endif
#include "tkInt.h"
#include "tkText.h"
@@ -31,6 +38,15 @@
#endif
/*
+ * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
+ * Tcltest_Init declaration is in the source file itself, which is only
+ * accessed when we are building a library.
+ */
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLEXPORT
+EXTERN int Tktest_Init(Tcl_Interp *interp);
+/*
* The following data structure represents the master for a test image:
*/
@@ -59,8 +75,8 @@ typedef struct TImageInstance {
*/
static int ImageCreate(Tcl_Interp *interp,
- char *name, int argc, Tcl_Obj *const objv[],
- Tk_ImageType *typePtr, Tk_ImageMaster master,
+ const char *name, int argc, Tcl_Obj *const objv[],
+ const Tk_ImageType *typePtr, Tk_ImageMaster master,
ClientData *clientDataPtr);
static ClientData ImageGet(Tk_Window tkwin, ClientData clientData);
static void ImageDisplay(ClientData clientData,
@@ -79,7 +95,8 @@ static Tk_ImageType imageType = {
ImageFree, /* freeProc */
ImageDelete, /* deleteProc */
NULL, /* postscriptPtr */
- NULL /* nextPtr */
+ NULL, /* nextPtr */
+ NULL
};
/*
@@ -96,25 +113,11 @@ typedef struct NewApp {
static NewApp *newAppPtr = NULL;/* First in list of all new interpreters. */
/*
- * Declaration for the square widget's class command function:
- */
-
-extern int SquareObjCmd(ClientData clientData,
- Tcl_Interp *interp, int objc,
- Tcl_Obj * const objv[]);
-
-typedef struct CBinding {
- Tcl_Interp *interp;
- char *command;
- char *delete;
-} CBinding;
-
-/*
* Header for trivial configuration command items.
*/
-#define ODD TK_CONFIG_USER_BIT
-#define EVEN (TK_CONFIG_USER_BIT << 1)
+#define ODD TK_CONFIG_USER_BIT
+#define EVEN (TK_CONFIG_USER_BIT << 1)
enum {
NONE,
@@ -136,15 +139,8 @@ typedef struct TrivialCommandHeader {
* Forward declarations for functions defined later in this file:
*/
-static int CBindingEvalProc(ClientData clientData,
- Tcl_Interp *interp, XEvent *eventPtr,
- Tk_Window tkwin, KeySym keySym);
-static void CBindingFreeProc(ClientData clientData);
-int Tktest_Init(Tcl_Interp *interp);
static int ImageCmd(ClientData dummy,
Tcl_Interp *interp, int argc, const char **argv);
-static int TestcbindCmd(ClientData dummy,
- Tcl_Interp *interp, int argc, const char **argv);
static int TestbitmapObjCmd(ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj * const objv[]);
@@ -200,21 +196,6 @@ static int TrivialConfigObjCmd(ClientData dummy,
Tcl_Obj * const objv[]);
static void TrivialEventProc(ClientData clientData,
XEvent *eventPtr);
-
-/*
- * External (platform specific) initialization routine:
- */
-
-#if !(defined(__WIN32__) || defined(MAC_OSX_TK))
-#define TkplatformtestInit(x) TCL_OK
-#else
-MODULE_SCOPE int TkplatformtestInit(Tcl_Interp *interp);
-#endif
-
-/*
- * External legacy testing initialization routine:
- */
-MODULE_SCOPE int TkOldTestInit(Tcl_Interp *interp);
/*
*----------------------------------------------------------------------
@@ -239,6 +220,13 @@ Tktest_Init(
{
static int initialized = 0;
+ if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
+ return TCL_ERROR;
+ }
+ if (Tk_InitStubs(interp, TK_VERSION, 0) == NULL) {
+ return TCL_ERROR;
+ }
+
/*
* Create additional commands for testing Tk.
*/
@@ -247,10 +235,7 @@ Tktest_Init(
return TCL_ERROR;
}
- Tcl_CreateObjCommand(interp, "square", SquareObjCmd,
- (ClientData) NULL, NULL);
- Tcl_CreateCommand(interp, "testcbind", TestcbindCmd,
- (ClientData) Tk_MainWindow(interp), NULL);
+ Tcl_CreateObjCommand(interp, "square", SquareObjCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testbitmap", TestbitmapObjCmd,
(ClientData) Tk_MainWindow(interp), NULL);
Tcl_CreateObjCommand(interp, "testborder", TestborderObjCmd,
@@ -313,113 +298,6 @@ Tktest_Init(
/*
*----------------------------------------------------------------------
*
- * TestcbindCmd --
- *
- * This function implements the "testcbinding" command. It provides a set
- * of functions for testing C bindings in tkBind.c.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * Depends on option; see below.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TestcbindCmd(
- ClientData clientData, /* Main window for application. */
- Tcl_Interp *interp, /* Current interpreter. */
- int argc, /* Number of arguments. */
- const char **argv) /* Argument strings. */
-{
- TkWindow *winPtr;
- Tk_Window tkwin;
- ClientData object;
- CBinding *cbindPtr;
-
-
- if (argc < 4 || argc > 5) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " bindtag pattern command ?deletecommand?", NULL);
- return TCL_ERROR;
- }
-
- tkwin = (Tk_Window) clientData;
-
- if (argv[1][0] == '.') {
- winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[1], tkwin);
- if (winPtr == NULL) {
- return TCL_ERROR;
- }
- object = (ClientData) winPtr->pathName;
- } else {
- winPtr = (TkWindow *) clientData;
- object = (ClientData) Tk_GetUid(argv[1]);
- }
-
- if (argv[3][0] == '\0') {
- return Tk_DeleteBinding(interp, winPtr->mainPtr->bindingTable,
- object, argv[2]);
- }
-
- cbindPtr = (CBinding *) ckalloc(sizeof(CBinding));
- cbindPtr->interp = interp;
- cbindPtr->command =
- strcpy((char *) ckalloc(strlen(argv[3]) + 1), argv[3]);
- if (argc == 4) {
- cbindPtr->delete = NULL;
- } else {
- cbindPtr->delete =
- strcpy((char *) ckalloc(strlen(argv[4]) + 1), argv[4]);
- }
-
- if (TkCreateBindingProcedure(interp, winPtr->mainPtr->bindingTable,
- object, argv[2], CBindingEvalProc, CBindingFreeProc,
- (ClientData) cbindPtr) == 0) {
- ckfree((char *) cbindPtr->command);
- if (cbindPtr->delete != NULL) {
- ckfree((char *) cbindPtr->delete);
- }
- ckfree((char *) cbindPtr);
- return TCL_ERROR;
- }
- return TCL_OK;
-}
-
-static int
-CBindingEvalProc(
- ClientData clientData,
- Tcl_Interp *interp,
- XEvent *eventPtr,
- Tk_Window tkwin,
- KeySym keySym)
-{
- CBinding *cbindPtr;
-
- cbindPtr = (CBinding *) clientData;
-
- return Tcl_EvalEx(interp, cbindPtr->command, -1, TCL_EVAL_GLOBAL);
-}
-
-static void
-CBindingFreeProc(
- ClientData clientData)
-{
- CBinding *cbindPtr = (CBinding *) clientData;
-
- if (cbindPtr->delete != NULL) {
- Tcl_EvalEx(cbindPtr->interp, cbindPtr->delete, -1, TCL_EVAL_GLOBAL);
- ckfree((char *) cbindPtr->delete);
- }
- ckfree((char *) cbindPtr->command);
- ckfree((char *) cbindPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
* TestbitmapObjCmd --
*
* This function implements the "testbitmap" command, which is used to
@@ -586,7 +464,7 @@ TestdeleteappsCmd(
while (newAppPtr != NULL) {
nextPtr = newAppPtr->nextPtr;
Tcl_DeleteInterp(newAppPtr->interp);
- ckfree((char *) newAppPtr);
+ ckfree(newAppPtr);
newAppPtr = nextPtr;
}
@@ -618,7 +496,7 @@ TestobjconfigObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- static const char *options[] = {
+ static const char *const options[] = {
"alltypes", "chain1", "chain2", "configerror", "delete", "info",
"internal", "new", "notenoughparams", "twowindows", NULL
};
@@ -637,7 +515,7 @@ TestobjconfigObjCmd(
CustomOptionGet,
CustomOptionRestore,
CustomOptionFree,
- (ClientData) 1
+ INT2PTR(1)
};
Tk_Window mainWin = (Tk_Window) clientData;
Tk_Window tkwin;
@@ -658,10 +536,10 @@ TestobjconfigObjCmd(
} ExtensionWidgetRecord;
static const Tk_OptionSpec baseSpecs[] = {
{TK_OPTION_STRING, "-one", "one", "One", "one",
- Tk_Offset(ExtensionWidgetRecord, base1ObjPtr), -1},
+ Tk_Offset(ExtensionWidgetRecord, base1ObjPtr), -1, 0, NULL, 0},
{TK_OPTION_STRING, "-two", "two", "Two", "two",
- Tk_Offset(ExtensionWidgetRecord, base2ObjPtr), -1},
- {TK_OPTION_END}
+ Tk_Offset(ExtensionWidgetRecord, base2ObjPtr), -1, 0, NULL, 0},
+ {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0}
};
if (objc < 2) {
@@ -669,8 +547,8 @@ TestobjconfigObjCmd(
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[1], options, "command", 0, &index)
- != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], options,
+ sizeof(char *), "command", 0, &index)!= TCL_OK) {
return TCL_ERROR;
}
@@ -697,7 +575,7 @@ TestobjconfigObjCmd(
Tcl_Obj *customPtr;
} TypesRecord;
TypesRecord *recordPtr;
- static const char *stringTable[] = {
+ static const char *const stringTable[] = {
"one", "two", "three", "four", NULL
};
static const Tk_OptionSpec typesSpecs[] = {
@@ -713,10 +591,10 @@ TestobjconfigObjCmd(
{TK_OPTION_STRING_TABLE,
"-stringtable", "StringTable", "stringTable",
"one", Tk_Offset(TypesRecord, stringTablePtr), -1,
- TK_CONFIG_NULL_OK, (ClientData) stringTable, 0x10},
+ TK_CONFIG_NULL_OK, stringTable, 0x10},
{TK_OPTION_COLOR, "-color", "color", "Color",
"red", Tk_Offset(TypesRecord, colorPtr), -1,
- TK_CONFIG_NULL_OK, (ClientData) "black", 0x20},
+ TK_CONFIG_NULL_OK, "black", 0x20},
{TK_OPTION_FONT, "-font", "font", "Font", "Helvetica 12",
Tk_Offset(TypesRecord, fontPtr), -1,
TK_CONFIG_NULL_OK, 0, 0x40},
@@ -725,7 +603,7 @@ TestobjconfigObjCmd(
TK_CONFIG_NULL_OK, 0, 0x80},
{TK_OPTION_BORDER, "-border", "border", "Border",
"blue", Tk_Offset(TypesRecord, borderPtr), -1,
- TK_CONFIG_NULL_OK, (ClientData) "white", 0x100},
+ TK_CONFIG_NULL_OK, "white", 0x100},
{TK_OPTION_RELIEF, "-relief", "relief", "Relief", "raised",
Tk_Offset(TypesRecord, reliefPtr), -1,
TK_CONFIG_NULL_OK, 0, 0x200},
@@ -743,10 +621,10 @@ TestobjconfigObjCmd(
TK_CONFIG_NULL_OK, 0, 0x2000},
{TK_OPTION_CUSTOM, "-custom", NULL, NULL,
"", Tk_Offset(TypesRecord, customPtr), -1,
- TK_CONFIG_NULL_OK, (ClientData)&CustomOption, 0x4000},
+ TK_CONFIG_NULL_OK, &CustomOption, 0x4000},
{TK_OPTION_SYNONYM, "-synonym", NULL, NULL,
- NULL, 0, -1, 0, (ClientData) "-color", 0x8000},
- {TK_OPTION_END}
+ NULL, 0, -1, 0, "-color", 0x8000},
+ {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0}
};
Tk_OptionTable optionTable;
Tk_Window tkwin;
@@ -760,7 +638,7 @@ TestobjconfigObjCmd(
}
Tk_SetClass(tkwin, "Test");
- recordPtr = (TypesRecord *) ckalloc(sizeof(TypesRecord));
+ recordPtr = ckalloc(sizeof(TypesRecord));
recordPtr->header.interp = interp;
recordPtr->header.optionTable = optionTable;
recordPtr->header.tkwin = tkwin;
@@ -795,7 +673,7 @@ TestobjconfigObjCmd(
}
} else {
Tk_DestroyWindow(tkwin);
- ckfree((char *) recordPtr);
+ ckfree(recordPtr);
}
if (result == TCL_OK) {
Tcl_SetObjResult(interp, objv[2]);
@@ -817,8 +695,7 @@ TestobjconfigObjCmd(
optionTable = Tk_CreateOptionTable(interp, baseSpecs);
tables[index] = optionTable;
- recordPtr = (ExtensionWidgetRecord *)
- ckalloc(sizeof(ExtensionWidgetRecord));
+ recordPtr = ckalloc(sizeof(ExtensionWidgetRecord));
recordPtr->header.interp = interp;
recordPtr->header.optionTable = optionTable;
recordPtr->header.tkwin = tkwin;
@@ -847,16 +724,16 @@ TestobjconfigObjCmd(
ExtensionWidgetRecord *recordPtr;
static const Tk_OptionSpec extensionSpecs[] = {
{TK_OPTION_STRING, "-three", "three", "Three", "three",
- Tk_Offset(ExtensionWidgetRecord, extension3ObjPtr), -1},
+ Tk_Offset(ExtensionWidgetRecord, extension3ObjPtr), -1, 0, NULL, 0},
{TK_OPTION_STRING, "-four", "four", "Four", "four",
- Tk_Offset(ExtensionWidgetRecord, extension4ObjPtr), -1},
+ Tk_Offset(ExtensionWidgetRecord, extension4ObjPtr), -1, 0, NULL, 0},
{TK_OPTION_STRING, "-two", "two", "Two", "two and a half",
- Tk_Offset(ExtensionWidgetRecord, base2ObjPtr), -1},
+ Tk_Offset(ExtensionWidgetRecord, base2ObjPtr), -1, 0, NULL, 0},
{TK_OPTION_STRING,
"-oneAgain", "oneAgain", "OneAgain", "one again",
- Tk_Offset(ExtensionWidgetRecord, extension5ObjPtr), -1},
+ Tk_Offset(ExtensionWidgetRecord, extension5ObjPtr), -1, 0, NULL, 0},
{TK_OPTION_END, NULL, NULL, NULL, NULL, 0, -1, 0,
- (ClientData) baseSpecs}
+ (ClientData) baseSpecs, 0}
};
Tk_Window tkwin;
Tk_OptionTable optionTable;
@@ -870,8 +747,7 @@ TestobjconfigObjCmd(
optionTable = Tk_CreateOptionTable(interp, extensionSpecs);
tables[index] = optionTable;
- recordPtr = (ExtensionWidgetRecord *) ckalloc(
- sizeof(ExtensionWidgetRecord));
+ recordPtr = ckalloc(sizeof(ExtensionWidgetRecord));
recordPtr->header.interp = interp;
recordPtr->header.optionTable = optionTable;
recordPtr->header.tkwin = tkwin;
@@ -904,8 +780,8 @@ TestobjconfigObjCmd(
ErrorWidgetRecord widgetRecord;
static const Tk_OptionSpec errorSpecs[] = {
{TK_OPTION_INT, "-int", "integer", "Integer", "bogus",
- Tk_Offset(ErrorWidgetRecord, intPtr)},
- {TK_OPTION_END}
+ Tk_Offset(ErrorWidgetRecord, intPtr), 0, 0, NULL, 0},
+ {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0}
};
Tk_OptionTable optionTable;
@@ -921,8 +797,8 @@ TestobjconfigObjCmd(
Tcl_WrongNumArgs(interp, 2, objv, "tableName");
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[2], options, "table", 0,
- &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[2], options,
+ sizeof(char *), "table", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
if (tables[index] != NULL) {
@@ -935,8 +811,8 @@ TestobjconfigObjCmd(
Tcl_WrongNumArgs(interp, 2, objv, "tableName");
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[2], options, "table", 0,
- &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[2], options,
+ sizeof(char *), "table", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, TkDebugConfig(interp, tables[index]));
@@ -986,10 +862,10 @@ TestobjconfigObjCmd(
{TK_OPTION_STRING_TABLE,
"-stringtable", "StringTable", "stringTable", "one",
-1, Tk_Offset(InternalRecord, index),
- TK_CONFIG_NULL_OK, (ClientData) internalStringTable, 0x10},
+ TK_CONFIG_NULL_OK, internalStringTable, 0x10},
{TK_OPTION_COLOR, "-color", "color", "Color", "red",
-1, Tk_Offset(InternalRecord, colorPtr),
- TK_CONFIG_NULL_OK, (ClientData) "black", 0x20},
+ TK_CONFIG_NULL_OK, "black", 0x20},
{TK_OPTION_FONT, "-font", "font", "Font", "Helvetica 12",
-1, Tk_Offset(InternalRecord, tkfont),
TK_CONFIG_NULL_OK, 0, 0x40},
@@ -998,7 +874,7 @@ TestobjconfigObjCmd(
TK_CONFIG_NULL_OK, 0, 0x80},
{TK_OPTION_BORDER, "-border", "border", "Border", "blue",
-1, Tk_Offset(InternalRecord, border),
- TK_CONFIG_NULL_OK, (ClientData) "white", 0x100},
+ TK_CONFIG_NULL_OK, "white", 0x100},
{TK_OPTION_RELIEF, "-relief", "relief", "Relief", "raised",
-1, Tk_Offset(InternalRecord, relief),
TK_CONFIG_NULL_OK, 0, 0x200},
@@ -1019,10 +895,10 @@ TestobjconfigObjCmd(
TK_CONFIG_NULL_OK, 0, 0},
{TK_OPTION_CUSTOM, "-custom", NULL, NULL, "",
-1, Tk_Offset(InternalRecord, custom),
- TK_CONFIG_NULL_OK, (ClientData)&CustomOption, 0x4000},
+ TK_CONFIG_NULL_OK, &CustomOption, 0x4000},
{TK_OPTION_SYNONYM, "-synonym", NULL, NULL,
- NULL, -1, -1, 0, (ClientData) "-color", 0x8000},
- {TK_OPTION_END}
+ NULL, -1, -1, 0, "-color", 0x8000},
+ {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0}
};
Tk_OptionTable optionTable;
Tk_Window tkwin;
@@ -1036,7 +912,7 @@ TestobjconfigObjCmd(
}
Tk_SetClass(tkwin, "Test");
- recordPtr = (InternalRecord *) ckalloc(sizeof(InternalRecord));
+ recordPtr = ckalloc(sizeof(InternalRecord));
recordPtr->header.interp = interp;
recordPtr->header.optionTable = optionTable;
recordPtr->header.tkwin = tkwin;
@@ -1062,9 +938,9 @@ TestobjconfigObjCmd(
if (result == TCL_OK) {
recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp,
Tcl_GetString(objv[2]), TrivialConfigObjCmd,
- (ClientData) recordPtr, TrivialCmdDeletedProc);
+ recordPtr, TrivialCmdDeletedProc);
Tk_CreateEventHandler(tkwin, StructureNotifyMask,
- TrivialEventProc, (ClientData) recordPtr);
+ TrivialEventProc, recordPtr);
result = Tk_SetOptions(interp, (char *) recordPtr, optionTable,
objc - 3, objv + 3, tkwin, NULL, NULL);
if (result != TCL_OK) {
@@ -1072,7 +948,7 @@ TestobjconfigObjCmd(
}
} else {
Tk_DestroyWindow(tkwin);
- ckfree((char *) recordPtr);
+ ckfree(recordPtr);
}
if (result == TCL_OK) {
Tcl_SetObjResult(interp, objv[2]);
@@ -1092,24 +968,24 @@ TestobjconfigObjCmd(
FiveRecord *recordPtr;
static const Tk_OptionSpec smallSpecs[] = {
{TK_OPTION_INT, "-one", "one", "One", "1",
- Tk_Offset(FiveRecord, one), -1},
+ Tk_Offset(FiveRecord, one), -1, 0, NULL, 0},
{TK_OPTION_INT, "-two", "two", "Two", "2",
- Tk_Offset(FiveRecord, two), -1},
+ Tk_Offset(FiveRecord, two), -1, 0, NULL, 0},
{TK_OPTION_INT, "-three", "three", "Three", "3",
- Tk_Offset(FiveRecord, three), -1},
+ Tk_Offset(FiveRecord, three), -1, 0, NULL, 0},
{TK_OPTION_INT, "-four", "four", "Four", "4",
- Tk_Offset(FiveRecord, four), -1},
+ Tk_Offset(FiveRecord, four), -1, 0, NULL, 0},
{TK_OPTION_STRING, "-five", NULL, NULL, NULL,
- Tk_Offset(FiveRecord, five), -1},
- {TK_OPTION_END}
+ Tk_Offset(FiveRecord, five), -1, 0, NULL, 0},
+ {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0}
};
if (objc < 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "new name ?options?");
+ Tcl_WrongNumArgs(interp, 1, objv, "new name ?-option value ...?");
return TCL_ERROR;
}
- recordPtr = (FiveRecord *) ckalloc(sizeof(FiveRecord));
+ recordPtr = ckalloc(sizeof(FiveRecord));
recordPtr->header.interp = interp;
recordPtr->header.optionTable = Tk_CreateOptionTable(interp,
smallSpecs);
@@ -1134,7 +1010,7 @@ TestobjconfigObjCmd(
}
}
if (result != TCL_OK) {
- ckfree((char *) recordPtr);
+ ckfree(recordPtr);
}
break;
@@ -1146,8 +1022,8 @@ TestobjconfigObjCmd(
NotEnoughRecord record;
static const Tk_OptionSpec errorSpecs[] = {
{TK_OPTION_INT, "-foo", "foo", "Foo", "0",
- Tk_Offset(NotEnoughRecord, fooObjPtr)},
- {TK_OPTION_END}
+ Tk_Offset(NotEnoughRecord, fooObjPtr), 0, 0, NULL, 0},
+ {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0}
};
Tcl_Obj *newObjPtr = Tcl_NewStringObj("-foo", -1);
Tk_OptionTable optionTable;
@@ -1177,8 +1053,8 @@ TestobjconfigObjCmd(
SlaveRecord *recordPtr;
static const Tk_OptionSpec slaveSpecs[] = {
{TK_OPTION_WINDOW, "-window", "window", "Window", ".bar",
- Tk_Offset(SlaveRecord, windowPtr), -1, TK_CONFIG_NULL_OK},
- {TK_OPTION_END}
+ Tk_Offset(SlaveRecord, windowPtr), -1, TK_CONFIG_NULL_OK, NULL, 0},
+ {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0}
};
Tk_Window tkwin = Tk_CreateWindowFromPath(interp,
(Tk_Window) clientData, Tcl_GetString(objv[2]), NULL);
@@ -1188,7 +1064,7 @@ TestobjconfigObjCmd(
}
Tk_SetClass(tkwin, "Test");
- recordPtr = (SlaveRecord *) ckalloc(sizeof(SlaveRecord));
+ recordPtr = ckalloc(sizeof(SlaveRecord));
recordPtr->header.interp = interp;
recordPtr->header.optionTable = Tk_CreateOptionTable(interp,
slaveSpecs);
@@ -1205,9 +1081,9 @@ TestobjconfigObjCmd(
if (result == TCL_OK) {
recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp,
Tcl_GetString(objv[2]), TrivialConfigObjCmd,
- (ClientData) recordPtr, TrivialCmdDeletedProc);
+ recordPtr, TrivialCmdDeletedProc);
Tk_CreateEventHandler(tkwin, StructureNotifyMask,
- TrivialEventProc, (ClientData) recordPtr);
+ TrivialEventProc, recordPtr);
Tcl_SetObjResult(interp, objv[2]);
} else {
Tk_FreeConfigOptions((char *) recordPtr,
@@ -1216,7 +1092,7 @@ TestobjconfigObjCmd(
}
if (result != TCL_OK) {
Tk_DestroyWindow(tkwin);
- ckfree((char *) recordPtr);
+ ckfree(recordPtr);
}
}
}
@@ -1250,7 +1126,7 @@ TrivialConfigObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
int result = TCL_OK;
- static const char *options[] = {
+ static const char *const options[] = {
"cget", "configure", "csave", NULL
};
enum {
@@ -1267,8 +1143,8 @@ TrivialConfigObjCmd(
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[1], options, "command", 0,
- &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], options,
+ sizeof(char *), "command", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
@@ -1312,7 +1188,7 @@ TrivialConfigObjCmd(
headerPtr->optionTable, objc - 2, objv + 2,
tkwin, NULL, &mask);
if (result == TCL_OK) {
- Tcl_SetIntObj(Tcl_GetObjResult(interp), mask);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(mask));
}
}
break;
@@ -1322,7 +1198,7 @@ TrivialConfigObjCmd(
tkwin, &saved, &mask);
Tk_FreeSavedOptions(&saved);
if (result == TCL_OK) {
- Tcl_SetIntObj(Tcl_GetObjResult(interp), mask);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(mask));
}
break;
}
@@ -1432,7 +1308,7 @@ TestfontObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- static const char *options[] = {"counts", "subfonts", NULL};
+ static const char *const options[] = {"counts", "subfonts", NULL};
enum option {COUNTS, SUBFONTS};
int index;
Tk_Window tkwin;
@@ -1445,8 +1321,8 @@ TestfontObjCmd(
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[1], options, "command", 0, &index)
- != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], options,
+ sizeof(char *), "command", 0, &index)!= TCL_OK) {
return TCL_ERROR;
}
@@ -1489,18 +1365,18 @@ static int
ImageCreate(
Tcl_Interp *interp, /* Interpreter for application containing
* image. */
- char *name, /* Name to use for image. */
+ const char *name, /* Name to use for image. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[], /* Argument strings for options (doesn't
* include image name or type). */
- Tk_ImageType *typePtr, /* Pointer to our type record (not used). */
+ const Tk_ImageType *typePtr, /* Pointer to our type record (not used). */
Tk_ImageMaster master, /* Token for image, to be used by us in later
* callbacks. */
ClientData *clientDataPtr) /* Store manager's token for image here; it
* will be returned in later callbacks. */
{
TImageMaster *timPtr;
- char *varName;
+ const char *varName;
int i;
varName = "log";
@@ -1518,17 +1394,17 @@ ImageCreate(
varName = Tcl_GetString(objv[i+1]);
}
- timPtr = (TImageMaster *) ckalloc(sizeof(TImageMaster));
+ timPtr = ckalloc(sizeof(TImageMaster));
timPtr->master = master;
timPtr->interp = interp;
timPtr->width = 30;
timPtr->height = 15;
- timPtr->imageName = (char *) ckalloc((unsigned) (strlen(name) + 1));
+ timPtr->imageName = ckalloc(strlen(name) + 1);
strcpy(timPtr->imageName, name);
- timPtr->varName = (char *) ckalloc((unsigned) (strlen(varName) + 1));
+ timPtr->varName = ckalloc(strlen(varName) + 1);
strcpy(timPtr->varName, varName);
- Tcl_CreateCommand(interp, name, ImageCmd, (ClientData) timPtr, NULL);
- *clientDataPtr = (ClientData) timPtr;
+ Tcl_CreateCommand(interp, name, ImageCmd, timPtr, NULL);
+ *clientDataPtr = timPtr;
Tk_ImageChanged(master, 0, 0, 30, 15, 30, 15);
return TCL_OK;
}
@@ -1563,7 +1439,7 @@ ImageCmd(
if (argc < 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], "option ?arg arg ...?", NULL);
+ argv[0], "option ?arg ...?", NULL);
return TCL_ERROR;
}
if (strcmp(argv[1], "changed") == 0) {
@@ -1620,15 +1496,15 @@ ImageGet(
XGCValues gcValues;
sprintf(buffer, "%s get", timPtr->imageName);
- Tcl_SetVar(timPtr->interp, timPtr->varName, buffer,
+ Tcl_SetVar2(timPtr->interp, timPtr->varName, NULL, buffer,
TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
- instPtr = (TImageInstance *) ckalloc(sizeof(TImageInstance));
+ instPtr = ckalloc(sizeof(TImageInstance));
instPtr->masterPtr = timPtr;
instPtr->fg = Tk_GetColor(timPtr->interp, tkwin, "#ff0000");
gcValues.foreground = instPtr->fg->pixel;
instPtr->gc = Tk_GetGC(tkwin, GCForeground, &gcValues);
- return (ClientData) instPtr;
+ return instPtr;
}
/*
@@ -1667,8 +1543,8 @@ ImageDisplay(
sprintf(buffer, "%s display %d %d %d %d %d %d",
instPtr->masterPtr->imageName, imageX, imageY, width, height,
drawableX, drawableY);
- Tcl_SetVar(instPtr->masterPtr->interp, instPtr->masterPtr->varName, buffer,
- TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
+ Tcl_SetVar2(instPtr->masterPtr->interp, instPtr->masterPtr->varName, NULL,
+ buffer, TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
if (width > (instPtr->masterPtr->width - imageX)) {
width = instPtr->masterPtr->width - imageX;
}
@@ -1710,11 +1586,11 @@ ImageFree(
char buffer[200];
sprintf(buffer, "%s free", instPtr->masterPtr->imageName);
- Tcl_SetVar(instPtr->masterPtr->interp, instPtr->masterPtr->varName, buffer,
- TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
+ Tcl_SetVar2(instPtr->masterPtr->interp, instPtr->masterPtr->varName, NULL,
+ buffer, TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
Tk_FreeColor(instPtr->fg);
Tk_FreeGC(display, instPtr->gc);
- ckfree((char *) instPtr);
+ ckfree(instPtr);
}
/*
@@ -1744,13 +1620,13 @@ ImageDelete(
char buffer[100];
sprintf(buffer, "%s delete", timPtr->imageName);
- Tcl_SetVar(timPtr->interp, timPtr->varName, buffer,
+ Tcl_SetVar2(timPtr->interp, timPtr->varName, NULL, buffer,
TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
Tcl_DeleteCommand(timPtr->interp, timPtr->imageName);
ckfree(timPtr->imageName);
ckfree(timPtr->varName);
- ckfree((char *) timPtr);
+ ckfree(timPtr);
}
/*
@@ -1858,8 +1734,7 @@ TestmenubarCmd(
return TCL_OK;
#else
- Tcl_SetResult(interp, "testmenubar is supported only under Unix",
- TCL_STATIC);
+ Tcl_AppendResult(interp, "testmenubar is supported only under Unix", NULL);
return TCL_ERROR;
#endif
}
@@ -1992,7 +1867,7 @@ TestpropCmd(
*p = '\n';
}
}
- Tcl_SetResult(interp, (/*!unsigned*/char*)property, TCL_VOLATILE);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj((/*!unsigned*/char*)property, -1));
} else {
for (p = property; length > 0; length--) {
if (actualFormat == 32) {
@@ -2063,7 +1938,7 @@ TestwrapperCmd(
char buf[TCL_INTEGER_SPACE];
TkpPrintWindowId(buf, Tk_WindowId(wrapperPtr));
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1));
}
return TCL_OK;
}
@@ -2123,28 +1998,28 @@ CustomOptionSet(
if (value == NULL) {
objEmpty = 1;
+ CLANG_ASSERT(value);
} else if ((*value)->bytes != NULL) {
objEmpty = ((*value)->length == 0);
} else {
- Tcl_GetStringFromObj((*value), &length);
+ (void)Tcl_GetStringFromObj(*value, &length);
objEmpty = (length == 0);
}
if ((flags & TK_OPTION_NULL_OK) && objEmpty) {
*value = NULL;
} else {
- string = Tcl_GetStringFromObj((*value), &length);
+ string = Tcl_GetStringFromObj(*value, &length);
Tcl_UtfToUpper(string);
if (strcmp(string, "BAD") == 0) {
- Tcl_SetResult(interp, "expected good value, got \"BAD\"",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("expected good value, got \"BAD\"", -1));
return TCL_ERROR;
}
}
if (internalPtr != NULL) {
- if ((*value) != NULL) {
- string = Tcl_GetStringFromObj((*value), &length);
- newStr = ckalloc((size_t) (length + 1));
+ if (*valu) != NULL) {
+ string = Tcl_GetStringFromObj(*value, &length);
+ newStr = ckalloc(length + 1);
strcpy(newStr, string);
} else {
newStr = NULL;
generated by cgit v0.12 at 2024-11-08 08:52:36 (GMT)