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
|
module Rahm.Desktop.Submap (
mapNextString,
mapNextStringWithKeysym,
submapButtonsWithKey,
nextButton,
nextMotion,
nextMotionOrButton,
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 along side the keysym.
-
- This function allows mappings where the mapped string might be important,
- but also allows submappings for keys that may not have a character associated
- with them (for example, the function keys).
-}
mapNextStringWithKeysym :: (KeyMask -> KeySym -> String -> X a) -> X a
mapNextStringWithKeysym fn = do
XConf { theRoot = root, display = d } <- ask
io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
(m, str, keysym) <- 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, keysym)
io $ ungrabKeyboard d currentTime
fn m keysym str
{- Like submap, but on the character typed rather than the kysym. -}
mapNextString :: (KeyMask -> String -> X a) -> X a
mapNextString fn = mapNextStringWithKeysym (\m _ s -> fn m s)
{- Grabs the mouse and returns the next button press. -}
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
{- Grabs the mouse and reports the next mouse motion. -}
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
{- Grabs the mouse and reports the next mouse motion or button press. -}
nextMotionOrButton :: X (Either (Int, Int) (ButtonMask, Button))
nextMotionOrButton = do
XConf { theRoot = root, display = d } <- ask
io $ grabPointer d root False (pointerMotionMask .|. buttonPressMask) grabModeAsync grabModeAsync 0 0 currentTime
ret <- io $ allocaXEvent $ \xEv -> do
maskEvent d (pointerMotionMask .|. buttonPressMask) xEv
ev <- getEvent xEv
case ev of
MotionEvent { ev_x = x, ev_y = y } ->
return $ Left (fromIntegral x, fromIntegral y)
ButtonEvent { ev_button = button, ev_state = m } ->
return $ Right (m, button)
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
|
