diff options
Diffstat (limited to 'generic/tkTest.c')
-rw-r--r-- | generic/tkTest.c | 327 |
1 files changed, 221 insertions, 106 deletions
diff --git a/generic/tkTest.c b/generic/tkTest.c index 1fa821c..125a9c2 100644 --- a/generic/tkTest.c +++ b/generic/tkTest.c @@ -48,7 +48,14 @@ #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLEXPORT +#ifdef __cplusplus +extern "C" { +#endif EXTERN int Tktest_Init(Tcl_Interp *interp); +#ifdef __cplusplus +} +#endif + /* * The following data structure represents the model for a test image: */ @@ -181,22 +188,16 @@ static int TestmetricsObjCmd(ClientData dummy, static int TestobjconfigObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj * const objv[]); -static int CustomOptionSet(ClientData clientData, - Tcl_Interp *interp, Tk_Window tkwin, - Tcl_Obj **value, char *recordPtr, - int internalOffset, char *saveInternalPtr, - int flags); -static Tcl_Obj * CustomOptionGet(ClientData clientData, - Tk_Window tkwin, char *recordPtr, - int internalOffset); -static void CustomOptionRestore(ClientData clientData, - Tk_Window tkwin, char *internalPtr, - char *saveInternalPtr); -static void CustomOptionFree(ClientData clientData, - Tk_Window tkwin, char *internalPtr); +static Tk_CustomOptionSetProc CustomOptionSet; +static Tk_CustomOptionGetProc CustomOptionGet; +static Tk_CustomOptionRestoreProc CustomOptionRestore; +static Tk_CustomOptionFreeProc CustomOptionFree; static int TestpropObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj * const objv[]); +static int TestprintfObjCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj * const objv[]); #if !(defined(_WIN32) || defined(MAC_OSX_TK) || defined(__CYGWIN__)) static int TestwrapperObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, @@ -208,6 +209,9 @@ static int TrivialConfigObjCmd(ClientData dummy, Tcl_Obj * const objv[]); static void TrivialEventProc(ClientData clientData, XEvent *eventPtr); +static int TestPhotoStringMatchCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj * const objv[]); /* *---------------------------------------------------------------------- @@ -232,7 +236,7 @@ Tktest_Init( { static int initialized = 0; - if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { + if (Tcl_InitStubs(interp, "8.6-", 0) == NULL) { return TCL_ERROR; } if (Tk_InitStubs(interp, TK_VERSION, 0) == NULL) { @@ -268,8 +272,12 @@ Tktest_Init( (ClientData) Tk_MainWindow(interp), NULL); Tcl_CreateObjCommand(interp, "testprop", TestpropObjCmd, (ClientData) Tk_MainWindow(interp), NULL); + Tcl_CreateObjCommand(interp, "testprintf", TestprintfObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testtext", TkpTesttextCmd, (ClientData) Tk_MainWindow(interp), NULL); + Tcl_CreateObjCommand(interp, "testphotostringmatch", + TestPhotoStringMatchCmd, (ClientData) Tk_MainWindow(interp), + NULL); #if defined(_WIN32) Tcl_CreateObjCommand(interp, "testmetrics", TestmetricsObjCmd, @@ -331,7 +339,6 @@ TestbitmapObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "bitmap"); return TCL_ERROR; @@ -365,7 +372,6 @@ TestborderObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "border"); return TCL_ERROR; @@ -523,7 +529,7 @@ TestobjconfigObjCmd( CustomOptionFree, INT2PTR(1) }; - Tk_Window mainWin = (Tk_Window) clientData; + Tk_Window mainWin = (Tk_Window)clientData; Tk_Window tkwin; int index, result = TCL_OK; @@ -542,9 +548,9 @@ TestobjconfigObjCmd( } ExtensionWidgetRecord; static const Tk_OptionSpec baseSpecs[] = { {TK_OPTION_STRING, "-one", "one", "One", "one", - Tk_Offset(ExtensionWidgetRecord, base1ObjPtr), -1, 0, NULL, 0}, + offsetof(ExtensionWidgetRecord, base1ObjPtr), TCL_INDEX_NONE, 0, NULL, 0}, {TK_OPTION_STRING, "-two", "two", "Two", "two", - Tk_Offset(ExtensionWidgetRecord, base2ObjPtr), -1, 0, NULL, 0}, + offsetof(ExtensionWidgetRecord, base2ObjPtr), TCL_INDEX_NONE, 0, NULL, 0}, {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0} }; @@ -586,57 +592,57 @@ TestobjconfigObjCmd( }; static const Tk_OptionSpec typesSpecs[] = { {TK_OPTION_BOOLEAN, "-boolean", "boolean", "Boolean", "1", - Tk_Offset(TypesRecord, booleanPtr), -1, 0, 0, 0x1}, + offsetof(TypesRecord, booleanPtr), TCL_INDEX_NONE, 0, 0, 0x1}, {TK_OPTION_INT, "-integer", "integer", "Integer", "7", - Tk_Offset(TypesRecord, integerPtr), -1, 0, 0, 0x2}, + offsetof(TypesRecord, integerPtr), TCL_INDEX_NONE, 0, 0, 0x2}, {TK_OPTION_DOUBLE, "-double", "double", "Double", "3.14159", - Tk_Offset(TypesRecord, doublePtr), -1, 0, 0, 0x4}, + offsetof(TypesRecord, doublePtr), TCL_INDEX_NONE, 0, 0, 0x4}, {TK_OPTION_STRING, "-string", "string", "String", - "foo", Tk_Offset(TypesRecord, stringPtr), -1, + "foo", offsetof(TypesRecord, stringPtr), TCL_INDEX_NONE, TK_CONFIG_NULL_OK, 0, 0x8}, {TK_OPTION_STRING_TABLE, "-stringtable", "StringTable", "stringTable", - "one", Tk_Offset(TypesRecord, stringTablePtr), -1, + "one", offsetof(TypesRecord, stringTablePtr), TCL_INDEX_NONE, TK_CONFIG_NULL_OK, stringTable, 0x10}, {TK_OPTION_COLOR, "-color", "color", "Color", - "red", Tk_Offset(TypesRecord, colorPtr), -1, + "red", offsetof(TypesRecord, colorPtr), TCL_INDEX_NONE, TK_CONFIG_NULL_OK, "black", 0x20}, {TK_OPTION_FONT, "-font", "font", "Font", "Helvetica 12", - Tk_Offset(TypesRecord, fontPtr), -1, + offsetof(TypesRecord, fontPtr), TCL_INDEX_NONE, TK_CONFIG_NULL_OK, 0, 0x40}, {TK_OPTION_BITMAP, "-bitmap", "bitmap", "Bitmap", "gray50", - Tk_Offset(TypesRecord, bitmapPtr), -1, + offsetof(TypesRecord, bitmapPtr), TCL_INDEX_NONE, TK_CONFIG_NULL_OK, 0, 0x80}, {TK_OPTION_BORDER, "-border", "border", "Border", - "blue", Tk_Offset(TypesRecord, borderPtr), -1, + "blue", offsetof(TypesRecord, borderPtr), TCL_INDEX_NONE, TK_CONFIG_NULL_OK, "white", 0x100}, {TK_OPTION_RELIEF, "-relief", "relief", "Relief", "raised", - Tk_Offset(TypesRecord, reliefPtr), -1, + offsetof(TypesRecord, reliefPtr), TCL_INDEX_NONE, TK_CONFIG_NULL_OK, 0, 0x200}, {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor", "xterm", - Tk_Offset(TypesRecord, cursorPtr), -1, + offsetof(TypesRecord, cursorPtr), TCL_INDEX_NONE, TK_CONFIG_NULL_OK, 0, 0x400}, {TK_OPTION_JUSTIFY, "-justify", NULL, NULL, "left", - Tk_Offset(TypesRecord, justifyPtr), -1, + offsetof(TypesRecord, justifyPtr), TCL_INDEX_NONE, TK_CONFIG_NULL_OK, 0, 0x800}, {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor", NULL, - Tk_Offset(TypesRecord, anchorPtr), -1, + offsetof(TypesRecord, anchorPtr), TCL_INDEX_NONE, TK_CONFIG_NULL_OK, 0, 0x1000}, {TK_OPTION_PIXELS, "-pixel", "pixel", "Pixel", - "1", Tk_Offset(TypesRecord, pixelPtr), -1, + "1", offsetof(TypesRecord, pixelPtr), TCL_INDEX_NONE, TK_CONFIG_NULL_OK, 0, 0x2000}, {TK_OPTION_CUSTOM, "-custom", NULL, NULL, - "", Tk_Offset(TypesRecord, customPtr), -1, + "", offsetof(TypesRecord, customPtr), TCL_INDEX_NONE, TK_CONFIG_NULL_OK, &CustomOption, 0x4000}, {TK_OPTION_SYNONYM, "-synonym", NULL, NULL, - NULL, 0, -1, 0, "-color", 0x8000}, + NULL, 0, TCL_INDEX_NONE, 0, "-color", 0x8000}, {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0} }; Tk_OptionTable optionTable; optionTable = Tk_CreateOptionTable(interp, typesSpecs); tables[index] = optionTable; - tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window) clientData, + tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window)clientData, Tcl_GetString(objv[2]), NULL); if (tkwin == NULL) { return TCL_ERROR; @@ -663,7 +669,7 @@ TestobjconfigObjCmd( recordPtr->mmPtr = NULL; recordPtr->stringTablePtr = NULL; recordPtr->customPtr = NULL; - result = Tk_InitOptions(interp, (char *) recordPtr, optionTable, + result = Tk_InitOptions(interp, recordPtr, optionTable, tkwin); if (result == TCL_OK) { recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp, @@ -671,7 +677,7 @@ TestobjconfigObjCmd( (ClientData) recordPtr, TrivialCmdDeletedProc); Tk_CreateEventHandler(tkwin, StructureNotifyMask, TrivialEventProc, (ClientData) recordPtr); - result = Tk_SetOptions(interp, (char *) recordPtr, optionTable, + result = Tk_SetOptions(interp, recordPtr, optionTable, objc-3, objv+3, tkwin, NULL, NULL); if (result != TCL_OK) { Tk_DestroyWindow(tkwin); @@ -690,7 +696,7 @@ TestobjconfigObjCmd( ExtensionWidgetRecord *recordPtr; Tk_OptionTable optionTable; - tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window) clientData, + tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window)clientData, Tcl_GetString(objv[2]), NULL); if (tkwin == NULL) { return TCL_ERROR; @@ -705,12 +711,12 @@ TestobjconfigObjCmd( recordPtr->header.tkwin = tkwin; recordPtr->base1ObjPtr = recordPtr->base2ObjPtr = NULL; recordPtr->extension3ObjPtr = recordPtr->extension4ObjPtr = NULL; - result = Tk_InitOptions(interp, (char *)recordPtr, optionTable, tkwin); + result = Tk_InitOptions(interp, recordPtr, optionTable, tkwin); if (result == TCL_OK) { - result = Tk_SetOptions(interp, (char *) recordPtr, optionTable, + result = Tk_SetOptions(interp, recordPtr, optionTable, objc-3, objv+3, tkwin, NULL, NULL); if (result != TCL_OK) { - Tk_FreeConfigOptions((char *) recordPtr, optionTable, tkwin); + Tk_FreeConfigOptions(recordPtr, optionTable, tkwin); } } if (result == TCL_OK) { @@ -729,20 +735,20 @@ TestobjconfigObjCmd( ExtensionWidgetRecord *recordPtr; static const Tk_OptionSpec extensionSpecs[] = { {TK_OPTION_STRING, "-three", "three", "Three", "three", - Tk_Offset(ExtensionWidgetRecord, extension3ObjPtr), -1, 0, NULL, 0}, + offsetof(ExtensionWidgetRecord, extension3ObjPtr), TCL_INDEX_NONE, 0, NULL, 0}, {TK_OPTION_STRING, "-four", "four", "Four", "four", - Tk_Offset(ExtensionWidgetRecord, extension4ObjPtr), -1, 0, NULL, 0}, + offsetof(ExtensionWidgetRecord, extension4ObjPtr), TCL_INDEX_NONE, 0, NULL, 0}, {TK_OPTION_STRING, "-two", "two", "Two", "two and a half", - Tk_Offset(ExtensionWidgetRecord, base2ObjPtr), -1, 0, NULL, 0}, + offsetof(ExtensionWidgetRecord, base2ObjPtr), TCL_INDEX_NONE, 0, NULL, 0}, {TK_OPTION_STRING, "-oneAgain", "oneAgain", "OneAgain", "one again", - Tk_Offset(ExtensionWidgetRecord, extension5ObjPtr), -1, 0, NULL, 0}, - {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, -1, 0, + offsetof(ExtensionWidgetRecord, extension5ObjPtr), TCL_INDEX_NONE, 0, NULL, 0}, + {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, TCL_INDEX_NONE, 0, (ClientData) baseSpecs, 0} }; Tk_OptionTable optionTable; - tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window) clientData, + tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window)clientData, Tcl_GetString(objv[2]), NULL); if (tkwin == NULL) { return TCL_ERROR; @@ -758,9 +764,9 @@ TestobjconfigObjCmd( recordPtr->base1ObjPtr = recordPtr->base2ObjPtr = NULL; recordPtr->extension3ObjPtr = recordPtr->extension4ObjPtr = NULL; recordPtr->extension5ObjPtr = NULL; - result = Tk_InitOptions(interp, (char *)recordPtr, optionTable, tkwin); + result = Tk_InitOptions(interp, recordPtr, optionTable, tkwin); if (result == TCL_OK) { - result = Tk_SetOptions(interp, (char *) recordPtr, optionTable, + result = Tk_SetOptions(interp, recordPtr, optionTable, objc-3, objv+3, tkwin, NULL, NULL); if (result != TCL_OK) { Tk_FreeConfigOptions((char *) recordPtr, optionTable, tkwin); @@ -784,7 +790,7 @@ TestobjconfigObjCmd( ErrorWidgetRecord widgetRecord; static const Tk_OptionSpec errorSpecs[] = { {TK_OPTION_INT, "-int", "integer", "Integer", "bogus", - Tk_Offset(ErrorWidgetRecord, intPtr), 0, 0, NULL, 0}, + offsetof(ErrorWidgetRecord, intPtr), 0, 0, NULL, 0}, {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0} }; Tk_OptionTable optionTable; @@ -792,7 +798,7 @@ TestobjconfigObjCmd( widgetRecord.intPtr = NULL; optionTable = Tk_CreateOptionTable(interp, errorSpecs); tables[index] = optionTable; - return Tk_InitOptions(interp, (char *) &widgetRecord, optionTable, + return Tk_InitOptions(interp, &widgetRecord, optionTable, (Tk_Window) NULL); } @@ -858,67 +864,67 @@ TestobjconfigObjCmd( }; static const Tk_OptionSpec internalSpecs[] = { {TK_OPTION_BOOLEAN, "-boolean", "boolean", "Boolean", "1", - -1, Tk_Offset(InternalRecord, boolean), 0, 0, 0x1}, + TCL_INDEX_NONE, offsetof(InternalRecord, boolean), 0, 0, 0x1}, {TK_OPTION_INT, "-integer", "integer", "Integer", "148962237", - -1, Tk_Offset(InternalRecord, integer), 0, 0, 0x2}, + TCL_INDEX_NONE, offsetof(InternalRecord, integer), 0, 0, 0x2}, {TK_OPTION_DOUBLE, "-double", "double", "Double", "3.14159", - -1, Tk_Offset(InternalRecord, doubleValue), 0, 0, 0x4}, + TCL_INDEX_NONE, offsetof(InternalRecord, doubleValue), 0, 0, 0x4}, {TK_OPTION_STRING, "-string", "string", "String", "foo", - -1, Tk_Offset(InternalRecord, string), + TCL_INDEX_NONE, offsetof(InternalRecord, string), TK_CONFIG_NULL_OK, 0, 0x8}, {TK_OPTION_STRING_TABLE, "-stringtable", "StringTable", "stringTable", "one", - -1, Tk_Offset(InternalRecord, index), + TCL_INDEX_NONE, offsetof(InternalRecord, index), TK_CONFIG_NULL_OK, internalStringTable, 0x10}, {TK_OPTION_COLOR, "-color", "color", "Color", "red", - -1, Tk_Offset(InternalRecord, colorPtr), + TCL_INDEX_NONE, offsetof(InternalRecord, colorPtr), TK_CONFIG_NULL_OK, "black", 0x20}, {TK_OPTION_FONT, "-font", "font", "Font", "Helvetica 12", - -1, Tk_Offset(InternalRecord, tkfont), + TCL_INDEX_NONE, offsetof(InternalRecord, tkfont), TK_CONFIG_NULL_OK, 0, 0x40}, {TK_OPTION_BITMAP, "-bitmap", "bitmap", "Bitmap", "gray50", - -1, Tk_Offset(InternalRecord, bitmap), + TCL_INDEX_NONE, offsetof(InternalRecord, bitmap), TK_CONFIG_NULL_OK, 0, 0x80}, {TK_OPTION_BORDER, "-border", "border", "Border", "blue", - -1, Tk_Offset(InternalRecord, border), + TCL_INDEX_NONE, offsetof(InternalRecord, border), TK_CONFIG_NULL_OK, "white", 0x100}, {TK_OPTION_RELIEF, "-relief", "relief", "Relief", "raised", - -1, Tk_Offset(InternalRecord, relief), + TCL_INDEX_NONE, offsetof(InternalRecord, relief), TK_CONFIG_NULL_OK, 0, 0x200}, {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor", "xterm", - -1, Tk_Offset(InternalRecord, cursor), + TCL_INDEX_NONE, offsetof(InternalRecord, cursor), TK_CONFIG_NULL_OK, 0, 0x400}, {TK_OPTION_JUSTIFY, "-justify", NULL, NULL, "left", - -1, Tk_Offset(InternalRecord, justify), + TCL_INDEX_NONE, offsetof(InternalRecord, justify), TK_CONFIG_NULL_OK, 0, 0x800}, {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor", NULL, - -1, Tk_Offset(InternalRecord, anchor), + TCL_INDEX_NONE, offsetof(InternalRecord, anchor), TK_CONFIG_NULL_OK, 0, 0x1000}, {TK_OPTION_PIXELS, "-pixel", "pixel", "Pixel", "1", - -1, Tk_Offset(InternalRecord, pixels), + TCL_INDEX_NONE, offsetof(InternalRecord, pixels), TK_CONFIG_NULL_OK, 0, 0x2000}, {TK_OPTION_WINDOW, "-window", "window", "Window", NULL, - -1, Tk_Offset(InternalRecord, tkwin), + TCL_INDEX_NONE, offsetof(InternalRecord, tkwin), TK_CONFIG_NULL_OK, 0, 0}, {TK_OPTION_CUSTOM, "-custom", NULL, NULL, "", - -1, Tk_Offset(InternalRecord, custom), + TCL_INDEX_NONE, offsetof(InternalRecord, custom), TK_CONFIG_NULL_OK, &CustomOption, 0x4000}, {TK_OPTION_SYNONYM, "-synonym", NULL, NULL, - NULL, -1, -1, 0, "-color", 0x8000}, + NULL, TCL_INDEX_NONE, TCL_INDEX_NONE, 0, "-color", 0x8000}, {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0} }; Tk_OptionTable optionTable; optionTable = Tk_CreateOptionTable(interp, internalSpecs); tables[index] = optionTable; - tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window) clientData, + tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window)clientData, Tcl_GetString(objv[2]), NULL); if (tkwin == NULL) { return TCL_ERROR; } Tk_SetClass(tkwin, "Test"); - recordPtr = ckalloc(sizeof(InternalRecord)); + recordPtr = (InternalRecord *)ckalloc(sizeof(InternalRecord)); recordPtr->header.interp = interp; recordPtr->header.optionTable = optionTable; recordPtr->header.tkwin = tkwin; @@ -939,7 +945,7 @@ TestobjconfigObjCmd( recordPtr->mm = 0.0; recordPtr->tkwin = NULL; recordPtr->custom = NULL; - result = Tk_InitOptions(interp, (char *) recordPtr, optionTable, + result = Tk_InitOptions(interp, recordPtr, optionTable, tkwin); if (result == TCL_OK) { recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp, @@ -947,7 +953,7 @@ TestobjconfigObjCmd( recordPtr, TrivialCmdDeletedProc); Tk_CreateEventHandler(tkwin, StructureNotifyMask, TrivialEventProc, recordPtr); - result = Tk_SetOptions(interp, (char *) recordPtr, optionTable, + result = Tk_SetOptions(interp, recordPtr, optionTable, objc - 3, objv + 3, tkwin, NULL, NULL); if (result != TCL_OK) { Tk_DestroyWindow(tkwin); @@ -974,15 +980,15 @@ TestobjconfigObjCmd( FiveRecord *recordPtr; static const Tk_OptionSpec smallSpecs[] = { {TK_OPTION_INT, "-one", "one", "One", "1", - Tk_Offset(FiveRecord, one), -1, 0, NULL, 0}, + offsetof(FiveRecord, one), TCL_INDEX_NONE, 0, NULL, 0}, {TK_OPTION_INT, "-two", "two", "Two", "2", - Tk_Offset(FiveRecord, two), -1, 0, NULL, 0}, + offsetof(FiveRecord, two), TCL_INDEX_NONE, 0, NULL, 0}, {TK_OPTION_INT, "-three", "three", "Three", "3", - Tk_Offset(FiveRecord, three), -1, 0, NULL, 0}, + offsetof(FiveRecord, three), TCL_INDEX_NONE, 0, NULL, 0}, {TK_OPTION_INT, "-four", "four", "Four", "4", - Tk_Offset(FiveRecord, four), -1, 0, NULL, 0}, + offsetof(FiveRecord, four), TCL_INDEX_NONE, 0, NULL, 0}, {TK_OPTION_STRING, "-five", NULL, NULL, NULL, - Tk_Offset(FiveRecord, five), -1, 0, NULL, 0}, + offsetof(FiveRecord, five), TCL_INDEX_NONE, 0, NULL, 0}, {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0} }; @@ -991,7 +997,7 @@ TestobjconfigObjCmd( return TCL_ERROR; } - recordPtr = ckalloc(sizeof(FiveRecord)); + recordPtr = (FiveRecord *)ckalloc(sizeof(FiveRecord)); recordPtr->header.interp = interp; recordPtr->header.optionTable = Tk_CreateOptionTable(interp, smallSpecs); @@ -1000,10 +1006,10 @@ TestobjconfigObjCmd( recordPtr->one = recordPtr->two = recordPtr->three = NULL; recordPtr->four = recordPtr->five = NULL; Tcl_SetObjResult(interp, objv[2]); - result = Tk_InitOptions(interp, (char *) recordPtr, + result = Tk_InitOptions(interp, recordPtr, recordPtr->header.optionTable, (Tk_Window) NULL); if (result == TCL_OK) { - result = Tk_SetOptions(interp, (char *) recordPtr, + result = Tk_SetOptions(interp, recordPtr, recordPtr->header.optionTable, objc - 3, objv + 3, (Tk_Window) NULL, NULL, NULL); if (result == TCL_OK) { @@ -1011,7 +1017,7 @@ TestobjconfigObjCmd( Tcl_GetString(objv[2]), TrivialConfigObjCmd, (ClientData) recordPtr, TrivialCmdDeletedProc); } else { - Tk_FreeConfigOptions((char *) recordPtr, + Tk_FreeConfigOptions(recordPtr, recordPtr->header.optionTable, (Tk_Window) NULL); } } @@ -1028,7 +1034,7 @@ TestobjconfigObjCmd( NotEnoughRecord record; static const Tk_OptionSpec errorSpecs[] = { {TK_OPTION_INT, "-foo", "foo", "Foo", "0", - Tk_Offset(NotEnoughRecord, fooObjPtr), 0, 0, NULL, 0}, + offsetof(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); @@ -1040,8 +1046,8 @@ TestobjconfigObjCmd( Tk_SetClass(tkwin, "Config"); optionTable = Tk_CreateOptionTable(interp, errorSpecs); tables[index] = optionTable; - Tk_InitOptions(interp, (char *) &record, optionTable, tkwin); - if (Tk_SetOptions(interp, (char *) &record, optionTable, 1, + Tk_InitOptions(interp, &record, optionTable, tkwin); + if (Tk_SetOptions(interp, &record, optionTable, 1, &newObjPtr, tkwin, NULL, NULL) != TCL_OK) { result = TCL_ERROR; } @@ -1059,11 +1065,11 @@ TestobjconfigObjCmd( ContentRecord *recordPtr; static const Tk_OptionSpec contentSpecs[] = { {TK_OPTION_WINDOW, "-window", "window", "Window", ".bar", - Tk_Offset(ContentRecord, windowPtr), -1, TK_CONFIG_NULL_OK, NULL, 0}, + offsetof(ContentRecord, windowPtr), TCL_INDEX_NONE, TK_CONFIG_NULL_OK, NULL, 0}, {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0} }; tkwin = Tk_CreateWindowFromPath(interp, - (Tk_Window) clientData, Tcl_GetString(objv[2]), NULL); + (Tk_Window)clientData, Tcl_GetString(objv[2]), NULL); if (tkwin == NULL) { return TCL_ERROR; @@ -1078,10 +1084,10 @@ TestobjconfigObjCmd( recordPtr->header.tkwin = tkwin; recordPtr->windowPtr = NULL; - result = Tk_InitOptions(interp, (char *) recordPtr, + result = Tk_InitOptions(interp, recordPtr, recordPtr->header.optionTable, tkwin); if (result == TCL_OK) { - result = Tk_SetOptions(interp, (char *) recordPtr, + result = Tk_SetOptions(interp, recordPtr, recordPtr->header.optionTable, objc - 3, objv + 3, tkwin, NULL, NULL); if (result == TCL_OK) { @@ -1092,7 +1098,7 @@ TestobjconfigObjCmd( TrivialEventProc, recordPtr); Tcl_SetObjResult(interp, objv[2]); } else { - Tk_FreeConfigOptions((char *) recordPtr, + Tk_FreeConfigOptions(recordPtr, recordPtr->header.optionTable, tkwin); } } @@ -1139,12 +1145,12 @@ TrivialConfigObjCmd( }; Tcl_Obj *resultObjPtr; int index, mask; - TrivialCommandHeader *headerPtr = (TrivialCommandHeader *) clientData; + TrivialCommandHeader *headerPtr = (TrivialCommandHeader *)clientData; Tk_Window tkwin = headerPtr->tkwin; Tk_SavedOptions saved; if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg...?"); + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } @@ -1162,7 +1168,7 @@ TrivialConfigObjCmd( result = TCL_ERROR; goto done; } - resultObjPtr = Tk_GetOptionValue(interp, (char *) clientData, + resultObjPtr = Tk_GetOptionValue(interp, clientData, headerPtr->optionTable, objv[2], tkwin); if (resultObjPtr != NULL) { Tcl_SetObjResult(interp, resultObjPtr); @@ -1173,7 +1179,7 @@ TrivialConfigObjCmd( break; case CONFIGURE: if (objc == 2) { - resultObjPtr = Tk_GetOptionInfo(interp, (char *) clientData, + resultObjPtr = Tk_GetOptionInfo(interp, clientData, headerPtr->optionTable, NULL, tkwin); if (resultObjPtr == NULL) { result = TCL_ERROR; @@ -1181,7 +1187,7 @@ TrivialConfigObjCmd( Tcl_SetObjResult(interp, resultObjPtr); } } else if (objc == 3) { - resultObjPtr = Tk_GetOptionInfo(interp, (char *) clientData, + resultObjPtr = Tk_GetOptionInfo(interp, clientData, headerPtr->optionTable, objv[2], tkwin); if (resultObjPtr == NULL) { result = TCL_ERROR; @@ -1189,21 +1195,21 @@ TrivialConfigObjCmd( Tcl_SetObjResult(interp, resultObjPtr); } } else { - result = Tk_SetOptions(interp, (char *) clientData, + result = Tk_SetOptions(interp, clientData, headerPtr->optionTable, objc - 2, objv + 2, tkwin, NULL, &mask); if (result == TCL_OK) { - Tcl_SetObjResult(interp, Tcl_NewIntObj(mask)); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(mask)); } } break; case CSAVE: - result = Tk_SetOptions(interp, (char *) clientData, + result = Tk_SetOptions(interp, clientData, headerPtr->optionTable, objc - 2, objv + 2, tkwin, &saved, &mask); Tk_FreeSavedOptions(&saved); if (result == TCL_OK) { - Tcl_SetObjResult(interp, Tcl_NewIntObj(mask)); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(mask)); } break; } @@ -1246,7 +1252,7 @@ TrivialCmdDeletedProc( * here. */ - Tk_FreeConfigOptions((char *)clientData, + Tk_FreeConfigOptions(clientData, headerPtr->optionTable, NULL); Tcl_EventuallyFree(clientData, TCL_DYNAMIC); } @@ -1277,7 +1283,7 @@ TrivialEventProc( if (eventPtr->type == DestroyNotify) { if (headerPtr->tkwin != NULL) { - Tk_FreeConfigOptions((char *)clientData, + Tk_FreeConfigOptions(clientData, headerPtr->optionTable, headerPtr->tkwin); headerPtr->optionTable = NULL; headerPtr->tkwin = NULL; @@ -1381,6 +1387,7 @@ ImageCreate( TImageModel *timPtr; const char *varName; int i; + (void)typePtr; varName = "log"; for (i = 0; i < objc; i += 2) { @@ -1901,6 +1908,60 @@ TestpropObjCmd( return TCL_OK; } +/* + *---------------------------------------------------------------------- + * + * TestpropObjCmd -- + * + * This function implements the "testprop" command. It fetches and prints + * the value of a property on a window. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TestprintfObjCmd( + ClientData dummy, /* Not used */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ +{ + char buffer[256]; + Tcl_WideInt wideInt; +#ifdef _WIN32 + __int64 longLongInt; +#else + long long longLongInt; +#endif + (void)dummy; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "wideint"); + return TCL_ERROR; + } + if (Tcl_GetWideIntFromObj(interp, objv[1], &wideInt) != TCL_OK) { + return TCL_ERROR; + } + longLongInt = wideInt; + + /* Just add a lot of arguments to sprintf. Reason: on AMD64, the first + * 4 or 6 arguments (we assume 8, just in case) might be put in registers, + * which still woudn't tell if the assumed size is correct: We want this + * test-case to fail if the 64-bit value is printed as truncated to 32-bit. + */ + sprintf(buffer, "%s%s%s%s%s%s%s%s%" TCL_LL_MODIFIER "d %" + TCL_LL_MODIFIER "u", "", "", "", "", "", "", "", "", + (Tcl_WideInt)longLongInt, (Tcl_WideUInt)longLongInt); + Tcl_AppendResult(interp, buffer, NULL); + return TCL_OK; +} + #if !(defined(_WIN32) || defined(MAC_OSX_TK) || defined(__CYGWIN__)) /* *---------------------------------------------------------------------- @@ -1984,7 +2045,7 @@ CustomOptionSet( TCL_UNUSED(Tk_Window), Tcl_Obj **value, char *recordPtr, - int internalOffset, + TkSizeT internalOffset, char *saveInternalPtr, int flags) { @@ -1993,7 +2054,7 @@ CustomOptionSet( objEmpty = 0; - if (internalOffset >= 0) { + if (internalOffset != TCL_INDEX_NONE) { internalPtr = recordPtr + internalOffset; } else { internalPtr = NULL; @@ -2043,32 +2104,86 @@ CustomOptionGet( TCL_UNUSED(void *), TCL_UNUSED(Tk_Window), char *recordPtr, - int internalOffset) + TkSizeT internalOffset) { return (Tcl_NewStringObj(*(char **)(recordPtr + internalOffset), -1)); } static void CustomOptionRestore( - ClientData clientData, + ClientData dummy, Tk_Window tkwin, char *internalPtr, char *saveInternalPtr) { + (void)dummy; + (void)tkwin; + *(char **)internalPtr = *(char **)saveInternalPtr; return; } static void CustomOptionFree( - ClientData clientData, + ClientData dummy, Tk_Window tkwin, char *internalPtr) { + (void)dummy; + (void)tkwin; + if (*(char **)internalPtr != NULL) { ckfree(*(char **)internalPtr); } } +/* + *---------------------------------------------------------------------- + * + * TestPhotoStringMatchCmd -- + * + * This function implements the "testphotostringmatch" command. It + * provides a way from Tcl to call the string match function for the + * default image handler directly. + * + * Results: + * A standard Tcl result. If data is in the proper format, the result in + * interp will contain width and height as a list. If the data cannot be + * parsed as default image format, returns TCL_ERROR and leaves an + * appropriate error message in interp. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TestPhotoStringMatchCmd( + ClientData clientData, /* Main window for application. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ +{ + Tcl_Obj *dummy = NULL; + Tcl_Obj *resultObj[2]; + int width, height; + (void)clientData; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "imageData"); + return TCL_ERROR; + } + if (TkDebugPhotoStringMatchDef(interp, objv[1], dummy, &width, &height)) { + resultObj[0] = Tcl_NewWideIntObj(width); + resultObj[1] = Tcl_NewWideIntObj(height); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObj)); + return TCL_OK; + } else { + return TCL_ERROR; + } +} + + /* * Local Variables: |