diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tk.decls | 19 | ||||
| -rw-r--r-- | generic/tk.h | 15 | ||||
| -rw-r--r-- | generic/tkDecls.h | 23 | ||||
| -rw-r--r-- | generic/tkImage.c | 6 | ||||
| -rw-r--r-- | generic/tkImgPhoto.c | 6 | ||||
| -rw-r--r-- | generic/tkOldTest.c | 406 | ||||
| -rw-r--r-- | generic/tkStubImg.c | 90 | ||||
| -rw-r--r-- | generic/tkStubInit.c | 4 | ||||
| -rw-r--r-- | generic/tkTest.c | 48 |
9 files changed, 468 insertions, 149 deletions
diff --git a/generic/tk.decls b/generic/tk.decls index 0bbec19..5e3763a 100644 --- a/generic/tk.decls +++ b/generic/tk.decls @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tk.decls,v 1.30 2007/01/03 05:06:26 nijtmans Exp $ +# RCS: @(#) $Id: tk.decls,v 1.31 2007/05/14 20:58:25 dgp Exp $ library tk @@ -1275,6 +1275,23 @@ declare 271 generic { Tcl_Interp * Tk_Interp (Tk_Window tkwin) } +# Now that the Tk 8.2 -> 8.3 transition is long past, use more conventional +# means to continue support for extensions using the USE_OLD_IMAGE to +# continue use of their string-based Tcl_ImageTypes and Tcl_PhotoImageFormats. +# +# Note that this restores the usual rules for stub compatibility. Stub-enabled +# extensions compiled against 8.5 headers and linked to the 8.5 stub library +# will produce a file [load]able into an interp with Tk 8.X, for X >= 5. +# It will *not* be [load]able into interps with Tk 8.4 (or Tk 8.2!). +# Developers who need to produce a file [load]able into legacy interps must +# build against legacy sources. +declare 272 generic { + void Tk_CreateOldImageType(Tk_ImageType *typePtr) +} +declare 273 generic { + void Tk_CreateOldPhotoImageFormat(Tk_PhotoImageFormat *formatPtr) +} + # Define the platform specific public Tk interface. These functions are # only available on the designated platform. diff --git a/generic/tk.h b/generic/tk.h index da72a5f..2e76231 100644 --- a/generic/tk.h +++ b/generic/tk.h @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tk.h,v 1.96 2007/04/17 15:25:08 dkf Exp $ + * RCS: @(#) $Id: tk.h,v 1.97 2007/05/14 20:58:26 dgp Exp $ */ #ifndef _TK @@ -1365,12 +1365,7 @@ struct Tk_PhotoImageFormat { * image format handler. */ }; -EXTERN void Tk_CreateOldImageType _ANSI_ARGS_(( - Tk_ImageType *typePtr)); -EXTERN void Tk_CreateOldPhotoImageFormat _ANSI_ARGS_(( - Tk_PhotoImageFormat *formatPtr)); - -#if !defined(USE_TK_STUBS) && defined(USE_OLD_IMAGE) +#ifdef USE_OLD_IMAGE #define Tk_CreateImageType Tk_CreateOldImageType #define Tk_CreatePhotoImageFormat Tk_CreateOldPhotoImageFormat #endif @@ -1501,14 +1496,8 @@ const char * Tk_InitStubs _ANSI_ARGS_((Tcl_Interp *interp, #endif -void Tk_InitImageArgs _ANSI_ARGS_((Tcl_Interp *interp, - int argc, char ***argv)); - -#if !defined(USE_TK_STUBS) || !defined(USE_OLD_IMAGE) - #define Tk_InitImageArgs(interp, argc, argv) /**/ -#endif /* *-------------------------------------------------------------- diff --git a/generic/tkDecls.h b/generic/tkDecls.h index b70cf80..4071501 100644 --- a/generic/tkDecls.h +++ b/generic/tkDecls.h @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkDecls.h,v 1.29 2007/01/03 05:06:26 nijtmans Exp $ + * RCS: @(#) $Id: tkDecls.h,v 1.30 2007/05/14 20:58:26 dgp Exp $ */ #ifndef _TKDECLS @@ -1683,6 +1683,17 @@ EXTERN void Tk_ResetUserInactiveTime (Display * dpy); /* 271 */ EXTERN Tcl_Interp * Tk_Interp (Tk_Window tkwin); #endif +#ifndef Tk_CreateOldImageType_TCL_DECLARED +#define Tk_CreateOldImageType_TCL_DECLARED +/* 272 */ +EXTERN void Tk_CreateOldImageType (Tk_ImageType * typePtr); +#endif +#ifndef Tk_CreateOldPhotoImageFormat_TCL_DECLARED +#define Tk_CreateOldPhotoImageFormat_TCL_DECLARED +/* 273 */ +EXTERN void Tk_CreateOldPhotoImageFormat ( + Tk_PhotoImageFormat * formatPtr); +#endif typedef struct TkStubHooks { struct TkPlatStubs *tkPlatStubs; @@ -1967,6 +1978,8 @@ typedef struct TkStubs { long (*tk_GetUserInactiveTime) (Display * dpy); /* 269 */ void (*tk_ResetUserInactiveTime) (Display * dpy); /* 270 */ Tcl_Interp * (*tk_Interp) (Tk_Window tkwin); /* 271 */ + void (*tk_CreateOldImageType) (Tk_ImageType * typePtr); /* 272 */ + void (*tk_CreateOldPhotoImageFormat) (Tk_PhotoImageFormat * formatPtr); /* 273 */ } TkStubs; #ifdef __cplusplus @@ -3065,6 +3078,14 @@ extern TkStubs *tkStubsPtr; #define Tk_Interp \ (tkStubsPtr->tk_Interp) /* 271 */ #endif +#ifndef Tk_CreateOldImageType +#define Tk_CreateOldImageType \ + (tkStubsPtr->tk_CreateOldImageType) /* 272 */ +#endif +#ifndef Tk_CreateOldPhotoImageFormat +#define Tk_CreateOldPhotoImageFormat \ + (tkStubsPtr->tk_CreateOldPhotoImageFormat) /* 273 */ +#endif #endif /* defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) */ diff --git a/generic/tkImage.c b/generic/tkImage.c index a9f65d4..bb78315 100644 --- a/generic/tkImage.c +++ b/generic/tkImage.c @@ -10,16 +10,12 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkImage.c,v 1.31 2007/02/12 23:13:45 dkf Exp $ + * RCS: @(#) $Id: tkImage.c,v 1.32 2007/05/14 20:58:27 dgp Exp $ */ #include "tkInt.h" #include "tkPort.h" -#ifndef USE_OLD_IMAGE -MODULE_SCOPE void Tk_CreateOldImageType(Tk_ImageType *typePtr); -#endif - /* * Each call to Tk_GetImage returns a pointer to one of the following * structures, which is used as a token by clients (widgets) that diff --git a/generic/tkImgPhoto.c b/generic/tkImgPhoto.c index 5838ef5..e9e5b0c 100644 --- a/generic/tkImgPhoto.c +++ b/generic/tkImgPhoto.c @@ -17,7 +17,7 @@ * Department of Computer Science, * Australian National University. * - * RCS: @(#) $Id: tkImgPhoto.c,v 1.68 2007/01/11 15:35:39 dkf Exp $ + * RCS: @(#) $Id: tkImgPhoto.c,v 1.69 2007/05/14 20:58:27 dgp Exp $ */ #include "tkInt.h" @@ -34,10 +34,6 @@ extern int _XInitImageFuncPtrs(XImage *image); -#ifndef USE_OLD_IMAGE -MODULE_SCOPE void Tk_CreateOldPhotoImageFormat(Tk_PhotoImageFormat *formatPtr); -#endif - /* * A signed 8-bit integral type. If chars are unsigned and the compiler isn't * an ANSI one, then we have to use short instead (which wastes space) to get diff --git a/generic/tkOldTest.c b/generic/tkOldTest.c new file mode 100644 index 0000000..473d92c --- /dev/null +++ b/generic/tkOldTest.c @@ -0,0 +1,406 @@ +/* + * tkOldTest.c -- + * + * This file contains C command functions for additional Tcl + * commands that are used to test Tk's support for legacy + * interfaces. These commands are not normally included in Tcl/Tk + * 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. + * Contributions by Don Porter, NIST, 2007. (not subject to US copyright) + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tkOldTest.c,v 1.1 2007/05/14 20:58:27 dgp Exp $ + */ + +#define USE_OLD_IMAGE +#include "tkInt.h" + +/* + * The following data structure represents the master for a test image: + */ + +typedef struct TImageMaster { + Tk_ImageMaster master; /* Tk's token for image master. */ + 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). */ +} TImageMaster; + +/* + * The following data structure represents a particular use of a particular + * test image. + */ + +typedef struct TImageInstance { + TImageMaster *masterPtr; /* Pointer to master for image. */ + XColor *fg; /* Foreground color for drawing in image. */ + GC gc; /* Graphics context for drawing in image. */ +} TImageInstance; + +/* + * The type record for test images: + */ + +static int ImageCreate(Tcl_Interp *interp, + char *name, int argc, char **argv, + 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(ClientData clientData, Display *display); +static void ImageDelete(ClientData clientData); + +static Tk_ImageType imageType = { + "oldtest", /* name */ + (Tk_ImageCreateProc *) ImageCreate, /* createProc */ + ImageGet, /* getProc */ + ImageDisplay, /* displayProc */ + ImageFree, /* freeProc */ + ImageDelete, /* deleteProc */ + NULL, /* postscriptPtr */ + NULL /* nextPtr */ +}; + +/* + * Forward declarations for functions defined later in this file: + */ + +static int ImageCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +MODULE_SCOPE int TkOldTestInit(Tcl_Interp *interp); + + +/* + *---------------------------------------------------------------------- + * + * TkOldTestInit -- + * + * This function performs intialization for the Tk test suite + * extensions for testing support for legacy interfaces. + * + * Results: + * 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. + * + *---------------------------------------------------------------------- + */ + +int +TkOldTestInit( + Tcl_Interp *interp) +{ + static int initialized = 0; + + if (!initialized) { + initialized = 1; + Tk_CreateImageType(&imageType); + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ImageCreate -- + * + * This function is called by the Tk image code to create "oldtest" images. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * The data structure for a new image is allocated. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +static int +ImageCreate( + 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; + + varName = "log"; + for (i = 0; i < argc; i += 2) { + if (strcmp(argv[i], "-variable") != 0) { + Tcl_AppendResult(interp, "bad option name \"", + argv[i], "\"", NULL); + return TCL_ERROR; + } + if ((i+1) == argc) { + Tcl_AppendResult(interp, "no value given for \"", + argv[i], "\" option", NULL); + return TCL_ERROR; + } + varName = argv[i+1]; + } + + timPtr = (TImageMaster *) ckalloc(sizeof(TImageMaster)); + timPtr->master = master; + timPtr->interp = interp; + timPtr->width = 30; + timPtr->height = 15; + timPtr->imageName = (char *) ckalloc((unsigned) (strlen(name) + 1)); + strcpy(timPtr->imageName, name); + timPtr->varName = (char *) ckalloc((unsigned) (strlen(varName) + 1)); + strcpy(timPtr->varName, varName); + Tcl_CreateCommand(interp, name, ImageCmd, (ClientData) timPtr, NULL); + *clientDataPtr = (ClientData) timPtr; + Tk_ImageChanged(master, 0, 0, 30, 15, 30, 15); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ImageCmd -- + * + * This function implements the commands corresponding to individual + * images. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * Forces windows to be created. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +static int +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 ...?", 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", NULL); + return TCL_ERROR; + } + if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK) + || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK) + || (Tcl_GetInt(interp, argv[4], &width) != TCL_OK) + || (Tcl_GetInt(interp, argv[5], &height) != TCL_OK) + || (Tcl_GetInt(interp, argv[6], &timPtr->width) != TCL_OK) + || (Tcl_GetInt(interp, argv[7], &timPtr->height) != TCL_OK)) { + return TCL_ERROR; + } + Tk_ImageChanged(timPtr->master, x, y, width, height, timPtr->width, + timPtr->height); + } else { + Tcl_AppendResult(interp, "bad option \"", argv[1], + "\": must be changed", NULL); + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ImageGet -- + * + * 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. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static ClientData +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; + char buffer[100]; + XGCValues gcValues; + + sprintf(buffer, "%s get", timPtr->imageName); + Tcl_SetVar(timPtr->interp, timPtr->varName, buffer, + TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT); + + instPtr = (TImageInstance *) 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; +} + +/* + *---------------------------------------------------------------------- + * + * ImageDisplay -- + * + * 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. + * + *---------------------------------------------------------------------- + */ + +static void +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, int height, /* Dimensions of area to redraw. */ + int drawableX, int drawableY) + /* Coordinates in drawable corresponding to + * imageX and imageY. */ +{ + TImageInstance *instPtr = (TImageInstance *) clientData; + char buffer[200 + TCL_INTEGER_SPACE * 6]; + + sprintf(buffer, "%s display %d %d %d %d %d %d", + instPtr->masterPtr->imageName, imageX, imageY, width, height, + drawableX, drawableY); + Tcl_SetVar(instPtr->masterPtr->interp, instPtr->masterPtr->varName, buffer, + TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT); + if (width > (instPtr->masterPtr->width - imageX)) { + width = instPtr->masterPtr->width - imageX; + } + if (height > (instPtr->masterPtr->height - imageY)) { + height = instPtr->masterPtr->height - imageY; + } + XDrawRectangle(display, drawable, instPtr->gc, drawableX, drawableY, + (unsigned) (width-1), (unsigned) (height-1)); + XDrawLine(display, drawable, instPtr->gc, drawableX, drawableY, + (int) (drawableX + width - 1), (int) (drawableY + height - 1)); + XDrawLine(display, drawable, instPtr->gc, drawableX, + (int) (drawableY + height - 1), + (int) (drawableX + width - 1), drawableY); +} + +/* + *---------------------------------------------------------------------- + * + * ImageFree -- + * + * This function is called when an instance of an image is no longer + * used. + * + * Results: + * None. + * + * Side effects: + * Information related to the instance is freed. + * + *---------------------------------------------------------------------- + */ + +static void +ImageFree( + ClientData clientData, /* Pointer to TImageInstance for instance. */ + Display *display) /* Display where image was to be drawn. */ +{ + TImageInstance *instPtr = (TImageInstance *) clientData; + char buffer[200]; + + sprintf(buffer, "%s free", instPtr->masterPtr->imageName); + Tcl_SetVar(instPtr->masterPtr->interp, instPtr->masterPtr->varName, buffer, + TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT); + Tk_FreeColor(instPtr->fg); + Tk_FreeGC(display, instPtr->gc); + ckfree((char *) instPtr); +} + +/* + *---------------------------------------------------------------------- + * + * ImageDelete -- + * + * This function is called to clean up a test image when an application + * goes away. + * + * Results: + * None. + * + * Side effects: + * Information about the image is deleted. + * + *---------------------------------------------------------------------- + */ + +static void +ImageDelete( + ClientData clientData) /* Pointer to TImageMaster for image. When + * this function is called, no more instances + * exist. */ +{ + TImageMaster *timPtr = (TImageMaster *) clientData; + char buffer[100]; + + sprintf(buffer, "%s delete", timPtr->imageName); + Tcl_SetVar(timPtr->interp, timPtr->varName, buffer, + TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT); + + Tcl_DeleteCommand(timPtr->interp, timPtr->imageName); + ckfree(timPtr->imageName); + ckfree(timPtr->varName); + ckfree((char *) timPtr); +} + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/generic/tkStubImg.c b/generic/tkStubImg.c deleted file mode 100644 index 88b7efe..0000000 --- a/generic/tkStubImg.c +++ /dev/null @@ -1,90 +0,0 @@ -/* - * tkStubImg.c -- - * - * Stub object that will be statically linked into extensions that wish - * to access Tk. - * - * Copyright (c) 1999 Jan Nijtmans. - * 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. - * - * RCS: @(#) $Id: tkStubImg.c,v 1.4 2005/11/15 15:18:22 dkf Exp $ - */ - -#include "tcl.h" - - -/* - *---------------------------------------------------------------------- - * - * Tk_InitImageArgs -- - * - * Performs the necessary conversion from Tcl_Obj's to strings in the - * createProc for Tcl_CreateImageType. If running under Tk 8.2 or earlier - * without the Img-patch, this function has no effect. - * - * Results: - * argvPtr will point to an argument list which is guaranteed to contain - * strings, no matter what Tk version is running. - * - * Side effects: - * None - * - *---------------------------------------------------------------------- - */ - -#ifdef Tk_InitImageArgs -#undef Tk_InitImageArgs -#endif - -void -Tk_InitImageArgs( - Tcl_Interp *interp, - int argc, - char ***argvPtr) -{ - static int useNewImage = -1; - static char **argv = NULL; - - if (argv) { - tclStubsPtr->tcl_Free((char *) argv); - argv = NULL; - } - - if (useNewImage < 0) { - Tcl_CmdInfo cmdInfo; - - /* - * Note that this is *not* safe; users are free to rename the [image] - * command. Sometime should fix to use assocData instead? - */ - - if (!tclStubsPtr->tcl_GetCommandInfo(interp, "image", &cmdInfo)) { - tclStubsPtr->tcl_Panic("cannot find the \"image\" command"); - } - if (cmdInfo.isNativeObjectProc == 1) { - useNewImage = 1; /* Tk uses the new image interface */ - } else { - useNewImage = 0; /* Tk uses old image interface */ - } - } - if (useNewImage && (argc > 0)) { - int i; - - argv = (char **) tclStubsPtr->tcl_Alloc(argc * sizeof(char *)); - for (i = 0; i < argc; i++) { - argv[i] = tclStubsPtr->tcl_GetString((Tcl_Obj *)(*argvPtr)[i]); - } - *argvPtr = (char **) argv; - } -} - -/* - * Local Variables: - * mode: c - * c-basic-offset: 4 - * fill-column: 78 - * End: - */ diff --git a/generic/tkStubInit.c b/generic/tkStubInit.c index 61a280a..9a9674e 100644 --- a/generic/tkStubInit.c +++ b/generic/tkStubInit.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkStubInit.c,v 1.56 2006/10/08 21:47:12 patthoyts Exp $ + * RCS: @(#) $Id: tkStubInit.c,v 1.57 2007/05/14 20:58:27 dgp Exp $ */ #include "tkInt.h" @@ -939,6 +939,8 @@ TkStubs tkStubs = { Tk_GetUserInactiveTime, /* 269 */ Tk_ResetUserInactiveTime, /* 270 */ Tk_Interp, /* 271 */ + Tk_CreateOldImageType, /* 272 */ + Tk_CreateOldPhotoImageFormat, /* 273 */ }; /* !END!: Do not edit above this line. */ diff --git a/generic/tkTest.c b/generic/tkTest.c index 2f16372..b5be7a2 100644 --- a/generic/tkTest.c +++ b/generic/tkTest.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkTest.c,v 1.31 2007/01/03 05:06:26 nijtmans Exp $ + * RCS: @(#) $Id: tkTest.c,v 1.32 2007/05/14 20:58:27 dgp Exp $ */ #include "tkInt.h" @@ -61,17 +61,10 @@ typedef struct TImageInstance { * The type record for test images: */ -#ifdef USE_OLD_IMAGE -static int ImageCreate(Tcl_Interp *interp, - char *name, int argc, char **argv, - Tk_ImageType *typePtr, Tk_ImageMaster master, - ClientData *clientDataPtr); -#else static int ImageCreate(Tcl_Interp *interp, char *name, int argc, Tcl_Obj *CONST objv[], Tk_ImageType *typePtr, Tk_ImageMaster master, ClientData *clientDataPtr); -#endif static ClientData ImageGet(Tk_Window tkwin, ClientData clientData); static void ImageDisplay(ClientData clientData, Display *display, Drawable drawable, @@ -83,7 +76,7 @@ static void ImageDelete(ClientData clientData); static Tk_ImageType imageType = { "test", /* name */ - (Tk_ImageCreateProc *) ImageCreate, /* createProc */ + ImageCreate, /* createProc */ ImageGet, /* getProc */ ImageDisplay, /* displayProc */ ImageFree, /* freeProc */ @@ -220,6 +213,11 @@ static void TrivialEventProc(ClientData clientData, #else MODULE_SCOPE int TkplatformtestInit(Tcl_Interp *interp); #endif + +/* + * External legacy testing initialization routine: + */ +MODULE_SCOPE int TkOldTestInit(Tcl_Interp *interp); /* *---------------------------------------------------------------------- @@ -301,6 +299,14 @@ Tktest_Init( } /* + * Enable testing of legacy interfaces. + */ + + if (TkOldTestInit(interp) != TCL_OK) { + return TCL_ERROR; + } + + /* * And finally add any platform specific test commands. */ @@ -1487,15 +1493,9 @@ ImageCreate( Tcl_Interp *interp, /* Interpreter for application containing * image. */ char *name, /* Name to use for image. */ -#ifdef USE_OLD_IMAGE - int argc, /* Number of arguments. */ - char **argv, /* Argument strings for options (doesn't - * include image name or type). */ -#else int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[], /* Argument strings for options (doesn't * include image name or type). */ -#endif /* USE_OLD_IMAGE */ Tk_ImageType *typePtr, /* Pointer to our type record (not used). */ Tk_ImageMaster master, /* Token for image, to be used by us in later * callbacks. */ @@ -1506,23 +1506,6 @@ ImageCreate( char *varName; int i; -#ifdef USE_OLD_IMAGE - 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], "\"", NULL); - return TCL_ERROR; - } - if ((i+1) == argc) { - Tcl_AppendResult(interp, "no value given for \"", - argv[i], "\" option", NULL); - return TCL_ERROR; - } - varName = argv[i+1]; - } -#else varName = "log"; for (i = 0; i < objc; i += 2) { if (strcmp(Tcl_GetString(objv[i]), "-variable") != 0) { @@ -1537,7 +1520,6 @@ ImageCreate( } varName = Tcl_GetString(objv[i+1]); } -#endif /* USE_OLD_IMAGE */ timPtr = (TImageMaster *) ckalloc(sizeof(TImageMaster)); timPtr->master = master; |