Tk Source Code

Check-in [1a49039b]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Implement TkCygwinMainEx for loading Cygwin's Tk_MainEx from the Tk dll
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-4-branch
Files: files | file ages | folders
SHA1: 1a49039bd572e1899dfb7dd653e355ac74a3f721
User & Date: jan.nijtmans 2012-06-08 20:53:38
Context
2012-06-08
22:11
function def in front check-in: 8c1ea956 user: jan.nijtmans tags: core-8-4-branch
21:22
Implement TkCygwinMainEx for loading Cygwin's Tk_MainEx from the Tk dll check-in: 3db2e9c6 user: jan.nijtmans tags: core-8-5-branch
20:53
Implement TkCygwinMainEx for loading Cygwin's Tk_MainEx from the Tk dll check-in: 1a49039b user: jan.nijtmans tags: core-8-4-branch
20:45
OXS Tiger Breakage check-in: 673c3417 user: jan.nijtmans tags: core-8-4-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.






1
2
3
4
5
6
7





2012-06-07  Jan Nijtmans  <[email protected]>

	* generic/tkInt.decls:   Change XChangeWindowAttributes signature and
	* generic/tkIntXlibDeclsDecls.h: many others to match Xorg, needed for Cygwin.

2012-06-02  Jan Nijtmans  <[email protected]>

>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
2012-06-08  Jan Nijtmans  <[email protected]>

	* generic/tkMain.c:   Implement TkCygwinMainEx for loading
	* generic/tkWindow.c: Cygwin's Tk_MainEx from the Tk dll.

2012-06-07  Jan Nijtmans  <[email protected]>

	* generic/tkInt.decls:   Change XChangeWindowAttributes signature and
	* generic/tkIntXlibDeclsDecls.h: many others to match Xorg, needed for Cygwin.

2012-06-02  Jan Nijtmans  <[email protected]>

Changes to generic/tkMain.c.

1
2
3
4
5
6
7
8
/* 
 * tkMain.c --
 *
 *	This file contains a generic main program for Tk-based applications.
 *	It can be used as-is for many applications, just by supplying a
 *	different appInitProc procedure for each specific application.
 *	Or, it can be used as a template for creating new main programs
 *	for Tk applications.
|







1
2
3
4
5
6
7
8
/*
 * tkMain.c --
 *
 *	This file contains a generic main program for Tk-based applications.
 *	It can be used as-is for many applications, just by supplying a
 *	different appInitProc procedure for each specific application.
 *	Or, it can be used as a template for creating new main programs
 *	for Tk applications.
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51

typedef struct ThreadSpecificData {
    Tcl_Interp *interp;         /* Interpreter for this thread. */
    Tcl_DString command;        /* Used to assemble lines of terminal input
				 * into Tcl commands. */
    Tcl_DString line;           /* Used to read the next line from the
				 * terminal input. */
    int tty;                    /* Non-zero means standard input is a 
				 * terminal-like device.  Zero means it's
				 * a file. */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * Declarations for various library procedures and variables (don't want







|







37
38
39
40
41
42
43
44
45
46
47
48
49
50
51

typedef struct ThreadSpecificData {
    Tcl_Interp *interp;         /* Interpreter for this thread. */
    Tcl_DString command;        /* Used to assemble lines of terminal input
				 * into Tcl commands. */
    Tcl_DString line;           /* Used to read the next line from the
				 * terminal input. */
    int tty;                    /* Non-zero means standard input is a
				 * terminal-like device.  Zero means it's
				 * a file. */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * Declarations for various library procedures and variables (don't want
151
152
153
154
155
156
157
158


159
160
161
162
163
164
165

166


167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
     * really only an issue when Tk is loaded dynamically.
     */

    if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
	abort();
    }

#if defined(__WIN32__) && !defined(STATIC_BUILD)


    if (tclStubsPtr->reserved9) {
	/* We are running win32 Tk under Cygwin, so let's check
	 * whether the env("DISPLAY") variable or the -display
	 * argument is set. If so, we really want to run the
	 * Tk_MainEx function of libtk.dll, not this one. */
 	if (Tcl_GetVar2(interp, "env", "DISPLAY", TCL_GLOBAL_ONLY)) {
	loadCygwinTk:

	    Tcl_Panic("Should load libtk.dll now, not yet implemented");


	} else {
	    int i;

	    for (i = 1; i < argc; ++i) {
		if (!strcmp(argv[i], "-display")) {
		    goto loadCygwinTk;
		}
	    }
	}
    }
#endif

    tsdPtr = (ThreadSpecificData *) 
	Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    
    Tcl_FindExecutable(argv[0]);
    tsdPtr->interp = interp;
    Tcl_Preserve((ClientData) interp);

#if defined(__WIN32__) && !defined(STATIC_BUILD)
    if (!tclStubsPtr->reserved9) {
	/* Only initialize console when not running under cygwin */
	Tk_InitConsoleChannels(interp);
    }
#elif  defined(__WIN32__) || defined(MAC_TCL)
    Tk_InitConsoleChannels(interp);
#endif

#ifdef MAC_OSX_TK
    if (TclGetStartupScriptFileName() == NULL) {
        TkMacOSXDefaultStartupScript();
    }
#endif
    
#ifdef TCL_MEM_DEBUG
    Tcl_InitMemory(interp);
#endif

    /*
     * Parse command-line arguments.  A leading "-file" argument is
     * ignored (a historical relic from the distant past).  If the







|
>
>




|
|

>
|
>
>












|

|


















|







151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
     * really only an issue when Tk is loaded dynamically.
     */

    if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
	abort();
    }

#if defined(__WIN32__) && !defined(__WIN64__) && !defined(STATIC_BUILD)
    extern int TkCygwinMainEx(int, char **, Tcl_AppInitProc *, Tcl_Interp *);

    if (tclStubsPtr->reserved9) {
	/* We are running win32 Tk under Cygwin, so let's check
	 * whether the env("DISPLAY") variable or the -display
	 * argument is set. If so, we really want to run the
	 * Tk_MainEx function of libtk8.?.dll, not this one. */
	if (Tcl_GetVar2(interp, "env", "DISPLAY", TCL_GLOBAL_ONLY)) {
	loadCygwinTk:
	    if (TkCygwinMainEx(argc, argv, appInitProc, interp)) {
		/* Should never reach here. */
		return;
	    }
	} else {
	    int i;

	    for (i = 1; i < argc; ++i) {
		if (!strcmp(argv[i], "-display")) {
		    goto loadCygwinTk;
		}
	    }
	}
    }
#endif

    tsdPtr = (ThreadSpecificData *)
	Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    Tcl_FindExecutable(argv[0]);
    tsdPtr->interp = interp;
    Tcl_Preserve((ClientData) interp);

#if defined(__WIN32__) && !defined(STATIC_BUILD)
    if (!tclStubsPtr->reserved9) {
	/* Only initialize console when not running under cygwin */
	Tk_InitConsoleChannels(interp);
    }
#elif  defined(__WIN32__) || defined(MAC_TCL)
    Tk_InitConsoleChannels(interp);
#endif

#ifdef MAC_OSX_TK
    if (TclGetStartupScriptFileName() == NULL) {
        TkMacOSXDefaultStartupScript();
    }
#endif

#ifdef TCL_MEM_DEBUG
    Tcl_InitMemory(interp);
#endif

    /*
     * Parse command-line arguments.  A leading "-file" argument is
     * ignored (a historical relic from the distant past).  If the
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
    if (TclGetStartupScriptFileName() == NULL) {
	if ((argc > 1) && (argv[1][0] != '-')) {
	    TclSetStartupScriptFileName(argv[1]);
	    argc--;
	    argv++;
	}
    }
    
    /*
     * Make command-line arguments available in the Tcl variables "argc"
     * and "argv".
     */

    if (TclGetStartupScriptFileName() == NULL) {
	Tcl_ExternalToUtfDString(NULL, argv[0], -1, &appName);







|







224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
    if (TclGetStartupScriptFileName() == NULL) {
	if ((argc > 1) && (argv[1][0] != '-')) {
	    TclSetStartupScriptFileName(argv[1]);
	    argc--;
	    argv++;
	}
    }

    /*
     * Make command-line arguments available in the Tcl variables "argc"
     * and "argv".
     */

    if (TclGetStartupScriptFileName() == NULL) {
	Tcl_ExternalToUtfDString(NULL, argv[0], -1, &appName);
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274

#if defined(MAC_OSX_TK)
    /*
     * On TkAqua, if we don't have a TTY and stdin is a special character file
     * of length 0, (e.g. /dev/null, which is what Finder sets when double
     * clicking Wish) then use the GUI console.
     */
    
    if (!tsdPtr->tty) {
	struct stat st;

	nullStdin = fstat(0, &st) || (S_ISCHR(st.st_mode) && !st.st_blocks);
    }
#endif
    Tcl_SetVar(interp, "tcl_interactive",







|







265
266
267
268
269
270
271
272
273
274
275
276
277
278
279

#if defined(MAC_OSX_TK)
    /*
     * On TkAqua, if we don't have a TTY and stdin is a special character file
     * of length 0, (e.g. /dev/null, which is what Finder sets when double
     * clicking Wish) then use the GUI console.
     */

    if (!tsdPtr->tty) {
	struct stat st;

	nullStdin = fstat(0, &st) || (S_ISCHR(st.st_mode) && !st.st_blocks);
    }
#endif
    Tcl_SetVar(interp, "tcl_interactive",
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
    ClientData clientData;		/* Not used. */
    int mask;				/* Not used. */
{
    static int gotPartial = 0;
    char *cmd;
    int code, count;
    Tcl_Channel chan = (Tcl_Channel) clientData;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    Tcl_Interp *interp = tsdPtr->interp;

    count = Tcl_Gets(chan, &tsdPtr->line);

    if (count < 0) {
	if (!gotPartial) {
	    if (tsdPtr->tty) {
		Tcl_Exit(0);
	    } else {
		Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan);
	    }
	    return;
	} 
    }

    (void) Tcl_DStringAppend(&tsdPtr->command, Tcl_DStringValue(
            &tsdPtr->line), -1);
    cmd = Tcl_DStringAppend(&tsdPtr->command, "\n", -1);
    Tcl_DStringFree(&tsdPtr->line);
    if (!Tcl_CommandComplete(cmd)) {







|













|







376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
    ClientData clientData;		/* Not used. */
    int mask;				/* Not used. */
{
    static int gotPartial = 0;
    char *cmd;
    int code, count;
    Tcl_Channel chan = (Tcl_Channel) clientData;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    Tcl_Interp *interp = tsdPtr->interp;

    count = Tcl_Gets(chan, &tsdPtr->line);

    if (count < 0) {
	if (!gotPartial) {
	    if (tsdPtr->tty) {
		Tcl_Exit(0);
	    } else {
		Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan);
	    }
	    return;
	}
    }

    (void) Tcl_DStringAppend(&tsdPtr->command, Tcl_DStringValue(
            &tsdPtr->line), -1);
    cmd = Tcl_DStringAppend(&tsdPtr->command, "\n", -1);
    Tcl_DStringFree(&tsdPtr->line);
    if (!Tcl_CommandComplete(cmd)) {
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
     * process commands from stdin before the current command is
     * finished.  Among other things, this will trash the text of the
     * command being evaluated.
     */

    Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) chan);
    code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL);
    
    chan = Tcl_GetStdChannel(TCL_STDIN);
    if (chan) {
	Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc,
		(ClientData) chan);
    }
    Tcl_DStringFree(&tsdPtr->command);
    if (Tcl_GetStringResult(interp)[0] != '\0') {







|







413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
     * process commands from stdin before the current command is
     * finished.  Among other things, this will trash the text of the
     * command being evaluated.
     */

    Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) chan);
    code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL);

    chan = Tcl_GetStdChannel(TCL_STDIN);
    if (chan) {
	Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc,
		(ClientData) chan);
    }
    Tcl_DStringFree(&tsdPtr->command);
    if (Tcl_GetStringResult(interp)[0] != '\0') {
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
	    Tcl_AddErrorInfo(interp,
		    "\n    (script that generates prompt)");
            /*
             * We must check that errChannel is a real channel - it
             * is possible that someone has transferred stderr out of
             * this interpreter with "interp transfer".
             */
            
	    errChannel = Tcl_GetChannel(interp, "stderr", NULL);
            if (errChannel != (Tcl_Channel) NULL) {
                Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
                Tcl_WriteChars(errChannel, "\n", 1);
            }
	    goto defaultPrompt;
	}
    }
    outChannel = Tcl_GetChannel(interp, "stdout", NULL);
    if (outChannel != (Tcl_Channel) NULL) {
        Tcl_Flush(outChannel);
    }
}







|













497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
	    Tcl_AddErrorInfo(interp,
		    "\n    (script that generates prompt)");
            /*
             * We must check that errChannel is a real channel - it
             * is possible that someone has transferred stderr out of
             * this interpreter with "interp transfer".
             */

	    errChannel = Tcl_GetChannel(interp, "stderr", NULL);
            if (errChannel != (Tcl_Channel) NULL) {
                Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
                Tcl_WriteChars(errChannel, "\n", 1);
            }
	    goto defaultPrompt;
	}
    }
    outChannel = Tcl_GetChannel(interp, "stdout", NULL);
    if (outChannel != (Tcl_Channel) NULL) {
        Tcl_Flush(outChannel);
    }
}

Changes to generic/tkWindow.c.

1
2
3
4
5
6
7
8
/* 
 * tkWindow.c --
 *
 *	This file provides basic window-manipulation procedures,
 *	which are equivalent to procedures in Xlib (and even
 *	invoke them) but also maintain the local Tk_Window
 *	structure.
 *
|







1
2
3
4
5
6
7
8
/*
 * tkWindow.c --
 *
 *	This file provides basic window-manipulation procedures,
 *	which are equivalent to procedures in Xlib (and even
 *	invoke them) but also maintain the local Tk_Window
 *	structure.
 *
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
#include "tkWinInt.h"
#elif !(defined(MAC_TCL) ||  defined(MAC_OSX_TK))
#include "tkUnixInt.h"
#endif

#include "tclInt.h" /* for Tcl_CreateNamespace() */

/* 
 * Type used to keep track of Window objects that were
 * only partically deallocated by Tk_DestroyWindow.
 */

#define HD_CLEANUP		1
#define HD_FOCUS		2
#define HD_MAIN_WIN		4







|







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
#include "tkWinInt.h"
#elif !(defined(MAC_TCL) ||  defined(MAC_OSX_TK))
#include "tkUnixInt.h"
#endif

#include "tclInt.h" /* for Tcl_CreateNamespace() */

/*
 * Type used to keep track of Window objects that were
 * only partically deallocated by Tk_DestroyWindow.
 */

#define HD_CLEANUP		1
#define HD_FOCUS		2
#define HD_MAIN_WIN		4
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
    TkMainInfo *mainWindowList;
                           /* First in list of all main windows managed
			    * by this thread. */
    TkHalfdeadWindow *halfdeadWindowList;
                           /* First in list of partially deallocated
			    * windows. */
    TkDisplay *displayList;
                           /* List of all displays currently in use by 
			    * the current thread. */
    int initialized;       /* 0 means the structures above need 
			    * initializing. */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/* 
 * The Mutex below is used to lock access to the Tk_Uid structs above. 
 */

TCL_DECLARE_MUTEX(windowMutex)

/*
 * Default values for "changes" and "atts" fields of TkWindows.  Note
 * that Tk always requests all events for all windows, except StructureNotify







|

|




|
|







48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
    TkMainInfo *mainWindowList;
                           /* First in list of all main windows managed
			    * by this thread. */
    TkHalfdeadWindow *halfdeadWindowList;
                           /* First in list of partially deallocated
			    * windows. */
    TkDisplay *displayList;
                           /* List of all displays currently in use by
			    * the current thread. */
    int initialized;       /* 0 means the structures above need
			    * initializing. */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * The Mutex below is used to lock access to the Tk_Uid structs above.
 */

TCL_DECLARE_MUTEX(windowMutex)

/*
 * Default values for "changes" and "atts" fields of TkWindows.  Note
 * that Tk always requests all events for all windows, except StructureNotify
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
};

/*
 * Forward declarations to procedures defined later in this file:
 */

static Tk_Window	CreateTopLevelWindow _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window parent, CONST char *name, 
			    CONST char *screenName, unsigned int flags));
static void		DeleteWindowsExitProc _ANSI_ARGS_((
			    ClientData clientData));
static TkDisplay *	GetScreen _ANSI_ARGS_((Tcl_Interp *interp,
			    CONST char *screenName, int *screenPtr));
static int		Initialize _ANSI_ARGS_((Tcl_Interp *interp));
static int		NameWindow _ANSI_ARGS_((Tcl_Interp *interp,







|







218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
};

/*
 * Forward declarations to procedures defined later in this file:
 */

static Tk_Window	CreateTopLevelWindow _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window parent, CONST char *name,
			    CONST char *screenName, unsigned int flags));
static void		DeleteWindowsExitProc _ANSI_ARGS_((
			    ClientData clientData));
static TkDisplay *	GetScreen _ANSI_ARGS_((Tcl_Interp *interp,
			    CONST char *screenName, int *screenPtr));
static int		Initialize _ANSI_ARGS_((Tcl_Interp *interp));
static int		NameWindow _ANSI_ARGS_((Tcl_Interp *interp,
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
				 * use parent's screen, or DISPLAY if no
				 * parent. */
    unsigned int flags;		/* Additional flags to set on the window. */
{
    register TkWindow *winPtr;
    register TkDisplay *dispPtr;
    int screenId;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (!tsdPtr->initialized) {
	tsdPtr->initialized = 1;

	/*
	 * Create built-in image types.







|







331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
				 * use parent's screen, or DISPLAY if no
				 * parent. */
    unsigned int flags;		/* Additional flags to set on the window. */
{
    register TkWindow *winPtr;
    register TkDisplay *dispPtr;
    int screenId;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (!tsdPtr->initialized) {
	tsdPtr->initialized = 1;

	/*
	 * Create built-in image types.
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394

    winPtr = TkAllocWindow(dispPtr, screenId, (TkWindow *) parent);

    /*
     * Set the flags specified in the call.
     */
    winPtr->flags |= flags;
    
    /*
     * Force the window to use a border pixel instead of border pixmap. 
     * This is needed for the case where the window doesn't use the
     * default visual.  In this case, the default border is a pixmap
     * inherited from the root window, which won't work because it will
     * have the wrong visual.
     */

    winPtr->dirtyAtts |= CWBorderPixel;







|

|







378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394

    winPtr = TkAllocWindow(dispPtr, screenId, (TkWindow *) parent);

    /*
     * Set the flags specified in the call.
     */
    winPtr->flags |= flags;

    /*
     * Force the window to use a border pixel instead of border pixmap.
     * This is needed for the case where the window doesn't use the
     * default visual.  In this case, the default border is a pixmap
     * inherited from the root window, which won't work because it will
     * have the wrong visual.
     */

    winPtr->dirtyAtts |= CWBorderPixel;
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
				 * use DISPLAY envariable. */
    int *screenPtr;		/* Where to store screen number. */
{
    register TkDisplay *dispPtr;
    CONST char *p;
    int screenId;
    size_t length;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    /*
     * Separate the screen number from the rest of the display
     * name.  ScreenName is assumed to have the syntax
     * <display>.<screen> with the dot and the screen being
     * optional.







|







443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
				 * use DISPLAY envariable. */
    int *screenPtr;		/* Where to store screen number. */
{
    register TkDisplay *dispPtr;
    CONST char *p;
    int screenId;
    size_t length;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    /*
     * Separate the screen number from the rest of the display
     * name.  ScreenName is assumed to have the syntax
     * <display>.<screen> with the dot and the screen being
     * optional.
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
	if ((strncmp(dispPtr->name, screenName, length) == 0)
		&& (dispPtr->name[length] == '\0')) {
	    break;
	}
    }
    if (screenId >= ScreenCount(dispPtr->display)) {
	char buf[32 + TCL_INTEGER_SPACE];
	
	sprintf(buf, "bad screen number \"%d\"", screenId);
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
	return (TkDisplay *) NULL;
    }
    *screenPtr = screenId;
    return dispPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TkGetDisplay --
 *
 *	Given an X display, TkGetDisplay returns the TkDisplay 
 *      structure for the display.
 *
 * Results:
 *	The return value is a pointer to information about the display,
 *	or NULL if the display did not have a TkDisplay structure.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

TkDisplay *
TkGetDisplay(display)
     Display *display;          /* X's display pointer */
{
    TkDisplay *dispPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    for (dispPtr = tsdPtr->displayList; dispPtr != NULL;
	    dispPtr = dispPtr->nextPtr) {
	if (dispPtr->display == display) {
	    break;
	}







|













|

















|







519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
	if ((strncmp(dispPtr->name, screenName, length) == 0)
		&& (dispPtr->name[length] == '\0')) {
	    break;
	}
    }
    if (screenId >= ScreenCount(dispPtr->display)) {
	char buf[32 + TCL_INTEGER_SPACE];

	sprintf(buf, "bad screen number \"%d\"", screenId);
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
	return (TkDisplay *) NULL;
    }
    *screenPtr = screenId;
    return dispPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TkGetDisplay --
 *
 *	Given an X display, TkGetDisplay returns the TkDisplay
 *      structure for the display.
 *
 * Results:
 *	The return value is a pointer to information about the display,
 *	or NULL if the display did not have a TkDisplay structure.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

TkDisplay *
TkGetDisplay(display)
     Display *display;          /* X's display pointer */
{
    TkDisplay *dispPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    for (dispPtr = tsdPtr->displayList; dispPtr != NULL;
	    dispPtr = dispPtr->nextPtr) {
	if (dispPtr->display == display) {
	    break;
	}
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
 *      None.
 *
 *--------------------------------------------------------------
 */
TkDisplay *
TkGetDisplayList()
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    
    return tsdPtr->displayList;
}

/*
 *--------------------------------------------------------------
 *
 * TkGetMainInfoList --







|

|







583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
 *      None.
 *
 *--------------------------------------------------------------
 */
TkDisplay *
TkGetDisplayList()
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    return tsdPtr->displayList;
}

/*
 *--------------------------------------------------------------
 *
 * TkGetMainInfoList --
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
 *      None.
 *
 *--------------------------------------------------------------
 */
TkMainInfo *
TkGetMainInfoList()
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    
    return tsdPtr->mainWindowList;
}
/*
 *--------------------------------------------------------------
 *
 * TkAllocWindow --
 *







|

|







610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
 *      None.
 *
 *--------------------------------------------------------------
 */
TkMainInfo *
TkGetMainInfoList()
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    return tsdPtr->mainWindowList;
}
/*
 *--------------------------------------------------------------
 *
 * TkAllocWindow --
 *
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
    int dummy;
    int isSafe;
    Tcl_HashEntry *hPtr;
    register TkMainInfo *mainPtr;
    register TkWindow *winPtr;
    register CONST TkCmd *cmdPtr;
    ClientData clientData;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    /*
     * Panic if someone updated the TkWindow structure without
     * also updating the Tk_FakeWin structure (or vice versa).
     */

    if (sizeof(TkWindow) != sizeof(Tk_FakeWin)) {
	panic("TkWindow and Tk_FakeWin are not the same size");
    }

    /*
     * Create the basic TkWindow structure.
     */

    tkwin = CreateTopLevelWindow(interp, (Tk_Window) NULL, baseName,
	    screenName, /* flags */ 0);
    if (tkwin == NULL) {
	return NULL;
    }
    
    /*
     * Create the TkMainInfo structure for this application, and set
     * up name-related information for the new window.
     */

    winPtr = (TkWindow *) tkwin;
    mainPtr = (TkMainInfo *) ckalloc(sizeof(TkMainInfo));







|




















|







855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
    int dummy;
    int isSafe;
    Tcl_HashEntry *hPtr;
    register TkMainInfo *mainPtr;
    register TkWindow *winPtr;
    register CONST TkCmd *cmdPtr;
    ClientData clientData;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    /*
     * Panic if someone updated the TkWindow structure without
     * also updating the Tk_FakeWin structure (or vice versa).
     */

    if (sizeof(TkWindow) != sizeof(Tk_FakeWin)) {
	panic("TkWindow and Tk_FakeWin are not the same size");
    }

    /*
     * Create the basic TkWindow structure.
     */

    tkwin = CreateTopLevelWindow(interp, (Tk_Window) NULL, baseName,
	    screenName, /* flags */ 0);
    if (tkwin == NULL) {
	return NULL;
    }

    /*
     * Create the TkMainInfo structure for this application, and set
     * up name-related information for the new window.
     */

    winPtr = (TkWindow *) tkwin;
    mainPtr = (TkMainInfo *) ckalloc(sizeof(TkMainInfo));
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
    if (p != fixedSpace) {
        ckfree(p);
    }
    if (parent == NULL) {
	return NULL;
    }
    if (((TkWindow *) parent)->flags & TK_ALREADY_DEAD) {
	Tcl_AppendResult(interp, 
	    "can't create window: parent has been destroyed", (char *) NULL);
	return NULL;
    } else if (((TkWindow *) parent)->flags & TK_CONTAINER) {
	Tcl_AppendResult(interp, 
	    "can't create window: its parent has -container = yes",
		(char *) NULL);
	return NULL;
    }

    /*
     * Create the window.







|



|







1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
    if (p != fixedSpace) {
        ckfree(p);
    }
    if (parent == NULL) {
	return NULL;
    }
    if (((TkWindow *) parent)->flags & TK_ALREADY_DEAD) {
	Tcl_AppendResult(interp,
	    "can't create window: parent has been destroyed", (char *) NULL);
	return NULL;
    } else if (((TkWindow *) parent)->flags & TK_CONTAINER) {
	Tcl_AppendResult(interp,
	    "can't create window: its parent has -container = yes",
		(char *) NULL);
	return NULL;
    }

    /*
     * Create the window.
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
Tk_DestroyWindow(tkwin)
    Tk_Window tkwin;		/* Window to destroy. */
{
    TkWindow *winPtr = (TkWindow *) tkwin;
    TkDisplay *dispPtr = winPtr->dispPtr;
    XEvent event;
    TkHalfdeadWindow *halfdeadPtr, *prev_halfdeadPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (winPtr->flags & TK_ALREADY_DEAD) {
	/*
	 * A destroy event binding caused the window to be destroyed
	 * again.  Ignore the request.
	 */







|







1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
Tk_DestroyWindow(tkwin)
    Tk_Window tkwin;		/* Window to destroy. */
{
    TkWindow *winPtr = (TkWindow *) tkwin;
    TkDisplay *dispPtr = winPtr->dispPtr;
    XEvent event;
    TkHalfdeadWindow *halfdeadPtr, *prev_halfdeadPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (winPtr->flags & TK_ALREADY_DEAD) {
	/*
	 * A destroy event binding caused the window to be destroyed
	 * again.  Ignore the request.
	 */
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
                    (!Tcl_InterpDeleted(winPtr->mainPtr->interp))) {
                for (cmdPtr = commands; cmdPtr->name != NULL; cmdPtr++) {
                    Tcl_CreateCommand(winPtr->mainPtr->interp, cmdPtr->name,
                            TkDeadAppCmd, (ClientData) NULL,
                            (void (*) _ANSI_ARGS_((ClientData))) NULL);
                }
                Tcl_CreateCommand(winPtr->mainPtr->interp, "send",
                        TkDeadAppCmd, (ClientData) NULL, 
                        (void (*) _ANSI_ARGS_((ClientData))) NULL);
                Tcl_UnlinkVar(winPtr->mainPtr->interp, "tk_strictMotif");
                Tcl_UnlinkVar(winPtr->mainPtr->interp, "::tk::AlwaysShowSelection");
            }
                
	    Tcl_DeleteHashTable(&winPtr->mainPtr->nameTable);
	    TkBindFree(winPtr->mainPtr);
	    TkDeleteAllImages(winPtr->mainPtr);
	    TkFontPkgFree(winPtr->mainPtr);
	    TkFocusFree(winPtr->mainPtr);
	    TkStylePkgFree(winPtr->mainPtr);

            /*
             * When embedding Tk into other applications, make sure 
             * that all destroy events reach the server. Otherwise
             * the embedding application may also attempt to destroy
             * the windows, resulting in an X error
             */

            if (winPtr->flags & TK_EMBEDDED) {
                XSync(winPtr->display, False); 
            }
	    ckfree((char *) winPtr->mainPtr);

            /*
             * If no other applications are using the display, close the
             * display now and relinquish its data structures.
             */







|




|








|






|







1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
                    (!Tcl_InterpDeleted(winPtr->mainPtr->interp))) {
                for (cmdPtr = commands; cmdPtr->name != NULL; cmdPtr++) {
                    Tcl_CreateCommand(winPtr->mainPtr->interp, cmdPtr->name,
                            TkDeadAppCmd, (ClientData) NULL,
                            (void (*) _ANSI_ARGS_((ClientData))) NULL);
                }
                Tcl_CreateCommand(winPtr->mainPtr->interp, "send",
                        TkDeadAppCmd, (ClientData) NULL,
                        (void (*) _ANSI_ARGS_((ClientData))) NULL);
                Tcl_UnlinkVar(winPtr->mainPtr->interp, "tk_strictMotif");
                Tcl_UnlinkVar(winPtr->mainPtr->interp, "::tk::AlwaysShowSelection");
            }

	    Tcl_DeleteHashTable(&winPtr->mainPtr->nameTable);
	    TkBindFree(winPtr->mainPtr);
	    TkDeleteAllImages(winPtr->mainPtr);
	    TkFontPkgFree(winPtr->mainPtr);
	    TkFocusFree(winPtr->mainPtr);
	    TkStylePkgFree(winPtr->mainPtr);

            /*
             * When embedding Tk into other applications, make sure
             * that all destroy events reach the server. Otherwise
             * the embedding application may also attempt to destroy
             * the windows, resulting in an X error
             */

            if (winPtr->flags & TK_EMBEDDED) {
                XSync(winPtr->display, False);
            }
	    ckfree((char *) winPtr->mainPtr);

            /*
             * If no other applications are using the display, close the
             * display now and relinquish its data structures.
             */
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
		/*
		 * Ideally this should be enabled, as unix Tk can use multiple
		 * displays.  However, there are order issues still, as well
		 * as the handling of queued events and such that must be
		 * addressed before this can be enabled.  The current cleanup
		 * works except for send event issues. -- hobbs 04/2002
		 */
                
                TkDisplay *theDispPtr, *backDispPtr;
                
                /*
                 * Splice this display out of the list of displays.
                 */
                
                for (theDispPtr = tsdPtr->displayList, backDispPtr = NULL;
                         (theDispPtr != winPtr->dispPtr) &&
                             (theDispPtr != NULL);
                         theDispPtr = theDispPtr->nextPtr) {
                    backDispPtr = theDispPtr;
                }
                if (theDispPtr == NULL) {







|

|



|







1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
		/*
		 * Ideally this should be enabled, as unix Tk can use multiple
		 * displays.  However, there are order issues still, as well
		 * as the handling of queued events and such that must be
		 * addressed before this can be enabled.  The current cleanup
		 * works except for send event issues. -- hobbs 04/2002
		 */

                TkDisplay *theDispPtr, *backDispPtr;

                /*
                 * Splice this display out of the list of displays.
                 */

                for (theDispPtr = tsdPtr->displayList, backDispPtr = NULL;
                         (theDispPtr != winPtr->dispPtr) &&
                             (theDispPtr != NULL);
                         theDispPtr = theDispPtr->nextPtr) {
                    backDispPtr = theDispPtr;
                }
                if (theDispPtr == NULL) {
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
    register TkWindow *winPtr = (TkWindow *) tkwin;

#if defined(MAC_TCL) || defined(MAC_OSX_TK)
    winPtr->atts.cursor = (XCursor) cursor;
#else
    winPtr->atts.cursor = (Cursor) cursor;
#endif
    
    if (winPtr->window != None) {
	XDefineCursor(winPtr->display, winPtr->window, winPtr->atts.cursor);
    } else {
	winPtr->dirtyAtts = winPtr->dirtyAtts | CWCursor;
    }
}








|







2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
    register TkWindow *winPtr = (TkWindow *) tkwin;

#if defined(MAC_TCL) || defined(MAC_OSX_TK)
    winPtr->atts.cursor = (XCursor) cursor;
#else
    winPtr->atts.cursor = (Cursor) cursor;
#endif

    if (winPtr->window != None) {
	XDefineCursor(winPtr->display, winPtr->window, winPtr->atts.cursor);
    } else {
	winPtr->dirtyAtts = winPtr->dirtyAtts | CWCursor;
    }
}

2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
	/*
	 * Either we're not really in Tk, or the main window was destroyed and
	 * we're on our way out of the application
	 */
	Tcl_AppendResult(interp, "NULL main window", (char *)NULL);
	return NULL;
    }
    
    hPtr = Tcl_FindHashEntry(&((TkWindow *) tkwin)->mainPtr->nameTable,
	    pathName);
    if (hPtr == NULL) {
	Tcl_AppendResult(interp, "bad window path name \"",
		pathName, "\"", (char *) NULL);
	return NULL;
    }







|







2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
	/*
	 * Either we're not really in Tk, or the main window was destroyed and
	 * we're on our way out of the application
	 */
	Tcl_AppendResult(interp, "NULL main window", (char *)NULL);
	return NULL;
    }

    hPtr = Tcl_FindHashEntry(&((TkWindow *) tkwin)->mainPtr->nameTable,
	    pathName);
    if (hPtr == NULL) {
	Tcl_AppendResult(interp, "bad window path name \"",
		pathName, "\"", (char *) NULL);
	return NULL;
    }
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
	return NULL;
    }
#ifdef USE_TCL_STUBS
    if (tclStubsPtr == NULL) {
	return NULL;
    }
#endif
    tsdPtr = (ThreadSpecificData *) 
	Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    for (mainPtr = tsdPtr->mainWindowList; mainPtr != NULL;
	    mainPtr = mainPtr->nextPtr) {
	if (mainPtr->interp == interp) {
	    return (Tk_Window) mainPtr->winPtr;
	}







|







2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
	return NULL;
    }
#ifdef USE_TCL_STUBS
    if (tclStubsPtr == NULL) {
	return NULL;
    }
#endif
    tsdPtr = (ThreadSpecificData *)
	Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    for (mainPtr = tsdPtr->mainWindowList; mainPtr != NULL;
	    mainPtr = mainPtr->nextPtr) {
	if (mainPtr->interp == interp) {
	    return (Tk_Window) mainPtr->winPtr;
	}
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714

#ifdef USE_TCL_STUBS
    if (tclStubsPtr == NULL) {
	return 0;
    }
#endif

    tsdPtr = (ThreadSpecificData *) 
	Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    return tsdPtr->numMainWindows;
}

/*
 *----------------------------------------------------------------------







|







2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714

#ifdef USE_TCL_STUBS
    if (tclStubsPtr == NULL) {
	return 0;
    }
#endif

    tsdPtr = (ThreadSpecificData *)
	Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    return tsdPtr->numMainWindows;
}

/*
 *----------------------------------------------------------------------
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
        Tcl_Release((ClientData) interp);
    }

    /*
     * Destroy any remaining main windows.
     */

    while (tsdPtr->mainWindowList != NULL) {        
        interp = tsdPtr->mainWindowList->interp;
        Tcl_Preserve((ClientData) interp);
        Tk_DestroyWindow((Tk_Window) tsdPtr->mainWindowList->winPtr);
        Tcl_Release((ClientData) interp);
    }

    /*







|







2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
        Tcl_Release((ClientData) interp);
    }

    /*
     * Destroy any remaining main windows.
     */

    while (tsdPtr->mainWindowList != NULL) {
        interp = tsdPtr->mainWindowList->interp;
        Tcl_Preserve((ClientData) interp);
        Tk_DestroyWindow((Tk_Window) tsdPtr->mainWindowList->winPtr);
        Tcl_Release((ClientData) interp);
    }

    /*
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829













































2830
2831
2832
2833
2834
2835
2836
         * set the global pointer to NULL so we will be able to notice if
         * any new displays got created during deletion of the current set.
         * We must also do this to ensure that Tk_IdToWindow does not find
         * the old display as it is being destroyed, when it wants to see
         * if it needs to dispatch a message.
         */

        for (tsdPtr->displayList = NULL; dispPtr != NULL; 
                dispPtr = nextPtr) {
            nextPtr = dispPtr->nextPtr;
            TkCloseDisplay(dispPtr);
        }
    }

    tsdPtr->numMainWindows = 0;
    tsdPtr->mainWindowList = NULL;
    tsdPtr->initialized = 0;
}














































/*
 *----------------------------------------------------------------------
 *
 * Tk_Init --
 *
 *	This procedure is invoked to add Tk to an interpreter.  It
 *	incorporates all of Tk's commands into the interpreter and







|











>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
         * set the global pointer to NULL so we will be able to notice if
         * any new displays got created during deletion of the current set.
         * We must also do this to ensure that Tk_IdToWindow does not find
         * the old display as it is being destroyed, when it wants to see
         * if it needs to dispatch a message.
         */

        for (tsdPtr->displayList = NULL; dispPtr != NULL;
                dispPtr = nextPtr) {
            nextPtr = dispPtr->nextPtr;
            TkCloseDisplay(dispPtr);
        }
    }

    tsdPtr->numMainWindows = 0;
    tsdPtr->mainWindowList = NULL;
    tsdPtr->initialized = 0;
}

#if defined(__WIN32__) && !defined(__WIN64__)

static HMODULE tkcygwindll = NULL;

/*
 * Run Tk_MainEx from libtk8.?.dll
 *
 * This function is only ever called from wish8.4.exe, the cygwin
 * port of Tcl. This means that the system encoding is utf-8,
 * so we don't have to do any encoding conversions.
 */
int
TkCygwinMainEx(argc, argv, appInitProc, interp)
    int argc;				/* Number of arguments. */
    char **argv;			/* Array of argument strings. */
    Tcl_AppInitProc *appInitProc;	/* Application-specific initialization
					 * procedure to call after most
					 * initialization but before starting
					 * to execute commands. */
    Tcl_Interp *interp;
{
    char name[MAX_PATH];
    int len;
    void (*sym)(int, char **, Tcl_AppInitProc *, Tcl_Interp *);

    /* construct "<path>/libtk8.?.dll", from "<path>/tk8?.dll" */
	len = GetModuleFileName(Tk_GetHINSTANCE(), name, MAX_PATH);
	name[len-2] = '.';
	name[len-1] = name[len-5];
	strcpy(name+len, ".dll");
	memcpy(name+len-8, "libtk8", 6);

	tkcygwindll = LoadLibrary(name);
	if (!tkcygwindll) {
	    /* dll is not present */
	    return 0;
	}
	sym = (void (*)(int, char **, Tcl_AppInitProc *, Tcl_Interp *)) GetProcAddress(tkcygwindll, "Tk_MainEx");
	if (!sym) {
		return 0;
	}
	sym(argc, argv, appInitProc, interp);
    return 1;
}
#endif
/*
 *----------------------------------------------------------------------
 *
 * Tk_Init --
 *
 *	This procedure is invoked to add Tk to an interpreter.  It
 *	incorporates all of Tk's commands into the interpreter and
2851
2852
2853
2854
2855
2856
2857










2858
2859
2860
2861
2862
2863
2864
 *----------------------------------------------------------------------
 */

int
Tk_Init(interp)
    Tcl_Interp *interp;		/* Interpreter to initialize. */
{










    return Initialize(interp);
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_SafeInit --







>
>
>
>
>
>
>
>
>
>







2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
 *----------------------------------------------------------------------
 */

int
Tk_Init(interp)
    Tcl_Interp *interp;		/* Interpreter to initialize. */
{
#if defined(__WIN32__) && !defined(__WIN64__)
    if (tkcygwindll) {
	int (*sym)(Tcl_Interp *);

	sym = (int (*)(Tcl_Interp *)) GetProcAddress(tkcygwindll, "Tk_Init");
	if (sym) {
	    return sym(interp);
	}
    }
#endif
    return Initialize(interp);
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_SafeInit --
2913
2914
2915
2916
2917
2918
2919










2920
2921
2922
2923
2924
2925
2926
     *
     * - No CPU time limit, no memory allocation limits, no color limits.
     *
     *  The actual code called is the same as Tk_Init but Tcl_IsSafe()
     *  is checked at several places to differentiate the two initialisations.
     */











    return Initialize(interp);
}


extern TkStubs tkStubs;

/*







>
>
>
>
>
>
>
>
>
>







2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
     *
     * - No CPU time limit, no memory allocation limits, no color limits.
     *
     *  The actual code called is the same as Tk_Init but Tcl_IsSafe()
     *  is checked at several places to differentiate the two initialisations.
     */

#if defined(__WIN32__) && !defined(__WIN64__)
    if (tkcygwindll) {
	int (*sym)(Tcl_Interp *);

	sym = (int (*)(Tcl_Interp *)) GetProcAddress(tkcygwindll, "Tk_SafeInit");
	if (sym) {
	    return sym(interp);
	}
    }
#endif
    return Initialize(interp);
}


extern TkStubs tkStubs;

/*
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975

static int
Initialize(interp)
    Tcl_Interp *interp;		/* Interpreter to initialize. */
{
    char *p;
    int argc, code;
    CONST char **argv; 
    char *args[20];
    CONST char *argString = NULL;
    Tcl_DString class;
    ThreadSpecificData *tsdPtr;
    
    /*
     * Ensure that we are getting the matching version of Tcl.  This is
     * really only an issue when Tk is loaded dynamically.
     */

    if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
        return TCL_ERROR;
    }

    /*
     * Ensure that our obj-types are registered with the Tcl runtime.
     */
    TkRegisterObjTypes();

    tsdPtr = (ThreadSpecificData *) 
	Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    /*
     * Start by initializing all the static variables to default acceptable
     * values so that no information is leaked from a previous run of this
     * code.
     */







|




|














|







3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040

static int
Initialize(interp)
    Tcl_Interp *interp;		/* Interpreter to initialize. */
{
    char *p;
    int argc, code;
    CONST char **argv;
    char *args[20];
    CONST char *argString = NULL;
    Tcl_DString class;
    ThreadSpecificData *tsdPtr;

    /*
     * Ensure that we are getting the matching version of Tcl.  This is
     * really only an issue when Tk is loaded dynamically.
     */

    if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
        return TCL_ERROR;
    }

    /*
     * Ensure that our obj-types are registered with the Tcl runtime.
     */
    TkRegisterObjTypes();

    tsdPtr = (ThreadSpecificData *)
	Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    /*
     * Start by initializing all the static variables to default acceptable
     * values so that no information is leaked from a previous run of this
     * code.
     */
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059

	if ((code = Tcl_Eval(master, Tcl_DStringValue(&ds))) != TCL_OK) {
	    /*
	     * We might want to transfer the error message or not.
	     * We don't. (no API to do it and maybe security reasons).
	     */
	    Tcl_DStringFree(&ds);
	    Tcl_AppendResult(interp, 
		    "not allowed to start Tk by master's safe::TkInit",
		    (char *) NULL);
	    goto done;
	}
	Tcl_DStringFree(&ds);
	/* 
	 * Use the master's result as argv.
	 * Note: We don't use the Obj interfaces to avoid dealing with
	 * cross interp refcounting and changing the code below.
	 */

	argString = Tcl_GetStringResult(master);
    } else {







|





|







3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124

	if ((code = Tcl_Eval(master, Tcl_DStringValue(&ds))) != TCL_OK) {
	    /*
	     * We might want to transfer the error message or not.
	     * We don't. (no API to do it and maybe security reasons).
	     */
	    Tcl_DStringFree(&ds);
	    Tcl_AppendResult(interp,
		    "not allowed to start Tk by master's safe::TkInit",
		    (char *) NULL);
	    goto done;
	}
	Tcl_DStringFree(&ds);
	/*
	 * Use the master's result as argv.
	 * Note: We don't use the Obj interfaces to avoid dealing with
	 * cross interp refcounting and changing the code below.
	 */

	argString = Tcl_GetStringResult(master);
    } else {

Changes to unix/Makefile.in.

208
209
210
211
212
213
214

215
216
217
218
219
220
221
# TCL_EXE is the name of a tclsh executable that is available *BEFORE*
# running make for the first time. Certain build targets (make genstubs)
# need it to be available on the PATH. This executable should *NOT* be
# required just to do a normal build although it can be required to run
# make dist. This variable is set to "" if no tclsh is available.
TCL_EXE			= @TCLSH_PROG@
WISH_EXE		= wish


# Tk used to let the configure script choose which program to use
# for installing, but there are just too many different versions of
# "install" around;  better to use the install-sh script that comes
# with the distribution, which is slower but guaranteed to work.

INSTALL_STRIP_PROGRAM   = -s







>







208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
# TCL_EXE is the name of a tclsh executable that is available *BEFORE*
# running make for the first time. Certain build targets (make genstubs)
# need it to be available on the PATH. This executable should *NOT* be
# required just to do a normal build although it can be required to run
# make dist. This variable is set to "" if no tclsh is available.
TCL_EXE			= @TCLSH_PROG@
WISH_EXE		= wish
TKTEST_EXE		= tktest

# Tk used to let the configure script choose which program to use
# for installing, but there are just too many different versions of
# "install" around;  better to use the install-sh script that comes
# with the distribution, which is slower but guaranteed to work.

INSTALL_STRIP_PROGRAM   = -s
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634

# Resetting the LIB_RUNTIME_DIR below is required so that
# the generated tktest executable gets the build directory
# burned into its ld search path. This keeps tktest from
# picking up an already installed version of the Tcl or
# Tk shared libraries.

tktest: $(TKTEST_OBJS) $(TK_LIB_FILE)
	$(MAKE) tktest-real LIB_RUNTIME_DIR="`pwd`:$(TCL_BIN_DIR)"

tktest-real:
	${CC} ${CFLAGS} ${LDFLAGS} $(TKTEST_OBJS) @TK_BUILD_LIB_SPEC@ \
		$(WISH_LIBS) $(CC_SEARCH_FLAGS) -o tktest

# FIXME: This xttest rule seems to be broken in a number of ways.
# It should use CC_SEARCH_FLAGS, it does not include the shared
# lib location logic from tktest, and it is not clear where this
# test.o object file comes from.
xttest: test.o tkTest.o tkSquare.o $(TK_LIB_FILE)
	${CC} ${CFLAGS} ${LDFLAGS} test.o tkTest.o tkSquare.o \
		@TK_BUILD_LIB_SPEC@ \
		$(WISH_LIBS) $(LD_SEARCH_FLAGS) -lXt -o xttest

# Note, in the target below TCL_LIBRARY needs to be set or else
# "make test" won't work in the case where the compilation directory
# isn't the same as the source directory.
# Specifying TESTFLAGS on the command line is the standard way to pass
# args to tcltest, ie:
#	% make test TESTFLAGS="-verbose bps -file fileName.test"

test: test-classic

test-classic: tktest
	$(SHELL_ENV) ./tktest $(TEST_DIR)/all.tcl -geometry +0+0 \
	$(TESTFLAGS) $(TCLTESTARGS)

# Tests with different languages
testlang: tktest
	$(SHELL_ENV) \
	for lang in $(LOCALES) ;  \
	do \
	LANG=$(lang); export LANG; \
	./tktest $(TEST_DIR)/all.tcl -geometry +0+0 \
	$(TESTFLAGS) $(TCLTESTARGS); \
	done

# Useful target to launch a built tktest with the proper path,...
runtest: tktest
	$(SHELL_ENV) ./tktest

# This target can be used to run wish from the build directory
# via `make shell` or `make shell SCRIPT=/tmp/foo.tcl`
shell: ${WISH_EXE}
	$(SHELL_ENV) ./${WISH_EXE} $(SCRIPT)

demo:
	$(SHELL_ENV) ./${WISH_EXE} $(TOP_DIR)/library/demos/widget

# This target can be used to run wish inside either gdb or insight
gdb: ${WISH_EXE}
	@echo "set env @LD_LIBRARY_PATH_VAR@=\"`pwd`:${TCL_BIN_DIR}:$${@LD_LIBRARY_PATH_VAR@}\"" > gdb.run
	@echo "set env TCL_LIBRARY=@TCL_SRC_DIR@/library" >> gdb.run
	@echo "set env TK_LIBRARY=@TK_SRC_DIR@/library" >> gdb.run
	gdb ./${WISH_EXE} --command=gdb.run
	rm gdb.run

VALGRINDARGS=--tool=memcheck --num-callers=8 --leak-resolution=high --leak-check=yes --show-reachable=yes -v

valgrind: tktest
	$(SHELL_ENV) valgrind $(VALGRINDARGS) ./tktest $(TEST_DIR)/all.tcl -geometry +0+0 -singleproc 1 $(TESTFLAGS)

valgrindshell: tktest
	$(SHELL_ENV) valgrind $(VALGRINDARGS) ./tktest $(SCRIPT)

INSTALL_TARGETS = install-binaries install-libraries install-demos install-doc @EXTRA_INSTALL@

install: $(INSTALL_TARGETS)

install-strip:
	$(MAKE) $(INSTALL_TARGETS) \







|




|



















|
|



|




|




|
|



















|
|

|
|







556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635

# Resetting the LIB_RUNTIME_DIR below is required so that
# the generated tktest executable gets the build directory
# burned into its ld search path. This keeps tktest from
# picking up an already installed version of the Tcl or
# Tk shared libraries.

$(TKTEST_EXE): $(TKTEST_OBJS) $(TK_LIB_FILE)
	$(MAKE) tktest-real LIB_RUNTIME_DIR="`pwd`:$(TCL_BIN_DIR)"

tktest-real:
	${CC} ${CFLAGS} ${LDFLAGS} $(TKTEST_OBJS) @TK_BUILD_LIB_SPEC@ \
		$(WISH_LIBS) $(CC_SEARCH_FLAGS) -o $(TKTEST_EXE)

# FIXME: This xttest rule seems to be broken in a number of ways.
# It should use CC_SEARCH_FLAGS, it does not include the shared
# lib location logic from tktest, and it is not clear where this
# test.o object file comes from.
xttest: test.o tkTest.o tkSquare.o $(TK_LIB_FILE)
	${CC} ${CFLAGS} ${LDFLAGS} test.o tkTest.o tkSquare.o \
		@TK_BUILD_LIB_SPEC@ \
		$(WISH_LIBS) $(LD_SEARCH_FLAGS) -lXt -o xttest

# Note, in the target below TCL_LIBRARY needs to be set or else
# "make test" won't work in the case where the compilation directory
# isn't the same as the source directory.
# Specifying TESTFLAGS on the command line is the standard way to pass
# args to tcltest, ie:
#	% make test TESTFLAGS="-verbose bps -file fileName.test"

test: test-classic

test-classic: $(TKTEST_EXE)
	$(SHELL_ENV) ./$(TKTEST_EXE) $(TEST_DIR)/all.tcl -geometry +0+0 \
	$(TESTFLAGS) $(TCLTESTARGS)

# Tests with different languages
testlang: $(TKTEST_EXE)
	$(SHELL_ENV) \
	for lang in $(LOCALES) ;  \
	do \
	LANG=$(lang); export LANG; \
	./$(TKTEST_EXE) $(TEST_DIR)/all.tcl -geometry +0+0 \
	$(TESTFLAGS) $(TCLTESTARGS); \
	done

# Useful target to launch a built tktest with the proper path,...
runtest: $(TKTEST_EXE)
	$(SHELL_ENV) ./$(TKTEST_EXE)

# This target can be used to run wish from the build directory
# via `make shell` or `make shell SCRIPT=/tmp/foo.tcl`
shell: ${WISH_EXE}
	$(SHELL_ENV) ./${WISH_EXE} $(SCRIPT)

demo:
	$(SHELL_ENV) ./${WISH_EXE} $(TOP_DIR)/library/demos/widget

# This target can be used to run wish inside either gdb or insight
gdb: ${WISH_EXE}
	@echo "set env @LD_LIBRARY_PATH_VAR@=\"`pwd`:${TCL_BIN_DIR}:$${@LD_LIBRARY_PATH_VAR@}\"" > gdb.run
	@echo "set env TCL_LIBRARY=@TCL_SRC_DIR@/library" >> gdb.run
	@echo "set env TK_LIBRARY=@TK_SRC_DIR@/library" >> gdb.run
	gdb ./${WISH_EXE} --command=gdb.run
	rm gdb.run

VALGRINDARGS=--tool=memcheck --num-callers=8 --leak-resolution=high --leak-check=yes --show-reachable=yes -v

valgrind: $(TKTEST_EXE)
	$(SHELL_ENV) valgrind $(VALGRINDARGS) ./$(TKTEST_EXE) $(TEST_DIR)/all.tcl -geometry +0+0 -singleproc 1 $(TESTFLAGS)

valgrindshell: $(TKTEST_EXE)
	$(SHELL_ENV) valgrind $(VALGRINDARGS) ./$(TKTEST_EXE) $(SCRIPT)

INSTALL_TARGETS = install-binaries install-libraries install-demos install-doc @EXTRA_INSTALL@

install: $(INSTALL_TARGETS)

install-strip:
	$(MAKE) $(INSTALL_TARGETS) \
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
	    chmod 755 "$(DEMO_INSTALL_DIR)/$$i"; \
	    fi; \
	    done;
	@echo "Installing demo images";
	@for i in $(TOP_DIR)/library/demos/images/*; \
	    do \
	    if [ -f $$i ] ; then \
		$(INSTALL_DATA) $$i $(DEMO_INSTALL_DIR)/images; \
		fi; \
	    done;

install-doc:
	@if test ! -x $(UNIX_DIR)/installManPage; then \
	    chmod +x $(UNIX_DIR)/installManPage; \
	    fi







|







764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
	    chmod 755 "$(DEMO_INSTALL_DIR)/$$i"; \
	    fi; \
	    done;
	@echo "Installing demo images";
	@for i in $(TOP_DIR)/library/demos/images/*; \
	    do \
	    if [ -f $$i ] ; then \
		$(INSTALL_DATA) $$i "$(DEMO_INSTALL_DIR)/images"; \
		fi; \
	    done;

install-doc:
	@if test ! -x $(UNIX_DIR)/installManPage; then \
	    chmod +x $(UNIX_DIR)/installManPage; \
	    fi