diff options
| -rw-r--r-- | generic/tkTest.c | 78 | ||||
| -rw-r--r-- | tests/bind.test | 49 | ||||
| -rw-r--r-- | tests/constraints.tcl | 1 |
3 files changed, 22 insertions, 106 deletions
diff --git a/generic/tkTest.c b/generic/tkTest.c index 1f373ad..a8929b9 100644 --- a/generic/tkTest.c +++ b/generic/tkTest.c @@ -206,9 +206,6 @@ static int TrivialConfigObjCmd(ClientData dummy, Tcl_Obj * const objv[]); static void TrivialEventProc(ClientData clientData, XEvent *eventPtr); -static int TestgrabObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); /* *---------------------------------------------------------------------- @@ -284,9 +281,6 @@ Tktest_Init( (ClientData) Tk_MainWindow(interp), NULL); #endif /* _WIN32 */ - Tcl_CreateObjCommand(interp, "testgrab", TestgrabObjCmd, - (ClientData) Tk_MainWindow(interp), NULL); - /* * Create test image type. */ @@ -2084,78 +2078,6 @@ CustomOptionFree( } /* - *---------------------------------------------------------------------- - * - * TestgrabObjCmd -- - * - * This function implements the "testgrab" command, which is used to test - * grabbing of windows. - * - * testgrab grabbed $win: returns true if $win is currently grabbed - * testgrab released $win: returns true if $win is currently not grabbed - * - * This function is useful when one wants to test for a grabbing window - * at the moment it is called. [grab current] cannot be used for that - * purpose because it returns the window dereferenced by eventualGrabWinPtr - * - * Results: - * A standard Tcl result. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -TestgrabObjCmd( - ClientData clientData, /* Main window for application. */ - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ -{ - static const char *const options[] = {"grabbed", "released", NULL}; - enum option {GRABBED, RELEASED}; - int index, res = 0; - Tk_Window mainWin, tkwin; - - mainWin = (Tk_Window) clientData; - - if (objc < 3) { - Tcl_WrongNumArgs(interp, 1, objv, "option window"); - return TCL_ERROR; - } - - if (Tcl_GetIndexFromObjStruct(interp, objv[1], options, - sizeof(char *), "command", 0, &index)!= TCL_OK) { - return TCL_ERROR; - } - - tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), mainWin); - if (tkwin == NULL) { - return TCL_ERROR; - } - /*printf("TestgrabObjCmd %s, grabWinPtr = %p , tkwin = %p\n", options[index], - ((TkWindow *) tkwin)->dispPtr->grabWinPtr, tkwin);fflush(stdout);*/ - - switch ((enum option) index) { - case GRABBED: - if (TkGrabState((TkWindow *) tkwin) != TK_GRAB_NONE) { - res = 1; - } - break; - case RELEASED: - if (TkGrabState((TkWindow *) tkwin) == TK_GRAB_NONE) { - res = 1; - } - break; - } - - Tcl_SetObjResult(interp, Tcl_NewBooleanObj(res)); - return TCL_OK; -} - -/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/tests/bind.test b/tests/bind.test index e333c6c..33183ca 100644 --- a/tests/bind.test +++ b/tests/bind.test @@ -36,12 +36,22 @@ proc unsetBindings {} { # move the mouse pointer away of the testing area # otherwise some spurious events may pollute the tests -toplevel .top -wm geometry .top 50x50-50-50 -update -event generate .top <Button-1> -warp 1 -update -destroy .top +# also, this will procure a known grab state at startup +# for tests mixing grabs and pointer warps +proc pointerAway {} { + toplevel .top + wm geometry .top 50x50-50-50 + update + # On KDE/Plasma _with_the_Aurorae_theme_ (at least), setting up the toplevel + # will not be finished right after the above 'update'. The WM still + # needs some time before the window is fully ready. For me 50 ms is enough, + # but let's wait more (it depends on computer performance). + after 100 ; update + event generate .top <Button-1> -warp 1 + update + destroy .top +} +pointerAway test bind-1.1 {bind command} -body { bind @@ -6709,26 +6719,10 @@ test bind-34.3 {-warp works with null or negative coordinates} -setup { } -cleanup { } -result {ok ok ok ok} -test bind-35.1 {pointer warp with grab on master, bug [e3888d5820]} -constraints { - testgrab -} -setup { - proc waitForGrab {type grabWin} { - # process events while $grabWin is not grabbed ($type == "grabbed"), - # or while $grabWin is not released ($type == "released"), but don't - # spend more than 5 seconds doing this - set i 0 - while {![testgrab $type $grabWin] && $i < 500} { - after 10 - update - incr i - } - } - event generate {} <Motion> -warp 1 -x 50 -y 50 - update idletasks ; # DoWarp is an idle callback - after 50 ; # Win specific - wait for SendInput to be executed +test bind-35.1 {pointer warp with grab on master, bug [e3888d5820]} -setup { + pointerAway toplevel .top grab release .top - waitForGrab released .top wm geometry .top 200x200+300+300 label .top.l -height 5 -width 20 -highlightthickness 2 \ -highlightbackground black -bg yellow -text "My label" @@ -6741,14 +6735,16 @@ test bind-35.1 {pointer warp with grab on master, bug [e3888d5820]} -constraints after 100 ; update } -body { grab .top ; # this will queue events - waitForGrab grabbed .top + after 50 + update event generate .top.l <Motion> -warp 1 -x 10 -y 10 update idletasks ; after 50 foreach {x1 y1} [winfo pointerxy .top.l] {} event generate {} <Motion> -warp 1 -x 50 -y 50 update idletasks ; after 50 grab release .top ; # this will queue events - waitForGrab released .top + after 50 + update event generate .top.l <Motion> -warp 1 -x 10 -y 10 update idletasks ; after 50 foreach {x2 y2} [winfo pointerxy .top.l] {} @@ -6759,7 +6755,6 @@ test bind-35.1 {pointer warp with grab on master, bug [e3888d5820]} -constraints } -cleanup { destroy .top unset x1 y1 x2 y2 - rename waitForGrab {} } -result {1} # cleanup diff --git a/tests/constraints.tcl b/tests/constraints.tcl index 49da142..c77fb00 100644 --- a/tests/constraints.tcl +++ b/tests/constraints.tcl @@ -207,7 +207,6 @@ testConstraint testcolor [llength [info commands testcolor]] testConstraint testcursor [llength [info commands testcursor]] testConstraint testembed [llength [info commands testembed]] testConstraint testfont [llength [info commands testfont]] -testConstraint testgrab [llength [info commands testgrab]] testConstraint testmakeexist [llength [info commands testmakeexist]] testConstraint testmenubar [llength [info commands testmenubar]] testConstraint testmetrics [llength [info commands testmetrics]] |