aboutsummaryrefslogtreecommitdiffstats
path: root/XMonad
diff options
context:
space:
mode:
authorBrent Yorgey <byorgey@gmail.com>2008-02-26 23:27:23 +0100
committerBrent Yorgey <byorgey@gmail.com>2008-02-26 23:27:23 +0100
commite4ab822948bbb5d72ee5fd167b94adecbd534ffc (patch)
tree9af714da9f40df6ba3a9b3d4915fe281ac1bf8d8 /XMonad
parent222c04e734cdae323630b67809edeb39e8992864 (diff)
downloadXMonadContrib-e4ab822948bbb5d72ee5fd167b94adecbd534ffc.tar.gz
XMonadContrib-e4ab822948bbb5d72ee5fd167b94adecbd534ffc.tar.xz
XMonadContrib-e4ab822948bbb5d72ee5fd167b94adecbd534ffc.zip
EZConfig: add an emacs-style keybinding parser!
Now, instead of writing out incredibly dull things like ((modMask conf .|. controlMask .|. shiftMask, xK_F2), ...) you can just write ("M-C-S-<F2>", ...) Hooray! darcs-hash:20080226222723-bd4d7-9990a79938a01b53d11f2a27488b127333b52685.gz
Diffstat (limited to 'XMonad')
-rw-r--r--XMonad/Util/EZConfig.hs287
1 files changed, 279 insertions, 8 deletions
diff --git a/XMonad/Util/EZConfig.hs b/XMonad/Util/EZConfig.hs
index 6c5f655..1033c8a 100644
--- a/XMonad/Util/EZConfig.hs
+++ b/XMonad/Util/EZConfig.hs
@@ -2,25 +2,52 @@
-- |
-- Module : XMonad.Util.EZConfig
-- Copyright : Devin Mullins <me@twifkak.com>
+-- Brent Yorgey <byorgey@gmail.com> (key parsing)
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : Devin Mullins <me@twifkak.com>
--
--- Useful helper functions for amending the defaultConfig.
+-- Useful helper functions for amending the defaultConfig, and for
+-- parsing keybindings specified in a special (emacs-like) format.
--
-- (See also "XMonad.Util.CustomKeys" in xmonad-contrib.)
--
--------------------------------------------------------------------
module XMonad.Util.EZConfig (
- additionalKeys, removeKeys,
- additionalMouseBindings, removeMouseBindings
+ -- * Usage
+ -- $usage
+
+ -- * Adding or removing keybindings
+
+ additionalKeys, additionalKeysP,
+ removeKeys, removeKeysP,
+ additionalMouseBindings, removeMouseBindings,
+
+ -- * Nicer keybinding specifications
+
+ mkKeymap, checkKeymap,
) where
--- TODO: write tests
import XMonad
+import XMonad.Actions.Submap
import qualified Data.Map as M
+import Data.List (foldl', intersperse, sortBy, groupBy, nub)
+import Data.Ord (comparing)
+import Data.Maybe (catMaybes, isNothing, isJust, fromJust)
+import Control.Arrow (first, (&&&))
+
+import Text.ParserCombinators.ReadP
+
+-- $usage
+-- To use this module, first import it into your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Util.EZConfig
+--
+-- Then, use one of the provided functions to modify your
+-- configuration. See the documentation provided with each exported
+-- function for more information.
-- |
-- Add or override keybindings from the existing set. Example use:
@@ -37,8 +64,22 @@ import qualified Data.Map as M
-- to the modMask you configured earlier. You must specify mod1Mask (or
-- whichever), or add your own @myModMask = mod1Mask@ line.
additionalKeys :: XConfig a -> [((ButtonMask, KeySym), X ())] -> XConfig a
-additionalKeys conf keysList =
- conf { keys = \cnf -> M.union (M.fromList keysList) (keys conf cnf) }
+additionalKeys conf keyList =
+ conf { keys = \cnf -> M.union (M.fromList keyList) (keys conf cnf) }
+
+-- | Like 'additionalKeys', except using short @String@ key
+-- descriptors like @\"M-m\"@ instead of @(modMask, xK_m)@, as
+-- described in the documentation for 'mkKeymap'. For example:
+--
+-- > main = xmonad $ defaultConfig { terminal = "urxvt" }
+-- > `additionalKeysP`
+-- > [ ("M-m", spawn "echo 'Hi, mom!' | dzen2 -p 4")
+-- > , ("M-<Backspace>", withFocused hide) -- N.B. this is an absurd thing to do
+-- > ]
+
+additionalKeysP :: XConfig l -> [(String, X ())] -> XConfig l
+additionalKeysP conf keyList =
+ conf { keys = \cnf -> M.union (mkKeymap cnf keyList) (keys conf cnf) }
-- |
-- Remove standard keybindings you're not using. Example use:
@@ -49,13 +90,243 @@ removeKeys :: XConfig a -> [(ButtonMask, KeySym)] -> XConfig a
removeKeys conf keyList =
conf { keys = \cnf -> keys conf cnf `M.difference` M.fromList (zip keyList $ return ()) }
--- | Like additionalKeys, but for mouseBindings.
+-- | Like 'removeKeys', except using short @String@ key descriptors
+-- like @\"M-m\"@ instead of @(modMask, xK_m)@, as described in the
+-- documentation for 'mkKeymap'. For example:
+--
+-- > main = xmonad $ defaultConfig { terminal = "urxvt" }
+-- > `removeKeysP` ["M-S-" ++ [n] | n <- ['1'..'9']]
+
+removeKeysP :: XConfig l -> [String] -> XConfig l
+removeKeysP conf keyList =
+ conf { keys = \cnf -> keys conf cnf `M.difference` mkKeymap cnf (zip keyList $ repeat (return ())) }
+
+-- | Like 'additionalKeys', but for mouse bindings.
additionalMouseBindings :: XConfig a -> [((ButtonMask, Button), Window -> X ())] -> XConfig a
additionalMouseBindings conf mouseBindingsList =
conf { mouseBindings = \cnf -> M.union (M.fromList mouseBindingsList) (mouseBindings conf cnf) }
--- | Like removeKeys, but for mouseBindings.
+-- | Like 'removeKeys', but for mouse bindings.
removeMouseBindings :: XConfig a -> [(ButtonMask, Button)] -> XConfig a
removeMouseBindings conf mouseBindingList =
conf { mouseBindings = \cnf -> mouseBindings conf cnf `M.difference`
M.fromList (zip mouseBindingList $ return ()) }
+
+
+--------------------------------------------------------------
+-- Keybinding parsing ---------------------------------------
+--------------------------------------------------------------
+
+-- | Given a config (used to determine the proper modifier key to use)
+-- and a list of @(String, X ())@ pairs, create a key map by parsing
+-- the key sequence descriptions contained in the Strings. The key
+-- sequence descriptions are \"emacs-style\": @M-@, @C-@, @S-@, and
+-- @M\#-@ denote mod, control, shift, and mod1-mod5 (where @\#@ is
+-- replaced by the appropriate number) respectively; some special
+-- keys can be specified by enclosing their name in angle brackets.
+--
+-- For example, @\"M-C-x\"@ denotes mod+ctrl+x; @\"S-\<Escape\>\"@ denotes
+-- shift-escape.
+--
+-- Sequences of keys can also be specified by separating the key
+-- descriptions with spaces. For example, @\"M-x y \<Down\>\"@ denotes the
+-- sequence of keys mod+x, y, down. Submaps (see
+-- "XMonad.Actions.Submap") will be automatically generated to
+-- correctly handle these cases.
+--
+-- So, for example, a complete key map might be specified as
+--
+-- > keys = \c -> mkKeymap c $
+-- > [ ("M-S-<Return>", spawn $ terminal c)
+-- > , ("M-x w", spawn "xmessage 'woohoo!'") -- type mod+x then w to pop up 'woohoo!'
+-- > , ("M-x y", spawn "xmessage 'yay!'") -- type mod+x then y to pop up 'yay!'
+-- > , ("M-S-c", kill)
+-- > ]
+--
+-- Alternatively, you can use 'additionalKeysP' to automatically
+-- create a keymap and add it to your config.
+--
+-- Here is a complete list of supported special keys. Note that a few
+-- keys, such as the arrow keys, have synonyms:
+--
+-- > <Backspace>
+-- > <Tab>
+-- > <Return>
+-- > <Pause>
+-- > <Scroll_lock>
+-- > <Sys_Req>
+-- > <Escape>, <Esc>
+-- > <Delete>
+-- > <Home>
+-- > <Left>, <L>
+-- > <Up>, <U>
+-- > <Right>, <R>
+-- > <Down>, <D>
+-- > <Page_Up>
+-- > <Page_Down>
+-- > <End>
+-- > <Insert>
+-- > <Break>
+-- > <Space>
+-- > <F1>-<F12>
+
+mkKeymap :: XConfig l -> [(String, X ())] -> M.Map (KeyMask, KeySym) (X ())
+mkKeymap c = M.fromList . mkSubmaps . readKeymap c
+
+-- | Given a list of pairs of parsed key sequences and actions,
+-- group them into submaps in the appropriate way.
+mkSubmaps :: [ ([(KeyMask,KeySym)], X ()) ] -> [((KeyMask, KeySym), X ())]
+mkSubmaps binds = map combine gathered
+ where gathered = groupBy fstKey
+ . sortBy (comparing fst)
+ $ binds
+ combine [([k],act)] = (k,act)
+ combine ks = (head . fst . head $ ks,
+ submap . M.fromList . mkSubmaps $ map (first tail) ks)
+ fstKey = (==) `on` (head . fst)
+
+on :: (a -> a -> b) -> (c -> a) -> c -> c -> b
+op `on` f = \x y -> f x `op` f y
+
+-- | Given a configuration record and a list of (key sequence
+-- description, action) pairs, parse the key sequences into lists of
+-- @(KeyMask,KeySym)@ pairs. Key sequences which fail to parse will
+-- be ignored.
+readKeymap :: XConfig l -> [(String, X())] -> [([(KeyMask,KeySym)], X())]
+readKeymap c = catMaybes . map (maybeKeys . first (readKeySequence c))
+ where maybeKeys (Nothing,_) = Nothing
+ maybeKeys (Just k, act) = Just (k, act)
+
+-- | Parse a sequence of keys, returning Nothing if there is
+-- a parse failure (no parse, or ambiguous parse).
+readKeySequence :: XConfig l -> String -> Maybe [(KeyMask, KeySym)]
+readKeySequence c s = case parses s of
+ [k] -> Just k
+ _ -> Nothing
+ where parses = map fst . filter (null.snd) . readP_to_S (parseKeySequence c)
+
+-- | Parse a sequence of key combinations separated by spaces, e.g.
+-- @\"M-c x C-S-2\"@ (mod+c, x, ctrl+shift+2).
+parseKeySequence :: XConfig l -> ReadP [(KeyMask, KeySym)]
+parseKeySequence c = sepBy1 (parseKeyCombo c) (many1 $ char ' ')
+
+-- | Parse a modifier-key combination such as "M-C-s" (mod+ctrl+s).
+parseKeyCombo :: XConfig l -> ReadP (KeyMask, KeySym)
+parseKeyCombo c = do mods <- many (parseModifier c)
+ k <- parseKey
+ return (foldl' (.|.) 0 mods, k)
+
+-- | Parse a modifier: either M- (user-defined mod-key),
+-- C- (control), S- (shift), or M#- where # is an integer
+-- from 1 to 5 (mod1Mask through mod5Mask).
+parseModifier :: XConfig l -> ReadP KeyMask
+parseModifier c = (string "M-" >> return (modMask c))
+ +++ (string "C-" >> return controlMask)
+ +++ (string "S-" >> return shiftMask)
+ +++ do char 'M'
+ n <- satisfy (`elem` ['1'..'5'])
+ char '-'
+ return (mod1Mask + (read [n]) - 1)
+
+-- | Parse an unmodified basic key, like @\"x\"@, @\"<F1>\"@, etc.
+parseKey :: ReadP KeySym
+parseKey = parseRegular +++ parseSpecial
+
+-- | Parse a regular key name (represented by itself).
+parseRegular :: ReadP KeySym
+parseRegular = choice [ char s >> return k
+ | (s,k) <- zip ['!'..'~'] [xK_exclam..xK_asciitilde]
+ ]
+
+-- | Parse a special key name (one enclosed in angle brackets).
+parseSpecial :: ReadP KeySym
+parseSpecial = do char '<'
+ key <- choice [ string name >> return k
+ | (name,k) <- keyNames
+ ]
+ char '>'
+ return key
+
+-- | A list of all special key names and their associated KeySyms.
+keyNames :: [(String, KeySym)]
+keyNames = functionKeys ++ specialKeys
+
+-- | A list pairing function key descriptor strings (e.g. @\"<F2>\"@) with
+-- the associated KeySyms.
+functionKeys :: [(String, KeySym)]
+functionKeys = [ ("F" ++ show n, k)
+ | (n,k) <- zip ([1..12] :: [Int]) [xK_F1..] ]
+
+-- | A list of special key names and their corresponding KeySyms.
+specialKeys :: [(String, KeySym)]
+specialKeys = [ ("Backspace", xK_BackSpace)
+ , ("Tab" , xK_Tab )
+ , ("Return" , xK_Return)
+ , ("Pause" , xK_Pause)
+ , ("Scroll_lock", xK_Scroll_Lock)
+ , ("Sys_Req" , xK_Sys_Req)
+ , ("Escape" , xK_Escape)
+ , ("Esc" , xK_Escape)
+ , ("Delete" , xK_Delete)
+ , ("Home" , xK_Home)
+ , ("Left" , xK_Left)
+ , ("Up" , xK_Up)
+ , ("Right" , xK_Right)
+ , ("Down" , xK_Down)
+ , ("L" , xK_Left)
+ , ("U" , xK_Up)
+ , ("R" , xK_Right)
+ , ("D" , xK_Down)
+ , ("Page_Up" , xK_Page_Up)
+ , ("Page_Down", xK_Page_Down)
+ , ("End" , xK_End)
+ , ("Insert" , xK_Insert)
+ , ("Break" , xK_Break)
+ , ("Space" , xK_space)
+ ]
+
+-- | Given a configuration record and a list of (key sequence
+-- description, action) pairs, check the key sequence descriptions
+-- for validity, and warn the user (via a popup xmessage window) of
+-- any unparseable or duplicate key sequences. This function is
+-- appropriate for adding to your @startupHook@, and you are highly
+-- encouraged to do so; otherwise, duplicate or unparseable
+-- keybindings will be silently ignored.
+--
+-- For example, you might do something like this:
+--
+-- > main = xmonad $ myConfig
+-- >
+-- > myKeymap = [("S-M-c", kill), ...]
+-- > myConfig = defaultConfig {
+-- > ...
+-- > keys = \c -> mkKeymap c myKeymap
+-- > startupHook = checkKeymap myConfig myKeymap
+-- > ...
+-- > }
+--
+checkKeymap :: XConfig l -> [(String, a)] -> X ()
+checkKeymap conf km = warn (doKeymapCheck conf km)
+ where warn ([],[]) = return ()
+ warn (bad,dup) = spawn $ "xmessage 'Warning:\n"
+ ++ msg "bad" bad ++ "\n"
+ ++ msg "duplicate" dup ++ "'"
+ msg _ [] = ""
+ msg m xs = m ++ " keybindings detected: " ++ showBindings xs
+ showBindings = concat . intersperse " " . map ((++"\"") . ("\""++))
+
+-- | Given a config and a list of (key sequence description, action)
+-- pairs, check the key sequence descriptions for validity,
+-- returning a list of unparseable key sequences, and a list of
+-- duplicate key sequences.
+doKeymapCheck :: XConfig l -> [(String,a)] -> ([String], [String])
+doKeymapCheck conf km = (bad,dups)
+ where ks = map ((readKeySequence conf &&& id) . fst) km
+ bad = nub . map snd . filter (isNothing . fst) $ ks
+ dups = map (snd . head)
+ . filter ((>1) . length)
+ . groupBy ((==) `on` fst)
+ . sortBy (comparing fst)
+ . map (first fromJust)
+ . filter (isJust . fst)
+ $ ks