{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
module XMonad.Config.Azerty (
azertyConfig, azertyKeys, belgianConfig, belgianKeys
) where
import XMonad
import qualified XMonad.StackSet as W
import qualified Data.Map as M
azertyConfig :: XConfig (Choose Tall (Choose (Mirror Tall) Full))
azertyConfig = forall a. Default a => a
def { keys :: XConfig Layout -> Map (ButtonMask, KeySym) (X ())
keys = forall {l :: * -> *}. XConfig l -> Map (ButtonMask, KeySym) (X ())
azertyKeys forall a. Semigroup a => a -> a -> a
<> forall (l :: * -> *).
XConfig l -> XConfig Layout -> Map (ButtonMask, KeySym) (X ())
keys forall a. Default a => a
def }
belgianConfig :: XConfig (Choose Tall (Choose (Mirror Tall) Full))
belgianConfig = forall a. Default a => a
def { keys :: XConfig Layout -> Map (ButtonMask, KeySym) (X ())
keys = forall {l :: * -> *}. XConfig l -> Map (ButtonMask, KeySym) (X ())
belgianKeys forall a. Semigroup a => a -> a -> a
<> forall (l :: * -> *).
XConfig l -> XConfig Layout -> Map (ButtonMask, KeySym) (X ())
keys forall a. Default a => a
def }
azertyKeys :: XConfig l -> Map (ButtonMask, KeySym) (X ())
azertyKeys = forall {l :: * -> *}.
[KeySym] -> XConfig l -> Map (ButtonMask, KeySym) (X ())
azertyKeysTop [KeySym
0x26,KeySym
0xe9,KeySym
0x22,KeySym
0x27,KeySym
0x28,KeySym
0x2d,KeySym
0xe8,KeySym
0x5f,KeySym
0xe7,KeySym
0xe0]
belgianKeys :: XConfig l -> Map (ButtonMask, KeySym) (X ())
belgianKeys = forall {l :: * -> *}.
[KeySym] -> XConfig l -> Map (ButtonMask, KeySym) (X ())
azertyKeysTop [KeySym
0x26,KeySym
0xe9,KeySym
0x22,KeySym
0x27,KeySym
0x28,KeySym
0xa7,KeySym
0xe8,KeySym
0x21,KeySym
0xe7,KeySym
0xe0]
azertyKeysTop :: [KeySym] -> XConfig l -> Map (ButtonMask, KeySym) (X ())
azertyKeysTop [KeySym]
topRow conf :: XConfig l
conf@XConfig{modMask :: forall (l :: * -> *). XConfig l -> ButtonMask
modMask = ButtonMask
modm} = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$
[((ButtonMask
modm, KeySym
xK_semicolon), forall a. Message a => a -> X ()
sendMessage (Int -> IncMasterN
IncMasterN (-Int
1)))]
forall a. [a] -> [a] -> [a]
++
[((ButtonMask
m forall a. Bits a => a -> a -> a
.|. ButtonMask
modm, KeySym
k), (WindowSet -> WindowSet) -> X ()
windows forall a b. (a -> b) -> a -> b
$ WorkspaceId -> WindowSet -> WindowSet
f WorkspaceId
i)
| (WorkspaceId
i, KeySym
k) <- forall a b. [a] -> [b] -> [(a, b)]
zip (forall (l :: * -> *). XConfig l -> [WorkspaceId]
workspaces XConfig l
conf) [KeySym]
topRow,
(WorkspaceId -> WindowSet -> WindowSet
f, ButtonMask
m) <- [(forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.greedyView, ButtonMask
0), (forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.shift, ButtonMask
shiftMask)]]
forall a. [a] -> [a] -> [a]
++
[((ButtonMask
m forall a. Bits a => a -> a -> a
.|. ButtonMask
modm, KeySym
key), ScreenId -> X (Maybe WorkspaceId)
screenWorkspace ScreenId
sc forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust ((WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId -> WindowSet -> WindowSet
f))
| (KeySym
key, ScreenId
sc) <- forall a b. [a] -> [b] -> [(a, b)]
zip [KeySym
xK_z, KeySym
xK_e, KeySym
xK_r] [ScreenId
0..],
(WorkspaceId -> WindowSet -> WindowSet
f, ButtonMask
m) <- [(forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.view, ButtonMask
0), (forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.shift, ButtonMask
shiftMask)]]