mirror of
https://github.com/xmonad/xmonad.git
synced 2025-08-01 20:51:55 -07:00
Move screen details into StackSet
This commit is contained in:
Spencer Janssen
67
StackSet.hs
67
StackSet.hs
@@ -37,7 +37,7 @@ module StackSet (
|
||||
|
||||
import Prelude hiding (filter)
|
||||
import Data.Maybe (listToMaybe)
|
||||
import qualified Data.List as L (delete,find,genericSplitAt,filter)
|
||||
import qualified Data.List as L (delete,deleteBy,find,splitAt,filter)
|
||||
import qualified Data.Map as M (Map,insert,delete,empty)
|
||||
|
||||
-- $intro
|
||||
@@ -146,15 +146,17 @@ import qualified Data.Map as M (Map,insert,delete,empty)
|
||||
-- that are produced are used to track those workspaces visible as
|
||||
-- Xinerama screens, and those workspaces not visible anywhere.
|
||||
|
||||
data StackSet i a sid =
|
||||
StackSet { current :: !(Screen i a sid) -- ^ currently focused workspace
|
||||
, visible :: [Screen i a sid] -- ^ non-focused workspaces, visible in xinerama
|
||||
data StackSet i a sid sd =
|
||||
StackSet { current :: !(Screen i a sid sd) -- ^ currently focused workspace
|
||||
, visible :: [Screen i a sid sd] -- ^ non-focused workspaces, visible in xinerama
|
||||
, hidden :: [Workspace i a] -- ^ workspaces not visible anywhere
|
||||
, floating :: M.Map a RationalRect -- ^ floating windows
|
||||
} deriving (Show, Read, Eq)
|
||||
|
||||
-- | Visible workspaces, and their Xinerama screens.
|
||||
data Screen i a sid = Screen { workspace :: !(Workspace i a), screen :: !sid }
|
||||
data Screen i a sid sd = Screen { workspace :: !(Workspace i a)
|
||||
, screen :: !sid
|
||||
, screenDetail :: !sd }
|
||||
deriving (Show, Read, Eq)
|
||||
|
||||
-- |
|
||||
@@ -205,10 +207,10 @@ abort x = error $ "xmonad: StackSet: " ++ x
|
||||
--
|
||||
-- Xinerama: Virtual workspaces are assigned to physical screens, starting at 0.
|
||||
--
|
||||
new :: Integral s => [i] -> s -> StackSet i a s
|
||||
new (wid:wids) m | m > 0 = StackSet cur visi unseen M.empty
|
||||
where (seen,unseen) = L.genericSplitAt m $ Workspace wid Nothing : [ Workspace i Nothing | i <- wids]
|
||||
(cur:visi) = [ Screen i s | (i,s) <- zip seen [0..] ]
|
||||
new :: (Integral s) => [i] -> [sd] -> StackSet i a s sd
|
||||
new wids m | not (null wids) && length m <= length wids = StackSet cur visi unseen M.empty
|
||||
where (seen,unseen) = L.splitAt (length m) $ map (flip Workspace Nothing) wids
|
||||
(cur:visi) = [ Screen i s sd | (i, s, sd) <- zip3 seen [0..] m ]
|
||||
-- now zip up visibles with their screen id
|
||||
new _ _ = abort "non-positive argument to StackSet.new"
|
||||
|
||||
@@ -222,21 +224,22 @@ new _ _ = abort "non-positive argument to StackSet.new"
|
||||
-- becomes the current screen. If it is in the visible list, it becomes
|
||||
-- current.
|
||||
|
||||
view :: (Eq a, Eq s, Eq i) => i -> StackSet i a s -> StackSet i a s
|
||||
view :: (Eq a, Eq s, Eq i) => i -> StackSet i a s sd -> StackSet i a s sd
|
||||
view i s
|
||||
| not (elem i $ map tag $ workspaces s)
|
||||
|| i == tag (workspace (current s)) = s -- out of bounds or current
|
||||
|
||||
| Just x <- L.find ((i==).tag.workspace) (visible s)
|
||||
-- if it is visible, it is just raised
|
||||
= s { current = x, visible = current s : L.delete x (visible s) }
|
||||
= s { current = x, visible = current s : L.deleteBy screenEq x (visible s) }
|
||||
|
||||
| Just x <- L.find ((i==).tag) (hidden s)
|
||||
-- if it was hidden, it is raised on the xine screen currently used
|
||||
= s { current = Screen x (screen (current s))
|
||||
= s { current = (current s) { workspace = x }
|
||||
, hidden = workspace (current s) : L.delete x (hidden s) }
|
||||
|
||||
| otherwise = s
|
||||
where screenEq x y = screen x == screen y
|
||||
|
||||
-- 'Catch'ing this might be hard. Relies on monotonically increasing
|
||||
-- workspace tags defined in 'new'
|
||||
@@ -246,8 +249,8 @@ view i s
|
||||
|
||||
-- | Find the tag of the workspace visible on Xinerama screen 'sc'.
|
||||
-- Nothing if screen is out of bounds.
|
||||
lookupWorkspace :: Eq s => s -> StackSet i a s -> Maybe i
|
||||
lookupWorkspace sc w = listToMaybe [ tag i | Screen i s <- current w : visible w, s == sc ]
|
||||
lookupWorkspace :: Eq s => s -> StackSet i a s sd -> Maybe i
|
||||
lookupWorkspace sc w = listToMaybe [ tag i | Screen i s _ <- current w : visible w, s == sc ]
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- $stackOperations
|
||||
@@ -258,13 +261,13 @@ lookupWorkspace sc w = listToMaybe [ tag i | Screen i s <- current w : visible w
|
||||
-- default value. Otherwise, it applies the function to the stack,
|
||||
-- returning the result. It is like 'maybe' for the focused workspace.
|
||||
--
|
||||
with :: b -> (Stack a -> b) -> StackSet i a s -> b
|
||||
with :: b -> (Stack a -> b) -> StackSet i a s sd -> b
|
||||
with dflt f = maybe dflt f . stack . workspace . current
|
||||
|
||||
-- |
|
||||
-- Apply a function, and a default value for Nothing, to modify the current stack.
|
||||
--
|
||||
modify :: StackOrNot a -> (Stack a -> StackOrNot a) -> StackSet i a s -> StackSet i a s
|
||||
modify :: StackOrNot a -> (Stack a -> StackOrNot a) -> StackSet i a s sd -> StackSet i a s sd
|
||||
modify d f s = s { current = (current s)
|
||||
{ workspace = (workspace (current s)) { stack = with d f s }}}
|
||||
|
||||
@@ -272,14 +275,14 @@ modify d f s = s { current = (current s)
|
||||
-- Apply a function to modify the current stack if it isn't empty, and we don't
|
||||
-- want to empty it.
|
||||
--
|
||||
modify' :: (Stack a -> Stack a) -> StackSet i a s -> StackSet i a s
|
||||
modify' :: (Stack a -> Stack a) -> StackSet i a s sd -> StackSet i a s sd
|
||||
modify' f = modify Nothing (Just . f)
|
||||
|
||||
-- |
|
||||
-- /O(1)/. Extract the focused element of the current stack.
|
||||
-- Return Just that element, or Nothing for an empty stack.
|
||||
--
|
||||
peek :: StackSet i a s -> Maybe a
|
||||
peek :: StackSet i a s sd -> Maybe a
|
||||
peek = with Nothing (return . focus)
|
||||
|
||||
-- |
|
||||
@@ -321,7 +324,7 @@ filter p (Stack f ls rs) = case L.filter p (f:rs) of
|
||||
-- the head of the list. The implementation is given by the natural
|
||||
-- integration of a one-hole list cursor, back to a list.
|
||||
--
|
||||
index :: Eq a => StackSet i a s -> [a]
|
||||
index :: Eq a => StackSet i a s sd -> [a]
|
||||
index = with [] integrate
|
||||
|
||||
-- let is = t : r ++ reverse l in take (length is) (dropWhile (/= m) (cycle is))
|
||||
@@ -338,7 +341,7 @@ index = with [] integrate
|
||||
-- if we reach the end. Again the wrapping model should 'cycle' on
|
||||
-- the current stack.
|
||||
--
|
||||
focusUp, focusDown, swapUp, swapDown :: StackSet i a s -> StackSet i a s
|
||||
focusUp, focusDown, swapUp, swapDown :: StackSet i a s sd -> StackSet i a s sd
|
||||
focusUp = modify' focusUp'
|
||||
focusDown = modify' (reverseStack . focusUp' . reverseStack)
|
||||
|
||||
@@ -360,7 +363,7 @@ reverseStack (Stack t ls rs) = Stack t rs ls
|
||||
-- | /O(1) on current window, O(n) in general/. Focus the window 'w',
|
||||
-- and set its workspace as current.
|
||||
--
|
||||
focusWindow :: (Integral i, Eq s, Eq a) => a -> StackSet i a s -> StackSet i a s
|
||||
focusWindow :: (Integral i, Eq s, Eq a) => a -> StackSet i a s sd -> StackSet i a s sd
|
||||
focusWindow w s | Just w == peek s = s
|
||||
| otherwise = maybe s id $ do
|
||||
n <- findIndex w s
|
||||
@@ -369,11 +372,11 @@ focusWindow w s | Just w == peek s = s
|
||||
|
||||
|
||||
-- | Get a list of all workspaces in the StackSet.
|
||||
workspaces :: StackSet i a s -> [Workspace i a]
|
||||
workspaces :: StackSet i a s sd -> [Workspace i a]
|
||||
workspaces s = workspace (current s) : map workspace (visible s) ++ hidden s
|
||||
|
||||
-- | Is the given tag present in the StackSet?
|
||||
tagMember :: Eq i => i -> StackSet i a s -> Bool
|
||||
tagMember :: Eq i => i -> StackSet i a s sd -> Bool
|
||||
tagMember t = elem t . map tag . workspaces
|
||||
|
||||
-- |
|
||||
@@ -382,13 +385,13 @@ tagMember t = elem t . map tag . workspaces
|
||||
--
|
||||
|
||||
-- | /O(n)/. Is a window in the StackSet.
|
||||
member :: Eq a => a -> StackSet i a s -> Bool
|
||||
member :: Eq a => a -> StackSet i a s sd -> Bool
|
||||
member a s = maybe False (const True) (findIndex a s)
|
||||
|
||||
-- | /O(1) on current window, O(n) in general/.
|
||||
-- Return Just the workspace index of the given window, or Nothing
|
||||
-- if the window is not in the StackSet.
|
||||
findIndex :: Eq a => a -> StackSet i a s -> Maybe i
|
||||
findIndex :: Eq a => a -> StackSet i a s sd -> Maybe i
|
||||
findIndex a s = listToMaybe
|
||||
[ tag w | w <- workspaces s, has a (stack w) ]
|
||||
where has _ Nothing = False
|
||||
@@ -411,11 +414,11 @@ findIndex a s = listToMaybe
|
||||
-- Semantics in Huet's paper is that insert doesn't move the cursor.
|
||||
-- However, we choose to insert above, and move the focus.
|
||||
--
|
||||
insertUp :: Eq a => a -> StackSet i a s -> StackSet i a s
|
||||
insertUp :: Eq a => a -> StackSet i a s sd -> StackSet i a s sd
|
||||
insertUp a s = if member a s then s else insert
|
||||
where insert = modify (Just $ Stack a [] []) (\(Stack t l r) -> Just $ Stack a l (t:r)) s
|
||||
|
||||
-- insertDown :: a -> StackSet i a s -> StackSet i a s
|
||||
-- insertDown :: a -> StackSet i a s sd -> StackSet i a s sd
|
||||
-- insertDown a = modify (Stack a [] []) $ \(Stack t l r) -> Stack a (t:l) r
|
||||
-- Old semantics, from Huet.
|
||||
-- > w { down = a : down w }
|
||||
@@ -434,7 +437,7 @@ insertUp a s = if member a s then s else insert
|
||||
-- * deleting the master window resets it to the newly focused window
|
||||
-- * otherwise, delete doesn't affect the master.
|
||||
--
|
||||
delete :: (Integral i, Ord a, Eq s) => a -> StackSet i a s -> StackSet i a s
|
||||
delete :: (Integral i, Ord a, Eq s) => a -> StackSet i a s sd -> StackSet i a s sd
|
||||
delete w s | Just w == peek s = remove s -- common case.
|
||||
| otherwise = maybe s (removeWindow.tag.workspace.current $ s) (findIndex w s)
|
||||
where
|
||||
@@ -454,11 +457,11 @@ delete w s | Just w == peek s = remove s -- common case.
|
||||
|
||||
-- | Given a window, and its preferred rectangle, set it as floating
|
||||
-- A floating window should already be managed by the StackSet.
|
||||
float :: Ord a => a -> RationalRect -> StackSet i a s -> StackSet i a s
|
||||
float :: Ord a => a -> RationalRect -> StackSet i a s sd -> StackSet i a s sd
|
||||
float w r s = s { floating = M.insert w r (floating s) }
|
||||
|
||||
-- | Clear the floating status of a window
|
||||
sink :: Ord a => a -> StackSet i a s -> StackSet i a s
|
||||
sink :: Ord a => a -> StackSet i a s sd -> StackSet i a s sd
|
||||
sink w s = s { floating = M.delete w (floating s) }
|
||||
|
||||
------------------------------------------------------------------------
|
||||
@@ -467,7 +470,7 @@ sink w s = s { floating = M.delete w (floating s) }
|
||||
-- | /O(s)/. Set the master window to the focused window.
|
||||
-- The old master window is swapped in the tiling order with the focused window.
|
||||
-- Focus stays with the item moved.
|
||||
swapMaster :: StackSet i a s -> StackSet i a s
|
||||
swapMaster :: StackSet i a s sd -> StackSet i a s sd
|
||||
swapMaster = modify' $ \c -> case c of
|
||||
Stack _ [] _ -> c -- already master.
|
||||
Stack t ls rs -> Stack t [] (ys ++ x : rs) where (x:ys) = reverse ls
|
||||
@@ -483,7 +486,7 @@ swapMaster = modify' $ \c -> case c of
|
||||
-- The actual focused workspace doesn't change. If there is -- no
|
||||
-- element on the current stack, the original stackSet is returned.
|
||||
--
|
||||
shift :: (Ord a, Eq s, Integral i) => i -> StackSet i a s -> StackSet i a s
|
||||
shift :: (Ord a, Eq s, Integral i) => i -> StackSet i a s sd -> StackSet i a s sd
|
||||
shift n s = if and [n >= 0,n `tagMember` s, n /= tag (workspace (current s))]
|
||||
then maybe s go (peek s) else s
|
||||
where go w = foldr ($) s [view (tag (workspace (current s))),insertUp w,view n,delete w]
|
||||
|
||||
Reference in New Issue
Block a user