mirror of
https://github.com/xmonad/xmonad.git
synced 2025-07-26 01:31:53 -07:00
234 lines
9.6 KiB
Haskell
234 lines
9.6 KiB
Haskell
-----------------------------------------------------------------------------
|
|
-- |
|
|
-- Module : StackSet
|
|
-- Copyright : (c) Don Stewart 2007
|
|
-- License : BSD3-style (see LICENSE)
|
|
--
|
|
-- Maintainer : dons@cse.unsw.edu.au
|
|
-- Stability : stable
|
|
-- Portability : portable
|
|
--
|
|
-----------------------------------------------------------------------------
|
|
--
|
|
-- The 'StackSet' data type encodes a set of stacks. A given stack in the
|
|
-- set is always current. Elements may appear only once in the entire
|
|
-- stack set.
|
|
--
|
|
-- A StackSet provides a nice data structure for window managers with
|
|
-- multiple physical screens, and multiple workspaces, where each screen
|
|
-- has a stack of windows, and a window may be on only 1 screen at any
|
|
-- given time.
|
|
--
|
|
|
|
module StackSet (
|
|
StackSet(..), -- abstract
|
|
|
|
screen, peekStack, index, empty, peek, push, delete, member,
|
|
raiseFocus, rotate, promote, shift, view, workspace, insert,
|
|
visibleWorkspaces, swap {- helper -}
|
|
) where
|
|
|
|
import Data.Maybe
|
|
import qualified Data.List as L (delete,elemIndex)
|
|
import qualified Data.Map as M
|
|
|
|
------------------------------------------------------------------------
|
|
|
|
-- | The StackSet data structure. Multiple screens containing tables of
|
|
-- stacks, with a current pointer
|
|
data StackSet i j a =
|
|
StackSet
|
|
{ current :: !i -- ^ the currently visible stack
|
|
, screen2ws:: !(M.Map j i) -- ^ screen -> workspace
|
|
, ws2screen:: !(M.Map i j) -- ^ workspace -> screen map
|
|
, stacks :: !(M.Map i ([a], [a])) -- ^ screen -> (floating, normal)
|
|
, focus :: !(M.Map i [a]) -- ^ the stack of window focus in each stack
|
|
, cache :: !(M.Map a i) -- ^ a cache of windows back to their stacks
|
|
} deriving (Eq, Show)
|
|
|
|
-- The cache is used to check on insertion that we don't already have
|
|
-- this window managed on another stack
|
|
|
|
------------------------------------------------------------------------
|
|
|
|
-- | /O(n)/. Create a new stackset, of empty stacks, of size 'n',
|
|
-- indexed from 0, with 'm' screens. (also indexed from 0) The 0-indexed
|
|
-- stack will be current.
|
|
empty :: (Integral i, Integral j) => Int -> Int -> StackSet i j a
|
|
empty n m = StackSet { current = 0
|
|
, screen2ws = wsScrs2Works
|
|
, ws2screen = wsWorks2Scrs
|
|
, stacks = M.fromList (zip [0..fromIntegral n-1] (repeat ([], [])))
|
|
, focus = M.empty
|
|
, cache = M.empty }
|
|
|
|
where scrs_wrks = unzip $ map (\x -> (fromIntegral x, fromIntegral x)) [0..m-1]
|
|
scrs = fst scrs_wrks
|
|
wrks = snd scrs_wrks
|
|
wsScrs2Works = M.fromList (zip scrs wrks)
|
|
wsWorks2Scrs = M.fromList (zip wrks scrs)
|
|
|
|
-- | /O(log w)/. True if x is somewhere in the StackSet
|
|
member :: Ord a => a -> StackSet i j a -> Bool
|
|
member a w = M.member a (cache w)
|
|
|
|
-- | /O(log n)/. Looks up the workspace that x is in, if it is in the StackSet
|
|
-- lookup :: (Monad m, Ord a) => a -> StackSet i j a -> m i
|
|
-- lookup x w = M.lookup x (cache w)
|
|
|
|
-- | /O(n)/. Number of stacks
|
|
-- size :: StackSet i j a -> Int
|
|
-- size = M.size . stacks
|
|
|
|
------------------------------------------------------------------------
|
|
|
|
-- | Push. Insert an element onto the top of the current stack.
|
|
-- If the element is already in the current stack, it is moved to the top.
|
|
-- If the element is managed on another stack, it is removed from that
|
|
-- stack first.
|
|
push :: (Integral i, Ord a) => a -> StackSet i j a -> StackSet i j a
|
|
push k w = insert k (current w) w
|
|
|
|
-- | /O(log s)/. Extract the element on the top of the current stack. If no such
|
|
-- element exists, Nothing is returned.
|
|
peek :: Integral i => StackSet i j a -> Maybe a
|
|
peek w = peekStack (current w) w
|
|
|
|
-- | /O(log s)/. Extract the element on the top of the given stack. If no such
|
|
-- element exists, Nothing is returned.
|
|
peekStack :: Integral i => i -> StackSet i j a -> Maybe a
|
|
peekStack i w = M.lookup i (focus w) >>= maybeHead
|
|
|
|
maybeHead :: [a] -> Maybe a
|
|
maybeHead (x:_) = Just x
|
|
maybeHead [] = Nothing
|
|
|
|
-- | /O(log s)/. Set the focus for the given stack to the given element.
|
|
pushFocus :: (Eq a, Integral i) => i -> a -> StackSet i j a -> StackSet i j a
|
|
pushFocus i a w = w { focus = M.insert i ((a:) $ L.delete a $ M.findWithDefault [] i $ focus w) (focus w) }
|
|
|
|
popFocus :: (Eq a, Integral i) => i -> a -> StackSet i j a -> StackSet i j a
|
|
popFocus i a w = w { focus = M.update upd i (focus w) }
|
|
where upd xs = case L.delete a xs of [] -> Nothing; xs' -> Just xs'
|
|
|
|
-- | /O(log s)/. Index. Extract the stack at workspace 'n'.
|
|
-- If the index is invalid, returns Nothing.
|
|
index :: Integral i => i -> StackSet i j a -> Maybe [a]
|
|
index k w = fmap (uncurry (++)) $ M.lookup k (stacks w)
|
|
|
|
-- | view. Set the stack specified by the argument as being visible and the
|
|
-- current StackSet. If the stack wasn't previously visible, it will become
|
|
-- visible on the current screen. If the index is out of range 'view' returns
|
|
-- the initial 'StackSet' unchanged.
|
|
view :: (Integral i, Integral j) => i -> StackSet i j a -> StackSet i j a
|
|
view n w | M.member n (stacks w)
|
|
= if M.member n (ws2screen w) then w { current = n }
|
|
else maybe w tweak (screen (current w) w)
|
|
| otherwise = w
|
|
where
|
|
tweak sc = w { screen2ws = M.insert sc n (screen2ws w)
|
|
, ws2screen = M.insert n sc (M.filter (/=sc) (ws2screen w))
|
|
, current = n }
|
|
|
|
-- | That screen that workspace 'n' is visible on, if any.
|
|
screen :: Integral i => i -> StackSet i j a -> Maybe j
|
|
screen n w = M.lookup n (ws2screen w)
|
|
|
|
-- | The workspace visible on screen 'sc'. Nothing if screen is out of bounds.
|
|
workspace :: Integral j => j -> StackSet i j a -> Maybe i
|
|
workspace sc w = M.lookup sc (screen2ws w)
|
|
|
|
-- | A list of the currently visible workspaces.
|
|
visibleWorkspaces :: StackSet i j a -> [i]
|
|
visibleWorkspaces = M.keys . ws2screen
|
|
|
|
--
|
|
-- | /O(log n)/. rotate. cycle the current window list up or down.
|
|
-- Has the effect of rotating focus. In fullscreen mode this will cause
|
|
-- a new window to be visible.
|
|
--
|
|
-- rotate EQ --> [5,6,7,8,1,2,3,4]
|
|
-- rotate GT --> [6,7,8,1,2,3,4,5]
|
|
-- rotate LT --> [4,5,6,7,8,1,2,3]
|
|
--
|
|
-- where xs = [5..8] ++ [1..4]
|
|
--
|
|
rotate :: (Integral i, Eq a) => Ordering -> StackSet i j a -> StackSet i j a
|
|
rotate o w = maybe w id $ do
|
|
f <- peekStack (current w) w
|
|
s <- fmap (uncurry (++)) $ M.lookup (current w) (stacks w)
|
|
ea <- case o of EQ -> Nothing
|
|
_ -> elemAfter f (if o == GT then s else reverse s)
|
|
return $ pushFocus (current w) ea w
|
|
|
|
-- | /O(log n)/. shift. move the client on top of the current stack to
|
|
-- the top of stack 'n'. If the stack to move to is not valid, and
|
|
-- exception is thrown.
|
|
--
|
|
shift :: (Integral i, Ord a) => i -> StackSet i j a -> StackSet i j a
|
|
shift n w = maybe w (\k -> insert k n w) (peek w)
|
|
|
|
-- | /O(log n)/. Insert an element onto the top of stack 'n'.
|
|
-- If the element is already in the stack 'n', it is moved to the top.
|
|
-- If the element exists on another stack, it is removed from that stack.
|
|
-- If the index is wrong an exception is thrown.
|
|
--
|
|
insert :: (Integral i, Ord a) => a -> i -> StackSet i j a -> StackSet i j a
|
|
insert k n old = pushFocus n k $
|
|
new { cache = M.insert k n (cache new)
|
|
, stacks = M.adjust (\(f, ks) -> (f, k:ks)) n (stacks new) }
|
|
where new = delete k old
|
|
|
|
-- | /O(log n)/. Delete an element entirely from from the StackSet.
|
|
-- This can be used to ensure that a given element is not managed elsewhere.
|
|
-- If the element doesn't exist, the original StackSet is returned unmodified.
|
|
delete :: (Integral i, Ord a) => a -> StackSet i j a -> StackSet i j a
|
|
delete k w = maybe w del (M.lookup k (cache w))
|
|
where del i = popFocus i k $
|
|
w { cache = M.delete k (cache w)
|
|
, stacks = M.adjust (\(xs, ys) -> (L.delete k xs, L.delete k ys)) i (stacks w) }
|
|
|
|
-- | /O(log n)/. If the given window is contained in a workspace, make it the
|
|
-- focused window of that workspace, and make that workspace the current one.
|
|
raiseFocus :: (Integral i, Integral j, Ord a) => a -> StackSet i j a -> StackSet i j a
|
|
raiseFocus k w = maybe w (\i -> pushFocus i k $ view i w) $ M.lookup k (cache w)
|
|
|
|
-- | Swap the currently focused window with the master window (the
|
|
-- window on top of the stack). Focus moves to the master.
|
|
promote :: (Integral i, Ord a) => StackSet i j a -> StackSet i j a
|
|
promote w = maybe w id $ do
|
|
a <- peek w -- fail if null
|
|
(f, xs@(x:_)) <- M.lookup (current w) (stacks w)
|
|
let w' = w { stacks = M.insert (current w) (f, swap a x xs) (stacks w) }
|
|
return $ insert a (current w) w' -- and maintain focus (?)
|
|
|
|
-- | Swap first occurences of 'a' and 'b' in list.
|
|
-- If both elements are not in the list, the list is unchanged.
|
|
--
|
|
-- Given a set as a list (no duplicates)
|
|
--
|
|
-- > swap a b . swap a b == id
|
|
--
|
|
swap :: Eq a => a -> a -> [a] -> [a]
|
|
swap a b xs = maybe xs id $ do
|
|
ai <- L.elemIndex a xs
|
|
bi <- L.elemIndex b xs
|
|
return . insertAt bi a . insertAt ai b $ xs
|
|
where insertAt n x ys = as ++ x : drop 1 bs
|
|
where (as,bs) = splitAt n ys
|
|
|
|
--
|
|
-- cycling:
|
|
-- promote w = w { stacks = M.adjust next (current w) (stacks w) }
|
|
-- where next [] = []
|
|
-- next xs = last xs : init xs
|
|
--
|
|
|
|
-- | Returns true if the window is in the floating layer
|
|
isFloat :: (Ord a, Ord i) => a -> StackSet i j a -> Bool
|
|
isFloat k w = maybe False (elem k . fst . (stacks w M.!)) (M.lookup k (cache w))
|
|
|
|
-- | Find the element in the (circular) list after given element.
|
|
elemAfter :: Eq a => a -> [a] -> Maybe a
|
|
elemAfter w ws = listToMaybe . filter (/= w) . dropWhile (/= w) $ ws ++ ws
|