src/Rahm/Desktop/Keys/Grab.hs


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

module Rahm.Desktop.Keys.Grab where

import Data.Map (Map)
import qualified Data.Map as Map
import XMonad
import Control.Monad (forM_, forM)

data KeySymOrKeyCode = Ks KeySym | Kc KeyCode
  deriving (Ord, Eq, Show, Read)

doGrab :: Display -> Window -> (KeyMask, KeySymOrKeyCode) -> X ()
doGrab dpy win (keyMask, keySymOrKeyCode) = do
  let grab kc m = io $ grabKey dpy kc m win True grabModeAsync grabModeAsync

  codes <-
    case keySymOrKeyCode of
      Ks keysym ->
        io $ getKeyCodesForKeysym dpy keysym
      Kc keycode -> return [keycode]

  forM_ codes $ \kc ->
    mapM_ (grab kc . (keyMask .|.)) =<< extraModifiers

getKeyCodesForKeysym :: Display -> KeySym -> IO [KeyCode]
getKeyCodesForKeysym dpy keysym = do
  let (minCode, maxCode) = displayKeycodes dpy
      allCodes = [fromIntegral minCode .. fromIntegral maxCode]

  syms <- forM allCodes $ \code -> keycodeToKeysym dpy code 0
  let keysymMap' = Map.fromListWith (++) (zip syms [[code] | code <- allCodes])

  -- keycodeToKeysym returns noSymbol for all unbound keycodes, and we don't
  -- want to grab those whenever someone accidentally uses def :: KeySym
  let keysymMap = Map.delete noSymbol keysymMap'
  let keysymToKeycodes sym = Map.findWithDefault [] keysym keysymMap

  return $ keysymToKeycodes keysym