diff options
Diffstat (limited to 'XMonad/StackSet.hs')
-rw-r--r-- | XMonad/StackSet.hs | 565 |
1 files changed, 565 insertions, 0 deletions
diff --git a/XMonad/StackSet.hs b/XMonad/StackSet.hs new file mode 100644 index 0000000..cb19746 --- /dev/null +++ b/XMonad/StackSet.hs @@ -0,0 +1,565 @@ +{-# LANGUAGE PatternGuards #-} + +----------------------------------------------------------------------------- +-- | +-- Module : StackSet +-- Copyright : (c) Don Stewart 2007 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : dons@galois.com +-- Stability : experimental +-- Portability : portable, Haskell 98 +-- + +module XMonad.StackSet ( + -- * Introduction + -- $intro + StackSet(..), Workspace(..), Screen(..), Stack(..), RationalRect(..), + -- * Construction + -- $construction + new, view, greedyView, + -- * Xinerama operations + -- $xinerama + lookupWorkspace, + screens, workspaces, allWindows, + -- * Operations on the current stack + -- $stackOperations + peek, index, integrate, integrate', differentiate, + focusUp, focusDown, focusMaster, focusWindow, + tagMember, renameTag, ensureTags, member, findTag, mapWorkspace, mapLayout, + -- * Modifying the stackset + -- $modifyStackset + insertUp, delete, delete', filter, + -- * Setting the master window + -- $settingMW + swapUp, swapDown, swapMaster, modify, modify', float, sink, -- needed by users + -- * Composite operations + -- $composite + shift, shiftWin, + + -- for testing + abort + ) where + +import Prelude hiding (filter) +import Data.Maybe (listToMaybe,fromJust) +import qualified Data.List as L (deleteBy,find,splitAt,filter,nub) +import Data.List ( (\\) ) +import qualified Data.Map as M (Map,insert,delete,empty) + +-- $intro +-- +-- The 'StackSet' data type encodes a window manager abstraction. The +-- window manager is a set of virtual workspaces. On each workspace is a +-- stack of windows. A given workspace is always current, and a given +-- window on each workspace has focus. The focused window on the current +-- workspace is the one which will take user input. It can be visualised +-- as follows: +-- +-- > Workspace { 0*} { 1 } { 2 } { 3 } { 4 } +-- > +-- > Windows [1 [] [3* [6*] [] +-- > ,2*] ,4 +-- > ,5] +-- +-- Note that workspaces are indexed from 0, windows are numbered +-- uniquely. A '*' indicates the window on each workspace that has +-- focus, and which workspace is current. +-- +-- Zipper +-- +-- We encode all the focus tracking directly in the data structure, with a 'zipper': +-- +-- A Zipper is essentially an `updateable' and yet pure functional +-- cursor into a data structure. Zipper is also a delimited +-- continuation reified as a data structure. +-- +-- The Zipper lets us replace an item deep in a complex data +-- structure, e.g., a tree or a term, without an mutation. The +-- resulting data structure will share as much of its components with +-- the old structure as possible. +-- +-- Oleg Kiselyov, 27 Apr 2005, haskell\@, "Zipper as a delimited continuation" +-- +-- We use the zipper to keep track of the focused workspace and the +-- focused window on each workspace, allowing us to have correct focus +-- by construction. We closely follow Huet's original implementation: +-- +-- G. Huet, /Functional Pearl: The Zipper/, +-- 1997, J. Functional Programming 75(5):549-554. +-- and: +-- R. Hinze and J. Jeuring, /Functional Pearl: The Web/. +-- +-- and Conor McBride's zipper differentiation paper. +-- Another good reference is: +-- +-- The Zipper, Haskell wikibook +-- +-- Xinerama support: +-- +-- Xinerama in X11 lets us view multiple virtual workspaces +-- simultaneously. While only one will ever be in focus (i.e. will +-- receive keyboard events), other workspaces may be passively +-- viewable. We thus need to track which virtual workspaces are +-- associated (viewed) on which physical screens. To keep track of +-- this, StackSet keeps separate lists of visible but non-focused +-- workspaces, and non-visible workspaces. +-- +-- Master and Focus +-- +-- Each stack tracks a focused item, and for tiling purposes also tracks +-- a 'master' position. The connection between 'master' and 'focus' +-- needs to be well defined, particularly in relation to 'insert' and +-- 'delete'. +-- + +-- | +-- API changes from xmonad 0.1: +-- StackSet constructor arguments changed. StackSet workspace window screen +-- +-- * new, -- was: empty +-- +-- * view, +-- +-- * index, +-- +-- * peek, -- was: peek\/peekStack +-- +-- * focusUp, focusDown, -- was: rotate +-- +-- * swapUp, swapDown +-- +-- * focus -- was: raiseFocus +-- +-- * insertUp, -- was: insert\/push +-- +-- * delete, +-- +-- * swapMaster, -- was: promote\/swap +-- +-- * member, +-- +-- * shift, +-- +-- * lookupWorkspace, -- was: workspace +-- +-- * visibleWorkspaces -- gone. +-- +------------------------------------------------------------------------ +-- | +-- A cursor into a non-empty list of workspaces. +-- +-- We puncture the workspace list, producing a hole in the structure +-- used to track the currently focused workspace. The two other lists +-- that are produced are used to track those workspaces visible as +-- Xinerama screens, and those workspaces not visible anywhere. + +data StackSet i l a sid sd = + StackSet { current :: !(Screen i l a sid sd) -- ^ currently focused workspace + , visible :: [Screen i l a sid sd] -- ^ non-focused workspaces, visible in xinerama + , hidden :: [Workspace i l 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 l a sid sd = Screen { workspace :: !(Workspace i l a) + , screen :: !sid + , screenDetail :: !sd } + deriving (Show, Read, Eq) + +-- | +-- A workspace is just a tag - its index - and a stack +-- +data Workspace i l a = Workspace { tag :: !i, layout :: l, stack :: Maybe (Stack a) } + deriving (Show, Read, Eq) + +-- | A structure for window geometries +data RationalRect = RationalRect Rational Rational Rational Rational + deriving (Show, Read, Eq) + +-- | +-- A stack is a cursor onto a (possibly empty) window list. +-- The data structure tracks focus by construction, and +-- the master window is by convention the top-most item. +-- Focus operations will not reorder the list that results from +-- flattening the cursor. The structure can be envisaged as: +-- +-- > +-- master: < '7' > +-- > up | [ '2' ] +-- > +--------- [ '3' ] +-- > focus: < '4' > +-- > dn +----------- [ '8' ] +-- +-- A 'Stack' can be viewed as a list with a hole punched in it to make +-- the focused position. Under the zipper\/calculus view of such +-- structures, it is the differentiation of a [a], and integrating it +-- back has a natural implementation used in 'index'. +-- +data Stack a = Stack { focus :: !a -- focused thing in this set + , up :: [a] -- clowns to the left + , down :: [a] } -- jokers to the right + deriving (Show, Read, Eq) + + +-- | this function indicates to catch that an error is expected +abort :: String -> a +abort x = error $ "xmonad: StackSet: " ++ x + +-- --------------------------------------------------------------------- +-- $construction + +-- | /O(n)/. Create a new stackset, of empty stacks, with given tags, +-- with physical screens whose descriptions are given by 'm'. The +-- number of physical screens (@length 'm'@) should be less than or +-- equal to the number of workspace tags. The first workspace in the +-- list will be current. +-- +-- Xinerama: Virtual workspaces are assigned to physical screens, starting at 0. +-- +new :: (Integral s) => l -> [i] -> [sd] -> StackSet i l a s sd +new l wids m | not (null wids) && length m <= length wids = StackSet cur visi unseen M.empty + where (seen,unseen) = L.splitAt (length m) $ map (\i -> Workspace i l 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" + +-- | +-- /O(w)/. Set focus to the workspace with index \'i\'. +-- If the index is out of range, return the original StackSet. +-- +-- Xinerama: If the workspace is not visible on any Xinerama screen, it +-- becomes the current screen. If it is in the visible list, it becomes +-- current. + +view :: (Eq s, Eq i) => i -> StackSet i l a s sd -> StackSet i l a s sd +view i s + | not (i `tagMember` 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.deleteBy (equating screen) x (visible s) } + + | Just x <- L.find ((i==).tag) (hidden s) -- must be hidden then + -- if it was hidden, it is raised on the xine screen currently used + = s { current = (current s) { workspace = x } + , hidden = workspace (current s) : L.deleteBy (equating tag) x (hidden s) } + + | otherwise = s -- can't happen: all workspaces are either invalid, current, visible, or hidden + + where equating f = \x y -> f x == f y + + -- 'Catch'ing this might be hard. Relies on monotonically increasing + -- workspace tags defined in 'new' + -- + -- and now tags are not monotonic, what happens here? + +-- | +-- Set focus to the given workspace. If that workspace does not exist +-- in the stackset, the original workspace is returned. If that workspace is +-- 'hidden', then display that workspace on the current screen, and move the +-- current workspace to 'hidden'. If that workspace is 'visible' on another +-- screen, the workspaces of the current screen and the other screen are +-- swapped. + +greedyView :: (Eq s, Eq i) => i -> StackSet i l a s sd -> StackSet i l a s sd +greedyView w ws + | any wTag (hidden ws) = view w ws + | (Just s) <- L.find (wTag . workspace) (visible ws) + = ws { current = (current ws) { workspace = workspace s } + , visible = s { workspace = workspace (current ws) } + : L.filter (not . wTag . workspace) (visible ws) } + | otherwise = ws + where wTag = (w == ) . tag + +-- --------------------------------------------------------------------- +-- $xinerama + +-- | Find the tag of the workspace visible on Xinerama screen 'sc'. +-- Nothing if screen is out of bounds. +lookupWorkspace :: Eq s => s -> StackSet i l a s sd -> Maybe i +lookupWorkspace sc w = listToMaybe [ tag i | Screen i s _ <- current w : visible w, s == sc ] + +-- --------------------------------------------------------------------- +-- $stackOperations + +-- | +-- The 'with' function takes a default value, a function, and a +-- StackSet. If the current stack is Nothing, 'with' returns the +-- 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 l 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 :: Maybe (Stack a) -> (Stack a -> Maybe (Stack a)) -> StackSet i l a s sd -> StackSet i l a s sd +modify d f s = s { current = (current s) + { workspace = (workspace (current s)) { stack = with d f 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 l a s sd -> StackSet i l 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 l a s sd -> Maybe a +peek = with Nothing (return . focus) + +-- | +-- /O(n)/. Flatten a Stack into a list. +-- +integrate :: Stack a -> [a] +integrate (Stack x l r) = reverse l ++ x : r + +-- | +-- /O(n)/ Flatten a possibly empty stack into a list. +integrate' :: Maybe (Stack a) -> [a] +integrate' = maybe [] integrate + +-- | +-- /O(n)/. Turn a list into a possibly empty stack (i.e., a zipper): +-- the first element of the list is current, and the rest of the list +-- is down. +differentiate :: [a] -> Maybe (Stack a) +differentiate [] = Nothing +differentiate (x:xs) = Just $ Stack x [] xs + +-- | +-- /O(n)/. 'filter p s' returns the elements of 's' such that 'p' evaluates to +-- True. Order is preserved, and focus moves as described for 'delete'. +-- +filter :: (a -> Bool) -> Stack a -> Maybe (Stack a) +filter p (Stack f ls rs) = case L.filter p (f:rs) of + f':rs' -> Just $ Stack f' (L.filter p ls) rs' -- maybe move focus down + [] -> case L.filter p ls of -- filter back up + f':ls' -> Just $ Stack f' ls' [] -- else up + [] -> Nothing + +-- | +-- /O(s)/. Extract the stack on the current workspace, as a list. +-- The order of the stack is determined by the master window -- it will be +-- the head of the list. The implementation is given by the natural +-- integration of a one-hole list cursor, back to a list. +-- +index :: StackSet i l a s sd -> [a] +index = with [] integrate + +-- | +-- /O(1), O(w) on the wrapping case/. +-- +-- focusUp, focusDown. Move the window focus up or down the stack, +-- wrapping if we reach the end. The wrapping should model a 'cycle' +-- on the current stack. The 'master' window, and window order, +-- are unaffected by movement of focus. +-- +-- swapUp, swapDown, swap the neighbour in the stack ordering, wrapping +-- if we reach the end. Again the wrapping model should 'cycle' on +-- the current stack. +-- +focusUp, focusDown, swapUp, swapDown :: StackSet i l a s sd -> StackSet i l a s sd +focusUp = modify' focusUp' +focusDown = modify' (reverseStack . focusUp' . reverseStack) + +swapUp = modify' swapUp' +swapDown = modify' (reverseStack . swapUp' . reverseStack) + +focusUp', swapUp' :: Stack a -> Stack a +focusUp' (Stack t (l:ls) rs) = Stack l ls (t:rs) +focusUp' (Stack t [] rs) = Stack x xs [] where (x:xs) = reverse (t:rs) + +swapUp' (Stack t (l:ls) rs) = Stack t ls (l:rs) +swapUp' (Stack t [] rs) = Stack t (reverse rs) [] + +-- | reverse a stack: up becomes down and down becomes up. +reverseStack :: Stack a -> Stack a +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 :: (Eq s, Eq a, Eq i) => a -> StackSet i l a s sd -> StackSet i l a s sd +focusWindow w s | Just w == peek s = s + | otherwise = maybe s id $ do + n <- findTag w s + return $ until ((Just w ==) . peek) focusUp (view n s) + +-- | Get a list of all screens in the StackSet. +screens :: StackSet i l a s sd -> [Screen i l a s sd] +screens s = current s : visible s + +-- | Get a list of all workspaces in the StackSet. +workspaces :: StackSet i l a s sd -> [Workspace i l a] +workspaces s = workspace (current s) : map workspace (visible s) ++ hidden s + +-- | Get a list of all windows in the StackSet in no particular order +allWindows :: Eq a => StackSet i l a s sd -> [a] +allWindows = L.nub . concatMap (integrate' . stack) . workspaces + +-- | Is the given tag present in the StackSet? +tagMember :: Eq i => i -> StackSet i l a s sd -> Bool +tagMember t = elem t . map tag . workspaces + +-- | Rename a given tag if present in the StackSet. +renameTag :: Eq i => i -> i -> StackSet i l a s sd -> StackSet i l a s sd +renameTag o n = mapWorkspace rename + where rename w = if tag w == o then w { tag = n } else w + +-- | Ensure that a given set of workspace tags is present by renaming +-- existing workspaces and/or creating new hidden workspaces as +-- necessary. +ensureTags :: Eq i => l -> [i] -> StackSet i l a s sd -> StackSet i l a s sd +ensureTags l allt st = et allt (map tag (workspaces st) \\ allt) st + where et [] _ s = s + et (i:is) rn s | i `tagMember` s = et is rn s + et (i:is) [] s = et is [] (s { hidden = Workspace i l Nothing : hidden s }) + et (i:is) (r:rs) s = et is rs $ renameTag r i s + +-- | Map a function on all the workspaces in the StackSet. +mapWorkspace :: (Workspace i l a -> Workspace i l a) -> StackSet i l a s sd -> StackSet i l a s sd +mapWorkspace f s = s { current = updScr (current s) + , visible = map updScr (visible s) + , hidden = map f (hidden s) } + where updScr scr = scr { workspace = f (workspace scr) } + +-- | Map a function on all the layouts in the StackSet. +mapLayout :: (l -> l') -> StackSet i l a s sd -> StackSet i l' a s sd +mapLayout f (StackSet v vs hs m) = StackSet (fScreen v) (map fScreen vs) (map fWorkspace hs) m + where + fScreen (Screen ws s sd) = Screen (fWorkspace ws) s sd + fWorkspace (Workspace t l s) = Workspace t (f l) s + +-- | /O(n)/. Is a window in the StackSet. +member :: Eq a => a -> StackSet i l a s sd -> Bool +member a s = maybe False (const True) (findTag a s) + +-- | /O(1) on current window, O(n) in general/. +-- Return Just the workspace tag of the given window, or Nothing +-- if the window is not in the StackSet. +findTag :: Eq a => a -> StackSet i l a s sd -> Maybe i +findTag a s = listToMaybe + [ tag w | w <- workspaces s, has a (stack w) ] + where has _ Nothing = False + has x (Just (Stack t l r)) = x `elem` (t : l ++ r) + +-- --------------------------------------------------------------------- +-- $modifyStackset + +-- | +-- /O(n)/. (Complexity due to duplicate check). Insert a new element +-- into the stack, above the currently focused element. The new +-- element is given focus; the previously focused element is moved +-- down. +-- +-- If the element is already in the stackset, the original stackset is +-- returned unmodified. +-- +-- 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 l a s sd -> StackSet i l 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 l a s sd -> StackSet i l 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 } + +-- | +-- /O(1) on current window, O(n) in general/. Delete window 'w' if it exists. +-- There are 4 cases to consider: +-- +-- * delete on an Nothing workspace leaves it Nothing +-- * otherwise, try to move focus to the down +-- * otherwise, try to move focus to the up +-- * otherwise, you've got an empty workspace, becomes Nothing +-- +-- Behaviour with respect to the master: +-- +-- * deleting the master window resets it to the newly focused window +-- * otherwise, delete doesn't affect the master. +-- +delete :: (Ord a, Eq s) => a -> StackSet i l a s sd -> StackSet i l a s sd +delete w = sink w . delete' w + +-- | Only temporarily remove the window from the stack, thereby not destroying special +-- information saved in the Stackset +delete' :: (Eq a, Eq s) => a -> StackSet i l a s sd -> StackSet i l a s sd +delete' w s = s { current = removeFromScreen (current s) + , visible = map removeFromScreen (visible s) + , hidden = map removeFromWorkspace (hidden s) } + where removeFromWorkspace ws = ws { stack = stack ws >>= filter (/=w) } + removeFromScreen scr = scr { workspace = removeFromWorkspace (workspace scr) } + +------------------------------------------------------------------------ + +-- | 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 l a s sd -> StackSet i l 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 l a s sd -> StackSet i l a s sd +sink w s = s { floating = M.delete w (floating s) } + +------------------------------------------------------------------------ +-- $settingMW + +-- | /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 l a s sd -> StackSet i l a s sd +swapMaster = modify' $ \c -> case c of + Stack _ [] _ -> c -- already master. + Stack t ls rs -> Stack t [] (xs ++ x : rs) where (x:xs) = reverse ls + +-- natural! keep focus, move current to the top, move top to current. + +-- | /O(s)/. Set focus to the master window. +focusMaster :: StackSet i l a s sd -> StackSet i l a s sd +focusMaster = modify' $ \c -> case c of + Stack _ [] _ -> c + Stack t ls rs -> Stack x [] (xs ++ t : rs) where (x:xs) = reverse ls + +-- +-- --------------------------------------------------------------------- +-- $composite + +-- | /O(w)/. shift. Move the focused element of the current stack to stack +-- 'n', leaving it as the focused element on that stack. The item is +-- inserted above the currently focused element on that workspace. +-- 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, Eq i) => i -> StackSet i l a s sd -> StackSet i l a s sd +shift n s | n `tagMember` s && n /= curtag = maybe s go (peek s) + | otherwise = s + where go w = view curtag . insertUp w . view n . delete' w $ s + curtag = tag (workspace (current s)) + +-- | /O(n)/. shiftWin. Searches for the specified window 'w' on all workspaces +-- of the stackSet and moves it to stack 'n', leaving it as the focused +-- element on that stack. The item is inserted above the currently +-- focused element on that workspace. +-- The actual focused workspace doesn't change. If the window is not +-- found in the stackSet, the original stackSet is returned. +-- TODO how does this duplicate 'shift's behaviour? +shiftWin :: (Ord a, Eq a, Eq s, Eq i) => i -> a -> StackSet i l a s sd -> StackSet i l a s sd +shiftWin n w s | from == Nothing = s -- not found + | n `tagMember` s && (Just n) /= from = go + | otherwise = s + where from = findTag w s + + go = on n (insertUp w) . on (fromJust from) (delete' w) $ s + curtag = tag (workspace (current s)) + on i f = view curtag . f . view i + |