mirror of
https://github.com/xmonad/xmonad.git
synced 2025-08-01 20:51:55 -07:00
moved screen <-> workspace mapping from XMonad to StackSet
This commit is contained in:
@@ -136,7 +136,7 @@ keys = M.fromList $
|
||||
-- Keybindings to each screen :
|
||||
-- mod-wer (underneath 123) switches to physical/Xinerama screens 1 2 and 3
|
||||
++
|
||||
[((m .|. modMask, key), screenWS sc >>= f)
|
||||
| (key, sc) <- zip [xK_w, xK_e, xK_r] [1..]
|
||||
[((m .|. modMask, key), gets workspace >>= f . (+1) . fromMaybe 0 . W.workspace sc)
|
||||
| (key, sc) <- zip [xK_s, xK_d, xK_f] [0..]
|
||||
, (f, m) <- [(view, 0), (tag, shiftMask)]]
|
||||
|
||||
|
3
Main.hs
3
Main.hs
@@ -43,14 +43,13 @@ main = do
|
||||
let st = XState
|
||||
{ display = dpy
|
||||
, xineScreens = xinesc
|
||||
, wsOnScreen = M.fromList $ map (\n -> (n,n)) [0.. length xinesc - 1]
|
||||
, theRoot = rootw
|
||||
, wmdelete = wmdelt
|
||||
, wmprotocols = wmprot
|
||||
-- fromIntegral needed for X11 versions that use Int instead of CInt.
|
||||
, dimensions = (fromIntegral (displayWidth dpy dflt),
|
||||
fromIntegral (displayHeight dpy dflt))
|
||||
, workspace = W.empty workspaces
|
||||
, workspace = W.empty workspaces (length xinesc)
|
||||
, defaultLayoutDesc = startingLayoutDesc
|
||||
, layoutDescs = M.empty
|
||||
}
|
||||
|
@@ -25,10 +25,10 @@ import qualified StackSet as W
|
||||
-- screen and raises the window.
|
||||
refresh :: X ()
|
||||
refresh = do
|
||||
XState {workspace = ws, wsOnScreen = ws2sc, xineScreens = xinesc
|
||||
XState {workspace = ws, xineScreens = xinesc
|
||||
,display = d ,layoutDescs = fls ,defaultLayoutDesc = dfltfl } <- get
|
||||
|
||||
flip mapM_ (M.assocs ws2sc) $ \(n, scn) -> do
|
||||
flip mapM_ (M.assocs (W.screen2ws ws)) $ \(scn, n) -> do
|
||||
let sc = xinesc !! scn
|
||||
fl = M.findWithDefault dfltfl n fls
|
||||
mapM_ (\(w, rect) -> io $ moveWindowInside d w rect) $
|
||||
@@ -159,10 +159,10 @@ safeFocus w = do ws <- gets workspace
|
||||
-- | Explicitly set the keyboard focus to the given window
|
||||
setFocus :: Window -> X ()
|
||||
setFocus w = do
|
||||
XState { workspace = ws, wsOnScreen = ws2sc} <- get
|
||||
ws <- gets workspace
|
||||
|
||||
-- clear mouse button grab and border on other windows
|
||||
flip mapM_ (M.keys ws2sc) $ \n -> do
|
||||
flip mapM_ (W.visibleWorkspaces ws) $ \n -> do
|
||||
flip mapM_ (W.index n ws) $ \otherw -> do
|
||||
setButtonGrab True otherw
|
||||
setBorder otherw 0xdddddd
|
||||
@@ -228,22 +228,13 @@ tag o = do
|
||||
-- | view. Change the current workspace to workspce at offset 'n-1'.
|
||||
view :: Int -> X ()
|
||||
view o = do
|
||||
XState { workspace = ws, wsOnScreen = ws2sc } <- get
|
||||
ws <- gets workspace
|
||||
let m = W.current ws
|
||||
-- is the workspace we want to switch to currently visible?
|
||||
if M.member n ws2sc
|
||||
then windows $ W.view n
|
||||
else do
|
||||
sc <- case M.lookup m ws2sc of
|
||||
Nothing -> do
|
||||
trace "Current workspace isn't visible! This should never happen!"
|
||||
-- we don't know what screen to use, just use the first one.
|
||||
return 0
|
||||
Just sc -> return sc
|
||||
modify $ \s -> s { wsOnScreen = M.insert n sc (M.filter (/=sc) ws2sc) }
|
||||
gets wsOnScreen >>= trace . show
|
||||
windows $ W.view n
|
||||
mapM_ hide (W.index m ws)
|
||||
windows $ W.view n
|
||||
ws' <- gets workspace
|
||||
-- If the old workspace isn't visible anymore, we have to hide the windows
|
||||
-- in case we're switching to an empty workspace.
|
||||
when (m `notElem` (W.visibleWorkspaces ws')) (mapM_ hide (W.index m ws))
|
||||
setTopFocus
|
||||
where n = o-1
|
||||
|
||||
@@ -251,15 +242,6 @@ view o = do
|
||||
isClient :: Window -> X Bool
|
||||
isClient w = liftM (W.member w) (gets workspace)
|
||||
|
||||
-- | screenWS. Returns the workspace currently visible on screen n
|
||||
screenWS :: Int -> X Int
|
||||
screenWS n = do
|
||||
ws2sc <- gets wsOnScreen
|
||||
-- FIXME: It's ugly to have to query this way. We need a different way to
|
||||
-- keep track of screen <-> workspace mappings.
|
||||
let ws = fmap fst $ find (\(_, scn) -> scn == (n-1)) (M.assocs ws2sc)
|
||||
return $ (fromMaybe 0 ws) + 1
|
||||
|
||||
-- | Restart xmonad by exec()'ing self. This doesn't save state and xmonad has
|
||||
-- to be in PATH for this to work.
|
||||
restart :: IO ()
|
||||
@@ -272,8 +254,8 @@ restart = do
|
||||
-- and -w options.)
|
||||
dmenu :: X ()
|
||||
dmenu = do
|
||||
XState { xineScreens = xinesc, workspace = ws, wsOnScreen = ws2sc } <- get
|
||||
let curscreen = fromMaybe 0 (M.lookup (W.current ws) ws2sc)
|
||||
XState { xineScreens = xinesc, workspace = ws } <- get
|
||||
let curscreen = fromMaybe 0 (M.lookup (W.current ws) (W.ws2screen ws))
|
||||
sc = xinesc !! curscreen
|
||||
spawn $ concat [ "exe=`dmenu_path | dmenu -x ", show (rect_x sc)
|
||||
, " -w " , show (rect_width sc) , "` && exec $exe" ]
|
||||
|
60
StackSet.hs
60
StackSet.hs
@@ -35,10 +35,12 @@ import qualified Data.Map as M
|
||||
-- | The StackSet data structure. A table of stacks, with a current pointer
|
||||
data StackSet a =
|
||||
StackSet
|
||||
{ current:: {-# UNPACK #-} !Int -- ^ the currently visible stack
|
||||
, stacks :: {-# UNPACK #-} !(M.Map Int [a]) -- ^ the separate stacks
|
||||
, focus :: {-# UNPACK #-} !(M.Map Int a) -- ^ the window focused in each stack
|
||||
, cache :: {-# UNPACK #-} !(M.Map a Int) -- ^ a cache of windows back to their stacks
|
||||
{ current :: !Int -- ^ the currently visible stack
|
||||
, ws2screen:: !(M.Map Int Int) -- ^ workspace -> screen map
|
||||
, screen2ws:: !(M.Map Int Int) -- ^ screen -> workspace
|
||||
, stacks :: !(M.Map Int [a]) -- ^ the separate stacks
|
||||
, focus :: !(M.Map Int a) -- ^ the window focused in each stack
|
||||
, cache :: !(M.Map a Int) -- ^ a cache of windows back to their stacks
|
||||
} deriving Eq
|
||||
|
||||
instance Show a => Show (StackSet a) where
|
||||
@@ -51,13 +53,16 @@ instance Show a => Show (StackSet a) where
|
||||
|
||||
------------------------------------------------------------------------
|
||||
|
||||
-- | /O(n)/. Create a new empty stacks of size 'n', indexed from 0. The
|
||||
-- 0-indexed stack will be current.
|
||||
empty :: Int -> StackSet a
|
||||
empty n = StackSet { current = 0
|
||||
, stacks = M.fromList (zip [0..n-1] (repeat []))
|
||||
, focus = M.empty
|
||||
, cache = M.empty }
|
||||
-- | /O(n)/. Create a new empty stacks of size 'n', indexed from 0, with 'm'
|
||||
-- screens. (also indexed from 0) The 0-indexed stack will be current.
|
||||
empty :: Int -> Int -> StackSet a
|
||||
empty n m = StackSet { current = 0
|
||||
, ws2screen = wsScreenAssn
|
||||
, screen2ws = wsScreenAssn
|
||||
, stacks = M.fromList (zip [0..n-1] (repeat []))
|
||||
, focus = M.empty
|
||||
, cache = M.empty }
|
||||
where wsScreenAssn = M.fromList $ map (\x -> (x,x)) [0..m-1]
|
||||
|
||||
-- | /O(log w)/. True if x is somewhere in the StackSet
|
||||
member :: Ord a => a -> StackSet a -> Bool
|
||||
@@ -75,6 +80,7 @@ size = M.size . stacks
|
||||
|
||||
-- | fromList. Build a new StackSet from a list of list of elements
|
||||
-- If there are duplicates in the list, the last occurence wins.
|
||||
-- FIXME: This always makes a StackSet with 1 screen.
|
||||
fromList :: Ord a => (Int,[[a]]) -> StackSet a
|
||||
fromList (_,[]) = error "Cannot build a StackSet from an empty list"
|
||||
|
||||
@@ -83,7 +89,7 @@ fromList (n,xs) | n < 0 || n >= length xs
|
||||
|
||||
fromList (o,xs) = view o $ foldr (\(i,ys) s ->
|
||||
foldr (\a t -> insert a i t) s ys)
|
||||
(empty (length xs)) (zip [0..] xs)
|
||||
(empty (length xs) 1) (zip [0..] xs)
|
||||
|
||||
-- | toList. Flatten a stackset to a list of lists
|
||||
toList :: StackSet a -> (Int,[[a]])
|
||||
@@ -111,12 +117,34 @@ peekStack n w = M.lookup n (focus w)
|
||||
index :: Int -> StackSet a -> [a]
|
||||
index k w = fromJust (M.lookup k (stacks w))
|
||||
|
||||
-- | /O(1)/. view. Set the stack specified by the Int argument as being the
|
||||
-- current StackSet. If the index is out of range an exception is thrown.
|
||||
-- | view. Set the stack specified by the Int 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 an exception is
|
||||
-- thrown.
|
||||
view :: Int -> StackSet a -> StackSet a
|
||||
view n w | n >= 0 && n < M.size (stacks w) = w { current = n }
|
||||
view n w | n >= 0 && n < M.size (stacks w) = if M.member n (ws2screen w)
|
||||
then w { current = n }
|
||||
else tweak (fromJust $ screen (current w) w)
|
||||
| otherwise = error $ "view: index out of bounds: " ++ show n
|
||||
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 :: Int -> StackSet a -> Maybe Int
|
||||
screen n w = M.lookup n (ws2screen w)
|
||||
|
||||
-- | The workspace visible on screen 'sc'. Nothing if screen is out of bounds.
|
||||
workspace :: Int -> StackSet a -> Maybe Int
|
||||
workspace sc w = M.lookup sc $ ws2screen w
|
||||
|
||||
-- | A list of the currently visible workspaces.
|
||||
visibleWorkspaces :: StackSet a -> [Int]
|
||||
visibleWorkspaces = M.keys . ws2screen
|
||||
|
||||
--
|
||||
-- | /O(log n)/. rotate. cycle the current window list up or down.
|
||||
--
|
||||
-- rotate EQ --> [5,6,7,8,1,2,3,4]
|
||||
@@ -171,7 +199,7 @@ delete k w = maybe w tweak (M.lookup k (cache w))
|
||||
raiseFocus :: Ord a => a -> StackSet a -> StackSet a
|
||||
raiseFocus k w = case M.lookup k (cache w) of
|
||||
Nothing -> w
|
||||
Just i -> w { focus = M.insert i k (focus w), current = i }
|
||||
Just i -> (view i w) { focus = M.insert i k (focus w) }
|
||||
|
||||
-- | Move a window to the top of its workspace.
|
||||
promote :: Ord a => a -> StackSet a -> StackSet a
|
||||
|
@@ -37,7 +37,6 @@ data XState = XState
|
||||
|
||||
, xineScreens :: ![Rectangle] -- ^ dimensions of each screen
|
||||
|
||||
, wsOnScreen :: !(M.Map Int Int) -- ^ mapping of workspaces to xinerama screen numbers
|
||||
, theRoot :: !Window -- ^ the root window
|
||||
, wmdelete :: !Atom -- ^ window deletion atom
|
||||
, wmprotocols :: !Atom -- ^ wm protocols atom
|
||||
|
@@ -31,22 +31,22 @@ instance (Ord a, Arbitrary a) => Arbitrary (StackSet a) where
|
||||
prop_id x = fromList (toList x) == x
|
||||
where _ = x :: T
|
||||
|
||||
prop_member1 i n = member i (push i x)
|
||||
where x = empty n :: T
|
||||
prop_member1 i n m = member i (push i x)
|
||||
where x = empty n m :: T
|
||||
|
||||
prop_member2 i x = not (member i (delete i x))
|
||||
where _ = x :: T
|
||||
|
||||
prop_member3 i n = member i (empty n :: T) == False
|
||||
prop_member3 i n m = member i (empty n m :: T) == False
|
||||
|
||||
prop_sizepush is n = n > 0 ==> size (foldr push x is ) == n
|
||||
where x = empty n :: T
|
||||
prop_sizepush is n m = n > 0 ==> size (foldr push x is ) == n
|
||||
where x = empty n m :: T
|
||||
|
||||
prop_currentpush is n = n > 0 ==>
|
||||
prop_currentpush is n m = n > 0 ==>
|
||||
height (current x) (foldr push x js) == length js
|
||||
where
|
||||
js = nub is
|
||||
x = empty n :: T
|
||||
x = empty n m :: T
|
||||
|
||||
prop_pushpeek x is = not (null is) ==> fromJust (peek (foldr push x is)) == head is
|
||||
where _ = x :: T
|
||||
@@ -86,6 +86,16 @@ prop_fullcache x = cached == allvals where
|
||||
allvals = sort . concat . elems $ stacks x
|
||||
_ = x :: T
|
||||
|
||||
prop_currentwsvisible x = (current x) `elem` (visibleWorkspaces x)
|
||||
where _ = x :: T
|
||||
|
||||
prop_ws2screen_screen2ws x = (ws == ws') && (sc == sc')
|
||||
where ws = sort . keys $ ws2screen x
|
||||
ws' = sort . elems $ screen2ws x
|
||||
sc = sort . keys $ screen2ws x
|
||||
sc' = sort . elems $ ws2screen x
|
||||
_ = x :: T
|
||||
|
||||
------------------------------------------------------------------------
|
||||
|
||||
main :: IO ()
|
||||
@@ -110,6 +120,8 @@ main = do
|
||||
,("rotate/rotate ", mytest prop_rotaterotate)
|
||||
,("view/view ", mytest prop_viewview)
|
||||
,("fullcache ", mytest prop_fullcache)
|
||||
,("currentwsvisible ", mytest prop_currentwsvisible)
|
||||
,("ws screen mapping", mytest prop_ws2screen_screen2ws)
|
||||
]
|
||||
|
||||
debug = False
|
||||
|
Reference in New Issue
Block a user