summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2007-05-14 20:58:24 (GMT)
committerdgp <dgp@users.sourceforge.net>2007-05-14 20:58:24 (GMT)
commit63b954a5775049b63f7067e80d9c1b31c8176222 (patch)
tree288d4d74decb1ae3a9c5616c310ea88b3b8bee31 /generic
parente34b1b4d9d3de8cc8c9af59dc8e6927c0af02283 (diff)
downloadtk-63b954a5775049b63f7067e80d9c1b31c8176222.zip
tk-63b954a5775049b63f7067e80d9c1b31c8176222.tar.gz
tk-63b954a5775049b63f7067e80d9c1b31c8176222.tar.bz2
[Tk Bug 1712081]
* unix/Makefile.in: Updates to account for new and deleted files * win/Makefile.in: tkStubImg.c and tkOldTest.c. * win/makefile.bc: * win/makefile.vc: * generic/tkOldTest.c (new): New file used to create testing * generic/tkTest.c: commands for testing various Tk * tests/constraints.tcl: legacy interfaces where a separate * tests/image.test: compilation unit is needed in order to #define suitable macros during compilation. Only the effect of USE_OLD_IMAGE on Tk_CreateImageType() is currently tested, but more similar testing commands can be added to this same file. New constraint defined to detect presence of the image type provided by the new testing code, and a few tests added to exercise it. Having USE_OLD_IMAGE support tested by the default test suite should reduce chance of a recurrence of this bug. * doc/CrtImgType.3: Revised docs to better indicate the legacy * doc/CrtPhImgFmt.3: nature of the interfaces supported by USE_OLD_IMAGE. * generic/tkDecls.h: make genstubs * generic/tkStubInit.c: * generic/tk.decls: Reworked USE_OLD_IMAGE support to use * generic/tk.h: the same support mechanisms both with * generic/tkStubImg.c (deleted):and without a stub-enabled build. In each case, route the legacy calls to Tk_CreateImageType and Tk_CreatePhotoImageFormat through the Tk_CreateOldImageType and Tk_CreateOldPhotoImageFormat routines. Add those routines to the public stub table so they're available to a stub-enabled extension. Remove the definition of Tk_InitImageArgs() and use a macro to convert any calls to it in source code into a comment. * generic/tkImage.c: Removed the MODULE_SCOPE declarations that * generic/tkImgPhoto.c: broke USE_OLD_IMAGE support.
Diffstat (limited to 'generic')
-rw-r--r--generic/tk.decls19
-rw-r--r--generic/tk.h15
-rw-r--r--generic/tkDecls.h23
-rw-r--r--generic/tkImage.c6
-rw-r--r--generic/tkImgPhoto.c6
-rw-r--r--generic/tkOldTest.c406
-rw-r--r--generic/tkStubImg.c90
-rw-r--r--generic/tkStubInit.c4
-rw-r--r--generic/tkTest.c48
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;