[XMonad] Add fade toggling for workspaces

This commit is contained in:
Ivan Malison 2016-11-26 12:47:44 -08:00
parent 0a9e76b120
commit 7b4a9d7a6b
No known key found for this signature in database
GPG Key ID: 62530EFBE99DC2F8

View File

@ -87,10 +87,12 @@ if' :: Bool -> a -> a -> a
if' True x _ = x if' True x _ = x
if' False _ y = y if' False _ y = y
toggleInMap' :: Ord k => Bool -> k -> M.Map k Bool -> M.Map k Bool
toggleInMap' d k m = toggleInMap' d k m =
let existingValue = M.findWithDefault d k m let existingValue = M.findWithDefault d k m
in M.insert k (not existingValue) m in M.insert k (not existingValue) m
toggleInMap :: Ord k => k -> M.Map k Bool -> M.Map k Bool
toggleInMap = toggleInMap' True toggleInMap = toggleInMap' True
maybeRemap k = M.findWithDefault k k maybeRemap k = M.findWithDefault k k
@ -311,23 +313,33 @@ getWorkspaceNameFromTag getWSName tag =
-- Toggleable fade -- Toggleable fade
newtype ToggleFade = newtype ToggleFade a =
ToggleFade { fadesMap :: M.Map Window Bool } ToggleFade { fadesMap :: M.Map a Bool }
deriving (Typeable, Read, Show) deriving (Typeable, Read, Show)
instance ExtensionClass ToggleFade where instance (Typeable a, Read a, Show a, Ord a) => ExtensionClass (ToggleFade a) where
initialValue = ToggleFade M.empty initialValue = ToggleFade M.empty
extensionType = PersistentExtension extensionType = PersistentExtension
fadeEnabledForWindow = ask >>= \w -> fadeEnabledFor query =
liftX $ M.findWithDefault True w . fadesMap <$> XS.get M.findWithDefault True <$> query <*> liftX (fadesMap <$> XS.get)
fadeEnabledForWindow = fadeEnabledFor ask
fadeEnabledForWorkspace = fadeEnabledFor getWindowWorkspace
getWindowWorkspace' = W.findTag <$> ask <*> liftX (withWindowSet return)
getWindowWorkspace = flip fromMaybe <$> getWindowWorkspace' <*> pure "1"
toggleFadeInactiveLogHook = toggleFadeInactiveLogHook =
fadeOutLogHook . fadeIf (isUnfocused <&&> fadeEnabledForWindow) fadeOutLogHook .
fadeIf (isUnfocused <&&> fadeEnabledForWindow <&&> fadeEnabledForWorkspace)
toggleFadingForActiveWindow = withWindowSet $ toggleFadingForActiveWindow = withWindowSet $
maybe (return()) toggleFadingForWindow . W.peek maybe (return()) toggleFadingForWindow . W.peek
toggleFadingForActiveWorkspace =
withWindowSet $ \ws -> toggleFadingForWindow $ W.currentTag ws
toggleFadingForWindow w = toggleFadingForWindow w =
fmap (ToggleFade . toggleInMap w . fadesMap) XS.get >>= XS.put fmap (ToggleFade . toggleInMap w . fadesMap) XS.get >>= XS.put
@ -476,6 +488,7 @@ addKeys conf@XConfig {modMask = modm} =
-- Hyper bindings -- Hyper bindings
, ((mod3Mask, xK_1), toggleFadingForActiveWindow) , ((mod3Mask, xK_1), toggleFadingForActiveWindow)
, ((mod3Mask .|. shiftMask, xK_1), toggleFadingForActiveWorkspace)
, ((mod3Mask, xK_e), moveTo Next EmptyWS) , ((mod3Mask, xK_e), moveTo Next EmptyWS)
, ((mod3Mask, xK_v), spawn "copyq_rofi.sh") , ((mod3Mask, xK_v), spawn "copyq_rofi.sh")
, ((mod3Mask, xK_p), spawn "system_password.sh") , ((mod3Mask, xK_p), spawn "system_password.sh")