Logo Search packages:      
Sourcecode: tcl8.0 version File versions  Download package

tclWinTest.c

/* 
 * 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.2 1998/09/14 18:40:20 stanton 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;
}

Generated by  Doxygen 1.6.0   Back to index