From d7f1f0da8c0c006613264f89b3acda8caaa573eb Mon Sep 17 00:00:00 2001 From: gwern0 Date: Tue, 12 Apr 2011 03:51:27 +0200 Subject: issue #406: ben boeckel +XMonad.Hooks.ToggleHook Ignore-this: 125891614da94a5ac0e66e39932aa17e darcs-hash:20110412015127-f7719-b454f97efad45c01418f606303595e8369b81f4e.gz --- XMonad/Hooks/ToggleHook.hs | 175 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 175 insertions(+) create mode 100644 XMonad/Hooks/ToggleHook.hs (limited to 'XMonad/Hooks') diff --git a/XMonad/Hooks/ToggleHook.hs b/XMonad/Hooks/ToggleHook.hs new file mode 100644 index 0000000..5949084 --- /dev/null +++ b/XMonad/Hooks/ToggleHook.hs @@ -0,0 +1,175 @@ +{-# LANGUAGE DeriveDataTypeable #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.ToggleHook +-- Copyright : Ben Boeckel +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Ben Boeckel +-- 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 + , willHookNext + , willHookAllNew + + -- * 'DynamicLog' utilities + -- $pp + , willHookNextPP + , willHookAllNewPP + , runLogHook ) where + +import Prelude hiding (all) + +import XMonad +import qualified XMonad.Util.ExtensibleState as XS + +import Control.Monad (join,guard) +import Control.Applicative ((<$>)) +import Control.Arrow (first, second) + +{- Helper functions -} + +_set :: String -> ((a -> a) -> (Bool, Bool) -> (Bool, Bool)) -> a -> X () +_set n f b = modify' n (f $ const b) + +_toggle :: String -> ((Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool)) -> X () +_toggle n f = modify' n (f not) + +_get :: String -> ((Bool, Bool) -> a) -> X a +_get n f = XS.gets $ f . (getKey n (False, False) . hooks) + +_pp :: String -> ((Bool, Bool) -> Bool) -> String -> (String -> String) -> X (Maybe String) +_pp n f s st = (\b -> guard b >> Just (st s)) <$> _get n f + +{- The current state is kept here -} + +data HookState = HookState { hooks :: [(String, (Bool, Bool))] } deriving (Typeable) + +instance ExtensionClass HookState where + initialValue = HookState [] + +setKey :: (Eq a) => a -> b -> [(a,b)] -> [(a,b)] +setKey = setKey' [] + +setKey' :: (Eq a) => [(a,b)] -> a -> b -> [(a,b)] -> [(a,b)] +setKey' r k v [] = r ++ [(k,v)] +setKey' r k v (p@(f,_):xs) | k == f = r ++ ((k,v) : xs) + | otherwise = setKey' (r ++ [p]) k v xs + +getKey :: (Eq a) => a -> b -> [(a,b)] -> b +getKey _ d [] = d +getKey k d ((f,s):xs) | k == f = s + | otherwise = getKey k d xs + +modify' :: String -> ((Bool, Bool) -> (Bool, Bool)) -> X () +modify' h f = XS.modify (HookState . setter . hooks) + where + setter m = setKey h (f (getKey h (False, False) m)) 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 defaultConfig +-- +-- Additionally, toggleHook' is provided to toggle between two hooks (rather +-- than on/off). +-- +-- > myManageHook = toggleHook' "oldfocus" (const id) W.focusWindow <+> manageHook defaultConfig +-- +-- 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 n h = toggleHook' n h idHook + +toggleHook' :: String -> ManageHook -> ManageHook -> ManageHook +toggleHook' n th fh = do m <- liftX $ XS.gets hooks + (next, all) <- return $ getKey n (False, False) m + liftX $ XS.put $ HookState $ setKey n (False, all) m + if next || all then th else 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 n = _set n first + +toggleHookNext :: String -> X () +toggleHookNext n = _toggle n first + +-- | @hookAllNew name True@ arranges for new windows to +-- have the hook @name@ applied, @hookAllNew name False@ cancels it +hookAllNew :: String -> Bool -> X () +hookAllNew n = _set n second + +toggleHookAllNew :: String -> X () +toggleHookAllNew n = _toggle n second + +-- | Whether the next window will trigger the hook @name@. +willHookNext :: String -> X Bool +willHookNext n = _get n fst + +-- | Whether new windows will trigger the hook @name@. +willHookAllNew :: String -> X Bool +willHookAllNew n = _get n snd + +-- $pp +-- The following functions are used to display the current +-- state of 'hookNext' and 'hookAllNew' in your +-- 'XMonad.Hooks.DynamicLog.dynamicLogWithPP'. +-- 'willHookNextPP' and 'willHookAllNewPP' should be added +-- to the 'XMonad.Hooks.DynamicLog.ppExtras' field of your +-- 'XMonad.Hooks.DynamicLog.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 n = _pp n fst "Next" + +willHookAllNewPP :: String -> (String -> String) -> X (Maybe String) +willHookAllNewPP n = _pp n snd "All" + +runLogHook :: X () +runLogHook = join $ asks $ logHook . config -- cgit v1.2.3