aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorgwern0 <gwern0@gmail.com>2011-04-12 03:51:27 +0200
committergwern0 <gwern0@gmail.com>2011-04-12 03:51:27 +0200
commitd7f1f0da8c0c006613264f89b3acda8caaa573eb (patch)
tree3b35ae5316c92b1e49a57c7887ff5728a356a49d
parent3fc026de3c1a7acc8a8d4a1be98401e519abcf9b (diff)
downloadXMonadContrib-d7f1f0da8c0c006613264f89b3acda8caaa573eb.tar.gz
XMonadContrib-d7f1f0da8c0c006613264f89b3acda8caaa573eb.tar.xz
XMonadContrib-d7f1f0da8c0c006613264f89b3acda8caaa573eb.zip
issue #406: ben boeckel <mathstuf@gmail.com> +XMonad.Hooks.ToggleHook
Ignore-this: 125891614da94a5ac0e66e39932aa17e darcs-hash:20110412015127-f7719-b454f97efad45c01418f606303595e8369b81f4e.gz
-rw-r--r--XMonad/Hooks/ToggleHook.hs175
-rw-r--r--xmonad-contrib.cabal1
2 files changed, 176 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
diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal
index da264f8..cca4862 100644
--- a/xmonad-contrib.cabal
+++ b/xmonad-contrib.cabal
@@ -154,6 +154,7 @@ library
XMonad.Hooks.Script
XMonad.Hooks.ServerMode
XMonad.Hooks.SetWMName
+ XMonad.Hooks.ToggleHook
XMonad.Hooks.UrgencyHook
XMonad.Hooks.WorkspaceByPos
XMonad.Hooks.XPropManage