blob: 024e581c578b45162e7ef3ebf807cf1261e1312b (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
|
/*
* 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$
*/
#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;
}
}
|
