* generic/tkDecls.h:

	* generic/tk.decls:
	* generic/tk.h: moved new public functions created in dash patch
	to the stubs interface [Bug: 4062]

	* generic/tk.h:
	* doc/CrtImgType.3:
	* doc/CrtPhImgFmt.3:
	* generic/tk.h:
	* generic/tkImgGIF.c:
	* generic/tkImgPhoto.c:
	* generic/tkStubImg.c (new file):
	* generic/tkTest.c:
	* unix/Makefile.in:
	* win/Makefile.in:
	* win/makefile.vc: improved support for moving from the old style
	image C API to the new obj'ified one with new Tk_InitImageArgs
	command and stub'ing of image code.  See docs for how to make the
	transition. [Bug: 4060]


FossilOrigin-Name: dbe34fe5efcb725442acc347dcb728ad8e30493c

1 files changed, 74 insertions, 0 deletions

diff --git a/generic/tkStubImg.c b/generic/tkStubImg.c
new file mode 100644
index 0000000..7e1e23f
--- /dev/null
+++ b/generic/tkStubImg.c
@@ -0,0 +1,74 @@
+/* 
+ * 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.1 2000/02/08 11:31:33 hobbs 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(interp, argc, argvPtr)
+    Tcl_Interp *interp;
+    int argc;
+    char ***argvPtr;
+{
+    static useNewImage = -1;
+    static char **argv = NULL;
+
+    if (argv) {
+	tclStubsPtr->tcl_Free((char *) argv);
+	argv = NULL;
+    }
+
+    if (useNewImage < 0) {
+	Tcl_CmdInfo cmdInfo;
+	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 */
+	}
+    }
+    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;
+    }
+}