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
|
module Internal.Submap (
mapNextString,
submapButtonsWithKey,
nextButton,
nextMotion,
module X) where
import XMonad hiding (keys)
import Control.Monad.Fix (fix)
import qualified Data.Map as Map
import Data.Map (Map)
import XMonad.Actions.Submap as X
{- Like submap fram XMonad.Actions.Submap, but sends the string from
- XLookupString to the function rather than the KeySym.
-}
mapNextString :: (KeyMask -> String -> X a) -> X a
mapNextString fn = do
XConf { theRoot = root, display = d } <- ask
io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
(m, str) <- io $ allocaXEvent $ \p -> fix $ \nextkey -> do
maskEvent d keyPressMask p
KeyEvent { ev_keycode = code, ev_state = m } <- getEvent p
keysym <- keycodeToKeysym d code 0
(_, str) <- lookupString (asKeyEvent p)
if isModifierKey keysym
then nextkey
else return $ (m, str)
io $ ungrabKeyboard d currentTime
fn m str
nextButton :: X (ButtonMask, Button)
nextButton = do
XConf { theRoot = root, display = d } <- ask
io $ grabPointer d root False buttonPressMask grabModeAsync grabModeAsync 0 0 currentTime
ret <- io $ allocaXEvent $ \xEv -> do
maskEvent d buttonPressMask xEv
ButtonEvent { ev_button = button, ev_state = m } <- getEvent xEv
return (m, button)
io $ ungrabPointer d currentTime
return ret
nextMotion :: X (Int, Int)
nextMotion = do
XConf { theRoot = root, display = d } <- ask
io $ grabPointer d root False pointerMotionMask grabModeAsync grabModeAsync 0 0 currentTime
ret <- io $ allocaXEvent $ \xEv -> do
maskEvent d pointerMotionMask xEv
MotionEvent { ev_x = x, ev_y = y } <- getEvent xEv
return (fromIntegral x, fromIntegral y)
io $ ungrabPointer d currentTime
return ret
submapButtonsWithKey ::
((ButtonMask, Button) -> Window -> X ()) -> (Map (ButtonMask, Button) (Window -> X ())) -> Window -> X ()
submapButtonsWithKey defaultAction actions window = do
arg <- nextButton
case Map.lookup arg actions of
Nothing -> defaultAction arg window
Just fn -> fn window
|
