[Adding XMonad.Actions.KeyRemap for mapping single keys
stettberger@dokucode.de**20100501150918
 Ignore-this: d0c02e4deff80cc69e6e7a871e713114
 
 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.
] {
addfile ./XMonad/Actions/KeyRemap.hs
hunk ./XMonad/Actions/KeyRemap.hs 1
+ {-# 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          = "`1234567890-=qwertyuiop[]\\asdfghjkl;'zxcvbnm,./~!@#$%^&*()_+QWERTYUIOP{}|ASDFGHJKL:\"ZXCVBNM<>?"
+    layoutUs = [96,49,50,51,52,53,54,55,56,57,48,45,61,113,119,101,114,116,121,117,105,111,112,91,93,92,
+                97,115,100,102,103,104,106,107,108,59,39,122,120,99,118,98,110,109,44,46,47,126,33,64,35,
+                36,37,94,38,42,40,41,95,43,81,87,69,82,84,89,85,73,79,80,123,125,124,65,83,68,70,71,72,
+                74,75,76,58,34,90,88,67,86,66,78,77,60,62,63] :: [KeySym]
+               [_$_]
+    --    layoutUsKey       = "`1234567890-=qwertyuiop[]\asdfghjkl;'zxcvbnm,./`1234567890-=qwertyuiop[]\asdfghjkl;'zxcvbnm,./"
+    layoutUsKey = [96,49,50,51,52,53,54,55,56,57,48,45,61,113,119,101,114,116,121,117,105,111,112,91,93,
+                   92,97,115,100,102,103,104,106,107,108,59,39,122,120,99,118,98,110,109,44,46,47,96,49,
+                   50,51,52,53,54,55,56,57,48,45,61,113,119,101,114,116,121,117,105,111,112,91,93,92,97,
+                   115,100,102,103,104,106,107,108,59,39,122,120,99,118,98,110,109,44,46,47] :: [KeySym]
+      [_$_]
+    layoutUsShift     = "0000000000000000000000000000000000000000000000011111111111111111111111111111111111111111111111"
+    [_$_]
+    -- layoutDvorak      = "$&[{}(=*)+]!#;,.pyfgcrl/@\aoeuidhtns-'qjkxbmwvz~%7531902468`:<>PYFGCRL?^|AOEUIDHTNS_\"QJKXBMWVZ"
+    layoutDvorak = [36,38,91,123,125,40,61,42,41,43,93,33,35,59,44,46,112,121,102,103,99,114,108,47,64,
+                    92,97,111,101,117,105,100,104,116,110,115,45,39,113,106,107,120,98,109,119,118,122,
+                    126,37,55,53,51,49,57,48,50,52,54,56,96,58,60,62,80,89,70,71,67,82,76,63,94,124,65,
+                    79,69,85,73,68,72,84,78,83,95,34,81,74,75,88,66,77,87,86,90] :: [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
hunk ./xmonad-contrib.cabal 109
+                        XMonad.Actions.KeyRemap
}