summaryrefslogtreecommitdiffstats
path: root/tcl8.6/unix/tclXtTest.c
diff options
context:
space:
mode:
authorWilliam Joye <wjoye@cfa.harvard.edu>2018-01-02 20:34:49 (GMT)
committerWilliam Joye <wjoye@cfa.harvard.edu>2018-01-02 20:34:49 (GMT)
commit89c1ac99d375fbd73892aa659f06ef5e2c5ea56e (patch)
treee76ce80d68d11f1ea137bc33a42f71a1d1f32028 /tcl8.6/unix/tclXtTest.c
parent01e4cd2ef2ff59418766b2259fbc99771646aba6 (diff)
downloadblt-89c1ac99d375fbd73892aa659f06ef5e2c5ea56e.zip
blt-89c1ac99d375fbd73892aa659f06ef5e2c5ea56e.tar.gz
blt-89c1ac99d375fbd73892aa659f06ef5e2c5ea56e.tar.bz2
upgrade to tcl/tk 8.6.8
Diffstat (limited to 'tcl8.6/unix/tclXtTest.c')
-rw-r--r--tcl8.6/unix/tclXtTest.c134
1 files changed, 0 insertions, 134 deletions
diff --git a/tcl8.6/unix/tclXtTest.c b/tcl8.6/unix/tclXtTest.c
deleted file mode 100644
index f7c2652..0000000
--- a/tcl8.6/unix/tclXtTest.c
+++ /dev/null
@@ -1,134 +0,0 @@
-/*
- * tclXtTest.c --
- *
- * Contains commands for Xt notifier specific tests on Unix.
- *
- * Copyright (c) 1997 by Sun Microsystems, Inc.
- *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
-
-#ifndef USE_TCL_STUBS
-# define USE_TCL_STUBS
-#endif
-#include <X11/Intrinsic.h>
-#include "tcl.h"
-
-static Tcl_ObjCmdProc TesteventloopCmd;
-extern DLLEXPORT Tcl_PackageInitProc Tclxttest_Init;
-
-/*
- * Functions defined in tclXtNotify.c for use by users of the Xt Notifier:
- */
-
-extern void InitNotifier(void);
-extern XtAppContext TclSetAppContext(XtAppContext ctx);
-
-/*
- *----------------------------------------------------------------------
- *
- * Tclxttest_Init --
- *
- * This procedure performs application-specific initialization. Most
- * applications, especially those that incorporate additional packages,
- * will have their own version of this procedure.
- *
- * Results:
- * Returns a standard Tcl completion code, and leaves an error message in
- * the interp's result if an error occurs.
- *
- * Side effects:
- * Depends on the startup script.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tclxttest_Init(
- Tcl_Interp *interp) /* Interpreter for application. */
-{
- if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
- return TCL_ERROR;
- }
- XtToolkitInitialize();
- InitNotifier();
- Tcl_CreateObjCommand(interp, "testeventloop", TesteventloopCmd,
- NULL, 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 clientData, /* Not used. */
- Tcl_Interp *interp, /* Current interpreter. */
- int objc, /* Number of arguments. */
- Tcl_Obj *const objv[]) /* Argument objects. */
-{
- static int *framePtr = NULL;/* Pointer to integer on stack frame of
- * innermost invocation of the "wait"
- * subcommand. */
-
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "option ...");
- return TCL_ERROR;
- }
- if (strcmp(Tcl_GetString(objv[1]), "done") == 0) {
- *framePtr = 1;
- } else if (strcmp(Tcl_GetString(objv[1]), "wait") == 0) {
- int *oldFramePtr;
- int done;
- int oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
-
- /*
- * Save the old stack frame pointer and set up the current frame.
- */
-
- oldFramePtr = framePtr;
- framePtr = &done;
-
- /*
- * Enter an Xt event loop until the flag changes. Note that we do not
- * explicitly call Tcl_ServiceEvent().
- */
-
- done = 0;
- while (!done) {
- XtAppProcessEvent(TclSetAppContext(NULL), XtIMAll);
- }
- (void) Tcl_SetServiceMode(oldMode);
- framePtr = oldFramePtr;
- } else {
- Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]),
- "\": must be done or wait", NULL);
- return TCL_ERROR;
- }
- return TCL_OK;
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * tab-width: 8
- * End:
- */