X.A.Repeatable: Auto-detect modifier keys from currentEvent

This makes all the cycleSomething key bindings easier to use: users
don't need to manually list the KeySyms of modifier keys in addition to
specifying the mask for the keybinding itself. We can easily get those
KeySyms from the KeyEvent currently being handled with the help of
XGetModifierMapping.

XMonad/Actions/Repeatable.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.Repeatable
@@ -23,6 +24,8 @@ module XMonad.Actions.Repeatable
   , repeatableM
   ) where
 
+import Data.Bits
+
 -- mtl
 import Control.Monad.State (StateT(..))
 
@@ -31,13 +34,16 @@ import Graphics.X11.Xlib.Extras
 
 -- xmonad
 import XMonad
+import XMonad.Prelude
 
 
 -- | An action that temporarily usurps and responds to key press/release events,
 --   concluding when one of the modifier keys is released.
 repeatable
   :: [KeySym]                      -- ^ The list of 'KeySym's under the
                                    --   modifiers used to invoke the action.
+                                   --   If empty, auto-detect from
+                                   --   'currentEvent'.
   -> KeySym                        -- ^ The keypress that invokes the action.
   -> (EventType -> KeySym -> X ()) -- ^ The keypress handler.
   -> X ()
@@ -51,6 +57,8 @@ repeatableSt
   -> [KeySym]                              -- ^ The list of 'KeySym's under the
                                            --   modifiers used to invoke the
                                            --   action.
+                                           --   If empty, auto-detect from
+                                           --   'currentEvent'.
   -> KeySym                                -- ^ The keypress that invokes the
                                            --   action.
   -> (EventType -> KeySym -> StateT s X a) -- ^ The keypress handler.
@@ -64,18 +72,23 @@ repeatableM
   => (m a -> X b)                 -- ^ How to run the monad in 'X'.
   -> [KeySym]                     -- ^ The list of 'KeySym's under the
                                   --   modifiers used to invoke the action.
+                                  --   If empty, auto-detect from
+                                  --   'currentEvent'.
   -> KeySym                       -- ^ The keypress that invokes the action.
   -> (EventType -> KeySym -> m a) -- ^ The keypress handler.
   -> X b
 repeatableM run mods key pressHandler = do
   XConf{ theRoot = root, display = d } <- ask
-  run (repeatableRaw d root mods key pressHandler)
+  mods' <- if null mods then getCurrentMods d else pure mods
+  run (repeatableRaw d root mods' key pressHandler)
 
 repeatableRaw
   :: (MonadIO m, Monoid a)
   => Display -> Window
   -> [KeySym] -> KeySym -> (EventType -> KeySym -> m a) -> m a
-repeatableRaw d root mods key pressHandler = do
+repeatableRaw d root mods key pressHandler
+    | null mods = error "XMonad.Actions.Repeatable: null mods, would loop indefinitely"
+    | otherwise = do
   io (grabKeyboard d root False grabModeAsync grabModeAsync currentTime)
   handleEvent (keyPress, key) <* io (ungrabKeyboard d currentTime)
   where
@@ -87,3 +100,34 @@ repeatableRaw d root mods key pressHandler = do
     handleEvent (t, s)
       | t == keyRelease && s `elem` mods = pure mempty
       | otherwise = (<>) <$> pressHandler t s <*> (getNextEvent >>= handleEvent)
+
+-- | Get 'KeySym's of currently pressed modifiers (assuming the event
+-- currently being handled is a 'KeyEvent').
+getCurrentMods :: Display -> X [KeySym]
+getCurrentMods d = ask >>= \case
+  XConf{ currentEvent = Just KeyEvent{ ev_state = mask } } -> io $ getCurrentMods' mask
+  _ -> pure []
+  where
+    getCurrentMods' mask = do
+      modMap <- modsToMasks <$> getModifierMapping d
+      keycodesToKeysyms $ currentModKeys mask modMap
+
+    modsToMasks :: [(Modifier, [KeyCode])] -> [(KeyMask, [KeyCode])]
+    modsToMasks modMap = [ (mask, kcs) | (modi, kcs) <- modMap, mask <- maybeToList (modi `lookup` masks) ]
+
+    masks =
+      [ (shiftMapIndex,   shiftMask)
+      , (lockMapIndex,    lockMask)
+      , (controlMapIndex, controlMask)
+      , (mod1MapIndex,    mod1Mask)
+      , (mod2MapIndex,    mod2Mask)
+      , (mod3MapIndex,    mod3Mask)
+      , (mod4MapIndex,    mod4Mask)
+      , (mod5MapIndex,    mod5Mask)
+      ]
+
+    currentModKeys :: KeyMask -> [(KeyMask, [KeyCode])] -> [KeyCode]
+    currentModKeys mask modMap = [ kc | (m, kcs) <- modMap, mask .&. m /= 0, kc <- kcs, kc /= 0 ]
+
+    keycodesToKeysyms :: [KeyCode] -> IO [KeySym]
+    keycodesToKeysyms = traverse $ \kc -> keycodeToKeysym d kc 0