diff options
Diffstat (limited to 'StackSet.hs')
| -rw-r--r-- | StackSet.hs | 67 |
1 files changed, 35 insertions, 32 deletions
diff --git a/StackSet.hs b/StackSet.hs index 3d369f9..037b124 100644 --- a/StackSet.hs +++ b/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] |