From 62ff9282a753b1651152c7dcf0987d5bbb1ca1b2 Mon Sep 17 00:00:00 2001 From: stettberger Date: Sun, 2 May 2010 17:23:22 +0200 Subject: 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 --- XMonad/Actions/KeyRemap.hs | 156 +++++++++++++++++++++++++++++++++++++++++++++ xmonad-contrib.cabal | 1 + 2 files changed, 157 insertions(+) create mode 100644 XMonad/Actions/KeyRemap.hs 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 -- cgit v1.2.3