-
Notifications
You must be signed in to change notification settings - Fork 3
/
track-currently-processing-event.dpatch
381 lines (361 loc) · 14.4 KB
/
track-currently-processing-event.dpatch
1
2
3
4
5
6
7
8
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
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
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
231
232
233
234
235
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
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
Sun Jun 21 23:56:49 EDT 2009 Geoff Reedy <[email protected]>
* track currently processing event
Mon Jun 22 01:19:11 EDT 2009 Geoff Reedy <[email protected]>
* implement the ICCCM WM_TAKE_FOCUS protocol
Sat Oct 10 19:19:07 EDT 2009 Geoff Reedy <[email protected]>
* Give focus to windows that don't set the input hint
Mon Feb 22 09:45:12 EST 2010 Adam Vogt <[email protected]>
* Resolve conflicts Geoff Reedy's window focus hack.
New patches:
[track currently processing event
Geoff Reedy <[email protected]>**20090622035649
Ignore-this: da2e82037548ab176a4333056c94a07a
] {
hunk ./XMonad/Core.hs 90
, mousePosition :: !(Maybe (Position, Position))
-- ^ position of the mouse according to
-- the event currently being processed
+ , currentEvent :: !(Maybe Event)
+ -- ^ event currently being processed
}
-- todo, better name
merger 0.0 (
hunk ./XMonad/Main.hsc 125
- st = XState
- { windowset = initialWinset
- , mapped = S.empty
- , waitingUnmap = M.empty
- , dragging = Nothing }
hunk ./XMonad/Main.hsc 124
- , mousePosition = Nothing }
+ , mousePosition = Nothing
+ , currentEvent = Nothing }
)
hunk ./XMonad/Main.hsc 173
prehandle e = let mouse = do guard (ev_event_type e `elem` evs)
return (fromIntegral (ev_x_root e)
,fromIntegral (ev_y_root e))
- in local (\c -> c { mousePosition = mouse }) (handleWithHook e)
+ in local (\c -> c { mousePosition = mouse, currentEvent = Just e }) (handleWithHook e)
evs = [ keyPress, keyRelease, enterNotify, leaveNotify
, buttonPress, buttonRelease]
}
[implement the ICCCM WM_TAKE_FOCUS protocol
Geoff Reedy <[email protected]>**20090622051911
Ignore-this: 5b397417dfcf9014ac515a64484cc314
] {
hunk ./XMonad/Core.hs 31
runX, catchX, userCode, userCodeDef, io, catchIO, installSignalHandlers, uninstallSignalHandlers,
withDisplay, withWindowSet, isRoot, runOnWorkspaces,
getAtom, spawn, spawnPID, xfork, getXMonadDir, recompile, trace, whenJust, whenX,
- atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, ManageHook, Query(..), runQuery
+ atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_TAKE_FOCUS, ManageHook, Query(..), runQuery
) where
import XMonad.StackSet hiding (modify)
hunk ./XMonad/Core.hs 212
getAtom str = withDisplay $ \dpy -> io $ internAtom dpy str False
-- | Common non-predefined atoms
-atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_STATE :: X Atom
+atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_STATE, atom_WM_TAKE_FOCUS :: X Atom
atom_WM_PROTOCOLS = getAtom "WM_PROTOCOLS"
atom_WM_DELETE_WINDOW = getAtom "WM_DELETE_WINDOW"
atom_WM_STATE = getAtom "WM_STATE"
hunk ./XMonad/Core.hs 216
+atom_WM_TAKE_FOCUS = getAtom "WM_TAKE_FOCUS"
------------------------------------------------------------------------
-- LayoutClass handling. See particular instances in Operations.hs
merger 0.0 (
hunk ./XMonad/Operations.hs 329
- io $ do setInputFocus dpy w revertToPointerRoot 0
- -- raiseWindow dpy w
+ io $ setInputFocus dpy w revertToPointerRoot 0
hunk ./XMonad/Operations.hs 329
- io $ do setInputFocus dpy w revertToPointerRoot 0
- -- raiseWindow dpy w
+
+ hints <- io $ getWMHints dpy w
+ protocols <- io $ getWMProtocols dpy w
+ wmprot <- atom_WM_PROTOCOLS
+ wmtf <- atom_WM_TAKE_FOCUS
+ currevt <- asks currentEvent
+
+ when (wmh_input hints) $ io $ do setInputFocus dpy w revertToPointerRoot 0
+ when (wmtf `elem` protocols) $
+ io $ allocaXEvent $ \ev -> do
+ setEventType ev clientMessage
+ setClientMessageEvent ev w wmprot 32 wmtf $ maybe currentTime event_time currevt
+ sendEvent dpy w False noEventMask ev
+ where event_time ev =
+ if (ev_event_type ev) `elem` timedEvents then
+ ev_time ev
+ else
+ currentTime
+ timedEvents = [ keyPress, keyRelease, buttonPress, buttonRelease, enterNotify, leaveNotify, selectionRequest ]
)
}
[Give focus to windows that don't set the input hint
Geoff Reedy <[email protected]>**20091010231907
Ignore-this: 4ffb55dd97b59234703e0411c06b4901
] {
hunk ./XMonad/Operations.hs 28
import Data.Maybe
import Data.Monoid (Endo(..))
import Data.List (nub, (\\), find)
-import Data.Bits ((.|.), (.&.), complement)
+import Data.Bits ((.|.), (.&.), complement, testBit)
import Data.Ratio
import qualified Data.Map as M
import qualified Data.Set as S
merger 0.0 (
merger 0.0 (
hunk ./XMonad/Operations.hs 329
- io $ do setInputFocus dpy w revertToPointerRoot 0
- -- raiseWindow dpy w
+
+ hints <- io $ getWMHints dpy w
+ protocols <- io $ getWMProtocols dpy w
+ wmprot <- atom_WM_PROTOCOLS
+ wmtf <- atom_WM_TAKE_FOCUS
+ currevt <- asks currentEvent
+
+ when (wmh_input hints) $ io $ do setInputFocus dpy w revertToPointerRoot 0
+ when (wmtf `elem` protocols) $
+ io $ allocaXEvent $ \ev -> do
+ setEventType ev clientMessage
+ setClientMessageEvent ev w wmprot 32 wmtf $ maybe currentTime event_time currevt
+ sendEvent dpy w False noEventMask ev
+ where event_time ev =
+ if (ev_event_type ev) `elem` timedEvents then
+ ev_time ev
+ else
+ currentTime
+ timedEvents = [ keyPress, keyRelease, buttonPress, buttonRelease, enterNotify, leaveNotify, selectionRequest ]
hunk ./XMonad/Operations.hs 329
- io $ do setInputFocus dpy w revertToPointerRoot 0
- -- raiseWindow dpy w
+ io $ setInputFocus dpy w revertToPointerRoot 0
)
hunk ./XMonad/Operations.hs 335
+ let inputHintSet = wmh_flags hints `testBit` inputHintBit
)
merger 0.0 (
merger 0.0 (
hunk ./XMonad/Operations.hs 335
+ let inputHintSet = wmh_flags hints `testBit` inputHintBit
merger 0.0 (
hunk ./XMonad/Operations.hs 329
- io $ do setInputFocus dpy w revertToPointerRoot 0
- -- raiseWindow dpy w
+
+ hints <- io $ getWMHints dpy w
+ protocols <- io $ getWMProtocols dpy w
+ wmprot <- atom_WM_PROTOCOLS
+ wmtf <- atom_WM_TAKE_FOCUS
+ currevt <- asks currentEvent
+
+ when (wmh_input hints) $ io $ do setInputFocus dpy w revertToPointerRoot 0
+ when (wmtf `elem` protocols) $
+ io $ allocaXEvent $ \ev -> do
+ setEventType ev clientMessage
+ setClientMessageEvent ev w wmprot 32 wmtf $ maybe currentTime event_time currevt
+ sendEvent dpy w False noEventMask ev
+ where event_time ev =
+ if (ev_event_type ev) `elem` timedEvents then
+ ev_time ev
+ else
+ currentTime
+ timedEvents = [ keyPress, keyRelease, buttonPress, buttonRelease, enterNotify, leaveNotify, selectionRequest ]
hunk ./XMonad/Operations.hs 329
- io $ do setInputFocus dpy w revertToPointerRoot 0
- -- raiseWindow dpy w
+ io $ setInputFocus dpy w revertToPointerRoot 0
)
)
hunk ./XMonad/Operations.hs 337
- when (wmh_input hints) $ io $ do setInputFocus dpy w revertToPointerRoot 0
+ when ((inputHintSet && wmh_input hints) || (not inputHintSet)) $
+ io $ do setInputFocus dpy w revertToPointerRoot 0
)
}
[Resolve conflicts Geoff Reedy's window focus hack.
Adam Vogt <[email protected]>**20100222144512
Ignore-this: a71f3cb0507642e828f4bdfdc7ccd289
]
<
[implement the ICCCM WM_TAKE_FOCUS protocol
Geoff Reedy <[email protected]>**20090622051911
Ignore-this: 5b397417dfcf9014ac515a64484cc314
]
[Give focus to windows that don't set the input hint
Geoff Reedy <[email protected]>**20091010231907
Ignore-this: 4ffb55dd97b59234703e0411c06b4901
]
> {
hunk ./XMonad/Main.hsc 124
, keyActions = keys xmc xmc
, buttonActions = mouseBindings xmc xmc
, mouseFocused = False
- , mousePosition = Nothing }
- st = XState
- { windowset = initialWinset
- , mapped = S.empty
- , waitingUnmap = M.empty
- , dragging = Nothing }
+ , mousePosition = Nothing
+ , currentEvent = Nothing }
st = XState
{ windowset = initialWinset
hunk ./XMonad/Operations.hs 329
-- If we ungrab buttons on the root window, we lose our mouse bindings.
whenX (not <$> isRoot w) $ setButtonGrab False w
- io $ do setInputFocus dpy w revertToPointerRoot 0
- -- raiseWindow dpy w
+
+ hints <- io $ getWMHints dpy w
+ protocols <- io $ getWMProtocols dpy w
+ wmprot <- atom_WM_PROTOCOLS
+ wmtf <- atom_WM_TAKE_FOCUS
+ currevt <- asks currentEvent
+ let inputHintSet = wmh_flags hints `testBit` inputHintBit
+
+ when ((inputHintSet && wmh_input hints) || (not inputHintSet)) $
+ io $ do setInputFocus dpy w revertToPointerRoot 0
+ when (wmtf `elem` protocols) $
+ io $ allocaXEvent $ \ev -> do
+ setEventType ev clientMessage
+ setClientMessageEvent ev w wmprot 32 wmtf $ maybe currentTime event_time currevt
+ sendEvent dpy w False noEventMask ev
+ where event_time ev =
+ if (ev_event_type ev) `elem` timedEvents then
+ ev_time ev
+ else
+ currentTime
+ timedEvents = [ keyPress, keyRelease, buttonPress, buttonRelease, enterNotify, leaveNotify, selectionRequest ]
------------------------------------------------------------------------
-- Message handling
}
Context:
[loc.hs: hlintify
[email protected]**20100213231537
Ignore-this: c447928ce68d0a968b55af3539c979fa
]
[Various clean-ups suggested by HLint
Spencer Janssen <[email protected]>**20100214025750
Ignore-this: ccaa6e774f2f8169e6083eddcffe31b6
]
[Make the --replace docs consistent
Spencer Janssen <[email protected]>**20100213002647
Ignore-this: c99526bce66ae1154fbf5713622f035d
]
[Add --replace flag with documentation (issue 99).
Adam Vogt <[email protected]>**20091220183529
Ignore-this: c56000295b75c66309913e29e1671d88
]
[Fix compile error when using base-3 (thanks bogner).
Adam Vogt <[email protected]>**20100211063938
Ignore-this: 60ba65613bc746e7e88f11a7e30b050f
]
[Broadcast PropertyChange events (needed for layouts with decoration)
Daniel Schoepe <[email protected]>**20100113204017
Ignore-this: c8315f438fed66b12282c9bfe70a4d0b
]
[Rename numlockMask to numberlockMask to help users of the template config.
Adam Vogt <[email protected]>**20100118162256
Ignore-this: 4050ed2d1ad373386c2e2b44145f07d9
Without the change, the errors are like:
> [ unrelated error messages ]
> No constructor has all these fields: `numlockMask',
> `terminal', [every other field set]
With the change:
> `numlockMask' is not a record selector
> [ context where numlockMask is named ]
]
[Correct warnings with ghc-6.12
Adam Vogt <[email protected]>**20100118181532
Ignore-this: a48ed095b72aedec9eeb88781ace66dc
Changes include:
- compatibility with base-4 or 3 (base-2 untested) by using
extensible-exceptions. This adds an additional dependency for users of
ghc<6.10)
- list all dependencies again when -ftesting (change in Cabal-1.8.0.2)
- remove unnecessary imports
- suppress -fwarn-unused-do-bind, with appropriate Cabal-1.8 workaround,
described here:
http://www.haskell.org/pipermail/xmonad/2010-January/009554.html
]
[Add xfork: a forkProcess that works around process global state
Spencer Janssen <[email protected]>**20091223061623
Ignore-this: 3f968260d8c1b6710c82566520c47c43
]
[TAG 0.9.1
Spencer Janssen <[email protected]>**20091216233643
Ignore-this: 856abdca8283155bbb8bdf003797ba34
]
[extra-source-files for the new manpage
Spencer Janssen <[email protected]>**20091216232005
Ignore-this: 919d964238198dd56d96a5052c2419c7
]
[Bump to 0.9.1
Spencer Janssen <[email protected]>**20091216231110
Ignore-this: 8a03850d758e1e4030d930cd8bf08ba9
]
[Determine numlockMask automatically, fixes #120
Spencer Janssen <[email protected]>**20091216012140
Ignore-this: d80c82dd0a23dc7a77fdc32fd2792130
]
[Update for X11 1.5.0.0
Spencer Janssen <[email protected]>**20091216011700
Ignore-this: 669c764c4c0ca516c8bdc1dfa35cd66
]
[Safer X11 version dependency
Spencer Janssen <[email protected]>**20091216010330
Ignore-this: 8297f7a6a65c5c97f83f860f642fc25
]
[man/xmonad.hs: remove reference to deprecated 'dynamicLogDzen' function
Brent Yorgey <[email protected]>**20091126053908
Ignore-this: 7aeeac9791ffd3e6ac22bf158ea86536
]
[A few tweaks to --verbose-version
Spencer Janssen <[email protected]>**20091208040729
Ignore-this: cf3d6a904d23891829c10f4966974673
]
[Generalize the type of (<+>). It can be used for keybindings too.
Adam Vogt <[email protected]>**20091205233611
Ignore-this: af15248be5e483d1a6e924f786fcc1c4
]
[Main.hs +--verbose-version flag
[email protected]**20091128144840
Ignore-this: 61a081f33adb460ea459950a750dd93f
This resolves http://code.google.com/p/xmonad/issues/detail?id=320 by adding a
--verbose-version option yielding output like "xmonad 0.9 compiled by ghc 6.10 for linux/i386"
]
[Swap the order that windows are mapped/unmapped. Addresses #322
Spencer Janssen <[email protected]>**20091119025440
Ignore-this: 22087204f1b84dae98a3cf2b7f116d3f
]
[Add GPL warning to GenerateManpage
Spencer Janssen <[email protected]>**20091111000106
Ignore-this: ea24691b8198976a4088a2708e0b4c94
]
[Add a basic header to the html manpage output
Adam Vogt <[email protected]>**20091028033042
Ignore-this: 2641e0fb3179616075fa7549b57740f3
]
[Use pandoc to convert a markdown manpage tranlation to html and man.
Adam Vogt <[email protected]>**20091028030639
Ignore-this: cdf7cdc8e44b21de8fc7725bde299792
]
[Support for extensible state in contrib modules.
Daniel Schoepe <[email protected]>**20091106115050
Ignore-this: d04ee1989313ed5710c94f9d7fda3f2a
]
[Set SIGPIPE to default in forked processes
Spencer Janssen <[email protected]>**20091106223743
Ignore-this: f73943e4fe6c5f08967ddb82afad3eaa
]
[TAG 0.9
Spencer Janssen <[email protected]>**20091026004641
Ignore-this: 80347d432f3b606c8d722536d0d729aa
]
Patch bundle hash:
1d44b9c75f095044a2d86b0715a127f417b8a91f