mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-08-14 11:45:54 -07:00
XMonad.Hooks.FloatNext: issue #406, make FloatNext use ToggleHook
This commit is contained in:
@@ -33,41 +33,13 @@ module XMonad.Hooks.FloatNext ( -- * Usage
|
|||||||
-- * 'DynamicLog' utilities
|
-- * 'DynamicLog' utilities
|
||||||
-- $pp
|
-- $pp
|
||||||
, willFloatNextPP
|
, willFloatNextPP
|
||||||
, willFloatAllNewPP
|
, willFloatAllNewPP ) where
|
||||||
, runLogHook ) where
|
|
||||||
|
|
||||||
import Prelude hiding (all)
|
|
||||||
|
|
||||||
import XMonad
|
import XMonad
|
||||||
import qualified XMonad.Util.ExtensibleState as XS
|
import XMonad.Hooks.ToggleHook
|
||||||
|
|
||||||
import Control.Monad (join,guard)
|
hookName :: String
|
||||||
import Control.Applicative ((<$>))
|
hookName = "__float"
|
||||||
import Control.Arrow (first, second)
|
|
||||||
|
|
||||||
{- Helper functions -}
|
|
||||||
|
|
||||||
_set :: ((a -> a) -> (Bool, Bool) -> (Bool, Bool)) -> a -> X ()
|
|
||||||
_set f b = modify' (f $ const b)
|
|
||||||
|
|
||||||
_toggle :: ((Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool)) -> X ()
|
|
||||||
_toggle f = modify' (f not)
|
|
||||||
|
|
||||||
_get :: ((Bool, Bool) -> a) -> X a
|
|
||||||
_get f = XS.gets (f . getFloatMode)
|
|
||||||
|
|
||||||
_pp :: ((Bool, Bool) -> Bool) -> String -> (String -> String) -> X (Maybe String)
|
|
||||||
_pp f s st = (\b -> guard b >> Just (st s)) <$> _get f
|
|
||||||
|
|
||||||
{- The current state is kept here -}
|
|
||||||
|
|
||||||
data FloatMode = FloatMode { getFloatMode :: (Bool,Bool) } deriving (Typeable)
|
|
||||||
|
|
||||||
instance ExtensionClass FloatMode where
|
|
||||||
initialValue = FloatMode (False,False)
|
|
||||||
|
|
||||||
modify' :: ((Bool,Bool) -> (Bool,Bool)) -> X ()
|
|
||||||
modify' f = XS.modify (FloatMode . f . getFloatMode)
|
|
||||||
|
|
||||||
-- $usage
|
-- $usage
|
||||||
-- This module provides actions (that can be set as keybindings)
|
-- This module provides actions (that can be set as keybindings)
|
||||||
@@ -95,33 +67,31 @@ modify' f = XS.modify (FloatMode . f . getFloatMode)
|
|||||||
-- | This 'ManageHook' will selectively float windows as set
|
-- | This 'ManageHook' will selectively float windows as set
|
||||||
-- by 'floatNext' and 'floatAllNew'.
|
-- by 'floatNext' and 'floatAllNew'.
|
||||||
floatNextHook :: ManageHook
|
floatNextHook :: ManageHook
|
||||||
floatNextHook = do (next, all) <- liftX $ XS.gets getFloatMode
|
floatNextHook = toggleHook hookName doFloat
|
||||||
liftX $ XS.put $ FloatMode (False, all)
|
|
||||||
if next || all then doFloat else idHook
|
|
||||||
|
|
||||||
-- | @floatNext True@ arranges for the next spawned window to be
|
-- | @floatNext True@ arranges for the next spawned window to be
|
||||||
-- sent to the floating layer, @floatNext False@ cancels it.
|
-- sent to the floating layer, @floatNext False@ cancels it.
|
||||||
floatNext :: Bool -> X ()
|
floatNext :: Bool -> X ()
|
||||||
floatNext = _set first
|
floatNext = hookNext hookName
|
||||||
|
|
||||||
toggleFloatNext :: X ()
|
toggleFloatNext :: X ()
|
||||||
toggleFloatNext = _toggle first
|
toggleFloatNext = toggleHookNext hookName
|
||||||
|
|
||||||
-- | @floatAllNew True@ arranges for new windows to be
|
-- | @floatAllNew True@ arranges for new windows to be
|
||||||
-- sent to the floating layer, @floatAllNew False@ cancels it
|
-- sent to the floating layer, @floatAllNew False@ cancels it
|
||||||
floatAllNew :: Bool -> X ()
|
floatAllNew :: Bool -> X ()
|
||||||
floatAllNew = _set second
|
floatAllNew = hookAllNew hookName
|
||||||
|
|
||||||
toggleFloatAllNew :: X ()
|
toggleFloatAllNew :: X ()
|
||||||
toggleFloatAllNew = _toggle second
|
toggleFloatAllNew = toggleHookAllNew hookName
|
||||||
|
|
||||||
-- | Whether the next window will be set floating
|
-- | Whether the next window will be set floating
|
||||||
willFloatNext :: X Bool
|
willFloatNext :: X Bool
|
||||||
willFloatNext = _get fst
|
willFloatNext = willHookNext hookName
|
||||||
|
|
||||||
-- | Whether new windows will be set floating
|
-- | Whether new windows will be set floating
|
||||||
willFloatAllNew :: X Bool
|
willFloatAllNew :: X Bool
|
||||||
willFloatAllNew = _get snd
|
willFloatAllNew = willHookAllNew hookName
|
||||||
|
|
||||||
-- $pp
|
-- $pp
|
||||||
-- The following functions are used to display the current
|
-- The following functions are used to display the current
|
||||||
@@ -143,10 +113,7 @@ willFloatAllNew = _get snd
|
|||||||
-- pass them 'id'.
|
-- pass them 'id'.
|
||||||
|
|
||||||
willFloatNextPP :: (String -> String) -> X (Maybe String)
|
willFloatNextPP :: (String -> String) -> X (Maybe String)
|
||||||
willFloatNextPP = _pp fst "Next"
|
willFloatNextPP = willHookNextPP hookName
|
||||||
|
|
||||||
willFloatAllNewPP :: (String -> String) -> X (Maybe String)
|
willFloatAllNewPP :: (String -> String) -> X (Maybe String)
|
||||||
willFloatAllNewPP = _pp snd "All"
|
willFloatAllNewPP = willHookAllNewPP hookName
|
||||||
|
|
||||||
runLogHook :: X ()
|
|
||||||
runLogHook = join $ asks $ logHook . config
|
|
||||||
|
Reference in New Issue
Block a user