blob: 88b7efe8ec4cb672d1349d78b2ba7c2f102581b2 (
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
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
|
/*
* 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:
*/
|
