Tcl Source Code

Check-in [1b663177f8]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:* tests/winNotify.test: * mac/tclMacNotify.c: * win/tclWinNotify.c: * unix/tclUnixNotfy.c: * generic/tclNotify.c: Added a new Tcl_ServiceModeHook interface that is invoked whenever the service mode changes. This is needed to allow the Windows notifier to create a communication window the first time Tcl is about to enter an external modal event loop instead of at startup time. This will avoid the various problems that people have been seeing where the system hangs when tclsh is running outside of the event loop. [Bug: 783]

* generic/tclInt.h: * generic/tcl.decls: Renamed TclpAlertNotifier back to Tcl_AlertNotifier since it is part of the public notifier driver API.

Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-1-branch-old
Files: files | file ages | folders
SHA1: 1b663177f8c8124691dacf04456389fb41c1a185
User & Date: stanton 1999-03-24 04:25:12
Context
1999-03-24
04:25
* tests/winNotify.test: * tests/ioCmd.test: * tests/event.test: Changed to use new style conditional... check-in: 9bdbccc71e user: stanton tags: core-8-1-branch-old
04:25
* tests/winNotify.test: * mac/tclMacNotify.c: * win/tclWinNotify.c: * unix/tclUnixNotfy.c: * generic... check-in: 1b663177f8 user: stanton tags: core-8-1-branch-old
04:22
* unix/dltest/configure.in: * unix/dltest/Makefile.in: Added missing DBGX macros. [Bug: 1564] check-in: 8095515d9b user: stanton tags: core-8-1-branch-old
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tcl.decls.

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
....
1162
1163
1164
1165
1166
1167
1168






1169
1170
1171
1172
1173
1174
1175
#	tclStub.c, and tclPlatStub.c files.
#	
#
# 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: tcl.decls,v 1.3.2.7 1999/03/19 04:01:18 stanton Exp $

library tcl

# Define the tcl interface with several sub interfaces:
#     tclPlat	 - platform specific public
#     tclInt	 - generic private
#     tclPlatInt - platform specific private
................................................................................
}
declare 341 generic {
    char * Tcl_GetDefaultEncodingDir(void)
}
declare 342 generic {
    void Tcl_SetDefaultEncodingDir(char *path)
}







##############################################################################

# Define the platform specific public Tcl interface.  These functions are
# only available on the designated platform.

interface tclPlat






|







 







>
>
>
>
>
>







6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
....
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
#	tclStub.c, and tclPlatStub.c files.
#	
#
# 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: tcl.decls,v 1.3.2.8 1999/03/24 04:25:12 stanton Exp $

library tcl

# Define the tcl interface with several sub interfaces:
#     tclPlat	 - platform specific public
#     tclInt	 - generic private
#     tclPlatInt - platform specific private
................................................................................
}
declare 341 generic {
    char * Tcl_GetDefaultEncodingDir(void)
}
declare 342 generic {
    void Tcl_SetDefaultEncodingDir(char *path)
}
declare 343 generic {
    void Tcl_AlertNotifier(ClientData clientData)
}
declare 344 generic {
    void Tcl_ServiceModeHook(int mode)
}

##############################################################################

# Define the platform specific public Tcl interface.  These functions are
# only available on the designated platform.

interface tclPlat

Changes to generic/tclDecls.h.

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
....
1043
1044
1045
1046
1047
1048
1049




1050
1051
1052
1053
1054
1055
1056
....
1421
1422
1423
1424
1425
1426
1427


1428
1429
1430
1431
1432
1433
1434
....
2788
2789
2790
2791
2792
2793
2794








2795
2796
2797
2798
2799
2800
2801
 *	Declarations of functions in the platform independent public Tcl API.
 *
 * 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: tclDecls.h,v 1.3.2.8 1999/03/19 04:01:19 stanton Exp $
 */

#ifndef _TCLDECLS
#define _TCLDECLS

/*
 * WARNING: This file is automatically generated by the tools/genStubs.tcl
................................................................................
				Tcl_Obj * objPtr));
/* 340 */
EXTERN char *		Tcl_GetString _ANSI_ARGS_((Tcl_Obj * objPtr));
/* 341 */
EXTERN char *		Tcl_GetDefaultEncodingDir _ANSI_ARGS_((void));
/* 342 */
EXTERN void		Tcl_SetDefaultEncodingDir _ANSI_ARGS_((char * path));





typedef struct TclStubHooks {
    struct TclPlatStubs *tclPlatStubs;
    struct TclIntStubs *tclIntStubs;
    struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;

................................................................................
    int (*tcl_UtfToUniChar) _ANSI_ARGS_((CONST char * src, Tcl_UniChar * chPtr)); /* 336 */
    int (*tcl_UtfToUpper) _ANSI_ARGS_((char * src)); /* 337 */
    int (*tcl_WriteChars) _ANSI_ARGS_((Tcl_Channel chan, CONST char * src, int srcLen)); /* 338 */
    int (*tcl_WriteObj) _ANSI_ARGS_((Tcl_Channel chan, Tcl_Obj * objPtr)); /* 339 */
    char * (*tcl_GetString) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 340 */
    char * (*tcl_GetDefaultEncodingDir) _ANSI_ARGS_((void)); /* 341 */
    void (*tcl_SetDefaultEncodingDir) _ANSI_ARGS_((char * path)); /* 342 */


} TclStubs;

extern TclStubs *tclStubsPtr;

#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)

/*
................................................................................
#define Tcl_GetDefaultEncodingDir() \
	(tclStubsPtr->tcl_GetDefaultEncodingDir)() /* 341 */
#endif
#ifndef Tcl_SetDefaultEncodingDir
#define Tcl_SetDefaultEncodingDir(path) \
	(tclStubsPtr->tcl_SetDefaultEncodingDir)(path) /* 342 */
#endif









#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */

/* !END!: Do not edit above this line. */

#endif /* _TCLDECLS */







|







 







>
>
>
>







 







>
>







 







>
>
>
>
>
>
>
>







4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
....
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
....
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
....
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
 *	Declarations of functions in the platform independent public Tcl API.
 *
 * 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: tclDecls.h,v 1.3.2.9 1999/03/24 04:25:12 stanton Exp $
 */

#ifndef _TCLDECLS
#define _TCLDECLS

/*
 * WARNING: This file is automatically generated by the tools/genStubs.tcl
................................................................................
				Tcl_Obj * objPtr));
/* 340 */
EXTERN char *		Tcl_GetString _ANSI_ARGS_((Tcl_Obj * objPtr));
/* 341 */
EXTERN char *		Tcl_GetDefaultEncodingDir _ANSI_ARGS_((void));
/* 342 */
EXTERN void		Tcl_SetDefaultEncodingDir _ANSI_ARGS_((char * path));
/* 343 */
EXTERN void		Tcl_AlertNotifier _ANSI_ARGS_((ClientData clientData));
/* 344 */
EXTERN void		Tcl_ServiceModeHook _ANSI_ARGS_((int mode));

typedef struct TclStubHooks {
    struct TclPlatStubs *tclPlatStubs;
    struct TclIntStubs *tclIntStubs;
    struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;

................................................................................
    int (*tcl_UtfToUniChar) _ANSI_ARGS_((CONST char * src, Tcl_UniChar * chPtr)); /* 336 */
    int (*tcl_UtfToUpper) _ANSI_ARGS_((char * src)); /* 337 */
    int (*tcl_WriteChars) _ANSI_ARGS_((Tcl_Channel chan, CONST char * src, int srcLen)); /* 338 */
    int (*tcl_WriteObj) _ANSI_ARGS_((Tcl_Channel chan, Tcl_Obj * objPtr)); /* 339 */
    char * (*tcl_GetString) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 340 */
    char * (*tcl_GetDefaultEncodingDir) _ANSI_ARGS_((void)); /* 341 */
    void (*tcl_SetDefaultEncodingDir) _ANSI_ARGS_((char * path)); /* 342 */
    void (*tcl_AlertNotifier) _ANSI_ARGS_((ClientData clientData)); /* 343 */
    void (*tcl_ServiceModeHook) _ANSI_ARGS_((int mode)); /* 344 */
} TclStubs;

extern TclStubs *tclStubsPtr;

#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)

/*
................................................................................
#define Tcl_GetDefaultEncodingDir() \
	(tclStubsPtr->tcl_GetDefaultEncodingDir)() /* 341 */
#endif
#ifndef Tcl_SetDefaultEncodingDir
#define Tcl_SetDefaultEncodingDir(path) \
	(tclStubsPtr->tcl_SetDefaultEncodingDir)(path) /* 342 */
#endif
#ifndef Tcl_AlertNotifier
#define Tcl_AlertNotifier(clientData) \
	(tclStubsPtr->tcl_AlertNotifier)(clientData) /* 343 */
#endif
#ifndef Tcl_ServiceModeHook
#define Tcl_ServiceModeHook(mode) \
	(tclStubsPtr->tcl_ServiceModeHook)(mode) /* 344 */
#endif

#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */

/* !END!: Do not edit above this line. */

#endif /* _TCLDECLS */

Changes to generic/tclInt.h.

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
....
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
 * Copyright (c) 1993-1997 Lucent Technologies.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * 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: tclInt.h,v 1.1.2.14 1999/03/12 23:29:14 surles Exp $
 */

#ifndef _TCLINT
#define _TCLINT

/*
 * Common include files needed by most of the Tcl source files are
................................................................................
			    int objc, Tcl_Obj *CONST objv[], int flags));
EXTERN int		TclOpenFileChannelDeleteProc _ANSI_ARGS_((
			    TclOpenFileChannelProc_ *proc));
EXTERN int		TclOpenFileChannelInsertProc _ANSI_ARGS_((
			    TclOpenFileChannelProc_ *proc));
EXTERN int		TclpAccess _ANSI_ARGS_((CONST char *filename,
			    int mode));
EXTERN void		TclpAlertNotifier _ANSI_ARGS_((ClientData clientData));
EXTERN char *		TclpAlloc _ANSI_ARGS_((unsigned int size));
EXTERN int		TclpCheckStackSpace _ANSI_ARGS_((void));
EXTERN int		TclpCloseFile _ANSI_ARGS_((TclFile file));
EXTERN int		TclpCopyFile _ANSI_ARGS_((CONST char *source,
			    CONST char *dest));
EXTERN int		TclpCopyDirectory _ANSI_ARGS_((CONST char *source,
			    CONST char *dest, Tcl_DString *errorPtr));






|







 







<







7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
....
1894
1895
1896
1897
1898
1899
1900

1901
1902
1903
1904
1905
1906
1907
 * Copyright (c) 1993-1997 Lucent Technologies.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * 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: tclInt.h,v 1.1.2.15 1999/03/24 04:25:14 stanton Exp $
 */

#ifndef _TCLINT
#define _TCLINT

/*
 * Common include files needed by most of the Tcl source files are
................................................................................
			    int objc, Tcl_Obj *CONST objv[], int flags));
EXTERN int		TclOpenFileChannelDeleteProc _ANSI_ARGS_((
			    TclOpenFileChannelProc_ *proc));
EXTERN int		TclOpenFileChannelInsertProc _ANSI_ARGS_((
			    TclOpenFileChannelProc_ *proc));
EXTERN int		TclpAccess _ANSI_ARGS_((CONST char *filename,
			    int mode));

EXTERN char *		TclpAlloc _ANSI_ARGS_((unsigned int size));
EXTERN int		TclpCheckStackSpace _ANSI_ARGS_((void));
EXTERN int		TclpCloseFile _ANSI_ARGS_((TclFile file));
EXTERN int		TclpCopyFile _ANSI_ARGS_((CONST char *source,
			    CONST char *dest));
EXTERN int		TclpCopyDirectory _ANSI_ARGS_((CONST char *source,
			    CONST char *dest, Tcl_DString *errorPtr));

Changes to generic/tclNotify.c.

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
...
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
...
668
669
670
671
672
673
674

675
676
677
678
679
680
681
....
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998 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: tclNotify.c,v 1.1.2.7 1999/03/11 01:50:31 stanton Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

/*
 * For each event source (created with Tcl_CreateEventSource) there
................................................................................
 *
 *	This routine sets the current service mode of the tsdPtr->
 *
 * Results:
 *	Returns the previous service mode.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_SetServiceMode(mode)
    int mode;			/* New service mode: TCL_SERVICE_ALL or
................................................................................
				 * TCL_SERVICE_NONE */
{
    int oldMode;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    oldMode = tsdPtr->serviceMode;
    tsdPtr->serviceMode = mode;

    return oldMode;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetMaxBlockTime --
................................................................................
    Tcl_ThreadId threadId;	/* Identifier for thread to use. */
{
    ThreadSpecificData *tsdPtr;

    /*
     * Find the notifier associated with the specified thread.
     * Note that we need to hold the listLock while calling
     * TclpAlertNotifier to avoid a race condition where
     * the specified thread might destroy its notifier.
     */

    Tcl_MutexLock(&listLock);
    for (tsdPtr = firstNotifierPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) {
	if (tsdPtr->threadId == threadId) {
	    TclpAlertNotifier(tsdPtr->clientData);
	    break;
	}
    }
    Tcl_MutexUnlock(&listLock);
}






|







 







|







 







>







 







|






|





9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
...
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
...
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
....
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998 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: tclNotify.c,v 1.1.2.8 1999/03/24 04:25:14 stanton Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

/*
 * For each event source (created with Tcl_CreateEventSource) there
................................................................................
 *
 *	This routine sets the current service mode of the tsdPtr->
 *
 * Results:
 *	Returns the previous service mode.
 *
 * Side effects:
 *	Invokes the notifier service mode hook procedure.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_SetServiceMode(mode)
    int mode;			/* New service mode: TCL_SERVICE_ALL or
................................................................................
				 * TCL_SERVICE_NONE */
{
    int oldMode;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    oldMode = tsdPtr->serviceMode;
    tsdPtr->serviceMode = mode;
    Tcl_ServiceModeHook(mode);
    return oldMode;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetMaxBlockTime --
................................................................................
    Tcl_ThreadId threadId;	/* Identifier for thread to use. */
{
    ThreadSpecificData *tsdPtr;

    /*
     * Find the notifier associated with the specified thread.
     * Note that we need to hold the listLock while calling
     * Tcl_AlertNotifier to avoid a race condition where
     * the specified thread might destroy its notifier.
     */

    Tcl_MutexLock(&listLock);
    for (tsdPtr = firstNotifierPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) {
	if (tsdPtr->threadId == threadId) {
	    Tcl_AlertNotifier(tsdPtr->clientData);
	    break;
	}
    }
    Tcl_MutexUnlock(&listLock);
}

Changes to generic/tclStubInit.c.

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
...
408
409
410
411
412
413
414


415
416
417
418
419
420
421
 *	This file contains the initializers for the Tcl stub vectors.
 *
 * 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: tclStubInit.c,v 1.3.2.6 1999/03/14 18:56:11 stanton Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

/*
 * Remove macros that will interfere with the definitions below.
................................................................................
    Tcl_UtfToUniChar, /* 336 */
    Tcl_UtfToUpper, /* 337 */
    Tcl_WriteChars, /* 338 */
    Tcl_WriteObj, /* 339 */
    Tcl_GetString, /* 340 */
    Tcl_GetDefaultEncodingDir, /* 341 */
    Tcl_SetDefaultEncodingDir, /* 342 */


};

TclStubs *tclStubsPtr = &tclStubs;

TclIntStubs tclIntStubs = {
    TCL_STUB_MAGIC,
    NULL,






|







 







>
>







4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
...
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
 *	This file contains the initializers for the Tcl stub vectors.
 *
 * 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: tclStubInit.c,v 1.3.2.7 1999/03/24 04:25:15 stanton Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

/*
 * Remove macros that will interfere with the definitions below.
................................................................................
    Tcl_UtfToUniChar, /* 336 */
    Tcl_UtfToUpper, /* 337 */
    Tcl_WriteChars, /* 338 */
    Tcl_WriteObj, /* 339 */
    Tcl_GetString, /* 340 */
    Tcl_GetDefaultEncodingDir, /* 341 */
    Tcl_SetDefaultEncodingDir, /* 342 */
    Tcl_AlertNotifier, /* 343 */
    Tcl_ServiceModeHook, /* 344 */
};

TclStubs *tclStubsPtr = &tclStubs;

TclIntStubs tclIntStubs = {
    TCL_STUB_MAGIC,
    NULL,

Changes to generic/tclStubs.c.

5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
....
3242
3243
3244
3245
3246
3247
3248
















3249
3250
3251
 *	public Tcl API.
 *
 * 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: tclStubs.c,v 1.3.2.7 1999/03/19 04:01:23 stanton Exp $
 */

#include "tcl.h"

/*
 * Undefine function macros that will interfere with the defintions below.
 */
................................................................................
/* Slot 342 */
void
Tcl_SetDefaultEncodingDir(path)
    char * path;
{
    (tclStubsPtr->tcl_SetDefaultEncodingDir)(path);
}


















/* !END!: Do not edit above this line. */






|







 







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



5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
....
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
 *	public Tcl API.
 *
 * 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: tclStubs.c,v 1.3.2.8 1999/03/24 04:25:15 stanton Exp $
 */

#include "tcl.h"

/*
 * Undefine function macros that will interfere with the defintions below.
 */
................................................................................
/* Slot 342 */
void
Tcl_SetDefaultEncodingDir(path)
    char * path;
{
    (tclStubsPtr->tcl_SetDefaultEncodingDir)(path);
}

/* Slot 343 */
void
Tcl_AlertNotifier(clientData)
    ClientData clientData;
{
    (tclStubsPtr->tcl_AlertNotifier)(clientData);
}

/* Slot 344 */
void
Tcl_ServiceModeHook(mode)
    int mode;
{
    (tclStubsPtr->tcl_ServiceModeHook)(mode);
}


/* !END!: Do not edit above this line. */

Changes to mac/tclMacNotify.c.

10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
...
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
...
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
...
339
340
341
342
343
344
345























346
347
348
349
350
351
352
 *	event proc will have to arbitrate which events go to which threads.
 *
 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclMacNotify.c,v 1.1.2.3 1999/03/11 01:50:32 stanton Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include "tclMac.h"
#include "tclMacInt.h"
#include <signal.h>
................................................................................
{
    /* Nothing to do on the Mac */
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclpAlertNotifier --
 *
 *	Wake up the specified notifier from any thread. This routine
 *	is called by the platform independent notifier code whenever
 *	the Tcl_ThreadAlert routine is called.  This routine is
 *	guaranteed not to be called on a given notifier after
 *	Tcl_FinalizeNotifier is called for that notifier.
 *
................................................................................
 * Side effects:
 *	Calls YieldToThread from this thread.
 *
 *----------------------------------------------------------------------
 */

void
TclpAlertNotifier(clientData)
    ClientData clientData;	/* Pointer to thread data. */
{

#ifdef TCL_THREADS
    if (TclMacHaveThreads()) {
        YieldToThread((ThreadID) clientData);
    }
................................................................................
	notifier.timer.usec += timePtr->usec;
	if (notifier.timer.usec >= 1000000) {
	    notifier.timer.usec -= 1000000;
	    notifier.timer.sec += 1;
	}
	notifier.timerActive = 1;
    }























}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_WaitForEvent --
 *






|







 







|







 







|







 







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







10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
...
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
...
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
...
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
 *	event proc will have to arbitrate which events go to which threads.
 *
 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclMacNotify.c,v 1.1.2.4 1999/03/24 04:25:16 stanton Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include "tclMac.h"
#include "tclMacInt.h"
#include <signal.h>
................................................................................
{
    /* Nothing to do on the Mac */
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_AlertNotifier --
 *
 *	Wake up the specified notifier from any thread. This routine
 *	is called by the platform independent notifier code whenever
 *	the Tcl_ThreadAlert routine is called.  This routine is
 *	guaranteed not to be called on a given notifier after
 *	Tcl_FinalizeNotifier is called for that notifier.
 *
................................................................................
 * Side effects:
 *	Calls YieldToThread from this thread.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_AlertNotifier(clientData)
    ClientData clientData;	/* Pointer to thread data. */
{

#ifdef TCL_THREADS
    if (TclMacHaveThreads()) {
        YieldToThread((ThreadID) clientData);
    }
................................................................................
	notifier.timer.usec += timePtr->usec;
	if (notifier.timer.usec >= 1000000) {
	    notifier.timer.usec -= 1000000;
	    notifier.timer.sec += 1;
	}
	notifier.timerActive = 1;
    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_ServiceModeHook --
 *
 *	This function is invoked whenever the service mode changes.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_ServiceModeHook(mode)
    int mode;			/* Either TCL_SERVICE_ALL, or
				 * TCL_SERVICE_NONE. */
{
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_WaitForEvent --
 *

Changes to unix/tclUnixNotfy.c.

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
...
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
...
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
...
332
333
334
335
336
337
338























339
340
341
342
343
344
345
 *	../generic/tclNotify.c.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclUnixNotfy.c,v 1.1.2.8 1999/03/11 01:50:33 stanton Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include <signal.h> 

/*
................................................................................
    Tcl_MutexUnlock(&notifierMutex);
#endif
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclpAlertNotifier --
 *
 *	Wake up the specified notifier from any thread. This routine
 *	is called by the platform independent notifier code whenever
 *	the Tcl_ThreadAlert routine is called.  This routine is
 *	guaranteed not to be called on a given notifier after
 *	Tcl_FinalizeNotifier is called for that notifier.
 *
................................................................................
 *	Signals the notifier condition variable for the specified
 *	notifier.
 *
 *----------------------------------------------------------------------
 */

void
TclpAlertNotifier(clientData)
    ClientData clientData;
{
#ifdef TCL_THREADS
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
    Tcl_MutexLock(&notifierMutex);
    tsdPtr->eventReady = 1;
    Tcl_ConditionNotify(&tsdPtr->waitCV);
................................................................................
    Tcl_Time *timePtr;		/* Timeout value, may be NULL. */
{
    /*
     * The interval timer doesn't do anything in this implementation,
     * because the only event loop is via Tcl_DoOneEvent, which passes
     * timeout values to Tcl_WaitForEvent.
     */























}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateFileHandler --
 *






|







 







|







 







|







 







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







7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
...
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
...
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
...
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
 *	../generic/tclNotify.c.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclUnixNotfy.c,v 1.1.2.9 1999/03/24 04:25:17 stanton Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include <signal.h> 

/*
................................................................................
    Tcl_MutexUnlock(&notifierMutex);
#endif
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_AlertNotifier --
 *
 *	Wake up the specified notifier from any thread. This routine
 *	is called by the platform independent notifier code whenever
 *	the Tcl_ThreadAlert routine is called.  This routine is
 *	guaranteed not to be called on a given notifier after
 *	Tcl_FinalizeNotifier is called for that notifier.
 *
................................................................................
 *	Signals the notifier condition variable for the specified
 *	notifier.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_AlertNotifier(clientData)
    ClientData clientData;
{
#ifdef TCL_THREADS
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
    Tcl_MutexLock(&notifierMutex);
    tsdPtr->eventReady = 1;
    Tcl_ConditionNotify(&tsdPtr->waitCV);
................................................................................
    Tcl_Time *timePtr;		/* Timeout value, may be NULL. */
{
    /*
     * The interval timer doesn't do anything in this implementation,
     * because the only event loop is via Tcl_DoOneEvent, which passes
     * timeout values to Tcl_WaitForEvent.
     */
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_ServiceModeHook --
 *
 *	This function is invoked whenever the service mode changes.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_ServiceModeHook(mode)
    int mode;			/* Either TCL_SERVICE_ALL, or
				 * TCL_SERVICE_NONE. */
{
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateFileHandler --
 *

Changes to win/tclWinNotify.c.

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
...
109
110
111
112
113
114
115

116
117
118
119
120
121
122

123


124
125
126
127
128
129
130
131
132
133
134
135
...
149
150
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
213
214



215
216
217
218



219
220
221
222
223
224
225
226
227



228
229
230
231
232
233
234
235
236
237
238

239
240
241

242
243
244
245
246
247
248
...
262
263
264
265
266
267
268











269
270
271
272
273
274
275
276

277
278
279
280
281



282





















































283
284
285
286
287
288
289
...
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
...
348
349
350
351
352
353
354
355

356
357
358
359
360
361
362
363
364
365
366
367
368

369




370













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
400
401
402
 *	works together with ../generic/tclNotify.c.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclWinNotify.c,v 1.1.2.5 1999/03/11 01:50:34 stanton Exp $
 */

#include "tclWinInt.h"
#include <winsock.h>

/*
 * The follwing static indicates whether this module has been initialized.
................................................................................
 */

static int initialized = 0;

#define INTERVAL_TIMER 1	/* Handle of interval timer. */

#define WM_WAKEUP WM_USER	/* Message that is send by
				 * TclpAlertNotifier. */
/*
 * The following static structure contains the state information for the
 * Windows implementation of the Tcl notifier.  One of these structures
 * is created for each thread that is using the notifier.  
 */

typedef struct ThreadSpecificData {
    CRITICAL_SECTION crit;	/* Monitor for this notifier. */




    int pending;		/* Alert message pending, this field is
				 * locked by the notifierMutex. */
    HWND hwnd;			/* Messaging window. */
    int timeout;		/* Current timeout value. */
    int timerActive;		/* 1 if interval timer is running. */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

/*
 * The following static indicates the number of threads that have
 * initialized notifiers.

 *
 * You must hold the notifierMutex lock before accessing this variable.
 */

static int notifierCount = 0;

/*
 * The notifierMutex locks access to all of the global notifier state,
 * as well as the pending flag for any specific notifier.
 */

TCL_DECLARE_MUTEX(notifierMutex)

/*
 * Static routines defined in this file.
 */

static LRESULT CALLBACK	NotifierProc(HWND hwnd, UINT message,
			    WPARAM wParam, LPARAM lParam);
static void		UpdateTimer(ThreadSpecificData *tsdPtr, int timeout);

 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_InitNotifier --
 *
................................................................................
	class.hCursor = NULL;

	if (!RegisterClassA(&class)) {
	    panic("Unable to register TclNotifier window class");
	}
    }
    notifierCount++;


    tsdPtr->pending = 0;
    tsdPtr->timerActive = 0;

    /*
     * Create a window for communication with the notifier.
     */




    tsdPtr->hwnd = CreateWindowA("TclNotifier", "TclNotifier", WS_TILED,
	    0, 0, 0, 0, NULL, NULL, TclWinGetTclInstance(), NULL);


    Tcl_MutexUnlock(&notifierMutex);

    return (ClientData) tsdPtr;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................

void
Tcl_FinalizeNotifier(clientData)
    ClientData clientData;	/* Pointer to notifier data. */
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;

    Tcl_MutexLock(&notifierMutex);


    /*
     * Clean up the timer and messaging window for this thread.
     */


    KillTimer(tsdPtr->hwnd, INTERVAL_TIMER);
    DestroyWindow(tsdPtr->hwnd);


    /*
     * If this is the last thread to use the notifier, unregister
     * the notifier window class.
     */


    notifierCount--;
    if (notifierCount == 0) {
	UnregisterClassA("TclNotifier", TclWinGetTclInstance());
    }

    Tcl_MutexUnlock(&notifierMutex);
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclpAlertNotifier --
 *
 *	Wake up the specified notifier from any thread. This routine
 *	is called by the platform independent notifier code whenever
 *	the Tcl_ThreadAlert routine is called.  This routine is
 *	guaranteed not to be called on a given notifier after
 *	Tcl_FinalizeNotifier is called for that notifier.


 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Sends a message to the messaging window for the notifier
 *	if there isn't already one pending.
 *
 *----------------------------------------------------------------------
 */

void
TclpAlertNotifier(clientData)
    ClientData clientData;	/* Pointer to thread data. */
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;

    Tcl_MutexLock(&notifierMutex);
    if (!tsdPtr->pending) {
	PostMessage(tsdPtr->hwnd, WM_WAKEUP, 0, 0);
	tsdPtr->pending = 1;
    }
    Tcl_MutexUnlock(&notifierMutex);
}
 
/*
 *----------------------------------------------------------------------



 *
 * UpdateTimer --
 *
 *	This function starts or stops the notifier interval timer.



 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */




void
UpdateTimer(
    ThreadSpecificData *tsdPtr,	/* Pointer to notifier state. */
    int timeout)		/* ms timeout, 0 means cancel timer */
{
    tsdPtr->timeout = timeout;
    if (timeout != 0) {
	tsdPtr->timerActive = 1;
	SetTimer(tsdPtr->hwnd, INTERVAL_TIMER,
		    (unsigned long) tsdPtr->timeout, NULL);

    } else {
	tsdPtr->timerActive = 0;
	KillTimer(tsdPtr->hwnd, INTERVAL_TIMER);

    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetTimer --
................................................................................

void
Tcl_SetTimer(
    Tcl_Time *timePtr)		/* Maximum block time, or NULL. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    UINT timeout;












    if (!timePtr) {
	timeout = 0;
    } else {
	/*
	 * Make sure we pass a non-zero value into the timeout argument.
	 * Windows seems to get confused by zero length timers.
	 */

	timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
	if (timeout == 0) {
	    timeout = 1;
	}
    }



    UpdateTimer(tsdPtr, timeout);





















































}
 
/*
 *----------------------------------------------------------------------
 *
 * NotifierProc --
 *
................................................................................
    HWND hwnd,
    UINT message,
    WPARAM wParam,
    LPARAM lParam)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (message == WM_USER) {
	Tcl_MutexLock(&notifierMutex);
	tsdPtr->pending = 0;
	Tcl_MutexUnlock(&notifierMutex);
    } else if (message != WM_TIMER) {
	return DefWindowProc(hwnd, message, wParam, lParam);
    }
	
    /*
     * Process all of the runnable events.
     */
................................................................................

int
Tcl_WaitForEvent(
    Tcl_Time *timePtr)		/* Maximum block time, or NULL. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    MSG msg;
    int timeout;


    /*
     * Only use the interval timer for non-zero timeouts.  This avoids
     * generating useless messages when we really just want to poll.
     */

    if (timePtr) {
	timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
    } else {
	timeout = 0;
    }
    UpdateTimer(tsdPtr, timeout);
	

    if (!timePtr || (timeout != 0)




	    || PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) {













	if (!GetMessage(&msg, NULL, 0, 0)) {






	    /*
	     * The application is exiting, so repost the quit message

	     * and start unwinding.
	     */

	    PostQuitMessage(msg.wParam);
	    return -1;
	}

	/*

	 * Handle timer expiration as a special case so we don't
	 * claim to be doing work when we aren't.
	 */


	if (msg.message == WM_TIMER && msg.hwnd == tsdPtr->hwnd) {
	    return 0;
	}

	TranslateMessage(&msg);
	DispatchMessage(&msg);



	return 1;
    }


    return 0;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_Sleep --
 *






|







 







|








>
>
>
>











|
>





<
<
<
<
<
<








<







 







>




<
<
<
>

>
>
|
|
<
<
<







 







|
>





>
|
|
>






>




<






|





|
>
>












|




<
<
<
<
<
<
<
<
|
<
>
>
>
|
<
|
<
>
>
>
|
<
<
|
<
<
<
<
<
>
>
>
|
<
<
<
<
<
<
<
|
<
<
>

<
<
>







 







>
>
>
>
>
>
>
>
>
>
>








>





>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|
|

|







 







|
>


<
|





|

<
|
>
|
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>

>
>

<
>
|



|
|
<
|
>
|
<
|

>
|
<
<
<
|
|
>
>
>
|

>
>
|







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
...
107
108
109
110
111
112
113
114
115
116
117
118



119
120
121
122
123
124



125
126
127
128
129
130
131
...
145
146
147
148
149
150
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
213
214
215


216





217
218
219
220







221


222
223


224
225
226
227
228
229
230
231
...
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
...
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
...
399
400
401
402
403
404
405
406
407
408
409

410
411
412
413
414
415
416
417

418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446

447
448
449
450
451
452
453

454
455
456

457
458
459
460



461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
 *	works together with ../generic/tclNotify.c.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclWinNotify.c,v 1.1.2.6 1999/03/24 04:25:17 stanton Exp $
 */

#include "tclWinInt.h"
#include <winsock.h>

/*
 * The follwing static indicates whether this module has been initialized.
................................................................................
 */

static int initialized = 0;

#define INTERVAL_TIMER 1	/* Handle of interval timer. */

#define WM_WAKEUP WM_USER	/* Message that is send by
				 * Tcl_AlertNotifier. */
/*
 * The following static structure contains the state information for the
 * Windows implementation of the Tcl notifier.  One of these structures
 * is created for each thread that is using the notifier.  
 */

typedef struct ThreadSpecificData {
    CRITICAL_SECTION crit;	/* Monitor for this notifier. */
    DWORD thread;		/* Identifier for thread associated with this
				 * notifier. */
    HANDLE event;		/* Event object used to wake up the notifier
				 * thread. */
    int pending;		/* Alert message pending, this field is
				 * locked by the notifierMutex. */
    HWND hwnd;			/* Messaging window. */
    int timeout;		/* Current timeout value. */
    int timerActive;		/* 1 if interval timer is running. */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

/*
 * The following static indicates the number of threads that have
 * initialized notifiers.  It controls the lifetime of the TclNotifier
 * window class.
 *
 * You must hold the notifierMutex lock before accessing this variable.
 */

static int notifierCount = 0;






TCL_DECLARE_MUTEX(notifierMutex)

/*
 * Static routines defined in this file.
 */

static LRESULT CALLBACK	NotifierProc(HWND hwnd, UINT message,
			    WPARAM wParam, LPARAM lParam);


 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_InitNotifier --
 *
................................................................................
	class.hCursor = NULL;

	if (!RegisterClassA(&class)) {
	    panic("Unable to register TclNotifier window class");
	}
    }
    notifierCount++;
    Tcl_MutexUnlock(&notifierMutex);

    tsdPtr->pending = 0;
    tsdPtr->timerActive = 0;




    InitializeCriticalSection(&tsdPtr->crit);

    tsdPtr->hwnd = NULL;
    tsdPtr->thread = GetCurrentThreadId();
    tsdPtr->event = CreateEvent(NULL, TRUE /* manual */,
	    FALSE /* !signaled */, NULL);




    return (ClientData) tsdPtr;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................

void
Tcl_FinalizeNotifier(clientData)
    ClientData clientData;	/* Pointer to notifier data. */
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;

    DeleteCriticalSection(&tsdPtr->crit);
    CloseHandle(tsdPtr->event);

    /*
     * Clean up the timer and messaging window for this thread.
     */

    if (tsdPtr->hwnd) {
	KillTimer(tsdPtr->hwnd, INTERVAL_TIMER);
	DestroyWindow(tsdPtr->hwnd);
    }

    /*
     * If this is the last thread to use the notifier, unregister
     * the notifier window class.
     */

    Tcl_MutexLock(&notifierMutex);
    notifierCount--;
    if (notifierCount == 0) {
	UnregisterClassA("TclNotifier", TclWinGetTclInstance());
    }

    Tcl_MutexUnlock(&notifierMutex);
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_AlertNotifier --
 *
 *	Wake up the specified notifier from any thread. This routine
 *	is called by the platform independent notifier code whenever
 *	the Tcl_ThreadAlert routine is called.  This routine is
 *	guaranteed not to be called on a given notifier after
 *	Tcl_FinalizeNotifier is called for that notifier.  This routine
 *	is typically called from a thread other than the notifier's
 *	thread.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Sends a message to the messaging window for the notifier
 *	if there isn't already one pending.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_AlertNotifier(clientData)
    ClientData clientData;	/* Pointer to thread data. */
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;









    /*

     * Note that we do not need to lock around access to the hwnd
     * because the race condition has no effect since any race condition
     * implies that the notifier thread is already awake.
     */



    if (tsdPtr->hwnd) {
	/*
	 * We do need to lock around access to the pending flag.
	 */








	EnterCriticalSection(&tsdPtr->crit);
	if (!tsdPtr->pending) {
	    PostMessage(tsdPtr->hwnd, WM_WAKEUP, 0, 0);
	}







	tsdPtr->pending = 1;


	LeaveCriticalSection(&tsdPtr->crit);
    } else {


	SetEvent(tsdPtr->event);
    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetTimer --
................................................................................

void
Tcl_SetTimer(
    Tcl_Time *timePtr)		/* Maximum block time, or NULL. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    UINT timeout;

    /*
     * We only need to set up an interval timer if we're being called
     * from an external event loop.  If we don't have a window handle
     * then we just return immediately and let Tcl_WaitForEvent handle
     * timeouts.
     */

    if (!tsdPtr->hwnd) {
	return;
    }

    if (!timePtr) {
	timeout = 0;
    } else {
	/*
	 * Make sure we pass a non-zero value into the timeout argument.
	 * Windows seems to get confused by zero length timers.
	 */

	timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
	if (timeout == 0) {
	    timeout = 1;
	}
    }
    tsdPtr->timeout = timeout;
    if (timeout != 0) {
	tsdPtr->timerActive = 1;
	SetTimer(tsdPtr->hwnd, INTERVAL_TIMER,
		    (unsigned long) tsdPtr->timeout, NULL);
    } else {
	tsdPtr->timerActive = 0;
	KillTimer(tsdPtr->hwnd, INTERVAL_TIMER);
    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_ServiceModeHook --
 *
 *	This function is invoked whenever the service mode changes.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If this is the first time the notifier is set into
 *	TCL_SERVICE_ALL, then the communication window is created.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_ServiceModeHook(mode)
    int mode;			/* Either TCL_SERVICE_ALL, or
				 * TCL_SERVICE_NONE. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    /*
     * If this is the first time that the notifier has been used from a
     * modal loop, then create a communication window.  Note that after
     * this point, the application needs to service events in a timely
     * fashion or Windows will hang waiting for the window to respond
     * to synchronous system messages.  At some point, we may want to
     * consider destroying the window if we leave the modal loop, but
     * for now we'll leave it around.
     */

    if (mode == TCL_SERVICE_ALL && !tsdPtr->hwnd) {
	tsdPtr->hwnd = CreateWindowA("TclNotifier", "TclNotifier", WS_TILED,
		0, 0, 0, 0, NULL, NULL, TclWinGetTclInstance(), NULL);
	/*
	 * Send an initial message to the window to ensure that we wake up the
	 * notifier once we get into the modal loop.  This will force the
	 * notifier to recompute the timeout value and schedule a timer
	 * if one is needed.
	 */

	Tcl_AlertNotifier((ClientData)tsdPtr);
    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * NotifierProc --
 *
................................................................................
    HWND hwnd,
    UINT message,
    WPARAM wParam,
    LPARAM lParam)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (message == WM_WAKEUP) {
	EnterCriticalSection(&tsdPtr->crit);
	tsdPtr->pending = 0;
	LeaveCriticalSection(&tsdPtr->crit);
    } else if (message != WM_TIMER) {
	return DefWindowProc(hwnd, message, wParam, lParam);
    }
	
    /*
     * Process all of the runnable events.
     */
................................................................................

int
Tcl_WaitForEvent(
    Tcl_Time *timePtr)		/* Maximum block time, or NULL. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    MSG msg;
    DWORD timeout, result;
    int status;

    /*

     * Compute the timeout in milliseconds.
     */

    if (timePtr) {
	timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
    } else {
	timeout = INFINITE;
    }


    /*
     * Check to see if there are any messages in the queue before waiting
     * because MsgWaitForMultipleObjects will not wake up if there are events
     * currently sitting in the queue.
     */

    if (!PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) {
	/*
	 * Wait for something to happen (a signal from another thread, a
	 * message, or timeout).
	 */

	result = MsgWaitForMultipleObjects(1, &tsdPtr->event, FALSE, timeout,
		QS_ALLINPUT);
    }

    /*
     * Check to see if there are any messages to process.
     */

    if (PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) {
	/*
	 * Retrieve and dispatch the first message.
	 */

	result = GetMessage(&msg, NULL, 0, 0);
	if (result == 0) {
	    /*

	     * We received a request to exit this thread (WM_QUIT), so
	     * propagate the quit message and start unwinding.
	     */

	    PostQuitMessage(msg.wParam);
	    status = -1;
	} else if (result == -1) {

	    /*
	     * We got an error from the system.  I have no idea why this would
	     * happen, so we'll just unwind.

	     */

	    status = -1;
	} else {



	    TranslateMessage(&msg);
	    DispatchMessage(&msg);
	    status = 1;
	}
    } else {
	status = 0;
    }

    ResetEvent(tsdPtr->event);
    return status;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_Sleep --
 *