Adding XMonad.Actions.KeyRemap for mapping single keys

Ignore-this: 113f6ef92fd31134fb6752a8b8253c3a

With KeyRemap it is possible to emit different keys to client windows, when
pressing some key. For example having dvorak layout for typing, but us for
keybindings.

darcs-hash:20100502152322-caded-3d1063ea35511ec6ffbbf98ead626181e7f0f512.gz

2 files changed, 157 insertions, 0 deletions

diff --git a/XMonad/Actions/KeyRemap.hs b/XMonad/Actions/KeyRemap.hs
new file mode 100644
index 0000000..f3b4335
--- /dev/null
+++ b/XMonad/Actions/KeyRemap.hs
@@ -0,0 +1,156 @@
+ {-# LANGUAGE DeriveDataTypeable #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.KeyRemap
+-- Copyright   :  (c) Christian Dietrich
+-- License     :  BSD-style (as xmonad)
+--
+-- Maintainer  :  stettberger@dokucde.de
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Remap Keybinding on the fly, e.g having Dvorak char, but everything with Control/Shift 
+-- is left us Layout
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.KeyRemap (
+  -- * Usage
+  -- $usage
+  setKeyRemap,
+  buildKeyRemapBindings,
+  setDefaultKeyRemap,
+  
+  KeymapTable (KeymapTable),
+  emptyKeyRemap,
+  dvorakProgrammerKeyRemap
+  ) where
+
+import XMonad
+import XMonad.Util.Paste
+import Data.List
+
+import qualified XMonad.Util.ExtensibleState as XS
+import Control.Monad
+
+
+data KeymapTable = KeymapTable [((KeyMask, KeySym), (KeyMask, KeySym))] deriving (Typeable, Show)
+
+instance ExtensionClass KeymapTable where
+   initialValue = KeymapTable []
+   
+-- $usage
+-- Provides the possibility to remap parts of the keymap to generate different keys
+--
+-- * E.g You want to type Programmers Dvorak, but your keybindings should be the normal us layout 
+--   after all
+--
+-- First, you must add all possible keybindings for all layout you want to use:
+--
+-- >   keys = myKeys ++ buildKeyRemapBindings [dvorakProgrammerKeyRemap,emptyKeyRemap]
+--
+-- Then you must add setDefaultKeyRemap to your startup hook (e.g. you want to set the 
+-- empty keyremap (no remapping is done) as default after startup):
+-- 
+-- > myStartupHook :: X()
+-- > myStartupHook = do               
+-- >   setWMName "LG3D"
+-- >   setDefaultKeyRemap emptyKeyRemap [dvorakProgrammerKeyRemap, emptyKeyRemap]
+--
+-- Then you add keybindings for changing keyboard layouts;
+--
+-- > , ((0                    , xK_F1    ), setKeyRemap emptyKeyRemap)
+-- > , ((0                    , xK_F2    ), setKeyRemap dvorakProgrammerKeyRemap)
+--
+-- When defining your own keymappings, please be aware of:
+--
+-- * If you want to emulate a key that is shifted on us you must emulate that keypress:
+--
+-- > KeymapTable [((0, xK_a), (shiftMask, xK_5))] -- would bind 'a' to '%'
+-- > KeymapTable [((shiftMask, xK_a), (0, xK_5))] -- would bind 'A' to '5'
+--
+-- * the dvorakProgrammerKeyRemap uses the original us layout as lookuptable to generate 
+--   the KeymapTable
+--
+-- * KeySym and (ord Char) are incompatible, therefore the magic numbers in dvorakProgrammerKeyRemap
+--   are nessesary
+
+doKeyRemap :: KeyMask -> KeySym -> X()
+doKeyRemap mask sym = do
+  table <- XS.get
+  let (insertMask, insertSym) = extractKeyMapping table mask sym
+  sendKey insertMask insertSym
+  
+-- | Using this in the keybindings to set the actual Key Translation table
+setKeyRemap :: KeymapTable -> X()
+setKeyRemap table = do
+  let KeymapTable newtable = table
+  KeymapTable oldtable <- XS.get
+  XConf { display = dpy, theRoot = rootw } <- ask
+  
+  let grab kc m = io $ grabKey dpy kc m rootw True grabModeAsync grabModeAsync
+  let ungrab kc m = io $ ungrabKey dpy kc m rootw
+      
+  forM_ oldtable $ \((mask, sym), _) -> do
+    kc <- io $ keysymToKeycode dpy sym
+    -- "If the specified KeySym is not defined for any KeyCode,
+    -- XKeysymToKeycode() returns zero."
+    when (kc /= 0) $ ungrab kc mask
+    
+  forM_ newtable $ \((mask, sym), _) -> do
+    kc <- io $ keysymToKeycode dpy sym
+    -- "If the specified KeySym is not defined for any KeyCode,
+    -- XKeysymToKeycode() returns zero."
+    when (kc /= 0) $ grab kc mask
+    
+  XS.put table
+  
+-- | Adding this to your startupHook, to select your default Key Translation table.
+--   You also must give it all the KeymapTables you are willing to use
+setDefaultKeyRemap  :: KeymapTable -> [KeymapTable] -> X()
+setDefaultKeyRemap dflt keyremaps = do
+  XS.put (KeymapTable mappings)
+  setKeyRemap dflt
+  where
+    mappings = nub (keyremaps >>= \(KeymapTable table) -> table)
+
+extractKeyMapping :: KeymapTable -> KeyMask -> KeySym -> (KeyMask, KeySym)
+extractKeyMapping (KeymapTable table) mask sym = 
+  insertKey filtered
+  where filtered = filter (\((m, s),_) -> m == mask && s == sym) table
+        insertKey [] = (mask, sym)
+        insertKey ((_, to):_) = to
+        
+-- | Append the output of this function to your keybindings with ++
+buildKeyRemapBindings :: [KeymapTable] -> [((KeyMask, KeySym), X ())]
+buildKeyRemapBindings keyremaps =
+  [((mask, sym), doKeyRemap mask sym) | (mask, sym) <- bindings]
+  where mappings = concat (map (\(KeymapTable table) -> table) keyremaps)
+        bindings = nub (map (\binding -> fst binding) mappings)
+        
+                                                 
+-- Here come the Keymappings
+-- | The empty KeymapTable, does no translation
+emptyKeyRemap :: KeymapTable
+emptyKeyRemap = KeymapTable []
+
+-- | The dvorak Programmers keymap, translates from us keybindings to dvorak programmers
+dvorakProgrammerKeyRemap :: KeymapTable
+dvorakProgrammerKeyRemap = 
+  KeymapTable [((charToMask maskFrom, from), (charToMask maskTo, to)) | 
+               (maskFrom, from, maskTo, to) <- (zip4 layoutUsShift layoutUsKey layoutDvorakShift layoutDvorakKey)]
+  where
+    
+    layoutUs    = map (fromIntegral . fromEnum) "`1234567890-=qwertyuiop[]\\asdfghjkl;'zxcvbnm,./~!@#$%^&*()_+QWERTYUIOP{}|ASDFGHJKL:\"ZXCVBNM<>?"  :: [KeySym]
+    layoutUsKey = map (fromIntegral . fromEnum) "`1234567890-=qwertyuiop[]\\asdfghjkl;'zxcvbnm,./`1234567890-=qwertyuiop[]\\asdfghjkl;'zxcvbnm,./"  :: [KeySym]
+    layoutUsShift = "0000000000000000000000000000000000000000000000011111111111111111111111111111111111111111111111"
+    
+    layoutDvorak = map (fromIntegral . fromEnum) "$&[{}(=*)+]!#;,.pyfgcrl/@\\aoeuidhtns-'qjkxbmwvz~%7531902468`:<>PYFGCRL?^|AOEUIDHTNS_\"QJKXBMWVZ" :: [KeySym]
+      
+    layoutDvorakShift = map getShift layoutDvorak
+    layoutDvorakKey   = map getKey layoutDvorak
+    getKey  char = let Just index = elemIndex char layoutUs
+                    in layoutUsKey !! index
+    getShift char = let Just index = elemIndex char layoutUs
+                    in layoutUsShift !! index
+    charToMask char = if [char] == "0" then 0 else shiftMask
diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal
index 7f2a4b7..91518d4 100644
--- a/xmonad-contrib.cabal
+++ b/xmonad-contrib.cabal
@@ -106,6 +106,7 @@ library
                         XMonad.Actions.Plane
                         XMonad.Actions.Promote
                         XMonad.Actions.RandomBackground
+                        XMonad.Actions.KeyRemap
                         XMonad.Actions.RotSlaves
                         XMonad.Actions.Search
                         XMonad.Actions.SimpleDate