Tk Source Code

Check-in [8aa0008c]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Added a regression test, which involved adding a command to tkMacOSXTest.c to simulate mouse button press events.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | bug-ee946e4ebd
Files: files | file ages | folders
SHA3-256: 8aa0008ceaff99a6b568f876a8e0eb16cf1d596bf3c9eeb348b0e2107a68d385
User & Date: culler 2019-10-18 21:59:41
Context
2019-10-20
03:30
Fix [ee946e4ebd]: on macOS local grabs only work for toplevels. check-in: 074f89b5 user: culler tags: core-8-6-branch
2019-10-18
21:59
Added a regression test, which involved adding a command to tkMacOSXTest.c to simulate mouse button press events. Closed-Leaf check-in: 8aa0008c user: culler tags: bug-ee946e4ebd
14:29
Restore injection of MouseMoved to avoid unknown trouble. check-in: dad87927 user: culler tags: bug-ee946e4ebd
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to macosx/tkMacOSXMouseEvent.c.

32
33
34
35
36
37
38

39
40
41
42
43
44
45
...
235
236
237
238
239
240
241

242
243
244
245
246
247
248
249
250
251

252
253
254
255
256
257
258
...
583
584
585
586
587
588
589

590
591
592
593
594
595
596
...
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
			    UInt32 keyModifiers);

#pragma mark TKApplication(TKMouseEvent)

enum {
    NSWindowWillMoveEventType = 20
};

/*
 * In OS X 10.6 an NSEvent of type NSMouseMoved would always have a non-Nil
 * window attribute pointing to the active window.  As of 10.8 this behavior
 * had changed.  The new behavior was that if the mouse were ever moved outside
 * of a window, all subsequent NSMouseMoved NSEvents would have a Nil window
 * attribute.  To work around this the TKApplication remembers the last non-Nil
 * window that it received in a mouse event. If it receives an NSEvent with a
................................................................................
	state |= Mod3Mask;
    }
    if (modifiers & NSFunctionKeyMask) {
	state |= Mod4Mask;
    }

    if (eventType != NSScrollWheel) {

	/*
	 * For normal mouse events, Tk_UpdatePointer will send the XEvent.
	 */

#ifdef TK_MAC_DEBUG_EVENTS
	TKLog(@"UpdatePointer %p x %f.0 y %f.0 %d",
		tkwin, global.x, global.y, state);
#endif
	Tk_UpdatePointer(tkwin, global.x, global.y, state);
    } else {

	/*
	 * For scroll wheel events we need to send the XEvent here.
	 */

	CGFloat delta;
	int coarseDelta;
	XEvent xEvent;
................................................................................
    MouseEventData *medPtr)
{
    Tk_Window tkwin;
    int dummy;
    TkDisplay *dispPtr;

#if UNUSED

    /*
     * ButtonDown events will always occur in the front window. ButtonUp
     * events, however, may occur anywhere on the screen. ButtonUp events
     * should only be sent to Tk if in the front window or during an implicit
     * grab.
     */

................................................................................
     *
     * It is not clear why this is necessary.  For example, calling
     *     event generate $w <Motion> -warp 1 -x $X -y $Y
     * will cause two <Motion> events to be added to the Tcl queue.
     */

    CGWarpMouseCursorPosition(pt);
    NSEvent *warpEvent = [NSEvent mouseEventWithType:NSMouseMoved 
	location:loc
	modifierFlags:0 
	timestamp:GetCurrentEventTime() 
	windowNumber:wNum
	context:nil 
	eventNumber:0
	clickCount:1 
	pressure:0.0];
    [NSApp postEvent:warpEvent atStart:NO];
}
 
/*
 *----------------------------------------------------------------------
 *






>







 







>










>







 







>







 







|

|
|

|

|







32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
...
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
...
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
...
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
			    UInt32 keyModifiers);

#pragma mark TKApplication(TKMouseEvent)

enum {
    NSWindowWillMoveEventType = 20
};

/*
 * In OS X 10.6 an NSEvent of type NSMouseMoved would always have a non-Nil
 * window attribute pointing to the active window.  As of 10.8 this behavior
 * had changed.  The new behavior was that if the mouse were ever moved outside
 * of a window, all subsequent NSMouseMoved NSEvents would have a Nil window
 * attribute.  To work around this the TKApplication remembers the last non-Nil
 * window that it received in a mouse event. If it receives an NSEvent with a
................................................................................
	state |= Mod3Mask;
    }
    if (modifiers & NSFunctionKeyMask) {
	state |= Mod4Mask;
    }

    if (eventType != NSScrollWheel) {

	/*
	 * For normal mouse events, Tk_UpdatePointer will send the XEvent.
	 */

#ifdef TK_MAC_DEBUG_EVENTS
	TKLog(@"UpdatePointer %p x %f.0 y %f.0 %d",
		tkwin, global.x, global.y, state);
#endif
	Tk_UpdatePointer(tkwin, global.x, global.y, state);
    } else {

	/*
	 * For scroll wheel events we need to send the XEvent here.
	 */

	CGFloat delta;
	int coarseDelta;
	XEvent xEvent;
................................................................................
    MouseEventData *medPtr)
{
    Tk_Window tkwin;
    int dummy;
    TkDisplay *dispPtr;

#if UNUSED

    /*
     * ButtonDown events will always occur in the front window. ButtonUp
     * events, however, may occur anywhere on the screen. ButtonUp events
     * should only be sent to Tk if in the front window or during an implicit
     * grab.
     */

................................................................................
     *
     * It is not clear why this is necessary.  For example, calling
     *     event generate $w <Motion> -warp 1 -x $X -y $Y
     * will cause two <Motion> events to be added to the Tcl queue.
     */

    CGWarpMouseCursorPosition(pt);
    NSEvent *warpEvent = [NSEvent mouseEventWithType:NSMouseMoved
	location:loc
	modifierFlags:0
	timestamp:GetCurrentEventTime()
	windowNumber:wNum
	context:nil
	eventNumber:0
	clickCount:1
	pressure:0.0];
    [NSApp postEvent:warpEvent atStart:NO];
}
 
/*
 *----------------------------------------------------------------------
 *

Changes to macosx/tkMacOSXTest.c.

9
10
11
12
13
14
15

16
17
18
19
20
21
22
23
24


25
26
27
28
29
30
31
..
48
49
50
51
52
53
54

55
56
57
58
59
60
61
...
114
115
116
117
118
119
120
121


122






























































































123
124
125
126
127
128
129
130
 * Copyright (c) 2005-2009 Daniel A. Steffen <[email protected]>
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tkMacOSXPrivate.h"


/*
 * Forward declarations of procedures defined later in this file:
 */

#if MAC_OS_X_VERSION_MAX_ALLOWED < 1080
static int		DebuggerObjCmd (ClientData dummy, Tcl_Interp *interp,
					int objc, Tcl_Obj *const objv[]);
#endif



 
/*
 *----------------------------------------------------------------------
 *
 * TkplatformtestInit --
 *
................................................................................
    /*
     * Add commands for platform specific tests on MacOS here.
     */

#if MAC_OS_X_VERSION_MAX_ALLOWED < 1080
    Tcl_CreateObjCommand(interp, "debugger", DebuggerObjCmd, NULL, NULL);
#endif


    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
TkTestLogDisplay(void) {
    if ([NSApp macMinorVersion] >= 14) {
	return [NSApp isDrawing];
    } else {
	return ![NSApp isDrawing];
    }
}
 

































































































/*
 * Local Variables:
 * mode: objc
 * c-basic-offset: 4
 * fill-column: 79
 * coding: utf-8
 * End:
 */






>









>
>







 







>







 








>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
..
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
...
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
 * Copyright (c) 2005-2009 Daniel A. Steffen <[email protected]>
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tkMacOSXPrivate.h"
#include "tkMacOSXConstants.h"

/*
 * Forward declarations of procedures defined later in this file:
 */

#if MAC_OS_X_VERSION_MAX_ALLOWED < 1080
static int		DebuggerObjCmd (ClientData dummy, Tcl_Interp *interp,
					int objc, Tcl_Obj *const objv[]);
#endif
static int		PressButtonObjCmd (ClientData dummy, Tcl_Interp *interp,
					int objc, Tcl_Obj *const objv[]);

 
/*
 *----------------------------------------------------------------------
 *
 * TkplatformtestInit --
 *
................................................................................
    /*
     * Add commands for platform specific tests on MacOS here.
     */

#if MAC_OS_X_VERSION_MAX_ALLOWED < 1080
    Tcl_CreateObjCommand(interp, "debugger", DebuggerObjCmd, NULL, NULL);
#endif
    Tcl_CreateObjCommand(interp, "pressbutton", PressButtonObjCmd, NULL, NULL);

    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
TkTestLogDisplay(void) {
    if ([NSApp macMinorVersion] >= 14) {
	return [NSApp isDrawing];
    } else {
	return ![NSApp isDrawing];
    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * PressButtonObjCmd --
 *
 *	This Tcl command simulates a button press at a specific screen
 *      location.  It injects NSEvents into the NSApplication event queue,
 *      as opposed to adding events to the Tcl queue as event generate
 *      would do.  One application is for testing the grab command.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

        /* ARGSUSED */
static int
PressButtonObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    int x, y, i, value, wNum;
    CGPoint pt;
    NSPoint loc;
    NSEvent *motion, *press, *release;
    NSArray *screens = [NSScreen screens];
    CGFloat ScreenHeight = 0;
    enum {X=1, Y};

    if (screens && [screens count]) {
	ScreenHeight = [[screens objectAtIndex:0] frame].size.height;
    }
    
    if (objc != 3) {
        Tcl_WrongNumArgs(interp, 1, objv, "x y");
        return TCL_ERROR;
    }
    for (i = 1; i < objc; i++) {
	if (Tcl_GetIntFromObj(interp,objv[i],&value) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (i) {
	case X:
	    x = value;
	    break;
	case Y:
	    y = value;
	    break;
	default:
	    break;
	}
    }
    pt.x = loc.x = x;
    pt.y = y;
    loc.y = ScreenHeight - y;
    wNum = 0;
    CGWarpMouseCursorPosition(pt);
    motion = [NSEvent mouseEventWithType:NSMouseMoved 
	location:loc
	modifierFlags:0 
	timestamp:GetCurrentEventTime() 
	windowNumber:wNum
	context:nil 
	eventNumber:0
	clickCount:1 
	pressure:0.0];
    [NSApp postEvent:motion atStart:NO];
    press = [NSEvent mouseEventWithType:NSLeftMouseDown 
	location:loc
	modifierFlags:0 
	timestamp:GetCurrentEventTime() 
	windowNumber:wNum
	context:nil 
	eventNumber:1
	clickCount:1 
	pressure:0.0];
    [NSApp postEvent:press atStart:NO];
    release = [NSEvent mouseEventWithType:NSLeftMouseUp
	location:loc
	modifierFlags:0 
	timestamp:GetCurrentEventTime() 
	windowNumber:wNum
	context:nil 
	eventNumber:2
	clickCount:1 
	pressure:0.0];
    [NSApp postEvent:release atStart:NO];
    return TCL_OK;
}
 

/*
 * Local Variables:
 * mode: objc
 * c-basic-offset: 4
 * fill-column: 79
 * coding: utf-8
 * End:
 */

Changes to tests/grab.test.

8
9
10
11
12
13
14



15
16
17
18

19
20
21
22
23
24
25
...
178
179
180
181
182
183
184


























185
186
187
188
# All rights reserved.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test




# There's currently no way to test the actual grab effect, per se,
# in an automated test.  Therefore, this test suite only covers the
# interface to the grab command (ie, error messages, etc.)



test grab-1.1 {Tk_GrabObjCmd} -body {
    grab
} -returnCodes error -result {wrong # args: should be "grab ?-global? window" or "grab option ?arg ...?"}
test grab-1.2 {Tk_GrabObjCmd} -body {
    rename grab grabTest1.2
    grabTest1.2
................................................................................
    }
    grab set -global .
    list [grab current .] [grab status .]
} -cleanup {
    grab release .
} -result {. global}




























cleanupTests
return







>
>
>
|
|
|

>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>




8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
...
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
# All rights reserved.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test

# The macOS test module includes the pressbutton command to simulate a
# mouse button press event by injecting events into the NSApplication
# event queue.  On other platforms there is currently no way to test
# the actual grab effect, per se, in an automated test.  Therefore,
# this test suite only covers the interface to the grab command (ie,
# error messages, etc.) on platforms other than macOS.

testConstraint pressbutton [llength [info commands pressbutton]]

test grab-1.1 {Tk_GrabObjCmd} -body {
    grab
} -returnCodes error -result {wrong # args: should be "grab ?-global? window" or "grab option ?arg ...?"}
test grab-1.2 {Tk_GrabObjCmd} -body {
    rename grab grabTest1.2
    grabTest1.2
................................................................................
    }
    grab set -global .
    list [grab current .] [grab status .]
} -cleanup {
    grab release .
} -result {. global}

test grab-6.1 {local grab on child window} -constraints {
    pressbutton
} -body {
    wm geometry . 100x200+200+100
    set result {}
    frame .f -background red -padx 10 -pady 10 -height 100 -width 80
    bind . <Button-1> {lappend result "outside"}
    bind .f <Button-1> {lappend result "inside"}
    pack .f
    update idletasks
    pressbutton 250 150
    update
    lappend result ":"
    pressbutton 250 250
    update
    lappend result ":"
    grab set .f
    pressbutton 250 150
    update
    lappend result ":"
    pressbutton 250 250
    update
    return $result
} -cleanup {
    grab release .f
} -result {inside outside : outside : inside outside :}

cleanupTests
return