diff options
Diffstat (limited to 'generic/tkTest.c')
| -rw-r--r-- | generic/tkTest.c | 2415 |
1 files changed, 978 insertions, 1437 deletions
diff --git a/generic/tkTest.c b/generic/tkTest.c index 0d6657a..1df8ae8 100644 --- a/generic/tkTest.c +++ b/generic/tkTest.c @@ -1,28 +1,35 @@ -/* +/* * tkTest.c -- * - * This file contains C command procedures for a bunch of additional - * Tcl commands that are used for testing out Tcl's C interfaces. - * These commands are not normally included in Tcl applications; - * they're only used for testing. + * This file contains C command functions for a bunch of additional Tcl + * commands that are used for testing out Tcl's C interfaces. These + * commands are not normally included in Tcl applications; they're only + * used for testing. * * Copyright (c) 1993-1994 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998-1999 by Scriptics Corporation. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * 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 "tkPort.h" #include "tkText.h" #ifdef __WIN32__ #include "tkWinInt.h" #endif -#if defined(MAC_TCL) || defined(MAC_OSX_TK) +#if defined(MAC_OSX_TK) +#include "tkMacOSXInt.h" #include "tkScrollbar.h" #endif @@ -31,8 +38,16 @@ #endif /* - * The following data structure represents the master for a test - * image: + * 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: */ typedef struct TImageMaster { @@ -40,13 +55,13 @@ typedef struct TImageMaster { Tcl_Interp *interp; /* Interpreter for application. */ int width, height; /* Dimensions of image. */ char *imageName; /* Name of image (malloc-ed). */ - char *varName; /* Name of variable in which to log - * events for image (malloc-ed). */ + char *varName; /* Name of variable in which to log events for + * image (malloc-ed). */ } TImageMaster; /* - * The following data structure represents a particular use of a - * particular test image. + * The following data structure represents a particular use of a particular + * test image. */ typedef struct TImageInstance { @@ -59,43 +74,35 @@ typedef struct TImageInstance { * The type record for test images: */ -#ifdef USE_OLD_IMAGE -static int ImageCreate _ANSI_ARGS_((Tcl_Interp *interp, - char *name, int argc, char **argv, - Tk_ImageType *typePtr, Tk_ImageMaster master, - ClientData *clientDataPtr)); -#else -static int ImageCreate _ANSI_ARGS_((Tcl_Interp *interp, - char *name, int argc, Tcl_Obj *CONST objv[], - Tk_ImageType *typePtr, Tk_ImageMaster master, - ClientData *clientDataPtr)); -#endif -static ClientData ImageGet _ANSI_ARGS_((Tk_Window tkwin, - ClientData clientData)); -static void ImageDisplay _ANSI_ARGS_((ClientData clientData, - Display *display, Drawable drawable, +static int ImageCreate(Tcl_Interp *interp, + 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, + Display *display, Drawable drawable, int imageX, int imageY, int width, int height, int drawableX, - int drawableY)); -static void ImageFree _ANSI_ARGS_((ClientData clientData, - Display *display)); -static void ImageDelete _ANSI_ARGS_((ClientData clientData)); + int drawableY); +static void ImageFree(ClientData clientData, Display *display); +static void ImageDelete(ClientData clientData); static Tk_ImageType imageType = { "test", /* name */ - (Tk_ImageCreateProc *) ImageCreate, /* createProc */ + ImageCreate, /* createProc */ ImageGet, /* getProc */ ImageDisplay, /* displayProc */ ImageFree, /* freeProc */ ImageDelete, /* deleteProc */ - (Tk_ImagePostscriptProc *) NULL,/* postscriptPtr */ - (Tk_ImageType *) NULL /* nextPtr */ + NULL, /* postscriptPtr */ + NULL, /* nextPtr */ + NULL }; /* - * One of the following structures describes each of the interpreters - * created by the "testnewapp" command. This information is used by - * the "testdeleteinterps" command to destroy all of those interpreters. + * One of the following structures describes each of the interpreters created + * by the "testnewapp" command. This information is used by the + * "testdeleteinterps" command to destroy all of those interpreters. */ typedef struct NewApp { @@ -103,143 +110,103 @@ typedef struct NewApp { struct NewApp *nextPtr; /* Next in list of new interpreters. */ } NewApp; -static NewApp *newAppPtr = NULL; - /* First in list of all new interpreters. */ - -/* - * Declaration for the square widget's class command procedure: - */ - -extern int SquareObjCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[])); - -typedef struct CBinding { - Tcl_Interp *interp; - char *command; - char *delete; -} CBinding; +static NewApp *newAppPtr = NULL;/* First in list of all new interpreters. */ /* * 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, - ODD_TYPE, + ODD_TYPE, EVEN_TYPE }; typedef struct TrivialCommandHeader { - Tcl_Interp *interp; /* The interp that this command - * lives in. */ - Tk_OptionTable optionTable; /* The option table that go with - * this command. */ - Tk_Window tkwin; /* For widgets, the window associated - * with this widget. */ - Tcl_Command widgetCmd; /* For widgets, the command associated - * with this widget. */ + Tcl_Interp *interp; /* The interp that this command lives in. */ + Tk_OptionTable optionTable; /* The option table that go with this + * command. */ + Tk_Window tkwin; /* For widgets, the window associated with + * this widget. */ + Tcl_Command widgetCmd; /* For widgets, the command associated with + * this widget. */ } TrivialCommandHeader; - - /* - * Forward declarations for procedures defined later in this file: + * Forward declarations for functions defined later in this file: */ -static int CBindingEvalProc _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, XEvent *eventPtr, - Tk_Window tkwin, KeySym keySym)); -static void CBindingFreeProc _ANSI_ARGS_((ClientData clientData)); -int Tktest_Init _ANSI_ARGS_((Tcl_Interp *interp)); -static int ImageCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TestcbindCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TestbitmapObjCmd _ANSI_ARGS_((ClientData dummy, +static int ImageCmd(ClientData dummy, + Tcl_Interp *interp, int argc, const char **argv); +static int TestbitmapObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, - Tcl_Obj * CONST objv[])); -static int TestborderObjCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Obj * const objv[]); +static int TestborderObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, - Tcl_Obj * CONST objv[])); -static int TestcolorObjCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Obj * const objv[]); +static int TestcolorObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, - Tcl_Obj * CONST objv[])); -static int TestcursorObjCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Obj * const objv[]); +static int TestcursorObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, - Tcl_Obj * CONST objv[])); -static int TestdeleteappsCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TestfontObjCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Obj * const objv[]); +static int TestdeleteappsCmd(ClientData dummy, + Tcl_Interp *interp, int argc, const char **argv); +static int TestfontObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int TestmakeexistCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -#if !(defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK)) -static int TestmenubarCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); + Tcl_Obj *const objv[]); +static int TestmakeexistCmd(ClientData dummy, + Tcl_Interp *interp, int argc, const char **argv); +#if !(defined(__WIN32__) || defined(MAC_OSX_TK)) +static int TestmenubarCmd(ClientData dummy, + Tcl_Interp *interp, int argc, const char **argv); #endif -#if defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK) -static int TestmetricsCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); +#if defined(__WIN32__) || defined(MAC_OSX_TK) +static int TestmetricsCmd(ClientData dummy, + Tcl_Interp *interp, int argc, const char **argv); #endif -static int TestobjconfigObjCmd _ANSI_ARGS_((ClientData dummy, +static int TestobjconfigObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, - Tcl_Obj * CONST objv[])); -static int CustomOptionSet _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, Tk_Window tkwin, - Tcl_Obj **value, char *recordPtr, int internalOffset, - char *saveInternalPtr, int flags)); -static Tcl_Obj *CustomOptionGet _ANSI_ARGS_((ClientData clientData, - Tk_Window tkwin, char *recordPtr, int internalOffset)); -static void CustomOptionRestore _ANSI_ARGS_((ClientData clientData, - Tk_Window tkwin, char *internalPtr, - char *saveInternalPtr)); -static void CustomOptionFree _ANSI_ARGS_((ClientData clientData, - Tk_Window tkwin, char *internalPtr)); -static int TestpropCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -#if !(defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK)) -static int TestsendCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); + 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 int TestpropCmd(ClientData dummy, + Tcl_Interp *interp, int argc, const char **argv); +#if !(defined(__WIN32__) || defined(MAC_OSX_TK)) +static int TestwrapperCmd(ClientData dummy, + Tcl_Interp *interp, int argc, const char **argv); #endif -static int TesttextCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -#if !(defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK)) -static int TestwrapperCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -#endif -static void TrivialCmdDeletedProc _ANSI_ARGS_(( - ClientData clientData)); -static int TrivialConfigObjCmd _ANSI_ARGS_((ClientData dummy, +static void TrivialCmdDeletedProc(ClientData clientData); +static int TrivialConfigObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, - Tcl_Obj * CONST objv[])); -static void TrivialEventProc _ANSI_ARGS_((ClientData clientData, - XEvent *eventPtr)); - -/* - * External (platform specific) initialization routine: - */ - -extern int TkplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp)); - -#if !(defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK)) -#define TkplatformtestInit(x) TCL_OK -#endif + Tcl_Obj * const objv[]); +static void TrivialEventProc(ClientData clientData, + XEvent *eventPtr); /* *---------------------------------------------------------------------- * * Tktest_Init -- * - * This procedure performs intialization for the Tk test - * suite exensions. + * This function performs intialization for the Tk test suite exensions. * * Results: - * Returns a standard Tcl completion code, and leaves an error - * message in the interp's result if an error occurs. + * Returns a standard Tcl completion code, and leaves an error message in + * the interp's result if an error occurs. * * Side effects: * Creates several test commands. @@ -248,11 +215,18 @@ extern int TkplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp)); */ int -Tktest_Init(interp) - Tcl_Interp *interp; /* Interpreter for application. */ +Tktest_Init( + Tcl_Interp *interp) /* Interpreter for application. */ { static int initialized = 0; + if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { + return TCL_ERROR; + } + if (Tk_InitStubs(interp, "8.1", 0) == NULL) { + return TCL_ERROR; + } + /* * Create additional commands for testing Tk. */ @@ -261,48 +235,41 @@ Tktest_Init(interp) return TCL_ERROR; } - Tcl_CreateObjCommand(interp, "square", SquareObjCmd, - (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateCommand(interp, "testcbind", TestcbindCmd, - (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateObjCommand(interp, "square", SquareObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testbitmap", TestbitmapObjCmd, - (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); + (ClientData) Tk_MainWindow(interp), NULL); Tcl_CreateObjCommand(interp, "testborder", TestborderObjCmd, - (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); + (ClientData) Tk_MainWindow(interp), NULL); Tcl_CreateObjCommand(interp, "testcolor", TestcolorObjCmd, - (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); + (ClientData) Tk_MainWindow(interp), NULL); Tcl_CreateObjCommand(interp, "testcursor", TestcursorObjCmd, - (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); + (ClientData) Tk_MainWindow(interp), NULL); Tcl_CreateCommand(interp, "testdeleteapps", TestdeleteappsCmd, - (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); + (ClientData) Tk_MainWindow(interp), NULL); Tcl_CreateCommand(interp, "testembed", TkpTestembedCmd, - (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); + (ClientData) Tk_MainWindow(interp), NULL); Tcl_CreateObjCommand(interp, "testobjconfig", TestobjconfigObjCmd, - (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); + (ClientData) Tk_MainWindow(interp), NULL); Tcl_CreateObjCommand(interp, "testfont", TestfontObjCmd, - (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); + (ClientData) Tk_MainWindow(interp), NULL); Tcl_CreateCommand(interp, "testmakeexist", TestmakeexistCmd, - (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); -#if !(defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK)) - Tcl_CreateCommand(interp, "testmenubar", TestmenubarCmd, - (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); -#endif -#if defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK) - Tcl_CreateCommand(interp, "testmetrics", TestmetricsCmd, - (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); -#endif + (ClientData) Tk_MainWindow(interp), NULL); Tcl_CreateCommand(interp, "testprop", TestpropCmd, - (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); -#if !(defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK)) - Tcl_CreateCommand(interp, "testsend", TestsendCmd, - (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); -#endif - Tcl_CreateCommand(interp, "testtext", TesttextCmd, - (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); -#if !(defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK)) + (ClientData) Tk_MainWindow(interp), NULL); + Tcl_CreateCommand(interp, "testtext", TkpTesttextCmd, + (ClientData) Tk_MainWindow(interp), NULL); + +#if defined(__WIN32__) || defined(MAC_OSX_TK) + Tcl_CreateCommand(interp, "testmetrics", TestmetricsCmd, + (ClientData) Tk_MainWindow(interp), NULL); +#else + Tcl_CreateCommand(interp, "testmenubar", TestmenubarCmd, + (ClientData) Tk_MainWindow(interp), NULL); + Tcl_CreateCommand(interp, "testsend", TkpTestsendCmd, + (ClientData) Tk_MainWindow(interp), NULL); Tcl_CreateCommand(interp, "testwrapper", TestwrapperCmd, - (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); -#endif + (ClientData) Tk_MainWindow(interp), NULL); +#endif /* __WIN32__ || MAC_OSX_TK */ /* * Create test image type. @@ -314,117 +281,18 @@ Tktest_Init(interp) } /* - * And finally add any platform specific test commands. + * Enable testing of legacy interfaces. */ - - return TkplatformtestInit(interp); -} - -/* - *---------------------------------------------------------------------- - * - * TestcbindCmd -- - * - * This procedure 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, interp, argc, argv) - 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?", (char *) 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); + if (TkOldTestInit(interp) != TCL_OK) { return TCL_ERROR; } - return TCL_OK; -} - -static int -CBindingEvalProc(clientData, interp, eventPtr, tkwin, keySym) - ClientData clientData; - Tcl_Interp *interp; - XEvent *eventPtr; - Tk_Window tkwin; - KeySym keySym; -{ - CBinding *cbindPtr; - cbindPtr = (CBinding *) clientData; - - return Tcl_GlobalEval(interp, cbindPtr->command); -} + /* + * And finally add any platform specific test commands. + */ -static void -CBindingFreeProc(clientData) - ClientData clientData; -{ - CBinding *cbindPtr = (CBinding *) clientData; - - if (cbindPtr->delete != NULL) { - Tcl_GlobalEval(cbindPtr->interp, cbindPtr->delete); - ckfree((char *) cbindPtr->delete); - } - ckfree((char *) cbindPtr->command); - ckfree((char *) cbindPtr); + return TkplatformtestInit(interp); } /* @@ -432,8 +300,8 @@ CBindingFreeProc(clientData) * * TestbitmapObjCmd -- * - * This procedure implements the "testbitmap" command, which is used - * to test color resource handling in tkBitmap tmp.c. + * This function implements the "testbitmap" command, which is used to + * test color resource handling in tkBitmap tmp.c. * * Results: * A standard Tcl result. @@ -446,11 +314,11 @@ CBindingFreeProc(clientData) /* ARGSUSED */ static int -TestbitmapObjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Main window for application. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +TestbitmapObjCmd( + ClientData clientData, /* Main window for application. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc < 2) { @@ -467,8 +335,8 @@ TestbitmapObjCmd(clientData, interp, objc, objv) * * TestborderObjCmd -- * - * This procedure implements the "testborder" command, which is used - * to test color resource handling in tkBorder.c. + * This function implements the "testborder" command, which is used to + * test color resource handling in tkBorder.c. * * Results: * A standard Tcl result. @@ -481,11 +349,11 @@ TestbitmapObjCmd(clientData, interp, objc, objv) /* ARGSUSED */ static int -TestborderObjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Main window for application. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +TestborderObjCmd( + ClientData clientData, /* Main window for application. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc < 2) { @@ -502,8 +370,8 @@ TestborderObjCmd(clientData, interp, objc, objv) * * TestcolorObjCmd -- * - * This procedure implements the "testcolor" command, which is used - * to test color resource handling in tkColor.c. + * This function implements the "testcolor" command, which is used to + * test color resource handling in tkColor.c. * * Results: * A standard Tcl result. @@ -516,13 +384,12 @@ TestborderObjCmd(clientData, interp, objc, objv) /* ARGSUSED */ static int -TestcolorObjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Main window for application. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +TestcolorObjCmd( + ClientData clientData, /* Main window for application. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { - if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "color"); return TCL_ERROR; @@ -537,8 +404,8 @@ TestcolorObjCmd(clientData, interp, objc, objv) * * TestcursorObjCmd -- * - * This procedure implements the "testcursor" command, which is used - * to test color resource handling in tkCursor.c. + * This function implements the "testcursor" command, which is used to + * test color resource handling in tkCursor.c. * * Results: * A standard Tcl result. @@ -551,13 +418,12 @@ TestcolorObjCmd(clientData, interp, objc, objv) /* ARGSUSED */ static int -TestcursorObjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Main window for application. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +TestcursorObjCmd( + ClientData clientData, /* Main window for application. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { - if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "cursor"); return TCL_ERROR; @@ -572,33 +438,33 @@ TestcursorObjCmd(clientData, interp, objc, objv) * * TestdeleteappsCmd -- * - * This procedure implements the "testdeleteapps" command. It cleans - * up all the interpreters left behind by the "testnewapp" command. + * This function implements the "testdeleteapps" command. It cleans up + * all the interpreters left behind by the "testnewapp" command. * * Results: * A standard Tcl result. * * Side effects: - * All the intepreters created by previous calls to "testnewapp" - * get deleted. + * All the intepreters created by previous calls to "testnewapp" get + * deleted. * *---------------------------------------------------------------------- */ /* ARGSUSED */ static int -TestdeleteappsCmd(clientData, interp, argc, argv) - ClientData clientData; /* Main window for application. */ - Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - CONST char **argv; /* Argument strings. */ +TestdeleteappsCmd( + ClientData clientData, /* Main window for application. */ + Tcl_Interp *interp, /* Current interpreter. */ + int argc, /* Number of arguments. */ + const char **argv) /* Argument strings. */ { NewApp *nextPtr; while (newAppPtr != NULL) { nextPtr = newAppPtr->nextPtr; Tcl_DeleteInterp(newAppPtr->interp); - ckfree((char *) newAppPtr); + ckfree(newAppPtr); newAppPtr = nextPtr; } @@ -610,8 +476,8 @@ TestdeleteappsCmd(clientData, interp, argc, argv) * * TestobjconfigObjCmd -- * - * This procedure implements the "testobjconfig" command, - * which is used to test the procedures in tkConfig.c. + * This function implements the "testobjconfig" command, which is used to + * test the functions in tkConfig.c. * * Results: * A standard Tcl result. @@ -624,46 +490,40 @@ TestdeleteappsCmd(clientData, interp, argc, argv) /* ARGSUSED */ static int -TestobjconfigObjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Main window for application. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +TestobjconfigObjCmd( + ClientData clientData, /* Main window for application. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { - static CONST char *options[] = {"alltypes", "chain1", "chain2", - "configerror", "delete", "info", "internal", "new", - "notenoughparams", "twowindows", (char *) NULL}; + static const char *const options[] = { + "alltypes", "chain1", "chain2", "configerror", "delete", "info", + "internal", "new", "notenoughparams", "twowindows", NULL + }; enum { - ALL_TYPES, - CHAIN1, - CHAIN2, - CONFIG_ERROR, + ALL_TYPES, CHAIN1, CHAIN2, CONFIG_ERROR, DEL, /* Can't use DELETE: VC++ compiler barfs. */ - INFO, - INTERNAL, - NEW, - NOT_ENOUGH_PARAMS, - TWO_WINDOWS + INFO, INTERNAL, NEW, NOT_ENOUGH_PARAMS, TWO_WINDOWS }; - static Tk_OptionTable tables[11]; /* Holds pointers to option tables - * created by commands below; indexed - * with same values as "options" - * array. */ - static Tk_ObjCustomOption CustomOption = { + static Tk_OptionTable tables[11]; + /* Holds pointers to option tables created by + * commands below; indexed with same values as + * "options" array. */ + static const Tk_ObjCustomOption CustomOption = { "custom option", - CustomOptionSet, - CustomOptionGet, - CustomOptionRestore, - CustomOptionFree, - (ClientData) 1 + CustomOptionSet, + CustomOptionGet, + CustomOptionRestore, + CustomOptionFree, + INT2PTR(1) }; Tk_Window mainWin = (Tk_Window) clientData; Tk_Window tkwin; int index, result = TCL_OK; /* - * Structures used by the "chain1" subcommand and also shared by - * the "chain2" subcommand: + * Structures used by the "chain1" subcommand and also shared by the + * "chain2" subcommand: */ typedef struct ExtensionWidgetRecord { @@ -674,14 +534,12 @@ TestobjconfigObjCmd(clientData, interp, objc, objv) Tcl_Obj *extension4ObjPtr; Tcl_Obj *extension5ObjPtr; } ExtensionWidgetRecord; - static Tk_OptionSpec baseSpecs[] = { - {TK_OPTION_STRING, - "-one", "one", "One", "one", - Tk_Offset(ExtensionWidgetRecord, base1ObjPtr), -1}, - {TK_OPTION_STRING, - "-two", "two", "Two", "two", - Tk_Offset(ExtensionWidgetRecord, base2ObjPtr), -1}, - {TK_OPTION_END} + static const Tk_OptionSpec baseSpecs[] = { + {TK_OPTION_STRING, "-one", "one", "One", "one", + Tk_Offset(ExtensionWidgetRecord, base1ObjPtr), -1, 0, NULL, 0}, + {TK_OPTION_STRING, "-two", "two", "Two", "two", + Tk_Offset(ExtensionWidgetRecord, base2ObjPtr), -1, 0, NULL, 0}, + {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0} }; if (objc < 2) { @@ -695,633 +553,548 @@ TestobjconfigObjCmd(clientData, interp, objc, objv) } switch (index) { - case ALL_TYPES: { - typedef struct TypesRecord { - TrivialCommandHeader header; - Tcl_Obj *booleanPtr; - Tcl_Obj *integerPtr; - Tcl_Obj *doublePtr; - Tcl_Obj *stringPtr; - Tcl_Obj *stringTablePtr; - Tcl_Obj *colorPtr; - Tcl_Obj *fontPtr; - Tcl_Obj *bitmapPtr; - Tcl_Obj *borderPtr; - Tcl_Obj *reliefPtr; - Tcl_Obj *cursorPtr; - Tcl_Obj *activeCursorPtr; - Tcl_Obj *justifyPtr; - Tcl_Obj *anchorPtr; - Tcl_Obj *pixelPtr; - Tcl_Obj *mmPtr; - Tcl_Obj *customPtr; - } TypesRecord; - TypesRecord *recordPtr; - static char *stringTable[] = {"one", "two", "three", "four", - (char *) NULL}; - static Tk_OptionSpec typesSpecs[] = { - {TK_OPTION_BOOLEAN, - "-boolean", "boolean", "Boolean", - "1", Tk_Offset(TypesRecord, booleanPtr), -1, 0, 0, 0x1}, - {TK_OPTION_INT, - "-integer", "integer", "Integer", - "7", Tk_Offset(TypesRecord, integerPtr), -1, 0, 0, 0x2}, - {TK_OPTION_DOUBLE, - "-double", "double", "Double", - "3.14159", Tk_Offset(TypesRecord, doublePtr), -1, 0, 0, - 0x4}, - {TK_OPTION_STRING, - "-string", "string", "String", - "foo", Tk_Offset(TypesRecord, stringPtr), -1, - TK_CONFIG_NULL_OK, 0, 0x8}, - {TK_OPTION_STRING_TABLE, - "-stringtable", "StringTable", "stringTable", - "one", Tk_Offset(TypesRecord, stringTablePtr), -1, - TK_CONFIG_NULL_OK, (ClientData) stringTable, 0x10}, - {TK_OPTION_COLOR, - "-color", "color", "Color", - "red", Tk_Offset(TypesRecord, colorPtr), -1, - TK_CONFIG_NULL_OK, (ClientData) "black", 0x20}, - {TK_OPTION_FONT, - "-font", "font", "Font", - "Helvetica 12", - Tk_Offset(TypesRecord, fontPtr), -1, - TK_CONFIG_NULL_OK, 0, 0x40}, - {TK_OPTION_BITMAP, - "-bitmap", "bitmap", "Bitmap", - "gray50", - Tk_Offset(TypesRecord, bitmapPtr), -1, - 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_OPTION_RELIEF, - "-relief", "relief", "Relief", - "raised", - Tk_Offset(TypesRecord, reliefPtr), -1, - TK_CONFIG_NULL_OK, 0, 0x200}, - {TK_OPTION_CURSOR, - "-cursor", "cursor", "Cursor", - "xterm", - Tk_Offset(TypesRecord, cursorPtr), -1, - TK_CONFIG_NULL_OK, 0, 0x400}, - {TK_OPTION_JUSTIFY, - "-justify", (char *) NULL, (char *) NULL, - "left", - Tk_Offset(TypesRecord, justifyPtr), -1, - TK_CONFIG_NULL_OK, 0, 0x800}, - {TK_OPTION_ANCHOR, - "-anchor", "anchor", "Anchor", - (char *) NULL, - Tk_Offset(TypesRecord, anchorPtr), -1, - TK_CONFIG_NULL_OK, 0, 0x1000}, - {TK_OPTION_PIXELS, - "-pixel", "pixel", "Pixel", - "1", Tk_Offset(TypesRecord, pixelPtr), -1, - TK_CONFIG_NULL_OK, 0, 0x2000}, - {TK_OPTION_CUSTOM, - "-custom", (char *) NULL, (char *) NULL, - "", Tk_Offset(TypesRecord, customPtr), -1, - TK_CONFIG_NULL_OK, (ClientData)&CustomOption, 0x4000}, - {TK_OPTION_SYNONYM, - "-synonym", (char *) NULL, (char *) NULL, - (char *) NULL, 0, -1, 0, (ClientData) "-color", - 0x8000}, - {TK_OPTION_END} - }; - Tk_OptionTable optionTable; - Tk_Window tkwin; - optionTable = Tk_CreateOptionTable(interp, - typesSpecs); - tables[index] = optionTable; - tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window) clientData, - Tcl_GetStringFromObj(objv[2], NULL), (char *) NULL); - if (tkwin == NULL) { - return TCL_ERROR; - } - Tk_SetClass(tkwin, "Test"); - - recordPtr = (TypesRecord *) ckalloc(sizeof(TypesRecord)); - recordPtr->header.interp = interp; - recordPtr->header.optionTable = optionTable; - recordPtr->header.tkwin = tkwin; - recordPtr->booleanPtr = NULL; - recordPtr->integerPtr = NULL; - recordPtr->doublePtr = NULL; - recordPtr->stringPtr = NULL; - recordPtr->colorPtr = NULL; - recordPtr->fontPtr = NULL; - recordPtr->bitmapPtr = NULL; - recordPtr->borderPtr = NULL; - recordPtr->reliefPtr = NULL; - recordPtr->cursorPtr = NULL; - recordPtr->justifyPtr = NULL; - recordPtr->anchorPtr = NULL; - recordPtr->pixelPtr = NULL; - recordPtr->mmPtr = NULL; - recordPtr->stringTablePtr = NULL; - recordPtr->customPtr = NULL; - result = Tk_InitOptions(interp, (char *) recordPtr, optionTable, - tkwin); - if (result == TCL_OK) { - recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp, - Tcl_GetStringFromObj(objv[2], NULL), - TrivialConfigObjCmd, (ClientData) recordPtr, - TrivialCmdDeletedProc); - Tk_CreateEventHandler(tkwin, StructureNotifyMask, - TrivialEventProc, (ClientData) recordPtr); - result = Tk_SetOptions(interp, (char *) recordPtr, - optionTable, objc - 3, objv + 3, tkwin, - (Tk_SavedOptions *) NULL, (int *) NULL); - if (result != TCL_OK) { - Tk_DestroyWindow(tkwin); - } - } else { + case ALL_TYPES: { + typedef struct TypesRecord { + TrivialCommandHeader header; + Tcl_Obj *booleanPtr; + Tcl_Obj *integerPtr; + Tcl_Obj *doublePtr; + Tcl_Obj *stringPtr; + Tcl_Obj *stringTablePtr; + Tcl_Obj *colorPtr; + Tcl_Obj *fontPtr; + Tcl_Obj *bitmapPtr; + Tcl_Obj *borderPtr; + Tcl_Obj *reliefPtr; + Tcl_Obj *cursorPtr; + Tcl_Obj *activeCursorPtr; + Tcl_Obj *justifyPtr; + Tcl_Obj *anchorPtr; + Tcl_Obj *pixelPtr; + Tcl_Obj *mmPtr; + Tcl_Obj *customPtr; + } TypesRecord; + TypesRecord *recordPtr; + static const char *const stringTable[] = { + "one", "two", "three", "four", NULL + }; + static const Tk_OptionSpec typesSpecs[] = { + {TK_OPTION_BOOLEAN, "-boolean", "boolean", "Boolean", "1", + Tk_Offset(TypesRecord, booleanPtr), -1, 0, 0, 0x1}, + {TK_OPTION_INT, "-integer", "integer", "Integer", "7", + Tk_Offset(TypesRecord, integerPtr), -1, 0, 0, 0x2}, + {TK_OPTION_DOUBLE, "-double", "double", "Double", "3.14159", + Tk_Offset(TypesRecord, doublePtr), -1, 0, 0, 0x4}, + {TK_OPTION_STRING, "-string", "string", "String", + "foo", Tk_Offset(TypesRecord, stringPtr), -1, + TK_CONFIG_NULL_OK, 0, 0x8}, + {TK_OPTION_STRING_TABLE, + "-stringtable", "StringTable", "stringTable", + "one", Tk_Offset(TypesRecord, stringTablePtr), -1, + TK_CONFIG_NULL_OK, (ClientData) stringTable, 0x10}, + {TK_OPTION_COLOR, "-color", "color", "Color", + "red", Tk_Offset(TypesRecord, colorPtr), -1, + TK_CONFIG_NULL_OK, (ClientData) "black", 0x20}, + {TK_OPTION_FONT, "-font", "font", "Font", "Helvetica 12", + Tk_Offset(TypesRecord, fontPtr), -1, + TK_CONFIG_NULL_OK, 0, 0x40}, + {TK_OPTION_BITMAP, "-bitmap", "bitmap", "Bitmap", "gray50", + Tk_Offset(TypesRecord, bitmapPtr), -1, + 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_OPTION_RELIEF, "-relief", "relief", "Relief", "raised", + Tk_Offset(TypesRecord, reliefPtr), -1, + TK_CONFIG_NULL_OK, 0, 0x200}, + {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor", "xterm", + Tk_Offset(TypesRecord, cursorPtr), -1, + TK_CONFIG_NULL_OK, 0, 0x400}, + {TK_OPTION_JUSTIFY, "-justify", NULL, NULL, "left", + Tk_Offset(TypesRecord, justifyPtr), -1, + TK_CONFIG_NULL_OK, 0, 0x800}, + {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor", NULL, + Tk_Offset(TypesRecord, anchorPtr), -1, + TK_CONFIG_NULL_OK, 0, 0x1000}, + {TK_OPTION_PIXELS, "-pixel", "pixel", "Pixel", + "1", Tk_Offset(TypesRecord, pixelPtr), -1, + 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_OPTION_SYNONYM, "-synonym", NULL, NULL, + NULL, 0, -1, 0, (ClientData) "-color", 0x8000}, + {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0} + }; + Tk_OptionTable optionTable; + Tk_Window tkwin; + + optionTable = Tk_CreateOptionTable(interp, typesSpecs); + tables[index] = optionTable; + 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(TypesRecord)); + recordPtr->header.interp = interp; + recordPtr->header.optionTable = optionTable; + recordPtr->header.tkwin = tkwin; + recordPtr->booleanPtr = NULL; + recordPtr->integerPtr = NULL; + recordPtr->doublePtr = NULL; + recordPtr->stringPtr = NULL; + recordPtr->colorPtr = NULL; + recordPtr->fontPtr = NULL; + recordPtr->bitmapPtr = NULL; + recordPtr->borderPtr = NULL; + recordPtr->reliefPtr = NULL; + recordPtr->cursorPtr = NULL; + recordPtr->justifyPtr = NULL; + recordPtr->anchorPtr = NULL; + recordPtr->pixelPtr = NULL; + recordPtr->mmPtr = NULL; + recordPtr->stringTablePtr = NULL; + recordPtr->customPtr = NULL; + result = Tk_InitOptions(interp, (char *) recordPtr, optionTable, + tkwin); + if (result == TCL_OK) { + recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp, + Tcl_GetString(objv[2]), TrivialConfigObjCmd, + (ClientData) recordPtr, TrivialCmdDeletedProc); + Tk_CreateEventHandler(tkwin, StructureNotifyMask, + TrivialEventProc, (ClientData) recordPtr); + result = Tk_SetOptions(interp, (char *) recordPtr, optionTable, + objc-3, objv+3, tkwin, NULL, NULL); + if (result != TCL_OK) { Tk_DestroyWindow(tkwin); - ckfree((char *) recordPtr); } - if (result == TCL_OK) { - Tcl_SetObjResult(interp, objv[2]); - } - break; + } else { + Tk_DestroyWindow(tkwin); + ckfree(recordPtr); + } + if (result == TCL_OK) { + Tcl_SetObjResult(interp, objv[2]); } + break; + } - case CHAIN1: { - ExtensionWidgetRecord *recordPtr; - Tk_Window tkwin; - Tk_OptionTable optionTable; + case CHAIN1: { + ExtensionWidgetRecord *recordPtr; + Tk_Window tkwin; + Tk_OptionTable optionTable; - tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window) clientData, - Tcl_GetStringFromObj(objv[2], NULL), (char *) NULL); - if (tkwin == NULL) { - return TCL_ERROR; - } - Tk_SetClass(tkwin, "Test"); - optionTable = Tk_CreateOptionTable(interp, baseSpecs); - tables[index] = optionTable; - - recordPtr = (ExtensionWidgetRecord *) ckalloc( - sizeof(ExtensionWidgetRecord)); - recordPtr->header.interp = interp; - recordPtr->header.optionTable = optionTable; - recordPtr->header.tkwin = tkwin; - recordPtr->base1ObjPtr = recordPtr->base2ObjPtr = NULL; - recordPtr->extension3ObjPtr = recordPtr->extension4ObjPtr = NULL; - result = Tk_InitOptions(interp, (char *) recordPtr, optionTable, - tkwin); - if (result == TCL_OK) { - result = Tk_SetOptions(interp, (char *) recordPtr, optionTable, - objc - 3, objv + 3, tkwin, (Tk_SavedOptions *) NULL, - (int *) NULL); - if (result != TCL_OK) { - Tk_FreeConfigOptions((char *) recordPtr, optionTable, - tkwin); - } + tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window) clientData, + Tcl_GetString(objv[2]), NULL); + if (tkwin == NULL) { + return TCL_ERROR; + } + Tk_SetClass(tkwin, "Test"); + optionTable = Tk_CreateOptionTable(interp, baseSpecs); + tables[index] = optionTable; + + recordPtr = ckalloc(sizeof(ExtensionWidgetRecord)); + recordPtr->header.interp = interp; + recordPtr->header.optionTable = optionTable; + recordPtr->header.tkwin = tkwin; + recordPtr->base1ObjPtr = recordPtr->base2ObjPtr = NULL; + recordPtr->extension3ObjPtr = recordPtr->extension4ObjPtr = NULL; + result = Tk_InitOptions(interp, (char *)recordPtr, optionTable, tkwin); + if (result == TCL_OK) { + result = Tk_SetOptions(interp, (char *) recordPtr, optionTable, + objc-3, objv+3, tkwin, NULL, NULL); + if (result != TCL_OK) { + Tk_FreeConfigOptions((char *) recordPtr, optionTable, tkwin); } - if (result == TCL_OK) { - recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp, - Tcl_GetStringFromObj(objv[2], NULL), - TrivialConfigObjCmd, (ClientData) recordPtr, - TrivialCmdDeletedProc); - Tk_CreateEventHandler(tkwin, StructureNotifyMask, - TrivialEventProc, (ClientData) recordPtr); - Tcl_SetObjResult(interp, objv[2]); + } + if (result == TCL_OK) { + recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp, + Tcl_GetString(objv[2]), TrivialConfigObjCmd, + (ClientData) recordPtr, TrivialCmdDeletedProc); + Tk_CreateEventHandler(tkwin, StructureNotifyMask, + TrivialEventProc, (ClientData) recordPtr); + Tcl_SetObjResult(interp, objv[2]); + } + break; + } + + case CHAIN2: { + ExtensionWidgetRecord *recordPtr; + static const Tk_OptionSpec extensionSpecs[] = { + {TK_OPTION_STRING, "-three", "three", "Three", "three", + Tk_Offset(ExtensionWidgetRecord, extension3ObjPtr), -1, 0, NULL, 0}, + {TK_OPTION_STRING, "-four", "four", "Four", "four", + Tk_Offset(ExtensionWidgetRecord, extension4ObjPtr), -1, 0, NULL, 0}, + {TK_OPTION_STRING, "-two", "two", "Two", "two and a half", + Tk_Offset(ExtensionWidgetRecord, base2ObjPtr), -1, 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, + (ClientData) baseSpecs, 0} + }; + Tk_Window tkwin; + Tk_OptionTable optionTable; + + tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window) clientData, + Tcl_GetString(objv[2]), NULL); + if (tkwin == NULL) { + return TCL_ERROR; + } + Tk_SetClass(tkwin, "Test"); + optionTable = Tk_CreateOptionTable(interp, extensionSpecs); + tables[index] = optionTable; + + recordPtr = ckalloc(sizeof(ExtensionWidgetRecord)); + recordPtr->header.interp = interp; + recordPtr->header.optionTable = optionTable; + recordPtr->header.tkwin = tkwin; + recordPtr->base1ObjPtr = recordPtr->base2ObjPtr = NULL; + recordPtr->extension3ObjPtr = recordPtr->extension4ObjPtr = NULL; + recordPtr->extension5ObjPtr = NULL; + result = Tk_InitOptions(interp, (char *)recordPtr, optionTable, tkwin); + if (result == TCL_OK) { + result = Tk_SetOptions(interp, (char *) recordPtr, optionTable, + objc-3, objv+3, tkwin, NULL, NULL); + if (result != TCL_OK) { + Tk_FreeConfigOptions((char *) recordPtr, optionTable, tkwin); } - break; } + if (result == TCL_OK) { + recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp, + Tcl_GetString(objv[2]), TrivialConfigObjCmd, + (ClientData) recordPtr, TrivialCmdDeletedProc); + Tk_CreateEventHandler(tkwin, StructureNotifyMask, + TrivialEventProc, (ClientData) recordPtr); + Tcl_SetObjResult(interp, objv[2]); + } + break; + } - case CHAIN2: { - ExtensionWidgetRecord *recordPtr; - static Tk_OptionSpec extensionSpecs[] = { - {TK_OPTION_STRING, - "-three", "three", "Three", "three", - Tk_Offset(ExtensionWidgetRecord, extension3ObjPtr), - -1}, - {TK_OPTION_STRING, - "-four", "four", "Four", "four", - Tk_Offset(ExtensionWidgetRecord, extension4ObjPtr), - -1}, - {TK_OPTION_STRING, - "-two", "two", "Two", "two and a half", - Tk_Offset(ExtensionWidgetRecord, base2ObjPtr), - -1}, - {TK_OPTION_STRING, - "-oneAgain", "oneAgain", "OneAgain", "one again", - Tk_Offset(ExtensionWidgetRecord, extension5ObjPtr), - -1}, - {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL, - (char *) NULL, 0, -1, 0, (ClientData) baseSpecs} - }; - Tk_Window tkwin; - Tk_OptionTable optionTable; + case CONFIG_ERROR: { + typedef struct ErrorWidgetRecord { + Tcl_Obj *intPtr; + } ErrorWidgetRecord; + ErrorWidgetRecord widgetRecord; + static const Tk_OptionSpec errorSpecs[] = { + {TK_OPTION_INT, "-int", "integer", "Integer", "bogus", + Tk_Offset(ErrorWidgetRecord, intPtr), 0, 0, NULL, 0}, + {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0} + }; + Tk_OptionTable optionTable; + + widgetRecord.intPtr = NULL; + optionTable = Tk_CreateOptionTable(interp, errorSpecs); + tables[index] = optionTable; + return Tk_InitOptions(interp, (char *) &widgetRecord, optionTable, + (Tk_Window) NULL); + } - tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window) clientData, - Tcl_GetStringFromObj(objv[2], NULL), (char *) NULL); - if (tkwin == NULL) { - return TCL_ERROR; - } - Tk_SetClass(tkwin, "Test"); - optionTable = Tk_CreateOptionTable(interp, extensionSpecs); - tables[index] = optionTable; - - recordPtr = (ExtensionWidgetRecord *) ckalloc( - sizeof(ExtensionWidgetRecord)); - recordPtr->header.interp = interp; - recordPtr->header.optionTable = optionTable; - recordPtr->header.tkwin = tkwin; - recordPtr->base1ObjPtr = recordPtr->base2ObjPtr = NULL; - recordPtr->extension3ObjPtr = recordPtr->extension4ObjPtr = NULL; - recordPtr->extension5ObjPtr = NULL; - result = Tk_InitOptions(interp, (char *) recordPtr, optionTable, - tkwin); - if (result == TCL_OK) { - result = Tk_SetOptions(interp, (char *) recordPtr, optionTable, - objc - 3, objv + 3, tkwin, (Tk_SavedOptions *) NULL, - (int *) NULL); - if (result != TCL_OK) { - Tk_FreeConfigOptions((char *) recordPtr, optionTable, - tkwin); - } - } - if (result == TCL_OK) { - recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp, - Tcl_GetStringFromObj(objv[2], NULL), - TrivialConfigObjCmd, (ClientData) recordPtr, - TrivialCmdDeletedProc); - Tk_CreateEventHandler(tkwin, StructureNotifyMask, - TrivialEventProc, (ClientData) recordPtr); - Tcl_SetObjResult(interp, objv[2]); - } - break; + case DEL: + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "tableName"); + return TCL_ERROR; } + if (Tcl_GetIndexFromObj(interp, objv[2], options, "table", 0, + &index) != TCL_OK) { + return TCL_ERROR; + } + if (tables[index] != NULL) { + Tk_DeleteOptionTable(tables[index]); + } + break; - case CONFIG_ERROR: { - typedef struct ErrorWidgetRecord { - Tcl_Obj *intPtr; - } ErrorWidgetRecord; - ErrorWidgetRecord widgetRecord; - static Tk_OptionSpec errorSpecs[] = { - {TK_OPTION_INT, - "-int", "integer", "Integer", - "bogus", Tk_Offset(ErrorWidgetRecord, intPtr)}, - {TK_OPTION_END} - }; - Tk_OptionTable optionTable; - - widgetRecord.intPtr = NULL; - optionTable = Tk_CreateOptionTable(interp, errorSpecs); - tables[index] = optionTable; - return Tk_InitOptions(interp, (char *) &widgetRecord, optionTable, - (Tk_Window) NULL); + case INFO: + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "tableName"); + return TCL_ERROR; } + if (Tcl_GetIndexFromObj(interp, objv[2], options, "table", 0, + &index) != TCL_OK) { + return TCL_ERROR; + } + Tcl_SetObjResult(interp, TkDebugConfig(interp, tables[index])); + break; - case DEL: { - if (objc != 3) { - Tcl_WrongNumArgs(interp, 2, objv, "tableName"); - return TCL_ERROR; - } - if (Tcl_GetIndexFromObj(interp, objv[2], options, "table", 0, - &index) != TCL_OK) { - return TCL_ERROR; - } - if (tables[index] != NULL) { - Tk_DeleteOptionTable(tables[index]); + case INTERNAL: { + /* + * This command is similar to the "alltypes" command except that it + * stores all the configuration options as internal forms instead of + * objects. + */ + + typedef struct InternalRecord { + TrivialCommandHeader header; + int boolean; + int integer; + double doubleValue; + char *string; + int index; + XColor *colorPtr; + Tk_Font tkfont; + Pixmap bitmap; + Tk_3DBorder border; + int relief; + Tk_Cursor cursor; + Tk_Justify justify; + Tk_Anchor anchor; + int pixels; + double mm; + Tk_Window tkwin; + char *custom; + } InternalRecord; + InternalRecord *recordPtr; + static const char *const internalStringTable[] = { + "one", "two", "three", "four", NULL + }; + static const Tk_OptionSpec internalSpecs[] = { + {TK_OPTION_BOOLEAN, "-boolean", "boolean", "Boolean", "1", + -1, Tk_Offset(InternalRecord, boolean), 0, 0, 0x1}, + {TK_OPTION_INT, "-integer", "integer", "Integer", "148962237", + -1, Tk_Offset(InternalRecord, integer), 0, 0, 0x2}, + {TK_OPTION_DOUBLE, "-double", "double", "Double", "3.14159", + -1, Tk_Offset(InternalRecord, doubleValue), 0, 0, 0x4}, + {TK_OPTION_STRING, "-string", "string", "String", "foo", + -1, Tk_Offset(InternalRecord, string), + TK_CONFIG_NULL_OK, 0, 0x8}, + {TK_OPTION_STRING_TABLE, + "-stringtable", "StringTable", "stringTable", "one", + -1, Tk_Offset(InternalRecord, index), + TK_CONFIG_NULL_OK, (ClientData) internalStringTable, 0x10}, + {TK_OPTION_COLOR, "-color", "color", "Color", "red", + -1, Tk_Offset(InternalRecord, colorPtr), + TK_CONFIG_NULL_OK, (ClientData) "black", 0x20}, + {TK_OPTION_FONT, "-font", "font", "Font", "Helvetica 12", + -1, Tk_Offset(InternalRecord, tkfont), + TK_CONFIG_NULL_OK, 0, 0x40}, + {TK_OPTION_BITMAP, "-bitmap", "bitmap", "Bitmap", "gray50", + -1, Tk_Offset(InternalRecord, bitmap), + 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_OPTION_RELIEF, "-relief", "relief", "Relief", "raised", + -1, Tk_Offset(InternalRecord, relief), + TK_CONFIG_NULL_OK, 0, 0x200}, + {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor", "xterm", + -1, Tk_Offset(InternalRecord, cursor), + TK_CONFIG_NULL_OK, 0, 0x400}, + {TK_OPTION_JUSTIFY, "-justify", NULL, NULL, "left", + -1, Tk_Offset(InternalRecord, justify), + TK_CONFIG_NULL_OK, 0, 0x800}, + {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor", NULL, + -1, Tk_Offset(InternalRecord, anchor), + TK_CONFIG_NULL_OK, 0, 0x1000}, + {TK_OPTION_PIXELS, "-pixel", "pixel", "Pixel", "1", + -1, Tk_Offset(InternalRecord, pixels), + TK_CONFIG_NULL_OK, 0, 0x2000}, + {TK_OPTION_WINDOW, "-window", "window", "Window", NULL, + -1, Tk_Offset(InternalRecord, tkwin), + 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_OPTION_SYNONYM, "-synonym", NULL, NULL, + NULL, -1, -1, 0, (ClientData) "-color", 0x8000}, + {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0} + }; + Tk_OptionTable optionTable; + Tk_Window tkwin; + + optionTable = Tk_CreateOptionTable(interp, internalSpecs); + tables[index] = optionTable; + 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->header.interp = interp; + recordPtr->header.optionTable = optionTable; + recordPtr->header.tkwin = tkwin; + recordPtr->boolean = 0; + recordPtr->integer = 0; + recordPtr->doubleValue = 0.0; + recordPtr->string = NULL; + recordPtr->index = 0; + recordPtr->colorPtr = NULL; + recordPtr->tkfont = NULL; + recordPtr->bitmap = None; + recordPtr->border = NULL; + recordPtr->relief = TK_RELIEF_FLAT; + recordPtr->cursor = NULL; + recordPtr->justify = TK_JUSTIFY_LEFT; + recordPtr->anchor = TK_ANCHOR_N; + recordPtr->pixels = 0; + recordPtr->mm = 0.0; + recordPtr->tkwin = NULL; + recordPtr->custom = NULL; + result = Tk_InitOptions(interp, (char *) recordPtr, optionTable, + tkwin); + if (result == TCL_OK) { + recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp, + Tcl_GetString(objv[2]), TrivialConfigObjCmd, + recordPtr, TrivialCmdDeletedProc); + Tk_CreateEventHandler(tkwin, StructureNotifyMask, + TrivialEventProc, recordPtr); + result = Tk_SetOptions(interp, (char *) recordPtr, optionTable, + objc - 3, objv + 3, tkwin, NULL, NULL); + if (result != TCL_OK) { + Tk_DestroyWindow(tkwin); } - break; + } else { + Tk_DestroyWindow(tkwin); + ckfree(recordPtr); } + if (result == TCL_OK) { + Tcl_SetObjResult(interp, objv[2]); + } + break; + } - case INFO: { - if (objc != 3) { - Tcl_WrongNumArgs(interp, 2, objv, "tableName"); - return TCL_ERROR; - } - if (Tcl_GetIndexFromObj(interp, objv[2], options, "table", 0, - &index) != TCL_OK) { - return TCL_ERROR; - } - Tcl_SetObjResult(interp, TkDebugConfig(interp, tables[index])); - break; + case NEW: { + typedef struct FiveRecord { + TrivialCommandHeader header; + Tcl_Obj *one; + Tcl_Obj *two; + Tcl_Obj *three; + Tcl_Obj *four; + Tcl_Obj *five; + } FiveRecord; + FiveRecord *recordPtr; + static const Tk_OptionSpec smallSpecs[] = { + {TK_OPTION_INT, "-one", "one", "One", "1", + Tk_Offset(FiveRecord, one), -1, 0, NULL, 0}, + {TK_OPTION_INT, "-two", "two", "Two", "2", + Tk_Offset(FiveRecord, two), -1, 0, NULL, 0}, + {TK_OPTION_INT, "-three", "three", "Three", "3", + Tk_Offset(FiveRecord, three), -1, 0, NULL, 0}, + {TK_OPTION_INT, "-four", "four", "Four", "4", + Tk_Offset(FiveRecord, four), -1, 0, NULL, 0}, + {TK_OPTION_STRING, "-five", NULL, NULL, NULL, + 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 ?-option value ...?"); + return TCL_ERROR; } - case INTERNAL: { - /* - * This command is similar to the "alltypes" command except - * that it stores all the configuration options as internal - * forms instead of objects. - */ - - typedef struct InternalRecord { - TrivialCommandHeader header; - int boolean; - int integer; - double doubleValue; - char *string; - int index; - XColor *colorPtr; - Tk_Font tkfont; - Pixmap bitmap; - Tk_3DBorder border; - int relief; - Tk_Cursor cursor; - Tk_Justify justify; - Tk_Anchor anchor; - int pixels; - double mm; - Tk_Window tkwin; - char *custom; - } InternalRecord; - InternalRecord *recordPtr; - static char *internalStringTable[] = { - "one", "two", "three", "four", (char *) NULL - }; - static Tk_OptionSpec internalSpecs[] = { - {TK_OPTION_BOOLEAN, - "-boolean", "boolean", "Boolean", - "1", -1, Tk_Offset(InternalRecord, boolean), 0, 0, 0x1}, - {TK_OPTION_INT, - "-integer", "integer", "Integer", - "148962237", -1, Tk_Offset(InternalRecord, integer), - 0, 0, 0x2}, - {TK_OPTION_DOUBLE, - "-double", "double", "Double", - "3.14159", -1, Tk_Offset(InternalRecord, doubleValue), - 0, 0, 0x4}, - {TK_OPTION_STRING, - "-string", "string", "String", - "foo", -1, Tk_Offset(InternalRecord, string), - TK_CONFIG_NULL_OK, 0, 0x8}, - {TK_OPTION_STRING_TABLE, - "-stringtable", "StringTable", "stringTable", - "one", -1, Tk_Offset(InternalRecord, index), - TK_CONFIG_NULL_OK, (ClientData) internalStringTable, - 0x10}, - {TK_OPTION_COLOR, - "-color", "color", "Color", - "red", -1, Tk_Offset(InternalRecord, colorPtr), - TK_CONFIG_NULL_OK, (ClientData) "black", 0x20}, - {TK_OPTION_FONT, - "-font", "font", "Font", - "Helvetica 12", -1, Tk_Offset(InternalRecord, tkfont), - TK_CONFIG_NULL_OK, 0, 0x40}, - {TK_OPTION_BITMAP, - "-bitmap", "bitmap", "Bitmap", - "gray50", -1, Tk_Offset(InternalRecord, bitmap), - 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_OPTION_RELIEF, - "-relief", "relief", "Relief", - "raised", -1, Tk_Offset(InternalRecord, relief), - TK_CONFIG_NULL_OK, 0, 0x200}, - {TK_OPTION_CURSOR, - "-cursor", "cursor", "Cursor", - "xterm", -1, Tk_Offset(InternalRecord, cursor), - TK_CONFIG_NULL_OK, 0, 0x400}, - {TK_OPTION_JUSTIFY, - "-justify", (char *) NULL, (char *) NULL, - "left", -1, Tk_Offset(InternalRecord, justify), - TK_CONFIG_NULL_OK, 0, 0x800}, - {TK_OPTION_ANCHOR, - "-anchor", "anchor", "Anchor", - (char *) NULL, -1, Tk_Offset(InternalRecord, anchor), - TK_CONFIG_NULL_OK, 0, 0x1000}, - {TK_OPTION_PIXELS, - "-pixel", "pixel", "Pixel", - "1", -1, Tk_Offset(InternalRecord, pixels), - TK_CONFIG_NULL_OK, 0, 0x2000}, - {TK_OPTION_WINDOW, - "-window", "window", "Window", - (char *) NULL, -1, Tk_Offset(InternalRecord, tkwin), - TK_CONFIG_NULL_OK, 0, 0}, - {TK_OPTION_CUSTOM, - "-custom", (char *) NULL, (char *) NULL, - "", -1, Tk_Offset(InternalRecord, custom), - TK_CONFIG_NULL_OK, (ClientData)&CustomOption, 0x4000}, - {TK_OPTION_SYNONYM, - "-synonym", (char *) NULL, (char *) NULL, - (char *) NULL, -1, -1, 0, (ClientData) "-color", - 0x8000}, - {TK_OPTION_END} - }; - Tk_OptionTable optionTable; - Tk_Window tkwin; - optionTable = Tk_CreateOptionTable(interp, internalSpecs); - tables[index] = optionTable; - tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window) clientData, - Tcl_GetStringFromObj(objv[2], NULL), (char *) NULL); - if (tkwin == NULL) { - return TCL_ERROR; - } - Tk_SetClass(tkwin, "Test"); - - recordPtr = (InternalRecord *) ckalloc(sizeof(InternalRecord)); - recordPtr->header.interp = interp; - recordPtr->header.optionTable = optionTable; - recordPtr->header.tkwin = tkwin; - recordPtr->boolean = 0; - recordPtr->integer = 0; - recordPtr->doubleValue = 0.0; - recordPtr->string = NULL; - recordPtr->index = 0; - recordPtr->colorPtr = NULL; - recordPtr->tkfont = NULL; - recordPtr->bitmap = None; - recordPtr->border = NULL; - recordPtr->relief = TK_RELIEF_FLAT; - recordPtr->cursor = NULL; - recordPtr->justify = TK_JUSTIFY_LEFT; - recordPtr->anchor = TK_ANCHOR_N; - recordPtr->pixels = 0; - recordPtr->mm = 0.0; - recordPtr->tkwin = NULL; - recordPtr->custom = NULL; - result = Tk_InitOptions(interp, (char *) recordPtr, optionTable, - tkwin); + recordPtr = ckalloc(sizeof(FiveRecord)); + recordPtr->header.interp = interp; + recordPtr->header.optionTable = Tk_CreateOptionTable(interp, + smallSpecs); + tables[index] = recordPtr->header.optionTable; + recordPtr->header.tkwin = NULL; + recordPtr->one = recordPtr->two = recordPtr->three = NULL; + recordPtr->four = recordPtr->five = NULL; + Tcl_SetObjResult(interp, objv[2]); + result = Tk_InitOptions(interp, (char *) recordPtr, + recordPtr->header.optionTable, (Tk_Window) NULL); + if (result == TCL_OK) { + result = Tk_SetOptions(interp, (char *) recordPtr, + recordPtr->header.optionTable, objc - 3, objv + 3, + (Tk_Window) NULL, NULL, NULL); if (result == TCL_OK) { recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp, - Tcl_GetStringFromObj(objv[2], NULL), - TrivialConfigObjCmd, (ClientData) recordPtr, - TrivialCmdDeletedProc); - Tk_CreateEventHandler(tkwin, StructureNotifyMask, - TrivialEventProc, (ClientData) recordPtr); - result = Tk_SetOptions(interp, (char *) recordPtr, - optionTable, objc - 3, objv + 3, tkwin, - (Tk_SavedOptions *) NULL, (int *) NULL); - if (result != TCL_OK) { - Tk_DestroyWindow(tkwin); - } + Tcl_GetString(objv[2]), TrivialConfigObjCmd, + (ClientData) recordPtr, TrivialCmdDeletedProc); } else { - Tk_DestroyWindow(tkwin); - ckfree((char *) recordPtr); + Tk_FreeConfigOptions((char *) recordPtr, + recordPtr->header.optionTable, (Tk_Window) NULL); } - if (result == TCL_OK) { - Tcl_SetObjResult(interp, objv[2]); - } - break; + } + if (result != TCL_OK) { + ckfree(recordPtr); } - case NEW: { - typedef struct FiveRecord { - TrivialCommandHeader header; - Tcl_Obj *one; - Tcl_Obj *two; - Tcl_Obj *three; - Tcl_Obj *four; - Tcl_Obj *five; - } FiveRecord; - FiveRecord *recordPtr; - static Tk_OptionSpec smallSpecs[] = { - {TK_OPTION_INT, - "-one", "one", "One", - "1", - Tk_Offset(FiveRecord, one), -1}, - {TK_OPTION_INT, - "-two", "two", "Two", - "2", - Tk_Offset(FiveRecord, two), -1}, - {TK_OPTION_INT, - "-three", "three", "Three", - "3", - Tk_Offset(FiveRecord, three), -1}, - {TK_OPTION_INT, - "-four", "four", "Four", - "4", - Tk_Offset(FiveRecord, four), -1}, - {TK_OPTION_STRING, - "-five", NULL, NULL, - NULL, - Tk_Offset(FiveRecord, five), -1}, - {TK_OPTION_END} - }; - - if (objc < 3) { - Tcl_WrongNumArgs(interp, 1, objv, "new name ?options?"); - return TCL_ERROR; - } + break; + } + case NOT_ENOUGH_PARAMS: { + typedef struct NotEnoughRecord { + Tcl_Obj *fooObjPtr; + } NotEnoughRecord; + NotEnoughRecord record; + static const Tk_OptionSpec errorSpecs[] = { + {TK_OPTION_INT, "-foo", "foo", "Foo", "0", + 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; + + record.fooObjPtr = NULL; + + tkwin = Tk_CreateWindowFromPath(interp, mainWin, ".config", NULL); + 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, + &newObjPtr, tkwin, NULL, NULL) != TCL_OK) { + result = TCL_ERROR; + } + Tcl_DecrRefCount(newObjPtr); + Tk_FreeConfigOptions( (char *) &record, optionTable, tkwin); + Tk_DestroyWindow(tkwin); + return result; + } - recordPtr = (FiveRecord *) ckalloc(sizeof(FiveRecord)); - recordPtr->header.interp = interp; - recordPtr->header.optionTable = Tk_CreateOptionTable(interp, - smallSpecs); - tables[index] = recordPtr->header.optionTable; - recordPtr->header.tkwin = NULL; - recordPtr->one = recordPtr->two = recordPtr->three = NULL; - recordPtr->four = recordPtr->five = NULL; - Tcl_SetObjResult(interp, objv[2]); - result = Tk_InitOptions(interp, (char *) recordPtr, - recordPtr->header.optionTable, (Tk_Window) NULL); - if (result == TCL_OK) { - result = Tk_SetOptions(interp, (char *) recordPtr, - recordPtr->header.optionTable, objc - 3, objv + 3, - (Tk_Window) NULL, (Tk_SavedOptions *) NULL, - (int *) NULL); - if (result == TCL_OK) { - recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp, - Tcl_GetStringFromObj(objv[2], NULL), - TrivialConfigObjCmd, (ClientData) recordPtr, - TrivialCmdDeletedProc); - } else { - Tk_FreeConfigOptions((char *) recordPtr, - recordPtr->header.optionTable, (Tk_Window) NULL); - } - } - if (result != TCL_OK) { - ckfree((char *) recordPtr); - } + case TWO_WINDOWS: { + typedef struct SlaveRecord { + TrivialCommandHeader header; + Tcl_Obj *windowPtr; + } SlaveRecord; + SlaveRecord *recordPtr; + static const Tk_OptionSpec slaveSpecs[] = { + {TK_OPTION_WINDOW, "-window", "window", "Window", ".bar", + 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); - break; - } - case NOT_ENOUGH_PARAMS: { - typedef struct NotEnoughRecord { - Tcl_Obj *fooObjPtr; - } NotEnoughRecord; - NotEnoughRecord record; - static Tk_OptionSpec errorSpecs[] = { - {TK_OPTION_INT, - "-foo", "foo", "Foo", - "0", Tk_Offset(NotEnoughRecord, fooObjPtr)}, - {TK_OPTION_END} - }; - Tcl_Obj *newObjPtr = Tcl_NewStringObj("-foo", -1); - Tk_OptionTable optionTable; - - record.fooObjPtr = NULL; - - tkwin = Tk_CreateWindowFromPath(interp, mainWin, - ".config", (char *) NULL); - 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, &newObjPtr, tkwin, (Tk_SavedOptions *) NULL, - (int *) NULL) - != TCL_OK) { - result = TCL_ERROR; - } - Tcl_DecrRefCount(newObjPtr); - Tk_FreeConfigOptions( (char *) &record, optionTable, tkwin); - Tk_DestroyWindow(tkwin); - return result; + if (tkwin == NULL) { + return TCL_ERROR; } - - case TWO_WINDOWS: { - typedef struct SlaveRecord { - TrivialCommandHeader header; - Tcl_Obj *windowPtr; - } SlaveRecord; - SlaveRecord *recordPtr; - static Tk_OptionSpec slaveSpecs[] = { - {TK_OPTION_WINDOW, - "-window", "window", "Window", - ".bar", Tk_Offset(SlaveRecord, windowPtr), -1, - TK_CONFIG_NULL_OK}, - {TK_OPTION_END} - }; - Tk_Window tkwin = Tk_CreateWindowFromPath(interp, - (Tk_Window) clientData, - Tcl_GetStringFromObj(objv[2], NULL), (char *) NULL); - if (tkwin == NULL) { - return TCL_ERROR; - } - Tk_SetClass(tkwin, "Test"); - - recordPtr = (SlaveRecord *) ckalloc(sizeof(SlaveRecord)); - recordPtr->header.interp = interp; - recordPtr->header.optionTable = Tk_CreateOptionTable(interp, - slaveSpecs); - tables[index] = recordPtr->header.optionTable; - recordPtr->header.tkwin = tkwin; - recordPtr->windowPtr = NULL; - - result = Tk_InitOptions(interp, (char *) recordPtr, - recordPtr->header.optionTable, tkwin); + Tk_SetClass(tkwin, "Test"); + + recordPtr = ckalloc(sizeof(SlaveRecord)); + recordPtr->header.interp = interp; + recordPtr->header.optionTable = Tk_CreateOptionTable(interp, + slaveSpecs); + tables[index] = recordPtr->header.optionTable; + recordPtr->header.tkwin = tkwin; + recordPtr->windowPtr = NULL; + + result = Tk_InitOptions(interp, (char *) recordPtr, + recordPtr->header.optionTable, tkwin); + if (result == TCL_OK) { + result = Tk_SetOptions(interp, (char *) recordPtr, + recordPtr->header.optionTable, objc - 3, objv + 3, + tkwin, NULL, NULL); if (result == TCL_OK) { - result = Tk_SetOptions(interp, (char *) recordPtr, - recordPtr->header.optionTable, objc - 3, objv + 3, - tkwin, (Tk_SavedOptions *) NULL, (int *) NULL); - if (result == TCL_OK) { - recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp, - Tcl_GetStringFromObj(objv[2], NULL), - TrivialConfigObjCmd, (ClientData) recordPtr, - TrivialCmdDeletedProc); - Tk_CreateEventHandler(tkwin, StructureNotifyMask, - TrivialEventProc, (ClientData) recordPtr); - Tcl_SetObjResult(interp, objv[2]); - } else { - Tk_FreeConfigOptions((char *) recordPtr, - recordPtr->header.optionTable, tkwin); - } - } - if (result != TCL_OK) { - Tk_DestroyWindow(tkwin); - ckfree((char *) recordPtr); + recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp, + Tcl_GetString(objv[2]), TrivialConfigObjCmd, + recordPtr, TrivialCmdDeletedProc); + Tk_CreateEventHandler(tkwin, StructureNotifyMask, + TrivialEventProc, recordPtr); + Tcl_SetObjResult(interp, objv[2]); + } else { + Tk_FreeConfigOptions((char *) recordPtr, + recordPtr->header.optionTable, tkwin); } - } + if (result != TCL_OK) { + Tk_DestroyWindow(tkwin); + ckfree(recordPtr); + } + } } return result; @@ -1346,15 +1119,15 @@ TestobjconfigObjCmd(clientData, interp, objc, objv) /* ARGSUSED */ static int -TrivialConfigObjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Main window for application. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +TrivialConfigObjCmd( + ClientData clientData, /* Main window for application. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { int result = TCL_OK; - static CONST char *options[] = { - "cget", "configure", "csave", (char *) NULL + static const char *const options[] = { + "cget", "configure", "csave", NULL }; enum { CGET, CONFIGURE, CSAVE @@ -1370,69 +1143,66 @@ TrivialConfigObjCmd(clientData, interp, objc, objv) return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], options, "command", - 0, &index) != TCL_OK) { + if (Tcl_GetIndexFromObj(interp, objv[1], options, "command", 0, + &index) != TCL_OK) { return TCL_ERROR; } Tcl_Preserve(clientData); - + switch (index) { - case CGET: { - if (objc != 3) { - Tcl_WrongNumArgs(interp, 2, objv, "option"); + case CGET: + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "option"); + result = TCL_ERROR; + goto done; + } + resultObjPtr = Tk_GetOptionValue(interp, (char *) clientData, + headerPtr->optionTable, objv[2], tkwin); + if (resultObjPtr != NULL) { + Tcl_SetObjResult(interp, resultObjPtr); + result = TCL_OK; + } else { + result = TCL_ERROR; + } + break; + case CONFIGURE: + if (objc == 2) { + resultObjPtr = Tk_GetOptionInfo(interp, (char *) clientData, + headerPtr->optionTable, NULL, tkwin); + if (resultObjPtr == NULL) { result = TCL_ERROR; - goto done; + } else { + Tcl_SetObjResult(interp, resultObjPtr); } - resultObjPtr = Tk_GetOptionValue(interp, (char *) clientData, + } else if (objc == 3) { + resultObjPtr = Tk_GetOptionInfo(interp, (char *) clientData, headerPtr->optionTable, objv[2], tkwin); - if (resultObjPtr != NULL) { - Tcl_SetObjResult(interp, resultObjPtr); - result = TCL_OK; - } else { + if (resultObjPtr == NULL) { result = TCL_ERROR; - } - break; - } - case CONFIGURE: { - if (objc == 2) { - resultObjPtr = Tk_GetOptionInfo(interp, (char *) clientData, - headerPtr->optionTable, (Tcl_Obj *) NULL, tkwin); - if (resultObjPtr == NULL) { - result = TCL_ERROR; - } else { - Tcl_SetObjResult(interp, resultObjPtr); - } - } else if (objc == 3) { - resultObjPtr = Tk_GetOptionInfo(interp, (char *) clientData, - headerPtr->optionTable, objv[2], tkwin); - if (resultObjPtr == NULL) { - result = TCL_ERROR; - } else { - Tcl_SetObjResult(interp, resultObjPtr); - } } else { - result = Tk_SetOptions(interp, (char *) clientData, - headerPtr->optionTable, objc - 2, objv + 2, - tkwin, (Tk_SavedOptions *) NULL, &mask); - if (result == TCL_OK) { - Tcl_SetIntObj(Tcl_GetObjResult(interp), mask); - } + Tcl_SetObjResult(interp, resultObjPtr); } - break; - } - case CSAVE: { + } else { result = Tk_SetOptions(interp, (char *) clientData, - headerPtr->optionTable, objc - 2, objv + 2, - tkwin, &saved, &mask); - Tk_FreeSavedOptions(&saved); + 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; } + break; + case CSAVE: + result = Tk_SetOptions(interp, (char *) clientData, + headerPtr->optionTable, objc - 2, objv + 2, + tkwin, &saved, &mask); + Tk_FreeSavedOptions(&saved); + if (result == TCL_OK) { + Tcl_SetObjResult(interp, Tcl_NewIntObj(mask)); + } + break; } -done: + done: Tcl_Release(clientData); return result; } @@ -1442,9 +1212,9 @@ done: * * TrivialCmdDeletedProc -- * - * This procedure is invoked when a widget command is deleted. If - * the widget isn't already in the process of being destroyed, - * this command destroys it. + * This function is invoked when a widget command is deleted. If the + * widget isn't already in the process of being destroyed, this command + * destroys it. * * Results: * None. @@ -1456,8 +1226,8 @@ done: */ static void -TrivialCmdDeletedProc(clientData) - ClientData clientData; /* Pointer to widget record for widget. */ +TrivialCmdDeletedProc( + ClientData clientData) /* Pointer to widget record for widget. */ { TrivialCommandHeader *headerPtr = (TrivialCommandHeader *) clientData; Tk_Window tkwin = headerPtr->tkwin; @@ -1466,9 +1236,9 @@ TrivialCmdDeletedProc(clientData) Tk_DestroyWindow(tkwin); } else if (headerPtr->optionTable != NULL) { /* - * This is a "new" object, which doesn't have a window, so - * we can't depend on cleaning up in the event procedure. - * Free its resources here. + * This is a "new" object, which doesn't have a window, so we can't + * depend on cleaning up in the event function. Free its resources + * here. */ Tk_FreeConfigOptions((char *) clientData, @@ -1488,16 +1258,15 @@ TrivialCmdDeletedProc(clientData) * None. * * Side effects: - * When the window gets deleted, internal structures get - * cleaned up. + * When the window gets deleted, internal structures get cleaned up. * *-------------------------------------------------------------- */ static void -TrivialEventProc(clientData, eventPtr) - ClientData clientData; /* Information about window. */ - XEvent *eventPtr; /* Information about event. */ +TrivialEventProc( + ClientData clientData, /* Information about window. */ + XEvent *eventPtr) /* Information about event. */ { TrivialCommandHeader *headerPtr = (TrivialCommandHeader *) clientData; @@ -1519,8 +1288,8 @@ TrivialEventProc(clientData, eventPtr) * * TestfontObjCmd -- * - * This procedure implements the "testfont" command, which is used - * to test TkFont objects. + * This function implements the "testfont" command, which is used to test + * TkFont objects. * * Results: * A standard Tcl result. @@ -1533,18 +1302,18 @@ TrivialEventProc(clientData, eventPtr) /* ARGSUSED */ static int -TestfontObjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Main window for application. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +TestfontObjCmd( + ClientData clientData, /* Main window for application. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { - static CONST char *options[] = {"counts", "subfonts", (char *) NULL}; + static const char *const options[] = {"counts", "subfonts", NULL}; enum option {COUNTS, SUBFONTS}; int index; Tk_Window tkwin; Tk_Font tkfont; - + tkwin = (Tk_Window) clientData; if (objc < 3) { @@ -1558,20 +1327,18 @@ TestfontObjCmd(clientData, interp, objc, objv) } switch ((enum option) index) { - case COUNTS: { - Tcl_SetObjResult(interp, TkDebugFont(Tk_MainWindow(interp), - Tcl_GetString(objv[2]))); - break; - } - case SUBFONTS: { - tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]); - if (tkfont == NULL) { - return TCL_ERROR; - } - TkpGetSubFonts(interp, tkfont); - Tk_FreeFont(tkfont); - break; + case COUNTS: + Tcl_SetObjResult(interp, + TkDebugFont(Tk_MainWindow(interp), Tcl_GetString(objv[2]))); + break; + case SUBFONTS: + tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]); + if (tkfont == NULL) { + return TCL_ERROR; } + TkpGetSubFonts(interp, tkfont); + Tk_FreeFont(tkfont); + break; } return TCL_OK; @@ -1582,8 +1349,7 @@ TestfontObjCmd(clientData, interp, objc, objv) * * ImageCreate -- * - * This procedure is called by the Tk image code to create "test" - * images. + * This function is called by the Tk image code to create "test" images. * * Results: * A standard Tcl result. @@ -1595,86 +1361,50 @@ TestfontObjCmd(clientData, interp, objc, objv) */ /* ARGSUSED */ -#ifdef USE_OLD_IMAGE -static int -ImageCreate(interp, name, argc, argv, typePtr, master, clientDataPtr) - Tcl_Interp *interp; /* Interpreter for application containing - * image. */ - char *name; /* Name to use for image. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings for options (doesn't - * include image name or type). */ - 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; - int i; - - Tk_InitImageArgs(interp, argc, &argv); - varName = "log"; - for (i = 0; i < argc; i += 2) { - if (strcmp(argv[i], "-variable") != 0) { - Tcl_AppendResult(interp, "bad option name \"", - argv[i], "\"", (char *) NULL); - return TCL_ERROR; - } - if ((i+1) == argc) { - Tcl_AppendResult(interp, "no value given for \"", - argv[i], "\" option", (char *) NULL); - return TCL_ERROR; - } - varName = argv[i+1]; - } -#else static int -ImageCreate(interp, name, objc, objv, typePtr, master, clientDataPtr) - Tcl_Interp *interp; /* Interpreter for application containing +ImageCreate( + Tcl_Interp *interp, /* Interpreter for application containing * image. */ - char *name; /* Name to use for image. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument strings for options (doesn't + 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). */ - 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. */ + 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"; for (i = 0; i < objc; i += 2) { if (strcmp(Tcl_GetString(objv[i]), "-variable") != 0) { Tcl_AppendResult(interp, "bad option name \"", - Tcl_GetString(objv[i]), "\"", (char *) NULL); + Tcl_GetString(objv[i]), "\"", NULL); return TCL_ERROR; } if ((i+1) == objc) { Tcl_AppendResult(interp, "no value given for \"", - Tcl_GetString(objv[i]), "\" option", (char *) NULL); + Tcl_GetString(objv[i]), "\" option", NULL); return TCL_ERROR; } varName = Tcl_GetString(objv[i+1]); } -#endif - 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, - (Tcl_CmdDeleteProc *) 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; } @@ -1684,8 +1414,8 @@ ImageCreate(interp, name, objc, objv, typePtr, master, clientDataPtr) * * ImageCmd -- * - * This procedure implements the commands corresponding to individual - * images. + * This function implements the commands corresponding to individual + * images. * * Results: * A standard Tcl result. @@ -1698,26 +1428,24 @@ ImageCreate(interp, name, objc, objv, typePtr, master, clientDataPtr) /* ARGSUSED */ static int -ImageCmd(clientData, interp, argc, argv) - ClientData clientData; /* Main window for application. */ - Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - CONST char **argv; /* Argument strings. */ +ImageCmd( + ClientData clientData, /* Main window for application. */ + Tcl_Interp *interp, /* Current interpreter. */ + int argc, /* Number of arguments. */ + const char **argv) /* Argument strings. */ { TImageMaster *timPtr = (TImageMaster *) clientData; int x, y, width, height; if (argc < 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], "option ?arg arg ...?", (char *) NULL); + argv[0], "option ?arg ...?", NULL); return TCL_ERROR; } if (strcmp(argv[1], "changed") == 0) { if (argc != 8) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], - " changed x y width height imageWidth imageHeight", - (char *) NULL); + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " changed x y width height imageWidth imageHeight", NULL); return TCL_ERROR; } if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK) @@ -1732,7 +1460,7 @@ ImageCmd(clientData, interp, argc, argv) timPtr->height); } else { Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be changed", (char *) NULL); + "\": must be changed", NULL); return TCL_ERROR; } return TCL_OK; @@ -1743,12 +1471,12 @@ ImageCmd(clientData, interp, argc, argv) * * ImageGet -- * - * This procedure is called by Tk to set things up for using a - * test image in a particular widget. + * This function is called by Tk to set things up for using a test image + * in a particular widget. * * Results: - * The return value is a token for the image instance, which is - * used in future callbacks to ImageDisplay and ImageFree. + * The return value is a token for the image instance, which is used in + * future callbacks to ImageDisplay and ImageFree. * * Side effects: * None. @@ -1757,10 +1485,10 @@ ImageCmd(clientData, interp, argc, argv) */ static ClientData -ImageGet(tkwin, clientData) - Tk_Window tkwin; /* Token for window in which image will - * be used. */ - ClientData clientData; /* Pointer to TImageMaster for image. */ +ImageGet( + Tk_Window tkwin, /* Token for window in which image will be + * used. */ + ClientData clientData) /* Pointer to TImageMaster for image. */ { TImageMaster *timPtr = (TImageMaster *) clientData; TImageInstance *instPtr; @@ -1771,12 +1499,12 @@ ImageGet(tkwin, clientData) Tcl_SetVar(timPtr->interp, timPtr->varName, 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; } /* @@ -1784,29 +1512,29 @@ ImageGet(tkwin, clientData) * * ImageDisplay -- * - * This procedure is invoked to redisplay part or all of an - * image in a given drawable. + * This function is invoked to redisplay part or all of an image in a + * given drawable. * * Results: * None. * * Side effects: - * The image gets partially redrawn, as an "X" that shows the - * exact redraw area. + * The image gets partially redrawn, as an "X" that shows the exact + * redraw area. * *---------------------------------------------------------------------- */ static void -ImageDisplay(clientData, display, drawable, imageX, imageY, width, height, - drawableX, drawableY) - ClientData clientData; /* Pointer to TImageInstance for image. */ - Display *display; /* Display to use for drawing. */ - Drawable drawable; /* Where to redraw image. */ - int imageX, imageY; /* Origin of area to redraw, relative to +ImageDisplay( + ClientData clientData, /* Pointer to TImageInstance for image. */ + Display *display, /* Display to use for drawing. */ + Drawable drawable, /* Where to redraw image. */ + int imageX, int imageY, /* Origin of area to redraw, relative to * origin of image. */ - int width, height; /* Dimensions of area to redraw. */ - int drawableX, drawableY; /* Coordinates in drawable corresponding to + int width, int height, /* Dimensions of area to redraw. */ + int drawableX, int drawableY) + /* Coordinates in drawable corresponding to * imageX and imageY. */ { TImageInstance *instPtr = (TImageInstance *) clientData; @@ -1837,8 +1565,8 @@ ImageDisplay(clientData, display, drawable, imageX, imageY, width, height, * * ImageFree -- * - * This procedure is called when an instance of an image is - * no longer used. + * This function is called when an instance of an image is no longer + * used. * * Results: * None. @@ -1850,9 +1578,9 @@ ImageDisplay(clientData, display, drawable, imageX, imageY, width, height, */ static void -ImageFree(clientData, display) - ClientData clientData; /* Pointer to TImageInstance for instance. */ - Display *display; /* Display where image was to be drawn. */ +ImageFree( + ClientData clientData, /* Pointer to TImageInstance for instance. */ + Display *display) /* Display where image was to be drawn. */ { TImageInstance *instPtr = (TImageInstance *) clientData; char buffer[200]; @@ -1862,7 +1590,7 @@ ImageFree(clientData, display) TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT); Tk_FreeColor(instPtr->fg); Tk_FreeGC(display, instPtr->gc); - ckfree((char *) instPtr); + ckfree(instPtr); } /* @@ -1870,8 +1598,8 @@ ImageFree(clientData, display) * * ImageDelete -- * - * This procedure is called to clean up a test image when - * an application goes away. + * This function is called to clean up a test image when an application + * goes away. * * Results: * None. @@ -1883,10 +1611,10 @@ ImageFree(clientData, display) */ static void -ImageDelete(clientData) - ClientData clientData; /* Pointer to TImageMaster for image. When - * this procedure is called, no more - * instances exist. */ +ImageDelete( + ClientData clientData) /* Pointer to TImageMaster for image. When + * this function is called, no more instances + * exist. */ { TImageMaster *timPtr = (TImageMaster *) clientData; char buffer[100]; @@ -1898,7 +1626,7 @@ ImageDelete(clientData) Tcl_DeleteCommand(timPtr->interp, timPtr->imageName); ckfree(timPtr->imageName); ckfree(timPtr->varName); - ckfree((char *) timPtr); + ckfree(timPtr); } /* @@ -1906,9 +1634,9 @@ ImageDelete(clientData) * * TestmakeexistCmd -- * - * This procedure implements the "testmakeexist" command. It calls - * Tk_MakeWindowExist on each of its arguments to force the windows - * to be created. + * This function implements the "testmakeexist" command. It calls + * Tk_MakeWindowExist on each of its arguments to force the windows to be + * created. * * Results: * A standard Tcl result. @@ -1921,11 +1649,11 @@ ImageDelete(clientData) /* ARGSUSED */ static int -TestmakeexistCmd(clientData, interp, argc, argv) - ClientData clientData; /* Main window for application. */ - Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - CONST char **argv; /* Argument strings. */ +TestmakeexistCmd( + ClientData clientData, /* Main window for application. */ + Tcl_Interp *interp, /* Current interpreter. */ + int argc, /* Number of arguments. */ + const char **argv) /* Argument strings. */ { Tk_Window mainWin = (Tk_Window) clientData; int i; @@ -1947,9 +1675,9 @@ TestmakeexistCmd(clientData, interp, argc, argv) * * TestmenubarCmd -- * - * This procedure implements the "testmenubar" command. It is used - * to test the Unix facilities for creating space above a toplevel - * window for a menubar. + * This function implements the "testmenubar" command. It is used to test + * the Unix facilities for creating space above a toplevel window for a + * menubar. * * Results: * A standard Tcl result. @@ -1961,13 +1689,13 @@ TestmakeexistCmd(clientData, interp, argc, argv) */ /* ARGSUSED */ -#if !(defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK)) +#if !(defined(__WIN32__) || defined(MAC_OSX_TK)) static int -TestmenubarCmd(clientData, interp, argc, argv) - ClientData clientData; /* Main window for application. */ - Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - CONST char **argv; /* Argument strings. */ +TestmenubarCmd( + ClientData clientData, /* Main window for application. */ + Tcl_Interp *interp, /* Current interpreter. */ + int argc, /* Number of arguments. */ + const char **argv) /* Argument strings. */ { #ifdef __UNIX__ Tk_Window mainWin = (Tk_Window) clientData; @@ -1975,14 +1703,14 @@ TestmenubarCmd(clientData, interp, argc, argv) if (argc < 2) { Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0], - " option ?arg ...?\"", (char *) NULL); + " option ?arg ...?\"", NULL); return TCL_ERROR; } if (strcmp(argv[1], "window") == 0) { if (argc != 4) { Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0], - "window toplevel menubar\"", (char *) NULL); + "window toplevel menubar\"", NULL); return TCL_ERROR; } tkwin = Tk_NameToWindow(interp, argv[2], mainWin); @@ -2000,7 +1728,7 @@ TestmenubarCmd(clientData, interp, argc, argv) } } else { Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be window", (char *) NULL); + "\": must be window", NULL); return TCL_ERROR; } @@ -2018,8 +1746,8 @@ TestmenubarCmd(clientData, interp, argc, argv) * * TestmetricsCmd -- * - * This procedure implements the testmetrics command. It provides - * a way to determine the size of various widget components. + * This function implements the testmetrics command. It provides a way to + * determine the size of various widget components. * * Results: * A standard Tcl result. @@ -2030,13 +1758,13 @@ TestmenubarCmd(clientData, interp, argc, argv) *---------------------------------------------------------------------- */ -#if defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK) +#if defined(__WIN32__) || defined(MAC_OSX_TK) static int -TestmetricsCmd(clientData, interp, argc, argv) - ClientData clientData; /* Main window for application. */ - Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - CONST char **argv; /* Argument strings. */ +TestmetricsCmd( + ClientData clientData, /* Main window for application. */ + Tcl_Interp *interp, /* Current interpreter. */ + int argc, /* Number of arguments. */ + const char **argv) /* Argument strings. */ { char buf[TCL_INTEGER_SPACE]; int val; @@ -2044,7 +1772,7 @@ TestmetricsCmd(clientData, interp, argc, argv) #ifdef __WIN32__ if (argc < 2) { Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0], - " option ?arg ...?\"", (char *) NULL); + " option ?arg ...?\"", NULL); return TCL_ERROR; } #else @@ -2053,7 +1781,7 @@ TestmetricsCmd(clientData, interp, argc, argv) if (argc != 3) { Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0], - " option window\"", (char *) NULL); + " option window\"", NULL); return TCL_ERROR; } @@ -2077,11 +1805,11 @@ TestmetricsCmd(clientData, interp, argc, argv) #endif } else { Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be cxhscroll or cyvscroll", (char *) NULL); + "\": must be cxhscroll or cyvscroll", NULL); return TCL_ERROR; } sprintf(buf, "%d", val); - Tcl_AppendResult(interp, buf, (char *) NULL); + Tcl_AppendResult(interp, buf, NULL); return TCL_OK; } #endif @@ -2091,8 +1819,8 @@ TestmetricsCmd(clientData, interp, argc, argv) * * TestpropCmd -- * - * This procedure implements the "testprop" command. It fetches - * and prints the value of a property on a window. + * This function implements the "testprop" command. It fetches and prints + * the value of a property on a window. * * Results: * A standard Tcl result. @@ -2105,23 +1833,24 @@ TestmetricsCmd(clientData, interp, argc, argv) /* ARGSUSED */ static int -TestpropCmd(clientData, interp, argc, argv) - ClientData clientData; /* Main window for application. */ - Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - CONST char **argv; /* Argument strings. */ +TestpropCmd( + ClientData clientData, /* Main window for application. */ + Tcl_Interp *interp, /* Current interpreter. */ + int argc, /* Number of arguments. */ + const char **argv) /* Argument strings. */ { Tk_Window mainWin = (Tk_Window) clientData; int result, actualFormat; unsigned long bytesAfter, length, value; Atom actualType, propName; - char *property, *p, *end; + unsigned char *property, *p; + char *end; Window w; char buffer[30]; if (argc != 3) { Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0], - " window property\"", (char *) NULL); + " window property\"", NULL); return TCL_ERROR; } @@ -2131,7 +1860,7 @@ TestpropCmd(clientData, interp, argc, argv) result = XGetWindowProperty(Tk_Display(mainWin), w, propName, 0, 100000, False, AnyPropertyType, &actualType, &actualFormat, &length, - &bytesAfter, (unsigned char **) &property); + &bytesAfter, &property); if ((result == Success) && (actualType != None)) { if ((actualFormat == 8) && (actualType == XA_STRING)) { for (p = property; ((unsigned long)(p-property)) < length; p++) { @@ -2139,7 +1868,7 @@ TestpropCmd(clientData, interp, argc, argv) *p = '\n'; } } - Tcl_SetResult(interp, property, TCL_VOLATILE); + Tcl_SetResult(interp, (/*!unsigned*/char*)property, TCL_VOLATILE); } else { for (p = property; length > 0; length--) { if (actualFormat == 32) { @@ -2163,209 +1892,15 @@ TestpropCmd(clientData, interp, argc, argv) return TCL_OK; } -/* - *---------------------------------------------------------------------- - * - * TestsendCmd -- - * - * This procedure implements the "testsend" command. It provides - * a set of functions for testing the "send" command and support - * procedure in tkSend.c. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * Depends on option; see below. - * - *---------------------------------------------------------------------- - */ - - /* ARGSUSED */ -#if !(defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK)) -static int -TestsendCmd(clientData, interp, argc, argv) - ClientData clientData; /* Main window for application. */ - Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - CONST char **argv; /* Argument strings. */ -{ - TkWindow *winPtr = (TkWindow *) clientData; - - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0], - " option ?arg ...?\"", (char *) NULL); - return TCL_ERROR; - } - - if (strcmp(argv[1], "bogus") == 0) { - XChangeProperty(winPtr->dispPtr->display, - RootWindow(winPtr->dispPtr->display, 0), - winPtr->dispPtr->registryProperty, XA_INTEGER, 32, - PropModeReplace, - (unsigned char *) "This is bogus information", 6); - } else if (strcmp(argv[1], "prop") == 0) { - int result, actualFormat; - unsigned long length, bytesAfter; - Atom actualType, propName; - char *property, *p, *end; - Window w; - - if ((argc != 4) && (argc != 5)) { - Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0], - " prop window name ?value ?\"", (char *) NULL); - return TCL_ERROR; - } - if (strcmp(argv[2], "root") == 0) { - w = RootWindow(winPtr->dispPtr->display, 0); - } else if (strcmp(argv[2], "comm") == 0) { - w = Tk_WindowId(winPtr->dispPtr->commTkwin); - } else { - w = strtoul(argv[2], &end, 0); - } - propName = Tk_InternAtom((Tk_Window) winPtr, argv[3]); - if (argc == 4) { - property = NULL; - result = XGetWindowProperty(winPtr->dispPtr->display, - w, propName, 0, 100000, False, XA_STRING, - &actualType, &actualFormat, &length, - &bytesAfter, (unsigned char **) &property); - if ((result == Success) && (actualType != None) - && (actualFormat == 8) && (actualType == XA_STRING)) { - for (p = property; (p-property) < length; p++) { - if (*p == 0) { - *p = '\n'; - } - } - Tcl_SetResult(interp, property, TCL_VOLATILE); - } - if (property != NULL) { - XFree(property); - } - } else { - if (argv[4][0] == 0) { - XDeleteProperty(winPtr->dispPtr->display, w, propName); - } else { - Tcl_DString tmp; - - Tcl_DStringInit(&tmp); - for (p = Tcl_DStringAppend(&tmp, argv[4], - (int) strlen(argv[4])); - *p != 0; p++) { - if (*p == '\n') { - *p = 0; - } - } - - XChangeProperty(winPtr->dispPtr->display, - w, propName, XA_STRING, 8, PropModeReplace, - (unsigned char *) Tcl_DStringValue(&tmp), - p-Tcl_DStringValue(&tmp)); - Tcl_DStringFree(&tmp); - } - } - } else if (strcmp(argv[1], "serial") == 0) { - char buf[TCL_INTEGER_SPACE]; - - sprintf(buf, "%d", tkSendSerial+1); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - } else { - Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be bogus, prop, or serial", (char *) NULL); - return TCL_ERROR; - } - return TCL_OK; -} -#endif - -/* - *---------------------------------------------------------------------- - * - * TesttextCmd -- - * - * This procedure implements the "testtext" command. It provides - * a set of functions for testing text widgets and the associated - * functions in tkText*.c. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * Depends on option; see below. - * - *---------------------------------------------------------------------- - */ - -static int -TesttextCmd(clientData, interp, argc, argv) - ClientData clientData; /* Main window for application. */ - Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - CONST char **argv; /* Argument strings. */ -{ - TkText *textPtr; - size_t len; - int lineIndex, byteIndex, byteOffset; - TkTextIndex index; - char buf[64]; - Tcl_CmdInfo info; - - if (argc < 3) { - return TCL_ERROR; - } - - if (Tcl_GetCommandInfo(interp, argv[1], &info) == 0) { - return TCL_ERROR; - } - textPtr = (TkText *) info.clientData; - len = strlen(argv[2]); - if (strncmp(argv[2], "byteindex", len) == 0) { - if (argc != 5) { - return TCL_ERROR; - } - lineIndex = atoi(argv[3]) - 1; - byteIndex = atoi(argv[4]); - - TkTextMakeByteIndex(textPtr->tree, lineIndex, byteIndex, &index); - } else if (strncmp(argv[2], "forwbytes", len) == 0) { - if (argc != 5) { - return TCL_ERROR; - } - if (TkTextGetIndex(interp, textPtr, argv[3], &index) != TCL_OK) { - return TCL_ERROR; - } - byteOffset = atoi(argv[4]); - TkTextIndexForwBytes(&index, byteOffset, &index); - } else if (strncmp(argv[2], "backbytes", len) == 0) { - if (argc != 5) { - return TCL_ERROR; - } - if (TkTextGetIndex(interp, textPtr, argv[3], &index) != TCL_OK) { - return TCL_ERROR; - } - byteOffset = atoi(argv[4]); - TkTextIndexBackBytes(&index, byteOffset, &index); - } else { - return TCL_ERROR; - } - - TkTextSetMark(textPtr, "insert", &index); - TkTextPrintIndex(&index, buf); - sprintf(buf + strlen(buf), " %d", index.byteIndex); - Tcl_AppendResult(interp, buf, NULL); - - return TCL_OK; -} - -#if !(defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK)) +#if !(defined(__WIN32__) || defined(MAC_OSX_TK)) /* *---------------------------------------------------------------------- * * TestwrapperCmd -- * - * This procedure implements the "testwrapper" command. It - * provides a way from Tcl to determine the extra window Tk adds - * in between the toplevel window and the window decorations. + * This function implements the "testwrapper" command. It provides a way + * from Tcl to determine the extra window Tk adds in between the toplevel + * window and the window decorations. * * Results: * A standard Tcl result. @@ -2378,21 +1913,21 @@ TesttextCmd(clientData, interp, argc, argv) /* ARGSUSED */ static int -TestwrapperCmd(clientData, interp, argc, argv) - ClientData clientData; /* Main window for application. */ - Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - CONST char **argv; /* Argument strings. */ +TestwrapperCmd( + ClientData clientData, /* Main window for application. */ + Tcl_Interp *interp, /* Current interpreter. */ + int argc, /* Number of arguments. */ + const char **argv) /* Argument strings. */ { TkWindow *winPtr, *wrapperPtr; Tk_Window tkwin; if (argc != 2) { Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0], - " window\"", (char *) NULL); + " window\"", NULL); return TCL_ERROR; } - + tkwin = (Tk_Window) clientData; winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[1], tkwin); if (winPtr == NULL) { @@ -2415,7 +1950,7 @@ TestwrapperCmd(clientData, interp, argc, argv) * * CustomOptionSet, CustomOptionGet, CustomOptionRestore, CustomOptionFree -- * - * Handlers for object-based custom configuration options. See + * Handlers for object-based custom configuration options. See * Testobjconfigcommand. * * Results: @@ -2437,20 +1972,19 @@ TestwrapperCmd(clientData, interp, argc, argv) */ static int -CustomOptionSet(clientData,interp, tkwin, value, recordPtr, internalOffset, - saveInternalPtr, flags) - ClientData clientData; - Tcl_Interp *interp; - Tk_Window tkwin; - Tcl_Obj **value; - char *recordPtr; - int internalOffset; - char *saveInternalPtr; - int flags; +CustomOptionSet( + ClientData clientData, + Tcl_Interp *interp, + Tk_Window tkwin, + Tcl_Obj **value, + char *recordPtr, + int internalOffset, + char *saveInternalPtr, + int flags) { int objEmpty, length; - char *new, *string, *internalPtr; - + char *newStr, *string, *internalPtr; + objEmpty = 0; if (internalOffset >= 0) { @@ -2458,21 +1992,21 @@ CustomOptionSet(clientData,interp, tkwin, value, recordPtr, internalOffset, } else { internalPtr = NULL; } - + /* * See if the object is empty. */ + if (value == NULL) { objEmpty = 1; + CLANG_ASSERT(value); + } else if ((*value)->bytes != NULL) { + objEmpty = ((*value)->length == 0); } else { - if ((*value)->bytes != NULL) { - objEmpty = ((*value)->length == 0); - } else { - Tcl_GetStringFromObj((*value), &length); - objEmpty = (length == 0); - } + Tcl_GetStringFromObj((*value), &length); + objEmpty = (length == 0); } - + if ((flags & TK_OPTION_NULL_OK) && objEmpty) { *value = NULL; } else { @@ -2487,47 +2021,54 @@ CustomOptionSet(clientData,interp, tkwin, value, recordPtr, internalOffset, if (internalPtr != NULL) { if ((*value) != NULL) { string = Tcl_GetStringFromObj((*value), &length); - new = ckalloc((size_t) (length + 1)); - strcpy(new, string); + newStr = ckalloc(length + 1); + strcpy(newStr, string); } else { - new = NULL; + newStr = NULL; } *((char **) saveInternalPtr) = *((char **) internalPtr); - *((char **) internalPtr) = new; + *((char **) internalPtr) = newStr; } return TCL_OK; } static Tcl_Obj * -CustomOptionGet(clientData, tkwin, recordPtr, internalOffset) - ClientData clientData; - Tk_Window tkwin; - char *recordPtr; - int internalOffset; +CustomOptionGet( + ClientData clientData, + Tk_Window tkwin, + char *recordPtr, + int internalOffset) { return (Tcl_NewStringObj(*(char **)(recordPtr + internalOffset), -1)); } static void -CustomOptionRestore(clientData, tkwin, internalPtr, saveInternalPtr) - ClientData clientData; - Tk_Window tkwin; - char *internalPtr; - char *saveInternalPtr; +CustomOptionRestore( + ClientData clientData, + Tk_Window tkwin, + char *internalPtr, + char *saveInternalPtr) { *(char **)internalPtr = *(char **)saveInternalPtr; return; } static void -CustomOptionFree(clientData, tkwin, internalPtr) - ClientData clientData; - Tk_Window tkwin; - char *internalPtr; +CustomOptionFree( + ClientData clientData, + Tk_Window tkwin, + char *internalPtr) { if (*(char **)internalPtr != NULL) { ckfree(*(char **)internalPtr); } } - + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |