/* 
 * 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 $
 */

/*
 * Allow this file to be compiled as loadable library (dll) separate
 * from the Tcl shared library (or dll). We don't want all
 * dll symbols to be exported, only the Wintest_Init() function.
 */
#undef BUILD_tcl

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

#ifdef TCL_USE_STUBS
Tcl_StubTable *tclStubTable;
#else
#define Tcl_Required(a,b,c) Tcl_PkgRequired(a,"Tcl",b,c)
#endif

/*
 * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
 * Wintest_Init declaration is in the source file itself, which is only
 * accessed when we are building a library.
 */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLEXPORT

/*
 * Forward declarations of procedures defined later in this file:
 */

EXTERN int		Wintest_Init _ANSI_ARGS_((Tcl_Interp *interp));
int			TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp));
static int		TesteventloopCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, char **argv));

/*
 *----------------------------------------------------------------------
 *
 * Wintest_Init --
 *
 *	Defines commands that test platform specific functionality for
 *	Windows platforms.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Defines new commands.
 *
 *----------------------------------------------------------------------
 */

int
#ifdef _USING_PROTOTYPES_
Wintest_Init(
    Tcl_Interp *interp)		/* Interpreter to add commands to. */
#else
Wintest_Init(interp)
    Tcl_Interp *interp;		/* Interpreter to add commands to. */
#endif
{
    if (Tcl_Required(interp, TCL_VERSION, 0) == NULL) {
	return TCL_ERROR;
    }
    if (Tcl_PkgProvide(interp, "Wintest", TCL_VERSION) != TCL_OK) {
        return TCL_ERROR;
    }
    /*
     * Add commands for platform specific tests for Windows here.
     */

    Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd,
            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tclplatformtest_Init --
 *
 *	Defines commands that test platform specific functionality for
 *	Windows platforms.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Defines new commands.
 *
 *----------------------------------------------------------------------
 */

int
#ifdef _USING_PROTOTYPES_
TclplatformtestInit (
    Tcl_Interp *interp)		/* Interpreter to add commands to. */
#else
TclplatformtestInit(interp)
    Tcl_Interp *interp;		/* Interpreter to add commands to. */
#endif
{
    return Wintest_Init(interp);
}

/*
 *----------------------------------------------------------------------
 *
 * 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
#ifdef _USING_PROTOTYPES_
TesteventloopCmd (
    ClientData clientData,		/* Not used. */
    Tcl_Interp *interp,			/* Current interpreter. */
    int argc,				/* Number of arguments. */
    char **argv)			/* Argument strings. */
#else
TesteventloopCmd(clientData, interp, argc, argv)
    ClientData clientData;		/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
#endif
{
    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;
}
