issue #406: ben boeckel <mathstuf@gmail.com> +XMonad.Hooks.ToggleHook

Ignore-this: 125891614da94a5ac0e66e39932aa17e

darcs-hash:20110412015127-f7719-b454f97efad45c01418f606303595e8369b81f4e.gz

1 files changed, 175 insertions, 0 deletions

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 <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
+                               , 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