os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/unix/tclXtTest.c
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 +}