1/* 2 * tkStubImg.c -- 3 * 4 * Stub object that will be statically linked into extensions that wish 5 * to access Tk. 6 * 7 * Copyright (c) 1999 Jan Nijtmans. 8 * Copyright (c) 1998-1999 by Scriptics Corporation. 9 * 10 * See the file "license.terms" for information on usage and redistribution 11 * of this file, and for a DISCLAIMER OF ALL WARRANTIES. 12 * 13 * RCS: @(#) $Id: tkStubImg.c,v 1.3 2003/01/09 01:00:36 dgp Exp $ 14 */ 15 16#include "tcl.h" 17 18 19/* 20 *---------------------------------------------------------------------- 21 * 22 * Tk_InitImageArgs -- 23 * 24 * Performs the necessary conversion from Tcl_Obj's to strings 25 * in the createProc for Tcl_CreateImageType. If running under 26 * Tk 8.2 or earlier without the Img-patch, this function has 27 * no effect. 28 * 29 * Results: 30 * argvPtr will point to an argument list which is guaranteed to 31 * contain strings, no matter what Tk version is running. 32 * 33 * Side effects: 34 * None 35 * 36 *---------------------------------------------------------------------- 37 */ 38 39#ifdef Tk_InitImageArgs 40#undef Tk_InitImageArgs 41#endif 42 43void 44Tk_InitImageArgs(interp, argc, argvPtr) 45 Tcl_Interp *interp; 46 int argc; 47 char ***argvPtr; 48{ 49 static int useNewImage = -1; 50 static char **argv = NULL; 51 52 if (argv) { 53 tclStubsPtr->tcl_Free((char *) argv); 54 argv = NULL; 55 } 56 57 if (useNewImage < 0) { 58 Tcl_CmdInfo cmdInfo; 59 if (!tclStubsPtr->tcl_GetCommandInfo(interp,"image", &cmdInfo)) { 60 tclStubsPtr->tcl_Panic("cannot find the \"image\" command"); 61 } 62 if (cmdInfo.isNativeObjectProc == 1) { 63 useNewImage = 1; /* Tk uses the new image interface */ 64 } else { 65 useNewImage = 0; /* Tk uses old image interface */ 66 } 67 } 68 if (useNewImage && (argc > 0)) { 69 int i; 70 argv = (char **) tclStubsPtr->tcl_Alloc(argc * sizeof(char *)); 71 for (i = 0; i < argc; i++) { 72 argv[i] = tclStubsPtr->tcl_GetString((Tcl_Obj *)(*argvPtr)[i]); 73 } 74 *argvPtr = (char **) argv; 75 } 76} 77