URL
https://opencores.org/ocsvn/or1k/or1k/trunk
Subversion Repositories or1k
[/] [or1k/] [trunk/] [insight/] [tcl/] [win/] [tclWinTest.c] - Rev 1774
Go to most recent revision | Compare with Previous | Blame | 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; }
Go to most recent revision | Compare with Previous | Blame | View Log