summaryrefslogtreecommitdiffstats
path: root/generic/tkStubImg.c
blob: 691bf7817d56909389c156c9df29062904086f2a (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
/* 
 * 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.2 2000/07/17 23:03:20 ericm 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 */
	} 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;
    }
}