1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
/*
* tclWinTest.c --
*
* Contains commands for platform specific tests on Windows.
*
* Copyright (c) 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: tclWinTest.c,v 1.3 1999/04/16 00:48:10 stanton Exp $
*/
#include "tclWinInt.h"
/*
* Forward declarations of procedures defined later in this file:
*/
int TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp));
static int TesteventloopCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, char **argv));
/*
*----------------------------------------------------------------------
*
* TclplatformtestInit --
*
* Defines commands that test platform specific functionality for
* Unix platforms.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* Defines new commands.
*
*----------------------------------------------------------------------
*/
int
TclplatformtestInit(interp)
Tcl_Interp *interp; /* Interpreter to add commands to. */
{
/*
* Add commands for platform specific tests for Windows here.
*/
Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TesteventloopCmd --
*
* This procedure implements the "testeventloop" command. It is
* used to test the Tcl notifier from an "external" event loop
* (i.e. not Tcl_DoOneEvent()).
*
* Results:
* A standard Tcl result.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
TesteventloopCmd(clientData, interp, argc, argv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
char **argv; /* Argument strings. */
{
static int *framePtr = NULL; /* Pointer to integer on stack frame of
* innermost invocation of the "wait"
* subcommand. */
if (argc < 2) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
" option ... \"", (char *) NULL);
return TCL_ERROR;
}
if (strcmp(argv[1], "done") == 0) {
*framePtr = 1;
} else if (strcmp(argv[1], "wait") == 0) {
int *oldFramePtr;
int done;
MSG msg;
int oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
/*
* Save the old stack frame pointer and set up the current frame.
*/
oldFramePtr = framePtr;
framePtr = &done;
/*
* Enter a standard Windows event loop until the flag changes.
* Note that we do not explicitly call Tcl_ServiceEvent().
*/
done = 0;
while (!done) {
if (!GetMessage(&msg, NULL, 0, 0)) {
/*
* The application is exiting, so repost the quit message
* and start unwinding.
*/
PostQuitMessage(msg.wParam);
break;
}
TranslateMessage(&msg);
DispatchMessage(&msg);
}
(void) Tcl_SetServiceMode(oldMode);
framePtr = oldFramePtr;
} else {
Tcl_AppendResult(interp, "bad option \"", argv[1],
"\": must be done or wait", (char *) NULL);
return TCL_ERROR;
}
return TCL_OK;
}
|
