diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tkTest.c | 46 |
1 files changed, 46 insertions, 0 deletions
diff --git a/generic/tkTest.c b/generic/tkTest.c index 755a6be..4fc6a80 100644 --- a/generic/tkTest.c +++ b/generic/tkTest.c @@ -147,6 +147,9 @@ typedef struct TrivialCommandHeader { static int ImageObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj * const objv[]); +static int ProcessEventsObjCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj * const objv[]); static int TestbitmapObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj * const objv[]); @@ -247,6 +250,7 @@ Tktest_Init( return TCL_ERROR; } + Tcl_CreateObjCommand(interp, "processevents", ProcessEventsObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "square", SquareObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testbitmap", TestbitmapObjCmd, (ClientData) Tk_MainWindow(interp), NULL); @@ -1682,6 +1686,48 @@ ImageDelete( /* *---------------------------------------------------------------------- * + * ProcessEventsObjCmd -- + * + * This function implements the "processevents" command. Currently + * It processes all <Enter> or <Leave> events on the queue. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * Events are processed + * + *---------------------------------------------------------------------- + */ + +static Tk_RestrictAction +CrossingRestrictProc( + ClientData arg, + XEvent *eventPtr) +{ + if (eventPtr->type == EnterNotify || eventPtr->type == LeaveNotify) { + return TK_PROCESS_EVENT; + } + return TK_DEFER_EVENT; +} + +static int ProcessEventsObjCmd(ClientData dummy, + Tcl_Interp *interp, + int objc, + Tcl_Obj * const objv[]) +{ + ClientData oldArg; + Tk_RestrictProc *oldProc; + int count = 0; + oldProc = Tk_RestrictEvents(CrossingRestrictProc, NULL, &oldArg); + while (Tcl_ServiceEvent(TCL_WINDOW_EVENTS|TCL_DONT_WAIT)) {}; + Tk_RestrictEvents(oldProc, oldArg, &oldArg); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * TestmakeexistObjCmd -- * * This function implements the "testmakeexist" command. It calls |