[XMonad] Add support for setting toggle state directly

This commit is contained in:
Ivan Malison 2016-11-21 15:53:00 -08:00
parent 3b473eb0d2
commit 24bf3cb999
No known key found for this signature in database
GPG Key ID: 62530EFBE99DC2F8

View File

@ -1,4 +1,6 @@
{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-}
{-# LANGUAGE DeriveDataTypeable, TypeSynonymInstances,
MultiParamTypeClasses, ExistentialQuantification,
FlexibleInstances, FlexibleContexts #-}
module Main where
import Control.Monad
@ -105,12 +107,41 @@ instance Transformer MyToggles Window where
myToggles = [LIMIT, GAPS, MAGICFOCUS]
otherToggles = [NBFULL, MIRROR]
togglesMap = M.fromList $ [ (show toggle, Toggle toggle) | toggle <- myToggles ] ++
[ (show toggle, Toggle toggle) | toggle <- otherToggles ]
togglesMap = fmap M.fromList $ sequence $ map toggleTuple myToggles ++ map toggleTuple otherToggles
where
toggleTuple toggle = fmap (\str -> (str, Toggle toggle)) (toggleToStringWithState toggle)
toggleStateToString s = case s of
Just True -> "ON"
Just False -> "OFF"
Nothing -> "N/A"
toggleToStringWithState :: (Transformer t Window, Show t) => t -> X String
toggleToStringWithState toggle = (printf "%s (%s)" (show toggle) . toggleStateToString) <$>
isToggleActive toggle
selectToggle = do
Just selectedToggle <- DM.menuMapArgs "rofi" ["-dmenu", "-i"] togglesMap
dmenuMap <- togglesMap
Just selectedToggle <- DM.menuMapArgs "rofi" ["-dmenu", "-i"] dmenuMap
sendMessage selectedToggle
toggleInState :: (Transformer t Window) => t -> Maybe Bool -> X Bool
toggleInState t s = fmap (/= s) (isToggleActive t)
whenB b a = do
when b a
return b
setToggleActive' toggle active = toggleInState toggle (Just active) >>=
flip whenB (sendMessage $ Toggle toggle)
-- Ambiguous type reference without signature
setToggleActive :: (Transformer t Window) => t -> Bool -> X ()
setToggleActive = (void .) . setToggleActive'
toggleOr toggle toState action = setToggleActive' toggle toState >>= ((`when` action) . not)
deactivateFullOr = toggleOr NBFULL False
-- Layout setup
@ -341,11 +372,12 @@ addKeys conf@XConfig {modMask = modm} =
"systemctl --user restart taffybar.service")
, ((modm, xK_v), spawn "copyq paste")
, ((modm, xK_s), swapNextScreen)
, ((modm .|. controlMask, xK_space), sendMessage $ Toggle FULL)
, ((modm .|. controlMask, xK_space), sendMessage $ Toggle NBFULL)
, ((modm, xK_slash), sendMessage $ Toggle MIRROR)
, ((modm, xK_m), withFocused minimizeWindow)
, ((modm .|. shiftMask, xK_m), withLastMinimized maximizeWindowAndFocus)
, ((modm, xK_backslash), toggleWS)
, ((modm, xK_space), deactivateFullOr $ sendMessage NextLayout)
-- These need to be rebound to support boringWindows
, ((modm, xK_j), focusDown)