mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-07-31 20:21:51 -07:00
X.A.CycleWS: Deprecated WSType Data Constructors
By deprecating everything except `WSIs` and adding constructors to logically combine `WSType` values, we can have a more flexible interface. Adding anything to the old interface would mean going through `WSIs`, and all old constructors can be implemented of terms of `WSIs`.
This commit is contained in:
@@ -18,13 +18,13 @@
|
||||
--
|
||||
-- Note that this module now subsumes the functionality of the former
|
||||
-- @XMonad.Actions.RotView@. Former users of @rotView@ can simply replace
|
||||
-- @rotView True@ with @moveTo Next NonEmptyWS@, and so on.
|
||||
-- @rotView True@ with @moveTo Next (Not emptyWS)@, and so on.
|
||||
--
|
||||
-- If you want to exactly replicate the action of @rotView@ (cycling
|
||||
-- through workspace in order lexicographically by tag, instead of in
|
||||
-- the order specified in the config), it can be implemented as:
|
||||
--
|
||||
-- > rotView b = do t <- findWorkspace getSortByTag (bToDir b) NonEmptyWS 1
|
||||
-- > rotView b = do t <- findWorkspace getSortByTag (bToDir b) (Not emptyWS) 1
|
||||
-- > windows . greedyView $ t
|
||||
-- > where bToDir True = Next
|
||||
-- > bToDir False = Prev
|
||||
@@ -63,6 +63,10 @@ module XMonad.Actions.CycleWS (
|
||||
|
||||
, Direction1D(..)
|
||||
, WSType(..)
|
||||
, emptyWS
|
||||
, hiddenWS
|
||||
, anyWS
|
||||
, wsTagGroup
|
||||
|
||||
, shiftTo
|
||||
, moveTo
|
||||
@@ -78,7 +82,7 @@ module XMonad.Actions.CycleWS (
|
||||
|
||||
) where
|
||||
|
||||
import XMonad.Prelude (find, findIndex, isJust, isNothing)
|
||||
import XMonad.Prelude (find, findIndex, isJust, isNothing, liftM2)
|
||||
import XMonad hiding (workspaces)
|
||||
import qualified XMonad.Hooks.WorkspaceHistory as WH
|
||||
import XMonad.StackSet hiding (filter)
|
||||
@@ -110,9 +114,9 @@ import XMonad.Util.WorkspaceCompare
|
||||
-- You can also get fancier with 'moveTo', 'shiftTo', and 'findWorkspace'.
|
||||
-- For example:
|
||||
--
|
||||
-- > , ((modm , xK_f), moveTo Next EmptyWS) -- find a free workspace
|
||||
-- > , ((modm , xK_f), moveTo Next emptyWS) -- find a free workspace
|
||||
-- > , ((modm .|. controlMask, xK_Right), -- a crazy keybinding!
|
||||
-- > do t <- findWorkspace getSortByXineramaRule Next NonEmptyWS 2
|
||||
-- > do t <- findWorkspace getSortByXineramaRule Next (Not emptyWS) 2
|
||||
-- > windows . view $ t )
|
||||
--
|
||||
-- For detailed instructions on editing your key bindings, see
|
||||
@@ -211,7 +215,7 @@ shiftBy :: Int -> X ()
|
||||
shiftBy d = wsBy d >>= windows . shift
|
||||
|
||||
wsBy :: Int -> X WorkspaceId
|
||||
wsBy = findWorkspace getSortByIndex Next AnyWS
|
||||
wsBy = findWorkspace getSortByIndex Next anyWS
|
||||
|
||||
{- $taketwo
|
||||
|
||||
@@ -220,7 +224,7 @@ through subsets of workspaces.
|
||||
|
||||
For example,
|
||||
|
||||
> moveTo Next EmptyWS
|
||||
> moveTo Next emptyWS
|
||||
|
||||
will move to the first available workspace with no windows, and
|
||||
|
||||
@@ -231,6 +235,13 @@ the letter 'p' in its name. =)
|
||||
|
||||
-}
|
||||
|
||||
{-# DEPRECATED EmptyWS "Use emptyWS instead." #-}
|
||||
{-# DEPRECATED HiddenWS "Use hiddenWS instead." #-}
|
||||
{-# DEPRECATED NonEmptyWS "Use Not emptyWS instead." #-}
|
||||
{-# DEPRECATED HiddenNonEmptyWS "Use hiddenWS :&: Not emptyWS instead." #-}
|
||||
{-# DEPRECATED HiddenEmptyWS "Use hiddenWS :&: emptyWS instead." #-}
|
||||
{-# DEPRECATED AnyWS "Use anyWS instead." #-}
|
||||
{-# DEPRECATED WSTagGroup "Use wsTagGroup instead." #-}
|
||||
-- | What type of workspaces should be included in the cycle?
|
||||
data WSType = EmptyWS -- ^ cycle through empty workspaces
|
||||
| NonEmptyWS -- ^ cycle through non-empty workspaces
|
||||
@@ -245,6 +256,11 @@ data WSType = EmptyWS -- ^ cycle through empty workspaces
|
||||
| WSIs (X (WindowSpace -> Bool))
|
||||
-- ^ cycle through workspaces satisfying
|
||||
-- an arbitrary predicate
|
||||
| WSType :&: WSType -- ^ cycle through workspaces satisfying both
|
||||
-- predicates.
|
||||
| WSType :|: WSType -- ^ cycle through workspaces satisfying one of
|
||||
-- the predicates.
|
||||
| Not WSType -- ^ cycle through workspaces not satisfying the predicate
|
||||
|
||||
-- | Convert a WSType value to a predicate on workspaces.
|
||||
wsTypeToPred :: WSType -> X (WindowSpace -> Bool)
|
||||
@@ -262,7 +278,34 @@ wsTypeToPred AnyWS = return (const True)
|
||||
wsTypeToPred (WSTagGroup sep) = do cur <- groupName.workspace.current <$> gets windowset
|
||||
return $ (cur ==).groupName
|
||||
where groupName = takeWhile (/=sep).tag
|
||||
wsTypeToPred (WSIs p) = p
|
||||
wsTypeToPred (WSIs p ) = p
|
||||
wsTypeToPred (p :&: q) = liftM2 (&&) <$> wsTypeToPred p <*> wsTypeToPred q
|
||||
wsTypeToPred (p :|: q) = liftM2 (||) <$> wsTypeToPred p <*> wsTypeToPred q
|
||||
wsTypeToPred (Not p ) = fmap not <$> wsTypeToPred p
|
||||
|
||||
-- | Cycle through empty workspaces
|
||||
emptyWS :: WSType
|
||||
emptyWS = WSIs . return $ isNothing . stack
|
||||
|
||||
-- | Cycle through non-visible workspaces
|
||||
hiddenWS :: WSType
|
||||
hiddenWS = WSIs $ do
|
||||
hs <- gets (map tag . hidden . windowset)
|
||||
return $ (`elem` hs) . tag
|
||||
|
||||
-- | Cycle through all workspaces
|
||||
anyWS :: WSType
|
||||
anyWS = WSIs . return $ const True
|
||||
|
||||
-- | Cycle through workspaces in the same group, the
|
||||
-- group name is all characters up to the first
|
||||
-- separator character or the end of the tag
|
||||
wsTagGroup :: Char -> WSType
|
||||
wsTagGroup sep = WSIs $ do
|
||||
cur <- groupName . workspace . current <$> gets windowset
|
||||
return $ (cur ==) . groupName
|
||||
where groupName = takeWhile (/= sep) . tag
|
||||
|
||||
|
||||
-- | View the next workspace in the given direction that satisfies
|
||||
-- the given condition.
|
||||
|
Reference in New Issue
Block a user