os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/unix/tclXtTest.c
changeset 0 bde4ae8d615e
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/unix/tclXtTest.c	Fri Jun 15 03:10:57 2012 +0200
     1.3 @@ -0,0 +1,120 @@
     1.4 +/* 
     1.5 + * tclXtTest.c --
     1.6 + *
     1.7 + *	Contains commands for Xt notifier specific tests on Unix.
     1.8 + *
     1.9 + * Copyright (c) 1997 by Sun Microsystems, Inc.
    1.10 + *
    1.11 + * See the file "license.terms" for information on usage and redistribution
    1.12 + * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    1.13 + *
    1.14 + * RCS: @(#) $Id: tclXtTest.c,v 1.5 2002/08/05 03:24:41 dgp Exp $
    1.15 + */
    1.16 +
    1.17 +#include <X11/Intrinsic.h>
    1.18 +#include "tcl.h"
    1.19 +
    1.20 +static int	TesteventloopCmd _ANSI_ARGS_((ClientData clientData,
    1.21 +		    Tcl_Interp *interp, int argc, CONST char **argv));
    1.22 +extern void	InitNotifier _ANSI_ARGS_((void));
    1.23 +
    1.24 +
    1.25 +/*
    1.26 + *----------------------------------------------------------------------
    1.27 + *
    1.28 + * Tclxttest_Init --
    1.29 + *
    1.30 + *	This procedure performs application-specific initialization.
    1.31 + *	Most applications, especially those that incorporate additional
    1.32 + *	packages, will have their own version of this procedure.
    1.33 + *
    1.34 + * Results:
    1.35 + *	Returns a standard Tcl completion code, and leaves an error
    1.36 + *	message in the interp's result if an error occurs.
    1.37 + *
    1.38 + * Side effects:
    1.39 + *	Depends on the startup script.
    1.40 + *
    1.41 + *----------------------------------------------------------------------
    1.42 + */
    1.43 +
    1.44 +int
    1.45 +Tclxttest_Init(interp)
    1.46 +    Tcl_Interp *interp;		/* Interpreter for application. */
    1.47 +{
    1.48 +    if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
    1.49 +	return TCL_ERROR;
    1.50 +    }
    1.51 +    XtToolkitInitialize();
    1.52 +    InitNotifier();
    1.53 +    Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd,
    1.54 +            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    1.55 +    return TCL_OK;
    1.56 +}
    1.57 +
    1.58 +/*
    1.59 + *----------------------------------------------------------------------
    1.60 + *
    1.61 + * TesteventloopCmd --
    1.62 + *
    1.63 + *	This procedure implements the "testeventloop" command. It is
    1.64 + *	used to test the Tcl notifier from an "external" event loop
    1.65 + *	(i.e. not Tcl_DoOneEvent()).
    1.66 + *
    1.67 + * Results:
    1.68 + *	A standard Tcl result.
    1.69 + *
    1.70 + * Side effects:
    1.71 + *	None.
    1.72 + *
    1.73 + *----------------------------------------------------------------------
    1.74 + */
    1.75 +
    1.76 +static int
    1.77 +TesteventloopCmd(clientData, interp, argc, argv)
    1.78 +    ClientData clientData;		/* Not used. */
    1.79 +    Tcl_Interp *interp;			/* Current interpreter. */
    1.80 +    int argc;				/* Number of arguments. */
    1.81 +    CONST char **argv;			/* Argument strings. */
    1.82 +{
    1.83 +    static int *framePtr = NULL; /* Pointer to integer on stack frame of
    1.84 +				  * innermost invocation of the "wait"
    1.85 +				  * subcommand. */
    1.86 +
    1.87 +   if (argc < 2) {
    1.88 +	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
    1.89 +                " option ... \"", (char *) NULL);
    1.90 +        return TCL_ERROR;
    1.91 +    }
    1.92 +    if (strcmp(argv[1], "done") == 0) {
    1.93 +	*framePtr = 1;
    1.94 +    } else if (strcmp(argv[1], "wait") == 0) {
    1.95 +	int *oldFramePtr;
    1.96 +	int done;
    1.97 +	int oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
    1.98 +
    1.99 +	/*
   1.100 +	 * Save the old stack frame pointer and set up the current frame.
   1.101 +	 */
   1.102 +
   1.103 +	oldFramePtr = framePtr;
   1.104 +	framePtr = &done;
   1.105 +
   1.106 +	/*
   1.107 +	 * Enter an Xt event loop until the flag changes.
   1.108 +	 * Note that we do not explicitly call Tcl_ServiceEvent().
   1.109 +	 */
   1.110 +
   1.111 +	done = 0;
   1.112 +	while (!done) {
   1.113 +	    XtAppProcessEvent(TclSetAppContext(NULL), XtIMAll);
   1.114 +	}
   1.115 +	(void) Tcl_SetServiceMode(oldMode);
   1.116 +	framePtr = oldFramePtr;
   1.117 +    } else {
   1.118 +	Tcl_AppendResult(interp, "bad option \"", argv[1],
   1.119 +		"\": must be done or wait", (char *) NULL);
   1.120 +	return TCL_ERROR;
   1.121 +    }
   1.122 +    return TCL_OK;
   1.123 +}