--------------------------------------------------------------------
-- |
-- Module      :  XMonad.Util.EZConfig
-- Description :  Configure key bindings easily in Emacs style.
-- 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 default configuration, and for
-- parsing keybindings specified in a special (emacs-like) format.
--
-- (See also "XMonad.Util.CustomKeys" in xmonad-contrib.)
--
--------------------------------------------------------------------

module XMonad.Util.EZConfig (
                             -- * Usage
                             -- $usage

                             -- * Adding or removing keybindings

                             additionalKeys, additionalKeysP,
                             removeKeys, removeKeysP,
                             additionalMouseBindings, removeMouseBindings,

                             -- * Emacs-style keybinding specifications

                             mkKeymap, checkKeymap,
                             mkNamedKeymap,

                             -- * Parsers

                             parseKey, -- used by XMonad.Util.Paste
                             parseKeyCombo,
                             parseKeySequence, readKeySequence
                            ) where

import XMonad
import XMonad.Actions.Submap
import XMonad.Prelude hiding (many)

import XMonad.Util.NamedActions

import Control.Arrow (first, (&&&))
import qualified Data.Map as M
import Data.Ord (comparing)

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.  You can use 'additionalKeys', 'removeKeys',
-- 'additionalMouseBindings', and 'removeMouseBindings' to easily add
-- and remove keybindings or mouse bindings.  You can use 'mkKeymap'
-- to create a keymap using emacs-style keybinding specifications
-- like @\"M-x\"@ instead of @(modMask, xK_x)@, or 'additionalKeysP'
-- and 'removeKeysP' to easily add or remove emacs-style keybindings.
-- If you use emacs-style keybindings, the 'checkKeymap' function is
-- provided, suitable for adding to your 'startupHook', which can warn
-- you of any parse errors or duplicate bindings in your keymap.
--
-- For more information and usage examples, see the documentation
-- provided with each exported function, and check the xmonad config
-- archive (<http://haskell.org/haskellwiki/Xmonad/Config_archive>)
-- for some real examples of use.

-- |
-- Add or override keybindings from the existing set. Example use:
--
-- > main = xmonad $ def { terminal = "urxvt" }
-- >                 `additionalKeys`
-- >                 [ ((mod1Mask, xK_m        ), spawn "echo 'Hi, mom!' | dzen2 -p 4")
-- >                 , ((mod1Mask, xK_BackSpace), withFocused hide) -- N.B. this is an absurd thing to do
-- >                 ]
--
-- This overrides the previous definition of mod-m.
--
-- Note that, unlike in xmonad 0.4 and previous, you can't use modMask to refer
-- to the modMask you configured earlier. You must specify mod1Mask (or
-- whichever), or add your own @myModMask = mod1Mask@ line.
additionalKeys :: XConfig a -> [((KeyMask, KeySym), X ())] -> XConfig a
additionalKeys :: forall (a :: * -> *).
XConfig a -> [((KeyMask, KeySym), X ())] -> XConfig a
additionalKeys XConfig a
conf [((KeyMask, KeySym), X ())]
keyList =
    XConfig a
conf { keys :: XConfig Layout -> Map (KeyMask, KeySym) (X ())
keys = Map (KeyMask, KeySym) (X ())
-> Map (KeyMask, KeySym) (X ()) -> Map (KeyMask, KeySym) (X ())
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union ([((KeyMask, KeySym), X ())] -> Map (KeyMask, KeySym) (X ())
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [((KeyMask, KeySym), X ())]
keyList) (Map (KeyMask, KeySym) (X ()) -> Map (KeyMask, KeySym) (X ()))
-> (XConfig Layout -> Map (KeyMask, KeySym) (X ()))
-> XConfig Layout
-> Map (KeyMask, KeySym) (X ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConfig a -> XConfig Layout -> Map (KeyMask, KeySym) (X ())
forall (l :: * -> *).
XConfig l -> XConfig Layout -> Map (KeyMask, KeySym) (X ())
keys XConfig a
conf }

-- | 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 $ def { 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 :: forall (l :: * -> *). XConfig l -> [(String, X ())] -> XConfig l
additionalKeysP XConfig l
conf [(String, X ())]
keyList =
    XConfig l
conf { keys :: XConfig Layout -> Map (KeyMask, KeySym) (X ())
keys = \XConfig Layout
cnf -> Map (KeyMask, KeySym) (X ())
-> Map (KeyMask, KeySym) (X ()) -> Map (KeyMask, KeySym) (X ())
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union (XConfig Layout -> [(String, X ())] -> Map (KeyMask, KeySym) (X ())
forall (l :: * -> *).
XConfig l -> [(String, X ())] -> Map (KeyMask, KeySym) (X ())
mkKeymap XConfig Layout
cnf [(String, X ())]
keyList) (XConfig l -> XConfig Layout -> Map (KeyMask, KeySym) (X ())
forall (l :: * -> *).
XConfig l -> XConfig Layout -> Map (KeyMask, KeySym) (X ())
keys XConfig l
conf XConfig Layout
cnf) }

-- |
-- Remove standard keybindings you're not using. Example use:
--
-- > main = xmonad $ def { terminal = "urxvt" }
-- >                 `removeKeys` [(mod1Mask .|. shiftMask, n) | n <- [xK_1 .. xK_9]]
removeKeys :: XConfig a -> [(KeyMask, KeySym)] -> XConfig a
removeKeys :: forall (a :: * -> *). XConfig a -> [(KeyMask, KeySym)] -> XConfig a
removeKeys XConfig a
conf [(KeyMask, KeySym)]
keyList =
    XConfig a
conf { keys :: XConfig Layout -> Map (KeyMask, KeySym) (X ())
keys = \XConfig Layout
cnf -> ((KeyMask, KeySym)
 -> Map (KeyMask, KeySym) (X ()) -> Map (KeyMask, KeySym) (X ()))
-> Map (KeyMask, KeySym) (X ())
-> [(KeyMask, KeySym)]
-> Map (KeyMask, KeySym) (X ())
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (KeyMask, KeySym)
-> Map (KeyMask, KeySym) (X ()) -> Map (KeyMask, KeySym) (X ())
forall k a. Ord k => k -> Map k a -> Map k a
M.delete (XConfig a -> XConfig Layout -> Map (KeyMask, KeySym) (X ())
forall (l :: * -> *).
XConfig l -> XConfig Layout -> Map (KeyMask, KeySym) (X ())
keys XConfig a
conf XConfig Layout
cnf) [(KeyMask, KeySym)]
keyList }

-- | 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 $ def { terminal = "urxvt" }
-- >                 `removeKeysP` ["M-S-" ++ [n] | n <- ['1'..'9']]

removeKeysP :: XConfig l -> [String] -> XConfig l
removeKeysP :: forall (l :: * -> *). XConfig l -> [String] -> XConfig l
removeKeysP XConfig l
conf [String]
keyList =
    XConfig l
conf { keys :: XConfig Layout -> Map (KeyMask, KeySym) (X ())
keys = \XConfig Layout
cnf -> XConfig l -> XConfig Layout -> Map (KeyMask, KeySym) (X ())
forall (l :: * -> *).
XConfig l -> XConfig Layout -> Map (KeyMask, KeySym) (X ())
keys XConfig l
conf XConfig Layout
cnf Map (KeyMask, KeySym) (X ())
-> Map (KeyMask, KeySym) (X ()) -> Map (KeyMask, KeySym) (X ())
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`M.difference` XConfig Layout -> [(String, X ())] -> Map (KeyMask, KeySym) (X ())
forall (l :: * -> *).
XConfig l -> [(String, X ())] -> Map (KeyMask, KeySym) (X ())
mkKeymap XConfig Layout
cnf ([String] -> [X ()] -> [(String, X ())]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
keyList ([X ()] -> [(String, X ())]) -> [X ()] -> [(String, X ())]
forall a b. (a -> b) -> a -> b
$ X () -> [X ()]
forall a. a -> [a]
repeat (() -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())) }

-- | Like 'additionalKeys', but for mouse bindings.
additionalMouseBindings :: XConfig a -> [((ButtonMask, Button), Window -> X ())] -> XConfig a
additionalMouseBindings :: forall (a :: * -> *).
XConfig a -> [((KeyMask, Button), KeySym -> X ())] -> XConfig a
additionalMouseBindings XConfig a
conf [((KeyMask, Button), KeySym -> X ())]
mouseBindingsList =
    XConfig a
conf { mouseBindings :: XConfig Layout -> Map (KeyMask, Button) (KeySym -> X ())
mouseBindings = Map (KeyMask, Button) (KeySym -> X ())
-> Map (KeyMask, Button) (KeySym -> X ())
-> Map (KeyMask, Button) (KeySym -> X ())
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union ([((KeyMask, Button), KeySym -> X ())]
-> Map (KeyMask, Button) (KeySym -> X ())
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [((KeyMask, Button), KeySym -> X ())]
mouseBindingsList) (Map (KeyMask, Button) (KeySym -> X ())
 -> Map (KeyMask, Button) (KeySym -> X ()))
-> (XConfig Layout -> Map (KeyMask, Button) (KeySym -> X ()))
-> XConfig Layout
-> Map (KeyMask, Button) (KeySym -> X ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConfig a
-> XConfig Layout -> Map (KeyMask, Button) (KeySym -> X ())
forall (l :: * -> *).
XConfig l
-> XConfig Layout -> Map (KeyMask, Button) (KeySym -> X ())
mouseBindings XConfig a
conf }

-- | Like 'removeKeys', but for mouse bindings.
removeMouseBindings :: XConfig a -> [(ButtonMask, Button)] -> XConfig a
removeMouseBindings :: forall (a :: * -> *). XConfig a -> [(KeyMask, Button)] -> XConfig a
removeMouseBindings XConfig a
conf [(KeyMask, Button)]
mouseBindingList =
    XConfig a
conf { mouseBindings :: XConfig Layout -> Map (KeyMask, Button) (KeySym -> X ())
mouseBindings = \XConfig Layout
cnf -> ((KeyMask, Button)
 -> Map (KeyMask, Button) (KeySym -> X ())
 -> Map (KeyMask, Button) (KeySym -> X ()))
-> Map (KeyMask, Button) (KeySym -> X ())
-> [(KeyMask, Button)]
-> Map (KeyMask, Button) (KeySym -> X ())
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (KeyMask, Button)
-> Map (KeyMask, Button) (KeySym -> X ())
-> Map (KeyMask, Button) (KeySym -> X ())
forall k a. Ord k => k -> Map k a -> Map k a
M.delete (XConfig a
-> XConfig Layout -> Map (KeyMask, Button) (KeySym -> X ())
forall (l :: * -> *).
XConfig l
-> XConfig Layout -> Map (KeyMask, Button) (KeySym -> X ())
mouseBindings XConfig a
conf XConfig Layout
cnf) [(KeyMask, Button)]
mouseBindingList }


--------------------------------------------------------------
--  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.  Note that if
--   you want to make a keybinding using \'alt\' even though you use a
--   different key (like the \'windows\' key) for \'mod\', you can use
--   something like @\"M1-x\"@ for alt+x (check the output of @xmodmap@
--   to see which mod key \'alt\' is bound to). Some special keys can
--   also be specified by enclosing their name in angle brackets.
--
--   For example, @\"M-C-x\"@ denotes mod+ctrl+x; @\"S-\<Escape\>\"@
--   denotes shift-escape; @\"M1-C-\<Delete\>\"@ denotes alt+ctrl+delete
--   (assuming alt is bound to mod1, which is common).
--
--   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.  If there are other
-- special keys you would like to see supported, feel free to submit a
-- patch, or ask on the xmonad mailing list; adding special keys is
-- quite simple.
--
-- > <Backspace>
-- > <Tab>
-- > <Return>
-- > <Pause>
-- > <Scroll_lock>
-- > <Sys_Req>
-- > <Print>
-- > <Escape>, <Esc>
-- > <Delete>
-- > <Home>
-- > <Left>, <L>
-- > <Up>, <U>
-- > <Right>, <R>
-- > <Down>, <D>
-- > <Page_Up>
-- > <Page_Down>
-- > <End>
-- > <Insert>
-- > <Break>
-- > <Space>
-- > <F1>-<F24>
-- > <KP_Space>
-- > <KP_Tab>
-- > <KP_Enter>
-- > <KP_F1>
-- > <KP_F2>
-- > <KP_F3>
-- > <KP_F4>
-- > <KP_Home>
-- > <KP_Left>
-- > <KP_Up>
-- > <KP_Right>
-- > <KP_Down>
-- > <KP_Prior>
-- > <KP_Page_Up>
-- > <KP_Next>
-- > <KP_Page_Down>
-- > <KP_End>
-- > <KP_Begin>
-- > <KP_Insert>
-- > <KP_Delete>
-- > <KP_Equal>
-- > <KP_Multiply>
-- > <KP_Add>
-- > <KP_Separator>
-- > <KP_Subtract>
-- > <KP_Decimal>
-- > <KP_Divide>
-- > <KP_0>-<KP_9>
--
-- Long list of multimedia keys. Please note that not all keys may be
-- present in your particular setup although most likely they will do.
--
-- > <XF86ModeLock>
-- > <XF86MonBrightnessUp>
-- > <XF86MonBrightnessDown>
-- > <XF86KbdLightOnOff>
-- > <XF86KbdBrightnessUp>
-- > <XF86KbdBrightnessDown>
-- > <XF86Standby>
-- > <XF86AudioLowerVolume>
-- > <XF86AudioMute>
-- > <XF86AudioRaiseVolume>
-- > <XF86AudioPlay>
-- > <XF86AudioStop>
-- > <XF86AudioPrev>
-- > <XF86AudioNext>
-- > <XF86HomePage>
-- > <XF86Mail>
-- > <XF86Start>
-- > <XF86Search>
-- > <XF86AudioRecord>
-- > <XF86Calculator>
-- > <XF86Memo>
-- > <XF86ToDoList>
-- > <XF86Calendar>
-- > <XF86PowerDown>
-- > <XF86ContrastAdjust>
-- > <XF86RockerUp>
-- > <XF86RockerDown>
-- > <XF86RockerEnter>
-- > <XF86Back>
-- > <XF86Forward>
-- > <XF86Stop>
-- > <XF86Refresh>
-- > <XF86PowerOff>
-- > <XF86WakeUp>
-- > <XF86Eject>
-- > <XF86ScreenSaver>
-- > <XF86WWW>
-- > <XF86Sleep>
-- > <XF86Favorites>
-- > <XF86AudioPause>
-- > <XF86AudioMedia>
-- > <XF86MyComputer>
-- > <XF86VendorHome>
-- > <XF86LightBulb>
-- > <XF86Shop>
-- > <XF86History>
-- > <XF86OpenURL>
-- > <XF86AddFavorite>
-- > <XF86HotLinks>
-- > <XF86BrightnessAdjust>
-- > <XF86Finance>
-- > <XF86Community>
-- > <XF86AudioRewind>
-- > <XF86XF86BackForward>
-- > <XF86Launch0>-<XF86Launch9>, <XF86LaunchA>-<XF86LaunchF>
-- > <XF86ApplicationLeft>
-- > <XF86ApplicationRight>
-- > <XF86Book>
-- > <XF86CD>
-- > <XF86Calculater>
-- > <XF86Clear>
-- > <XF86Close>
-- > <XF86Copy>
-- > <XF86Cut>
-- > <XF86Display>
-- > <XF86DOS>
-- > <XF86Documents>
-- > <XF86Excel>
-- > <XF86Explorer>
-- > <XF86Game>
-- > <XF86Go>
-- > <XF86iTouch>
-- > <XF86LogOff>
-- > <XF86Market>
-- > <XF86Meeting>
-- > <XF86MenuKB>
-- > <XF86MenuPB>
-- > <XF86MySites>
-- > <XF86New>
-- > <XF86News>
-- > <XF86OfficeHome>
-- > <XF86Open>
-- > <XF86Option>
-- > <XF86Paste>
-- > <XF86Phone>
-- > <XF86Q>
-- > <XF86Reply>
-- > <XF86Reload>
-- > <XF86RotateWindows>
-- > <XF86RotationPB>
-- > <XF86RotationKB>
-- > <XF86Save>
-- > <XF86ScrollUp>
-- > <XF86ScrollDown>
-- > <XF86ScrollClick>
-- > <XF86Send>
-- > <XF86Spell>
-- > <XF86SplitScreen>
-- > <XF86Support>
-- > <XF86TaskPane>
-- > <XF86Terminal>
-- > <XF86Tools>
-- > <XF86Travel>
-- > <XF86UserPB>
-- > <XF86User1KB>
-- > <XF86User2KB>
-- > <XF86Video>
-- > <XF86WheelButton>
-- > <XF86Word>
-- > <XF86Xfer>
-- > <XF86ZoomIn>
-- > <XF86ZoomOut>
-- > <XF86Away>
-- > <XF86Messenger>
-- > <XF86WebCam>
-- > <XF86MailForward>
-- > <XF86Pictures>
-- > <XF86Music>
-- > <XF86TouchpadToggle>
-- > <XF86AudioMicMute>
-- > <XF86_Switch_VT_1>-<XF86_Switch_VT_12>
-- > <XF86_Ungrab>
-- > <XF86_ClearGrab>
-- > <XF86_Next_VMode>
-- > <XF86_Prev_VMode>
-- > <XF86Bluetooth>

mkKeymap :: XConfig l -> [(String, X ())] -> M.Map (KeyMask, KeySym) (X ())
mkKeymap :: forall (l :: * -> *).
XConfig l -> [(String, X ())] -> Map (KeyMask, KeySym) (X ())
mkKeymap XConfig l
c = [((KeyMask, KeySym), X ())] -> Map (KeyMask, KeySym) (X ())
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([((KeyMask, KeySym), X ())] -> Map (KeyMask, KeySym) (X ()))
-> ([(String, X ())] -> [((KeyMask, KeySym), X ())])
-> [(String, X ())]
-> Map (KeyMask, KeySym) (X ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([(KeyMask, KeySym)], X ())] -> [((KeyMask, KeySym), X ())]
mkSubmaps ([([(KeyMask, KeySym)], X ())] -> [((KeyMask, KeySym), X ())])
-> ([(String, X ())] -> [([(KeyMask, KeySym)], X ())])
-> [(String, X ())]
-> [((KeyMask, KeySym), X ())]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConfig l -> [(String, X ())] -> [([(KeyMask, KeySym)], X ())]
forall (l :: * -> *) t.
XConfig l -> [(String, t)] -> [([(KeyMask, KeySym)], t)]
readKeymap XConfig l
c

mkNamedKeymap :: XConfig l -> [(String, NamedAction)] -> [((KeyMask, KeySym), NamedAction)]
mkNamedKeymap :: forall (l :: * -> *).
XConfig l
-> [(String, NamedAction)] -> [((KeyMask, KeySym), NamedAction)]
mkNamedKeymap XConfig l
c = [([(KeyMask, KeySym)], NamedAction)]
-> [((KeyMask, KeySym), NamedAction)]
mkNamedSubmaps ([([(KeyMask, KeySym)], NamedAction)]
 -> [((KeyMask, KeySym), NamedAction)])
-> ([(String, NamedAction)]
    -> [([(KeyMask, KeySym)], NamedAction)])
-> [(String, NamedAction)]
-> [((KeyMask, KeySym), NamedAction)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConfig l
-> [(String, NamedAction)] -> [([(KeyMask, KeySym)], NamedAction)]
forall (l :: * -> *) t.
XConfig l -> [(String, t)] -> [([(KeyMask, KeySym)], t)]
readKeymap XConfig l
c

-- | Given a list of pairs of parsed key sequences and actions,
--   group them into submaps in the appropriate way.

mkNamedSubmaps :: [([(KeyMask, KeySym)], NamedAction)] -> [((KeyMask, KeySym), NamedAction)]
mkNamedSubmaps :: [([(KeyMask, KeySym)], NamedAction)]
-> [((KeyMask, KeySym), NamedAction)]
mkNamedSubmaps = ([((KeyMask, KeySym), NamedAction)] -> NamedAction)
-> [([(KeyMask, KeySym)], NamedAction)]
-> [((KeyMask, KeySym), NamedAction)]
forall a c. Ord a => ([(a, c)] -> c) -> [([a], c)] -> [(a, c)]
mkSubmaps' [((KeyMask, KeySym), NamedAction)] -> NamedAction
forall a. HasName a => [((KeyMask, KeySym), a)] -> NamedAction
submapName

mkSubmaps :: [ ([(KeyMask,KeySym)], X ()) ] -> [((KeyMask, KeySym), X ())]
mkSubmaps :: [([(KeyMask, KeySym)], X ())] -> [((KeyMask, KeySym), X ())]
mkSubmaps = ([((KeyMask, KeySym), X ())] -> X ())
-> [([(KeyMask, KeySym)], X ())] -> [((KeyMask, KeySym), X ())]
forall a c. Ord a => ([(a, c)] -> c) -> [([a], c)] -> [(a, c)]
mkSubmaps' (([((KeyMask, KeySym), X ())] -> X ())
 -> [([(KeyMask, KeySym)], X ())] -> [((KeyMask, KeySym), X ())])
-> ([((KeyMask, KeySym), X ())] -> X ())
-> [([(KeyMask, KeySym)], X ())]
-> [((KeyMask, KeySym), X ())]
forall a b. (a -> b) -> a -> b
$ Map (KeyMask, KeySym) (X ()) -> X ()
submap (Map (KeyMask, KeySym) (X ()) -> X ())
-> ([((KeyMask, KeySym), X ())] -> Map (KeyMask, KeySym) (X ()))
-> [((KeyMask, KeySym), X ())]
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [((KeyMask, KeySym), X ())] -> Map (KeyMask, KeySym) (X ())
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList

mkSubmaps' ::  (Ord a) => ([(a, c)] -> c) -> [([a], c)] -> [(a, c)]
mkSubmaps' :: forall a c. Ord a => ([(a, c)] -> c) -> [([a], c)] -> [(a, c)]
mkSubmaps' [(a, c)] -> c
subm [([a], c)]
binds = ([([a], c)] -> (a, c)) -> [[([a], c)]] -> [(a, c)]
forall a b. (a -> b) -> [a] -> [b]
map [([a], c)] -> (a, c)
combine [[([a], c)]]
gathered
  where gathered :: [[([a], c)]]
gathered = (([a], c) -> ([a], c) -> Bool) -> [([a], c)] -> [[([a], c)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy ([a], c) -> ([a], c) -> Bool
forall {b}. ([a], b) -> ([a], b) -> Bool
fstKey
                 ([([a], c)] -> [[([a], c)]])
-> ([([a], c)] -> [([a], c)]) -> [([a], c)] -> [[([a], c)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([a], c) -> ([a], c) -> Ordering) -> [([a], c)] -> [([a], c)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((([a], c) -> [a]) -> ([a], c) -> ([a], c) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ([a], c) -> [a]
forall a b. (a, b) -> a
fst)
                 ([([a], c)] -> [[([a], c)]]) -> [([a], c)] -> [[([a], c)]]
forall a b. (a -> b) -> a -> b
$ [([a], c)]
binds
        combine :: [([a], c)] -> (a, c)
combine [([a
k],c
act)] = (a
k,c
act)
        combine [([a], c)]
ks = ([a] -> a
forall a. [a] -> a
head ([a] -> a) -> ([([a], c)] -> [a]) -> [([a], c)] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a], c) -> [a]
forall a b. (a, b) -> a
fst (([a], c) -> [a]) -> ([([a], c)] -> ([a], c)) -> [([a], c)] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([a], c)] -> ([a], c)
forall a. [a] -> a
head ([([a], c)] -> a) -> [([a], c)] -> a
forall a b. (a -> b) -> a -> b
$ [([a], c)]
ks,
                      [(a, c)] -> c
subm ([(a, c)] -> c) -> ([([a], c)] -> [(a, c)]) -> [([a], c)] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(a, c)] -> c) -> [([a], c)] -> [(a, c)]
forall a c. Ord a => ([(a, c)] -> c) -> [([a], c)] -> [(a, c)]
mkSubmaps' [(a, c)] -> c
subm ([([a], c)] -> c) -> [([a], c)] -> c
forall a b. (a -> b) -> a -> b
$ (([a], c) -> ([a], c)) -> [([a], c)] -> [([a], c)]
forall a b. (a -> b) -> [a] -> [b]
map (([a] -> [a]) -> ([a], c) -> ([a], c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first [a] -> [a]
forall a. [a] -> [a]
tail) [([a], c)]
ks)
        fstKey :: ([a], b) -> ([a], b) -> Bool
fstKey = a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) (a -> a -> Bool) -> (([a], b) -> a) -> ([a], b) -> ([a], b) -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ([a] -> a
forall a. [a] -> a
head ([a] -> a) -> (([a], b) -> [a]) -> ([a], b) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a], b) -> [a]
forall a b. (a, b) -> a
fst)

-- | 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, t)] -> [([(KeyMask, KeySym)], t)]
readKeymap :: forall (l :: * -> *) t.
XConfig l -> [(String, t)] -> [([(KeyMask, KeySym)], t)]
readKeymap XConfig l
c = ((String, t) -> Maybe ([(KeyMask, KeySym)], t))
-> [(String, t)] -> [([(KeyMask, KeySym)], t)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Maybe [(KeyMask, KeySym)], t) -> Maybe ([(KeyMask, KeySym)], t)
forall {a} {b}. (Maybe a, b) -> Maybe (a, b)
maybeKeys ((Maybe [(KeyMask, KeySym)], t) -> Maybe ([(KeyMask, KeySym)], t))
-> ((String, t) -> (Maybe [(KeyMask, KeySym)], t))
-> (String, t)
-> Maybe ([(KeyMask, KeySym)], t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe [(KeyMask, KeySym)])
-> (String, t) -> (Maybe [(KeyMask, KeySym)], t)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (XConfig l -> String -> Maybe [(KeyMask, KeySym)]
forall (l :: * -> *).
XConfig l -> String -> Maybe [(KeyMask, KeySym)]
readKeySequence XConfig l
c))
  where maybeKeys :: (Maybe a, b) -> Maybe (a, b)
maybeKeys (Maybe a
Nothing,b
_) = Maybe (a, b)
forall a. Maybe a
Nothing
        maybeKeys (Just a
k, b
act) = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
k, b
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 :: forall (l :: * -> *).
XConfig l -> String -> Maybe [(KeyMask, KeySym)]
readKeySequence XConfig l
c = [[(KeyMask, KeySym)]] -> Maybe [(KeyMask, KeySym)]
forall a. [a] -> Maybe a
listToMaybe ([[(KeyMask, KeySym)]] -> Maybe [(KeyMask, KeySym)])
-> (String -> [[(KeyMask, KeySym)]])
-> String
-> Maybe [(KeyMask, KeySym)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[(KeyMask, KeySym)]]
parses
  where parses :: String -> [[(KeyMask, KeySym)]]
parses = (([(KeyMask, KeySym)], String) -> [(KeyMask, KeySym)])
-> [([(KeyMask, KeySym)], String)] -> [[(KeyMask, KeySym)]]
forall a b. (a -> b) -> [a] -> [b]
map ([(KeyMask, KeySym)], String) -> [(KeyMask, KeySym)]
forall a b. (a, b) -> a
fst ([([(KeyMask, KeySym)], String)] -> [[(KeyMask, KeySym)]])
-> (String -> [([(KeyMask, KeySym)], String)])
-> String
-> [[(KeyMask, KeySym)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([(KeyMask, KeySym)], String) -> Bool)
-> [([(KeyMask, KeySym)], String)]
-> [([(KeyMask, KeySym)], String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null(String -> Bool)
-> (([(KeyMask, KeySym)], String) -> String)
-> ([(KeyMask, KeySym)], String)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([(KeyMask, KeySym)], String) -> String
forall a b. (a, b) -> b
snd) ([([(KeyMask, KeySym)], String)]
 -> [([(KeyMask, KeySym)], String)])
-> (String -> [([(KeyMask, KeySym)], String)])
-> String
-> [([(KeyMask, KeySym)], String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadP [(KeyMask, KeySym)]
-> String -> [([(KeyMask, KeySym)], String)]
forall a. ReadP a -> ReadS a
readP_to_S (XConfig l -> ReadP [(KeyMask, KeySym)]
forall (l :: * -> *). XConfig l -> ReadP [(KeyMask, KeySym)]
parseKeySequence XConfig l
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 :: forall (l :: * -> *). XConfig l -> ReadP [(KeyMask, KeySym)]
parseKeySequence XConfig l
c = ReadP (KeyMask, KeySym)
-> ReadP String -> ReadP [(KeyMask, KeySym)]
forall a sep. ReadP a -> ReadP sep -> ReadP [a]
sepBy1 (XConfig l -> ReadP (KeyMask, KeySym)
forall (l :: * -> *). XConfig l -> ReadP (KeyMask, KeySym)
parseKeyCombo XConfig l
c) (ReadP Char -> ReadP String
forall a. ReadP a -> ReadP [a]
many1 (ReadP Char -> ReadP String) -> ReadP Char -> ReadP String
forall a b. (a -> b) -> a -> b
$ Char -> ReadP Char
char Char
' ')

-- | Parse a modifier-key combination such as "M-C-s" (mod+ctrl+s).
parseKeyCombo :: XConfig l -> ReadP (KeyMask, KeySym)
parseKeyCombo :: forall (l :: * -> *). XConfig l -> ReadP (KeyMask, KeySym)
parseKeyCombo XConfig l
c = do [KeyMask]
mods <- ReadP KeyMask -> ReadP [KeyMask]
forall a. ReadP a -> ReadP [a]
many (XConfig l -> ReadP KeyMask
forall (l :: * -> *). XConfig l -> ReadP KeyMask
parseModifier XConfig l
c)
                     KeySym
k <- ReadP KeySym
parseKey
                     (KeyMask, KeySym) -> ReadP (KeyMask, KeySym)
forall (m :: * -> *) a. Monad m => a -> m a
return ((KeyMask -> KeyMask -> KeyMask) -> KeyMask -> [KeyMask] -> KeyMask
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
(.|.) KeyMask
0 [KeyMask]
mods, KeySym
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 :: forall (l :: * -> *). XConfig l -> ReadP KeyMask
parseModifier XConfig l
c =  (String -> ReadP String
string String
"M-" ReadP String -> ReadP KeyMask -> ReadP KeyMask
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> KeyMask -> ReadP KeyMask
forall (m :: * -> *) a. Monad m => a -> m a
return (XConfig l -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig l
c))
               ReadP KeyMask -> ReadP KeyMask -> ReadP KeyMask
forall a. ReadP a -> ReadP a -> ReadP a
+++ (String -> ReadP String
string String
"C-" ReadP String -> ReadP KeyMask -> ReadP KeyMask
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> KeyMask -> ReadP KeyMask
forall (m :: * -> *) a. Monad m => a -> m a
return KeyMask
controlMask)
               ReadP KeyMask -> ReadP KeyMask -> ReadP KeyMask
forall a. ReadP a -> ReadP a -> ReadP a
+++ (String -> ReadP String
string String
"S-" ReadP String -> ReadP KeyMask -> ReadP KeyMask
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> KeyMask -> ReadP KeyMask
forall (m :: * -> *) a. Monad m => a -> m a
return KeyMask
shiftMask)
               ReadP KeyMask -> ReadP KeyMask -> ReadP KeyMask
forall a. ReadP a -> ReadP a -> ReadP a
+++ do Char
_ <- Char -> ReadP Char
char Char
'M'
                      Char
n <- (Char -> Bool) -> ReadP Char
satisfy (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'1'..Char
'5'])
                      Char
_ <- Char -> ReadP Char
char Char
'-'
                      KeyMask -> ReadP KeyMask
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyMask -> ReadP KeyMask) -> KeyMask -> ReadP KeyMask
forall a b. (a -> b) -> a -> b
$ Int -> KeyMask
indexMod (String -> Int
forall a. Read a => String -> a
read [Char
n] Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    where indexMod :: Int -> KeyMask
indexMod = [KeyMask] -> Int -> KeyMask
forall a. [a] -> Int -> a
(!!) [KeyMask
mod1Mask,KeyMask
mod2Mask,KeyMask
mod3Mask,KeyMask
mod4Mask,KeyMask
mod5Mask]

-- | Parse an unmodified basic key, like @\"x\"@, @\"<F1>\"@, etc.
parseKey :: ReadP KeySym
parseKey :: ReadP KeySym
parseKey = ReadP KeySym
parseRegular ReadP KeySym -> ReadP KeySym -> ReadP KeySym
forall a. ReadP a -> ReadP a -> ReadP a
+++ ReadP KeySym
parseSpecial

-- | Parse a regular key name (represented by itself).
parseRegular :: ReadP KeySym
parseRegular :: ReadP KeySym
parseRegular = [ReadP KeySym] -> ReadP KeySym
forall a. [ReadP a] -> ReadP a
choice [ Char -> ReadP Char
char Char
s ReadP Char -> ReadP KeySym -> ReadP KeySym
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> KeySym -> ReadP KeySym
forall (m :: * -> *) a. Monad m => a -> m a
return KeySym
k
                      | (Char
s,KeySym
k) <- String -> [KeySym] -> [(Char, KeySym)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Char
'!'             .. Char
'~'          ] -- ASCII
                                     [KeySym
xK_exclam       .. KeySym
xK_asciitilde]

                              [(Char, KeySym)] -> [(Char, KeySym)] -> [(Char, KeySym)]
forall a. [a] -> [a] -> [a]
++ String -> [KeySym] -> [(Char, KeySym)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Char
'\xa0'          .. Char
'\xff'       ] -- Latin1
                                     [KeySym
xK_nobreakspace .. KeySym
xK_ydiaeresis]
                      ]

-- | Parse a special key name (one enclosed in angle brackets).
parseSpecial :: ReadP KeySym
parseSpecial :: ReadP KeySym
parseSpecial = do Char
_   <- Char -> ReadP Char
char Char
'<'
                  KeySym
key <- [ReadP KeySym] -> ReadP KeySym
forall a. [ReadP a] -> ReadP a
choice [ String -> ReadP String
string String
name ReadP String -> ReadP KeySym -> ReadP KeySym
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> KeySym -> ReadP KeySym
forall (m :: * -> *) a. Monad m => a -> m a
return KeySym
k
                                | (String
name,KeySym
k) <- [(String, KeySym)]
keyNames
                                ]
                  Char
_   <- Char -> ReadP Char
char Char
'>'
                  KeySym -> ReadP KeySym
forall (m :: * -> *) a. Monad m => a -> m a
return KeySym
key

-- | A list of all special key names and their associated KeySyms.
keyNames :: [(String, KeySym)]
keyNames :: [(String, KeySym)]
keyNames = [(String, KeySym)]
functionKeys [(String, KeySym)] -> [(String, KeySym)] -> [(String, KeySym)]
forall a. [a] -> [a] -> [a]
++ [(String, KeySym)]
specialKeys [(String, KeySym)] -> [(String, KeySym)] -> [(String, KeySym)]
forall a. [a] -> [a] -> [a]
++ [(String, KeySym)]
multimediaKeys

-- | A list pairing function key descriptor strings (e.g. @\"<F2>\"@) with
--   the associated KeySyms.
functionKeys :: [(String, KeySym)]
functionKeys :: [(String, KeySym)]
functionKeys = [ (Char
'F' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
n, KeySym
k)
               | (Int
n,KeySym
k) <- [Int] -> [KeySym] -> [(Int, KeySym)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int
1..Int
24] :: [Int]) [KeySym
xK_F1..] ]

-- | A list of special key names and their corresponding KeySyms.
specialKeys :: [(String, KeySym)]
specialKeys :: [(String, KeySym)]
specialKeys = [ (String
"Backspace"  , KeySym
xK_BackSpace)
              , (String
"Tab"        , KeySym
xK_Tab)
              , (String
"Return"     , KeySym
xK_Return)
              , (String
"Pause"      , KeySym
xK_Pause)
              , (String
"Scroll_lock", KeySym
xK_Scroll_Lock)
              , (String
"Sys_Req"    , KeySym
xK_Sys_Req)
              , (String
"Print"      , KeySym
xK_Print)
              , (String
"Escape"     , KeySym
xK_Escape)
              , (String
"Esc"        , KeySym
xK_Escape)
              , (String
"Delete"     , KeySym
xK_Delete)
              , (String
"Home"       , KeySym
xK_Home)
              , (String
"Left"       , KeySym
xK_Left)
              , (String
"Up"         , KeySym
xK_Up)
              , (String
"Right"      , KeySym
xK_Right)
              , (String
"Down"       , KeySym
xK_Down)
              , (String
"L"          , KeySym
xK_Left)
              , (String
"U"          , KeySym
xK_Up)
              , (String
"R"          , KeySym
xK_Right)
              , (String
"D"          , KeySym
xK_Down)
              , (String
"Page_Up"    , KeySym
xK_Page_Up)
              , (String
"Page_Down"  , KeySym
xK_Page_Down)
              , (String
"End"        , KeySym
xK_End)
              , (String
"Insert"     , KeySym
xK_Insert)
              , (String
"Break"      , KeySym
xK_Break)
              , (String
"Space"      , KeySym
xK_space)
              , (String
"KP_Space"   , KeySym
xK_KP_Space)
              , (String
"KP_Tab"     , KeySym
xK_KP_Tab)
              , (String
"KP_Enter"   , KeySym
xK_KP_Enter)
              , (String
"KP_F1"      , KeySym
xK_KP_F1)
              , (String
"KP_F2"      , KeySym
xK_KP_F2)
              , (String
"KP_F3"      , KeySym
xK_KP_F3)
              , (String
"KP_F4"      , KeySym
xK_KP_F4)
              , (String
"KP_Home"    , KeySym
xK_KP_Home)
              , (String
"KP_Left"    , KeySym
xK_KP_Left)
              , (String
"KP_Up"      , KeySym
xK_KP_Up)
              , (String
"KP_Right"   , KeySym
xK_KP_Right)
              , (String
"KP_Down"    , KeySym
xK_KP_Down)
              , (String
"KP_Prior"   , KeySym
xK_KP_Prior)
              , (String
"KP_Page_Up" , KeySym
xK_KP_Page_Up)
              , (String
"KP_Next"    , KeySym
xK_KP_Next)
              , (String
"KP_Page_Down", KeySym
xK_KP_Page_Down)
              , (String
"KP_End"     , KeySym
xK_KP_End)
              , (String
"KP_Begin"   , KeySym
xK_KP_Begin)
              , (String
"KP_Insert"  , KeySym
xK_KP_Insert)
              , (String
"KP_Delete"  , KeySym
xK_KP_Delete)
              , (String
"KP_Equal"   , KeySym
xK_KP_Equal)
              , (String
"KP_Multiply", KeySym
xK_KP_Multiply)
              , (String
"KP_Add"     , KeySym
xK_KP_Add)
              , (String
"KP_Separator", KeySym
xK_KP_Separator)
              , (String
"KP_Subtract", KeySym
xK_KP_Subtract)
              , (String
"KP_Decimal" , KeySym
xK_KP_Decimal)
              , (String
"KP_Divide"  , KeySym
xK_KP_Divide)
              , (String
"KP_0"       , KeySym
xK_KP_0)
              , (String
"KP_1"       , KeySym
xK_KP_1)
              , (String
"KP_2"       , KeySym
xK_KP_2)
              , (String
"KP_3"       , KeySym
xK_KP_3)
              , (String
"KP_4"       , KeySym
xK_KP_4)
              , (String
"KP_5"       , KeySym
xK_KP_5)
              , (String
"KP_6"       , KeySym
xK_KP_6)
              , (String
"KP_7"       , KeySym
xK_KP_7)
              , (String
"KP_8"       , KeySym
xK_KP_8)
              , (String
"KP_9"       , KeySym
xK_KP_9)
              ]

-- | List of multimedia keys. If X server does not know about some
-- | keysym it's omitted from list. (stringToKeysym returns noSymbol in this case)
multimediaKeys :: [(String, KeySym)]
multimediaKeys :: [(String, KeySym)]
multimediaKeys = ((String, KeySym) -> Bool)
-> [(String, KeySym)] -> [(String, KeySym)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((KeySym -> KeySym -> Bool
forall a. Eq a => a -> a -> Bool
/= KeySym
noSymbol) (KeySym -> Bool)
-> ((String, KeySym) -> KeySym) -> (String, KeySym) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, KeySym) -> KeySym
forall a b. (a, b) -> b
snd) ([(String, KeySym)] -> [(String, KeySym)])
-> ([String] -> [(String, KeySym)])
-> [String]
-> [(String, KeySym)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> (String, KeySym)) -> [String] -> [(String, KeySym)]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String
forall a. a -> a
id (String -> String)
-> (String -> KeySym) -> String -> (String, KeySym)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& String -> KeySym
stringToKeysym) ([String] -> [(String, KeySym)]) -> [String] -> [(String, KeySym)]
forall a b. (a -> b) -> a -> b
$
                 [ String
"XF86ModeLock"
                 , String
"XF86MonBrightnessUp"
                 , String
"XF86MonBrightnessDown"
                 , String
"XF86KbdLightOnOff"
                 , String
"XF86KbdBrightnessUp"
                 , String
"XF86KbdBrightnessDown"
                 , String
"XF86Standby"
                 , String
"XF86AudioLowerVolume"
                 , String
"XF86AudioMute"
                 , String
"XF86AudioRaiseVolume"
                 , String
"XF86AudioPlay"
                 , String
"XF86AudioStop"
                 , String
"XF86AudioPrev"
                 , String
"XF86AudioNext"
                 , String
"XF86HomePage"
                 , String
"XF86Mail"
                 , String
"XF86Start"
                 , String
"XF86Search"
                 , String
"XF86AudioRecord"
                 , String
"XF86Calculator"
                 , String
"XF86Memo"
                 , String
"XF86ToDoList"
                 , String
"XF86Calendar"
                 , String
"XF86PowerDown"
                 , String
"XF86ContrastAdjust"
                 , String
"XF86RockerUp"
                 , String
"XF86RockerDown"
                 , String
"XF86RockerEnter"
                 , String
"XF86Back"
                 , String
"XF86Forward"
                 , String
"XF86Stop"
                 , String
"XF86Refresh"
                 , String
"XF86PowerOff"
                 , String
"XF86WakeUp"
                 , String
"XF86Eject"
                 , String
"XF86ScreenSaver"
                 , String
"XF86WWW"
                 , String
"XF86Sleep"
                 , String
"XF86Favorites"
                 , String
"XF86AudioPause"
                 , String
"XF86AudioMedia"
                 , String
"XF86MyComputer"
                 , String
"XF86VendorHome"
                 , String
"XF86LightBulb"
                 , String
"XF86Shop"
                 , String
"XF86History"
                 , String
"XF86OpenURL"
                 , String
"XF86AddFavorite"
                 , String
"XF86HotLinks"
                 , String
"XF86BrightnessAdjust"
                 , String
"XF86Finance"
                 , String
"XF86Community"
                 , String
"XF86AudioRewind"
                 , String
"XF86BackForward"
                 , String
"XF86Launch0"
                 , String
"XF86Launch1"
                 , String
"XF86Launch2"
                 , String
"XF86Launch3"
                 , String
"XF86Launch4"
                 , String
"XF86Launch5"
                 , String
"XF86Launch6"
                 , String
"XF86Launch7"
                 , String
"XF86Launch8"
                 , String
"XF86Launch9"
                 , String
"XF86LaunchA"
                 , String
"XF86LaunchB"
                 , String
"XF86LaunchC"
                 , String
"XF86LaunchD"
                 , String
"XF86LaunchE"
                 , String
"XF86LaunchF"
                 , String
"XF86ApplicationLeft"
                 , String
"XF86ApplicationRight"
                 , String
"XF86Book"
                 , String
"XF86CD"
                 , String
"XF86Calculater"
                 , String
"XF86Clear"
                 , String
"XF86Close"
                 , String
"XF86Copy"
                 , String
"XF86Cut"
                 , String
"XF86Display"
                 , String
"XF86DOS"
                 , String
"XF86Documents"
                 , String
"XF86Excel"
                 , String
"XF86Explorer"
                 , String
"XF86Game"
                 , String
"XF86Go"
                 , String
"XF86iTouch"
                 , String
"XF86LogOff"
                 , String
"XF86Market"
                 , String
"XF86Meeting"
                 , String
"XF86MenuKB"
                 , String
"XF86MenuPB"
                 , String
"XF86MySites"
                 , String
"XF86New"
                 , String
"XF86News"
                 , String
"XF86OfficeHome"
                 , String
"XF86Open"
                 , String
"XF86Option"
                 , String
"XF86Paste"
                 , String
"XF86Phone"
                 , String
"XF86Q"
                 , String
"XF86Reply"
                 , String
"XF86Reload"
                 , String
"XF86RotateWindows"
                 , String
"XF86RotationPB"
                 , String
"XF86RotationKB"
                 , String
"XF86Save"
                 , String
"XF86ScrollUp"
                 , String
"XF86ScrollDown"
                 , String
"XF86ScrollClick"
                 , String
"XF86Send"
                 , String
"XF86Spell"
                 , String
"XF86SplitScreen"
                 , String
"XF86Support"
                 , String
"XF86TaskPane"
                 , String
"XF86Terminal"
                 , String
"XF86Tools"
                 , String
"XF86Travel"
                 , String
"XF86UserPB"
                 , String
"XF86User1KB"
                 , String
"XF86User2KB"
                 , String
"XF86Video"
                 , String
"XF86WheelButton"
                 , String
"XF86Word"
                 , String
"XF86Xfer"
                 , String
"XF86ZoomIn"
                 , String
"XF86ZoomOut"
                 , String
"XF86Away"
                 , String
"XF86Messenger"
                 , String
"XF86WebCam"
                 , String
"XF86MailForward"
                 , String
"XF86Pictures"
                 , String
"XF86Music"
                 , String
"XF86TouchpadToggle"
                 , String
"XF86AudioMicMute"
                 , String
"XF86_Switch_VT_1"
                 , String
"XF86_Switch_VT_2"
                 , String
"XF86_Switch_VT_3"
                 , String
"XF86_Switch_VT_4"
                 , String
"XF86_Switch_VT_5"
                 , String
"XF86_Switch_VT_6"
                 , String
"XF86_Switch_VT_7"
                 , String
"XF86_Switch_VT_8"
                 , String
"XF86_Switch_VT_9"
                 , String
"XF86_Switch_VT_10"
                 , String
"XF86_Switch_VT_11"
                 , String
"XF86_Switch_VT_12"
                 , String
"XF86_Ungrab"
                 , String
"XF86_ClearGrab"
                 , String
"XF86_Next_VMode"
                 , String
"XF86_Prev_VMode"
                 , String
"XF86Bluetooth" ]

-- | 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 = def {
-- >     ...
-- >     keys = \c -> mkKeymap c myKeymap
-- >     startupHook = return () >> checkKeymap myConfig myKeymap
-- >     ...
-- > }
--
-- NOTE: the @return ()@ in the example above is very important!
-- Otherwise, you might run into problems with infinite mutual
-- recursion: the definition of myConfig depends on the definition of
-- startupHook, which depends on the definition of myConfig, ... and
-- so on.  Actually, it's likely that the above example in particular
-- would be OK without the @return ()@, but making @myKeymap@ take
-- @myConfig@ as a parameter would definitely lead to
-- problems. Believe me.  It, uh, happened to my friend. In... a
-- dream. Yeah. In any event, the @return () >>@ introduces enough
-- laziness to break the deadlock.
--
checkKeymap :: XConfig l -> [(String, a)] -> X ()
checkKeymap :: forall (l :: * -> *) a. XConfig l -> [(String, a)] -> X ()
checkKeymap XConfig l
conf [(String, a)]
km = ([String], [String]) -> X ()
forall {m :: * -> *}. MonadIO m => ([String], [String]) -> m ()
warn (XConfig l -> [(String, a)] -> ([String], [String])
forall (l :: * -> *) a.
XConfig l -> [(String, a)] -> ([String], [String])
doKeymapCheck XConfig l
conf [(String, a)]
km)
  where warn :: ([String], [String]) -> m ()
warn ([],[])   = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        warn ([String]
bad,[String]
dup) = String -> m ()
forall (m :: * -> *). MonadIO m => String -> m ()
xmessage (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Warning:\n"
                            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
msg String
"bad" [String]
bad String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
                            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
msg String
"duplicate" [String]
dup
        msg :: String -> [String] -> String
msg String
_ [] = String
""
        msg String
m [String]
xs = String
m String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" keybindings detected: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
showBindings [String]
xs
        showBindings :: [String] -> String
showBindings = [String] -> String
unwords ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String
"\""String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\""))

-- | 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 :: forall (l :: * -> *) a.
XConfig l -> [(String, a)] -> ([String], [String])
doKeymapCheck XConfig l
conf [(String, a)]
km = ([String]
bad,[String]
dups)
  where ks :: [(Maybe [(KeyMask, KeySym)], String)]
ks = ((String, a) -> (Maybe [(KeyMask, KeySym)], String))
-> [(String, a)] -> [(Maybe [(KeyMask, KeySym)], String)]
forall a b. (a -> b) -> [a] -> [b]
map ((XConfig l -> String -> Maybe [(KeyMask, KeySym)]
forall (l :: * -> *).
XConfig l -> String -> Maybe [(KeyMask, KeySym)]
readKeySequence XConfig l
conf (String -> Maybe [(KeyMask, KeySym)])
-> (String -> String)
-> String
-> (Maybe [(KeyMask, KeySym)], String)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& String -> String
forall a. a -> a
id) (String -> (Maybe [(KeyMask, KeySym)], String))
-> ((String, a) -> String)
-> (String, a)
-> (Maybe [(KeyMask, KeySym)], String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, a) -> String
forall a b. (a, b) -> a
fst) [(String, a)]
km
        bad :: [String]
bad = [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String])
-> ([(Maybe [(KeyMask, KeySym)], String)] -> [String])
-> [(Maybe [(KeyMask, KeySym)], String)]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe [(KeyMask, KeySym)], String) -> String)
-> [(Maybe [(KeyMask, KeySym)], String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe [(KeyMask, KeySym)], String) -> String
forall a b. (a, b) -> b
snd ([(Maybe [(KeyMask, KeySym)], String)] -> [String])
-> ([(Maybe [(KeyMask, KeySym)], String)]
    -> [(Maybe [(KeyMask, KeySym)], String)])
-> [(Maybe [(KeyMask, KeySym)], String)]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe [(KeyMask, KeySym)], String) -> Bool)
-> [(Maybe [(KeyMask, KeySym)], String)]
-> [(Maybe [(KeyMask, KeySym)], String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe [(KeyMask, KeySym)] -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe [(KeyMask, KeySym)] -> Bool)
-> ((Maybe [(KeyMask, KeySym)], String)
    -> Maybe [(KeyMask, KeySym)])
-> (Maybe [(KeyMask, KeySym)], String)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe [(KeyMask, KeySym)], String) -> Maybe [(KeyMask, KeySym)]
forall a b. (a, b) -> a
fst) ([(Maybe [(KeyMask, KeySym)], String)] -> [String])
-> [(Maybe [(KeyMask, KeySym)], String)] -> [String]
forall a b. (a -> b) -> a -> b
$ [(Maybe [(KeyMask, KeySym)], String)]
ks
        dups :: [String]
dups = ([([(KeyMask, KeySym)], String)] -> String)
-> [[([(KeyMask, KeySym)], String)]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (([(KeyMask, KeySym)], String) -> String
forall a b. (a, b) -> b
snd (([(KeyMask, KeySym)], String) -> String)
-> ([([(KeyMask, KeySym)], String)]
    -> ([(KeyMask, KeySym)], String))
-> [([(KeyMask, KeySym)], String)]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([(KeyMask, KeySym)], String)] -> ([(KeyMask, KeySym)], String)
forall a. [a] -> a
head)
             ([[([(KeyMask, KeySym)], String)]] -> [String])
-> ([(Maybe [(KeyMask, KeySym)], String)]
    -> [[([(KeyMask, KeySym)], String)]])
-> [(Maybe [(KeyMask, KeySym)], String)]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([([(KeyMask, KeySym)], String)] -> Bool)
-> [[([(KeyMask, KeySym)], String)]]
-> [[([(KeyMask, KeySym)], String)]]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
1) (Int -> Bool)
-> ([([(KeyMask, KeySym)], String)] -> Int)
-> [([(KeyMask, KeySym)], String)]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([(KeyMask, KeySym)], String)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length)
             ([[([(KeyMask, KeySym)], String)]]
 -> [[([(KeyMask, KeySym)], String)]])
-> ([(Maybe [(KeyMask, KeySym)], String)]
    -> [[([(KeyMask, KeySym)], String)]])
-> [(Maybe [(KeyMask, KeySym)], String)]
-> [[([(KeyMask, KeySym)], String)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([(KeyMask, KeySym)], String)
 -> ([(KeyMask, KeySym)], String) -> Bool)
-> [([(KeyMask, KeySym)], String)]
-> [[([(KeyMask, KeySym)], String)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy ([(KeyMask, KeySym)] -> [(KeyMask, KeySym)] -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([(KeyMask, KeySym)] -> [(KeyMask, KeySym)] -> Bool)
-> (([(KeyMask, KeySym)], String) -> [(KeyMask, KeySym)])
-> ([(KeyMask, KeySym)], String)
-> ([(KeyMask, KeySym)], String)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ([(KeyMask, KeySym)], String) -> [(KeyMask, KeySym)]
forall a b. (a, b) -> a
fst)
             ([([(KeyMask, KeySym)], String)]
 -> [[([(KeyMask, KeySym)], String)]])
-> ([(Maybe [(KeyMask, KeySym)], String)]
    -> [([(KeyMask, KeySym)], String)])
-> [(Maybe [(KeyMask, KeySym)], String)]
-> [[([(KeyMask, KeySym)], String)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([(KeyMask, KeySym)], String)
 -> ([(KeyMask, KeySym)], String) -> Ordering)
-> [([(KeyMask, KeySym)], String)]
-> [([(KeyMask, KeySym)], String)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((([(KeyMask, KeySym)], String) -> [(KeyMask, KeySym)])
-> ([(KeyMask, KeySym)], String)
-> ([(KeyMask, KeySym)], String)
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ([(KeyMask, KeySym)], String) -> [(KeyMask, KeySym)]
forall a b. (a, b) -> a
fst)
             ([([(KeyMask, KeySym)], String)]
 -> [([(KeyMask, KeySym)], String)])
-> ([(Maybe [(KeyMask, KeySym)], String)]
    -> [([(KeyMask, KeySym)], String)])
-> [(Maybe [(KeyMask, KeySym)], String)]
-> [([(KeyMask, KeySym)], String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe [(KeyMask, KeySym)], String)
 -> ([(KeyMask, KeySym)], String))
-> [(Maybe [(KeyMask, KeySym)], String)]
-> [([(KeyMask, KeySym)], String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe [(KeyMask, KeySym)] -> [(KeyMask, KeySym)])
-> (Maybe [(KeyMask, KeySym)], String)
-> ([(KeyMask, KeySym)], String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Maybe [(KeyMask, KeySym)] -> [(KeyMask, KeySym)]
forall a. HasCallStack => Maybe a -> a
fromJust)
             ([(Maybe [(KeyMask, KeySym)], String)]
 -> [([(KeyMask, KeySym)], String)])
-> ([(Maybe [(KeyMask, KeySym)], String)]
    -> [(Maybe [(KeyMask, KeySym)], String)])
-> [(Maybe [(KeyMask, KeySym)], String)]
-> [([(KeyMask, KeySym)], String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe [(KeyMask, KeySym)], String) -> Bool)
-> [(Maybe [(KeyMask, KeySym)], String)]
-> [(Maybe [(KeyMask, KeySym)], String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe [(KeyMask, KeySym)] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [(KeyMask, KeySym)] -> Bool)
-> ((Maybe [(KeyMask, KeySym)], String)
    -> Maybe [(KeyMask, KeySym)])
-> (Maybe [(KeyMask, KeySym)], String)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe [(KeyMask, KeySym)], String) -> Maybe [(KeyMask, KeySym)]
forall a b. (a, b) -> a
fst)
             ([(Maybe [(KeyMask, KeySym)], String)] -> [String])
-> [(Maybe [(KeyMask, KeySym)], String)] -> [String]
forall a b. (a -> b) -> a -> b
$ [(Maybe [(KeyMask, KeySym)], String)]
ks