path: root/XMonad/Hooks/ToggleHook.hs

{-# 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