{-# LANGUAGE CPP #-}
module XMonad.Util.EZConfig (
additionalKeys, additionalKeysP,
removeKeys, removeKeysP,
additionalMouseBindings, removeMouseBindings,
mkKeymap, checkKeymap,
mkNamedKeymap,
parseKey,
parseKeyCombo,
parseKeySequence, readKeySequence,
#ifdef TESTING
parseModifier,
#endif
) where
import XMonad
import XMonad.Actions.Submap
import XMonad.Prelude
import XMonad.Util.NamedActions
import XMonad.Util.Parser
import Control.Arrow (first, (&&&))
import qualified Data.Map as M
import Data.Ord (comparing)
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 }
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) }
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 }
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 ())) }
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 }
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 }
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
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)
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)
readKeySequence :: XConfig l -> String -> Maybe [(KeyMask, KeySym)]
readKeySequence :: forall (l :: * -> *).
XConfig l -> String -> Maybe [(KeyMask, KeySym)]
readKeySequence XConfig l
c = Parser [(KeyMask, KeySym)] -> String -> Maybe [(KeyMask, KeySym)]
forall a. Parser a -> String -> Maybe a
runParser (XConfig l -> Parser [(KeyMask, KeySym)]
forall (l :: * -> *). XConfig l -> Parser [(KeyMask, KeySym)]
parseKeySequence XConfig l
c Parser [(KeyMask, KeySym)]
-> Parser () -> Parser [(KeyMask, KeySym)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
eof)
parseKeySequence :: XConfig l -> Parser [(KeyMask, KeySym)]
parseKeySequence :: forall (l :: * -> *). XConfig l -> Parser [(KeyMask, KeySym)]
parseKeySequence XConfig l
c = XConfig l -> Parser (KeyMask, KeySym)
forall (l :: * -> *). XConfig l -> Parser (KeyMask, KeySym)
parseKeyCombo XConfig l
c Parser (KeyMask, KeySym)
-> Parser String -> Parser [(KeyMask, KeySym)]
forall a sep. Parser a -> Parser sep -> Parser [a]
`sepBy1` Parser Char -> Parser String
forall a. Parser a -> Parser [a]
many1 (Char -> Parser Char
char Char
' ')
parseKeyCombo :: XConfig l -> Parser (KeyMask, KeySym)
parseKeyCombo :: forall (l :: * -> *). XConfig l -> Parser (KeyMask, KeySym)
parseKeyCombo XConfig l
c = do [KeyMask]
mods <- Parser KeyMask -> Parser [KeyMask]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (XConfig l -> Parser KeyMask
forall (l :: * -> *). XConfig l -> Parser KeyMask
parseModifier XConfig l
c)
KeySym
k <- Parser KeySym
parseKey
(KeyMask, KeySym) -> Parser (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)
parseModifier :: XConfig l -> Parser KeyMask
parseModifier :: forall (l :: * -> *). XConfig l -> Parser KeyMask
parseModifier XConfig l
c = (String -> Parser String
string String
"M-" Parser String -> KeyMask -> Parser KeyMask
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> XConfig l -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig l
c)
Parser KeyMask -> Parser KeyMask -> Parser KeyMask
forall a. Semigroup a => a -> a -> a
<> (String -> Parser String
string String
"C-" Parser String -> KeyMask -> Parser KeyMask
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> KeyMask
controlMask)
Parser KeyMask -> Parser KeyMask -> Parser KeyMask
forall a. Semigroup a => a -> a -> a
<> (String -> Parser String
string String
"S-" Parser String -> KeyMask -> Parser KeyMask
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> KeyMask
shiftMask)
Parser KeyMask -> Parser KeyMask -> Parser KeyMask
forall a. Semigroup a => a -> a -> a
<> do Char
_ <- Char -> Parser Char
char Char
'M'
Char
n <- (Char -> Bool) -> Parser Char
satisfy (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'1'..Char
'5'])
Char
_ <- Char -> Parser Char
char Char
'-'
KeyMask -> Parser KeyMask
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyMask -> Parser KeyMask) -> KeyMask -> Parser 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]
parseKey :: Parser KeySym
parseKey :: Parser KeySym
parseKey = Parser KeySym
parseSpecial Parser KeySym -> Parser KeySym -> Parser KeySym
forall a. Semigroup a => a -> a -> a
<> Parser KeySym
parseRegular
parseRegular :: Parser KeySym
parseRegular :: Parser KeySym
parseRegular = [Parser KeySym] -> Parser KeySym
forall a. [Parser a] -> Parser a
choice [ String -> Parser String
string String
s Parser String -> KeySym -> Parser KeySym
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> KeySym
k | (String
s, KeySym
k) <- [(String, KeySym)]
regularKeys ]
parseSpecial :: Parser KeySym
parseSpecial :: Parser KeySym
parseSpecial = do Char
_ <- Char -> Parser Char
char Char
'<'
[Parser KeySym] -> Parser KeySym
forall a. [Parser a] -> Parser a
choice [ KeySym
k KeySym -> Parser String -> Parser KeySym
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser String
string String
name Parser KeySym -> Parser Char -> Parser KeySym
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
'>'
| (String
name, KeySym
k) <- [(String, KeySym)]
allSpecialKeys
]
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
"\""))
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