tk/generic/tkStubImg.c

   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$
  14  */
  15
  16 #include "tcl.h"
  17
  18 \f
  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
  43 void
  44 Tk_InitImageArgs(interp, argc, argvPtr)
  45     Tcl_Interp *interp;
  46     int argc;
  47     char ***argvPtr;
  48 {
  49     static 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 }