URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [win/] [tclWinTest.c] - Blame information for rev 578

Go to most recent revision | Details | Compare with Previous | View Log


/*
 * 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.1.1.1 2002-01-16 10:25:39 markom Exp $
 */
 
#include "tclInt.h"
#include "tclPort.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;
}

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

Browse

Tools

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [win/] [tclWinTest.c] - Blame information for rev 578