----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.ToggleHook -- Description : Hook and keybindings for toggling hook behavior. -- Copyright : Ben Boeckel <mathstuf@gmail.com> -- License : BSD-style (see LICENSE) -- -- Maintainer : Ben Boeckel <mathstuf@gmail.com> -- Stability : unstable -- Portability : unportable -- -- Hook and keybindings for toggling hook behavior. ----------------------------------------------------------------------------- module XMonad.Hooks.ToggleHook ( -- * Usage -- $usage -- * The hook toggleHook , toggleHook' -- * Actions , hookNext , toggleHookNext , hookAllNew , toggleHookAllNew -- * Queries , willHook , willHookNext , willHookAllNew -- * Status bar utilities -- $pp , willHookNextPP , willHookAllNewPP , runLogHook ) where import Prelude hiding (all) import XMonad import XMonad.Prelude (guard, join) import qualified XMonad.Util.ExtensibleState as XS import Control.Arrow (first, second) import Data.Map {- Helper functions -} _set :: String -> ((a -> a) -> (Bool, Bool) -> (Bool, Bool)) -> a -> X () _set :: String -> ((a -> a) -> (Bool, Bool) -> (Bool, Bool)) -> a -> X () _set String n (a -> a) -> (Bool, Bool) -> (Bool, Bool) f a b = String -> ((Bool, Bool) -> (Bool, Bool)) -> X () modify' String n ((a -> a) -> (Bool, Bool) -> (Bool, Bool) f ((a -> a) -> (Bool, Bool) -> (Bool, Bool)) -> (a -> a) -> (Bool, Bool) -> (Bool, Bool) forall a b. (a -> b) -> a -> b $ a -> a -> a forall a b. a -> b -> a const a b) _toggle :: String -> ((Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool)) -> X () _toggle :: String -> ((Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool)) -> X () _toggle String n (Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool) f = String -> ((Bool, Bool) -> (Bool, Bool)) -> X () modify' String n ((Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool) f Bool -> Bool not) _get :: String -> ((Bool, Bool) -> a) -> X a _get :: String -> ((Bool, Bool) -> a) -> X a _get String n (Bool, Bool) -> a f = (HookState -> a) -> X a forall a (m :: * -> *) b. (ExtensionClass a, XLike m) => (a -> b) -> m b XS.gets ((HookState -> a) -> X a) -> (HookState -> a) -> X a forall a b. (a -> b) -> a -> b $ (Bool, Bool) -> a f ((Bool, Bool) -> a) -> (HookState -> (Bool, Bool)) -> HookState -> a forall b c a. (b -> c) -> (a -> b) -> a -> c . ((Bool, Bool) -> String -> Map String (Bool, Bool) -> (Bool, Bool) forall k a. Ord k => a -> k -> Map k a -> a findWithDefault (Bool False, Bool False) String n (Map String (Bool, Bool) -> (Bool, Bool)) -> (HookState -> Map String (Bool, Bool)) -> HookState -> (Bool, Bool) forall b c a. (b -> c) -> (a -> b) -> a -> c . HookState -> Map String (Bool, Bool) hooks) _pp :: String -> ((Bool, Bool) -> Bool) -> String -> (String -> String) -> X (Maybe String) _pp :: String -> ((Bool, Bool) -> Bool) -> String -> (String -> String) -> X (Maybe String) _pp String n (Bool, Bool) -> Bool f String s String -> String st = (\Bool b -> Bool -> Maybe () forall (f :: * -> *). Alternative f => Bool -> f () guard Bool b Maybe () -> Maybe String -> Maybe String forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> String -> Maybe String forall a. a -> Maybe a Just (String -> String st String s)) (Bool -> Maybe String) -> X Bool -> X (Maybe String) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> String -> ((Bool, Bool) -> Bool) -> X Bool forall a. String -> ((Bool, Bool) -> a) -> X a _get String n (Bool, Bool) -> Bool f {- The current state is kept here -} newtype HookState = HookState { HookState -> Map String (Bool, Bool) hooks :: Map String (Bool, Bool) } deriving (ReadPrec [HookState] ReadPrec HookState Int -> ReadS HookState ReadS [HookState] (Int -> ReadS HookState) -> ReadS [HookState] -> ReadPrec HookState -> ReadPrec [HookState] -> Read HookState forall a. (Int -> ReadS a) -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a readListPrec :: ReadPrec [HookState] $creadListPrec :: ReadPrec [HookState] readPrec :: ReadPrec HookState $creadPrec :: ReadPrec HookState readList :: ReadS [HookState] $creadList :: ReadS [HookState] readsPrec :: Int -> ReadS HookState $creadsPrec :: Int -> ReadS HookState Read, Int -> HookState -> String -> String [HookState] -> String -> String HookState -> String (Int -> HookState -> String -> String) -> (HookState -> String) -> ([HookState] -> String -> String) -> Show HookState forall a. (Int -> a -> String -> String) -> (a -> String) -> ([a] -> String -> String) -> Show a showList :: [HookState] -> String -> String $cshowList :: [HookState] -> String -> String show :: HookState -> String $cshow :: HookState -> String showsPrec :: Int -> HookState -> String -> String $cshowsPrec :: Int -> HookState -> String -> String Show) instance ExtensionClass HookState where initialValue :: HookState initialValue = Map String (Bool, Bool) -> HookState HookState Map String (Bool, Bool) forall k a. Map k a empty extensionType :: HookState -> StateExtension extensionType = HookState -> StateExtension forall a. (Read a, Show a, ExtensionClass a) => a -> StateExtension PersistentExtension modify' :: String -> ((Bool, Bool) -> (Bool, Bool)) -> X () modify' :: String -> ((Bool, Bool) -> (Bool, Bool)) -> X () modify' String n (Bool, Bool) -> (Bool, Bool) f = (HookState -> HookState) -> X () forall a (m :: * -> *). (ExtensionClass a, XLike m) => (a -> a) -> m () XS.modify (Map String (Bool, Bool) -> HookState HookState (Map String (Bool, Bool) -> HookState) -> (HookState -> Map String (Bool, Bool)) -> HookState -> HookState forall b c a. (b -> c) -> (a -> b) -> a -> c . Map String (Bool, Bool) -> Map String (Bool, Bool) setter (Map String (Bool, Bool) -> Map String (Bool, Bool)) -> (HookState -> Map String (Bool, Bool)) -> HookState -> Map String (Bool, Bool) forall b c a. (b -> c) -> (a -> b) -> a -> c . HookState -> Map String (Bool, Bool) hooks) where setter :: Map String (Bool, Bool) -> Map String (Bool, Bool) setter Map String (Bool, Bool) m = String -> (Bool, Bool) -> Map String (Bool, Bool) -> Map String (Bool, Bool) forall k a. Ord k => k -> a -> Map k a -> Map k a insert String n ((Bool, Bool) -> (Bool, Bool) f ((Bool, Bool) -> String -> Map String (Bool, Bool) -> (Bool, Bool) forall k a. Ord k => a -> k -> Map k a -> a findWithDefault (Bool False, Bool False) String n Map String (Bool, Bool) m)) Map String (Bool, Bool) m -- $usage -- This module provides actions (that can be set as keybindings) -- to be able to cause hooks to be occur on a conditional basis. -- -- You can use it by including the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Hooks.ToggleHook -- -- and adding 'toggleHook name hook' to your 'ManageHook' where @name@ is the -- name of the hook and @hook@ is the hook to execute based on the state. -- -- > myManageHook = toggleHook "float" doFloat <+> manageHook def -- -- Additionally, toggleHook' is provided to toggle between two hooks (rather -- than on/off). -- -- > myManageHook = toggleHook' "oldfocus" (const id) W.focusWindow <+> manageHook def -- -- The 'hookNext' and 'toggleHookNext' functions can be used in key -- bindings to set whether the hook is applied or not. -- -- > , ((modm, xK_e), toggleHookNext "float") -- -- 'hookAllNew' and 'toggleHookAllNew' are similar but float all -- spawned windows until disabled again. -- -- > , ((modm, xK_r), toggleHookAllNew "float") -- | This 'ManageHook' will selectively apply a hook as set -- by 'hookNext' and 'hookAllNew'. toggleHook :: String -> ManageHook -> ManageHook toggleHook :: String -> ManageHook -> ManageHook toggleHook String n ManageHook h = String -> ManageHook -> ManageHook -> ManageHook toggleHook' String n ManageHook h ManageHook forall m. Monoid m => m idHook toggleHook' :: String -> ManageHook -> ManageHook -> ManageHook toggleHook' :: String -> ManageHook -> ManageHook -> ManageHook toggleHook' String n ManageHook th ManageHook fh = do Map String (Bool, Bool) m <- X (Map String (Bool, Bool)) -> Query (Map String (Bool, Bool)) forall a. X a -> Query a liftX (X (Map String (Bool, Bool)) -> Query (Map String (Bool, Bool))) -> X (Map String (Bool, Bool)) -> Query (Map String (Bool, Bool)) forall a b. (a -> b) -> a -> b $ (HookState -> Map String (Bool, Bool)) -> X (Map String (Bool, Bool)) forall a (m :: * -> *) b. (ExtensionClass a, XLike m) => (a -> b) -> m b XS.gets HookState -> Map String (Bool, Bool) hooks (Bool next, Bool all) <- (Bool, Bool) -> Query (Bool, Bool) forall (m :: * -> *) a. Monad m => a -> m a return ((Bool, Bool) -> Query (Bool, Bool)) -> (Bool, Bool) -> Query (Bool, Bool) forall a b. (a -> b) -> a -> b $ (Bool, Bool) -> String -> Map String (Bool, Bool) -> (Bool, Bool) forall k a. Ord k => a -> k -> Map k a -> a findWithDefault (Bool False, Bool False) String n Map String (Bool, Bool) m X () -> Query () forall a. X a -> Query a liftX (X () -> Query ()) -> X () -> Query () forall a b. (a -> b) -> a -> b $ HookState -> X () forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m () XS.put (HookState -> X ()) -> HookState -> X () forall a b. (a -> b) -> a -> b $ Map String (Bool, Bool) -> HookState HookState (Map String (Bool, Bool) -> HookState) -> Map String (Bool, Bool) -> HookState forall a b. (a -> b) -> a -> b $ String -> (Bool, Bool) -> Map String (Bool, Bool) -> Map String (Bool, Bool) forall k a. Ord k => k -> a -> Map k a -> Map k a insert String n (Bool False, Bool all) Map String (Bool, Bool) m if Bool next Bool -> Bool -> Bool || Bool all then ManageHook th else ManageHook fh -- | @hookNext name True@ arranges for the next spawned window to -- have the hook @name@ applied, @hookNext name False@ cancels it. hookNext :: String -> Bool -> X () hookNext :: String -> Bool -> X () hookNext String n = String -> ((Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool)) -> Bool -> X () forall a. String -> ((a -> a) -> (Bool, Bool) -> (Bool, Bool)) -> a -> X () _set String n (Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool) forall (a :: * -> * -> *) b c d. Arrow a => a b c -> a (b, d) (c, d) first toggleHookNext :: String -> X () toggleHookNext :: String -> X () toggleHookNext String n = String -> ((Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool)) -> X () _toggle String n (Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool) forall (a :: * -> * -> *) b c d. Arrow a => a b c -> a (b, d) (c, d) first -- | @hookAllNew name True@ arranges for new windows to -- have the hook @name@ applied, @hookAllNew name False@ cancels it hookAllNew :: String -> Bool -> X () hookAllNew :: String -> Bool -> X () hookAllNew String n = String -> ((Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool)) -> Bool -> X () forall a. String -> ((a -> a) -> (Bool, Bool) -> (Bool, Bool)) -> a -> X () _set String n (Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool) forall (a :: * -> * -> *) b c d. Arrow a => a b c -> a (d, b) (d, c) second toggleHookAllNew :: String -> X () toggleHookAllNew :: String -> X () toggleHookAllNew String n = String -> ((Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool)) -> X () _toggle String n (Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool) forall (a :: * -> * -> *) b c d. Arrow a => a b c -> a (d, b) (d, c) second -- | Query what will happen at the next ManageHook call for the hook @name@. willHook :: String -> X Bool willHook :: String -> X Bool willHook String n = String -> X Bool willHookNext String n X Bool -> X Bool -> X Bool forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool <||> String -> X Bool willHookAllNew String n -- | Whether the next window will trigger the hook @name@. willHookNext :: String -> X Bool willHookNext :: String -> X Bool willHookNext String n = String -> ((Bool, Bool) -> Bool) -> X Bool forall a. String -> ((Bool, Bool) -> a) -> X a _get String n (Bool, Bool) -> Bool forall a b. (a, b) -> a fst -- | Whether new windows will trigger the hook @name@. willHookAllNew :: String -> X Bool willHookAllNew :: String -> X Bool willHookAllNew String n = String -> ((Bool, Bool) -> Bool) -> X Bool forall a. String -> ((Bool, Bool) -> a) -> X a _get String n (Bool, Bool) -> Bool forall a b. (a, b) -> b snd -- $pp -- The following functions are used to display the current -- state of 'hookNext' and 'hookAllNew' in your -- "XMonad.Hooks.StatusBar". 'willHookNextPP' and -- 'willHookAllNewPP' should be added to the -- 'XMonad.Hooks.StatusBar.PP.ppExtras' field of your -- "XMonad.Hooks.StatusBar.PP". -- -- Use 'runLogHook' to refresh the output of your 'logHook', so -- that the effects of a 'hookNext'/... will be visible -- immediately: -- -- > , ((modm, xK_e), toggleHookNext "float" >> runLogHook) -- -- The @String -> String@ parameters to 'willHookNextPP' and -- 'willHookAllNewPP' will be applied to their output, you -- can use them to set the text color, etc., or you can just -- pass them 'id'. willHookNextPP :: String -> (String -> String) -> X (Maybe String) willHookNextPP :: String -> (String -> String) -> X (Maybe String) willHookNextPP String n = String -> ((Bool, Bool) -> Bool) -> String -> (String -> String) -> X (Maybe String) _pp String n (Bool, Bool) -> Bool forall a b. (a, b) -> a fst String "Next" willHookAllNewPP :: String -> (String -> String) -> X (Maybe String) willHookAllNewPP :: String -> (String -> String) -> X (Maybe String) willHookAllNewPP String n = String -> ((Bool, Bool) -> Bool) -> String -> (String -> String) -> X (Maybe String) _pp String n (Bool, Bool) -> Bool forall a b. (a, b) -> b snd String "All" runLogHook :: X () runLogHook :: X () runLogHook = X (X ()) -> X () forall (m :: * -> *) a. Monad m => m (m a) -> m a join (X (X ()) -> X ()) -> X (X ()) -> X () forall a b. (a -> b) -> a -> b $ (XConf -> X ()) -> X (X ()) forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks ((XConf -> X ()) -> X (X ())) -> (XConf -> X ()) -> X (X ()) forall a b. (a -> b) -> a -> b $ XConfig Layout -> X () forall (l :: * -> *). XConfig l -> X () logHook (XConfig Layout -> X ()) -> (XConf -> XConfig Layout) -> XConf -> X () forall b c a. (b -> c) -> (a -> b) -> a -> c . XConf -> XConfig Layout config