From 5b87ecbe82f6b979069ebf26dc8b3357867bea8b Mon Sep 17 00:00:00 2001 From: Matthias Schiffer Date: Wed, 4 Sep 2013 22:21:18 +0200 Subject: Per screen workspaces --- XMonad/Core.hs | 12 +++++---- XMonad/Main.hsc | 3 +-- XMonad/Operations.hs | 48 +++++++++++++++------------------ XMonad/StackSet.hs | 75 ++++++++++++++++++++++++---------------------------- 4 files changed, 65 insertions(+), 73 deletions(-) diff --git a/XMonad/Core.hs b/XMonad/Core.hs index 20d7258..e60a01a 100644 --- a/XMonad/Core.hs +++ b/XMonad/Core.hs @@ -48,7 +48,7 @@ import System.Posix.Types (ProcessID) import System.Process import System.Directory import System.Exit -import Graphics.X11.Xlib +import Graphics.X11.Xlib hiding (Screen) import Graphics.X11.Xlib.Extras (Event) import Data.Typeable import Data.List ((\\)) @@ -424,10 +424,12 @@ xfork x = io . forkProcess . finally nullStdin $ do runOnWorkspaces :: (WindowSpace -> X WindowSpace) -> X () runOnWorkspaces job = do ws <- gets windowset - h <- mapM job $ hidden ws - c:v <- mapM (\s -> (\w -> s { workspace = w}) <$> job (workspace s)) - $ current ws : visible ws - modify $ \s -> s { windowset = ws { current = c, visible = v, hidden = h } } + c:v <- mapM runOnScreen $ current ws : visible ws + modify $ \s -> s { windowset = ws { current = c, visible = v } } + where + runOnScreen scr@Screen { screenWorkspace = w, screenHidden = ws } = do + w':ws' <- mapM job (w:ws) + return scr { screenWorkspace = w', screenHidden = ws' } -- | Return the path to @~\/.xmonad@. getXMonadDir :: MonadIO m => m String diff --git a/XMonad/Main.hsc b/XMonad/Main.hsc index 5d59042..75cb94c 100644 --- a/XMonad/Main.hsc +++ b/XMonad/Main.hsc @@ -104,8 +104,7 @@ xmonad initxmc = do winset = fromMaybe initialWinset $ do ("--resume" : s : _) <- return args ws <- maybeRead reads s - return . W.ensureTags layout (workspaces xmc) - $ W.mapLayout (fromMaybe layout . maybeRead lreads) ws + return $ W.mapLayout (fromMaybe layout . maybeRead lreads) ws extState = fromMaybe M.empty $ do ("--resume" : _ : dyns : _) <- return args vals <- maybeRead reads dyns diff --git a/XMonad/Operations.hs b/XMonad/Operations.hs index 41fbed0..c005335 100644 --- a/XMonad/Operations.hs +++ b/XMonad/Operations.hs @@ -63,7 +63,7 @@ manage w = whenX (not <$> isClient w) $ withDisplay $ \d -> do f ws | isFixedSize || isTransient = W.float w (adjust rr) . W.insertUp w . W.view i $ ws | otherwise = W.insertUp w ws - where i = W.tag $ W.workspace $ W.current ws + where i = W.tag $ W.screenWorkspace $ W.current ws mh <- asks (manageHook . config) g <- appEndo <$> userCodeDef (Endo id) (runQuery mh w) @@ -104,7 +104,7 @@ kill = withFocused killWindow windows :: (WindowSet -> WindowSet) -> X () windows f = do XState { windowset = old } <- get - let oldvisible = concatMap (W.integrate' . W.stack . W.workspace) $ W.current old : W.visible old + let oldvisible = concatMap (W.integrate' . W.stack . W.screenWorkspace) $ W.screens old newwindows = W.allWindows ws \\ W.allWindows old ws = f old XConf { display = d , normalBorder = nbc, focusedBorder = fbc } <- ask @@ -115,18 +115,18 @@ windows f = do modify (\s -> s { windowset = ws }) -- notify non visibility - let tags_oldvisible = map (W.tag . W.workspace) $ W.current old : W.visible old + let tags_oldvisible = map (W.tag . W.screenWorkspace) $ W.screens old gottenhidden = filter (flip elem tags_oldvisible . W.tag) $ W.hidden ws mapM_ (sendMessageWithNoRefresh Hide) gottenhidden -- for each workspace, layout the currently visible workspaces let allscreens = W.screens ws - summed_visible = scanl (++) [] $ map (W.integrate' . W.stack . W.workspace) allscreens + summed_visible = scanl (++) [] $ map (W.integrate' . W.stack . W.screenWorkspace) allscreens rects <- fmap concat $ forM (zip allscreens summed_visible) $ \ (w, vis) -> do - let wsp = W.workspace w + let wsp = W.screenWorkspace w this = W.view n ws n = W.tag wsp - tiled = (W.stack . W.workspace . W.current $ this) + tiled = (W.stack . W.screenWorkspace . W.current $ this) >>= W.filter (`M.notMember` W.floating ws) >>= W.filter (`notElem` vis) viewrect = screenRect $ W.screenDetail w @@ -269,12 +269,11 @@ rescreen :: X () rescreen = do xinesc <- withDisplay getCleanedScreenInfo - windows $ \ws@(W.StackSet { W.current = v, W.visible = vs, W.hidden = hs }) -> - let (xs, ys) = splitAt (length xinesc) $ map W.workspace (v:vs) ++ hs - (a:as) = zipWith3 W.Screen xs [0..] $ map SD xinesc - in ws { W.current = a - , W.visible = as - , W.hidden = ys } + windows $ \ws -> + let (xs, ys) = splitAt (length xinesc) $ W.workspaces ws + (a:as) = zipWith3 (flip W.Screen []) xs [0..] $ map SD xinesc + in ws { W.current = a { W.screenHidden = ys } + , W.visible = as } -- --------------------------------------------------------------------- @@ -302,7 +301,7 @@ setTopFocus = withWindowSet $ maybe (setFocusX =<< asks theRoot) setFocusX . W.p -- the mouse to a new screen). focus :: Window -> X () focus w = local (\c -> c { mouseFocused = True }) $ withWindowSet $ \s -> do - let stag = W.tag . W.workspace + let stag = W.tag . W.screenWorkspace curr = stag $ W.current s mnew <- maybe (return Nothing) (fmap (fmap stag) . uncurry pointScreen) =<< asks mousePosition @@ -319,9 +318,9 @@ setFocusX w = withWindowSet $ \ws -> do dpy <- asks display -- clear mouse button grab and border on other windows - forM_ (W.current ws : W.visible ws) $ \wk -> - forM_ (W.index (W.view (W.tag (W.workspace wk)) ws)) $ \otherw -> - setButtonGrab True otherw + forM_ (W.screens ws) $ \wk -> + forM_ (W.index (W.view (W.tag (W.screenWorkspace wk)) ws)) $ \otherw -> + setButtonGrab True otherw -- If we ungrab buttons on the root window, we lose our mouse bindings. whenX (not <$> isRoot w) $ setButtonGrab False w @@ -354,20 +353,17 @@ setFocusX w = withWindowSet $ \ws -> do -- layout the windows, then refresh. sendMessage :: Message a => a -> X () sendMessage a = do - w <- W.workspace . W.current <$> gets windowset + w <- W.screenWorkspace . W.current <$> gets windowset ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing whenJust ml' $ \l' -> windows $ \ws -> ws { W.current = (W.current ws) - { W.workspace = (W.workspace $ W.current ws) + { W.screenWorkspace = (W.screenWorkspace $ W.current ws) { W.layout = l' }}} -- | Send a message to all layouts, without refreshing. broadcastMessage :: Message a => a -> X () -broadcastMessage a = withWindowSet $ \ws -> do - let c = W.workspace . W.current $ ws - v = map W.workspace . W.visible $ ws - h = W.hidden ws - mapM_ (sendMessageWithNoRefresh a) (c : v ++ h) +broadcastMessage a = withWindowSet $ \ws -> + mapM_ (sendMessageWithNoRefresh a) (W.workspaces ws) -- | Send a message to a layout, without refreshing. sendMessageWithNoRefresh :: Message a => a -> W.Workspace WorkspaceId (Layout Window) Window -> X () @@ -383,9 +379,9 @@ updateLayout i ml = whenJust ml $ \l -> -- | Set the layout of the currently viewed workspace setLayout :: Layout Window -> X () setLayout l = do - ss@(W.StackSet { W.current = c@(W.Screen { W.workspace = ws })}) <- gets windowset + ss@(W.StackSet { W.current = c@(W.Screen { W.screenWorkspace = ws })}) <- gets windowset handleMessage (W.layout ws) (SomeMessage ReleaseResources) - windows $ const $ ss {W.current = c { W.workspace = ws { W.layout = l } } } + windows $ const $ ss {W.current = c { W.screenWorkspace = ws { W.layout = l } } } ------------------------------------------------------------------------ -- Utilities @@ -479,7 +475,7 @@ float w = do (sc, rr) <- floatLocation w windows $ \ws -> W.float w rr . fromMaybe ws $ do i <- W.findTag w ws - guard $ i `elem` map (W.tag . W.workspace) (W.screens ws) + guard $ i `elem` concatMap (map W.tag . W.screenWorkspaces) (W.screens ws) f <- W.peek ws sw <- W.lookupWorkspace sc ws return (W.focusWindow f . W.shiftWin sw w $ ws) diff --git a/XMonad/StackSet.hs b/XMonad/StackSet.hs index a7e9f6b..da87ccf 100644 --- a/XMonad/StackSet.hs +++ b/XMonad/StackSet.hs @@ -31,12 +31,12 @@ module XMonad.StackSet ( -- * Xinerama operations -- $xinerama lookupWorkspace, - screens, workspaces, allWindows, currentTag, + screens, screenWorkspaces, workspaces, hidden, allWindows, currentTag, -- * Operations on the current stack -- $stackOperations peek, index, integrate, integrate', differentiate, focusUp, focusDown, focusUp', focusDown', focusMaster, focusWindow, - tagMember, renameTag, ensureTags, member, findTag, mapWorkspace, mapLayout, + tagMember, renameTag, member, findTag, mapWorkspace, mapLayout, -- * Modifying the stackset -- $modifyStackset insertUp, delete, delete', filter, @@ -52,9 +52,9 @@ module XMonad.StackSet ( ) where import Prelude hiding (filter) +import Data.Function (on) import Data.Maybe (listToMaybe,isJust,fromMaybe) 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 @@ -134,12 +134,12 @@ import qualified Data.Map as M (Map,insert,delete,empty) 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) +data Screen i l a sid sd = Screen { screenWorkspace :: !(Workspace i l a) + , screenHidden :: [Workspace i l a] , screen :: !sid , screenDetail :: !sd } deriving (Show, Read, Eq) @@ -195,9 +195,9 @@ abort x = error $ "xmonad: StackSet: " ++ x -- new :: (Integral s) => l -> [i] -> [sd] -> StackSet i l a s sd new l wids m | not (null wids) && length m <= length wids && not (null m) - = 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 ] + = StackSet cur visi M.empty + where (seen,_) = 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" @@ -210,21 +210,13 @@ new _ _ _ = abort "non-positive argument to StackSet.new" -- current. view :: (Eq s, Eq i) => i -> StackSet i l a s sd -> StackSet i l a s sd -view i s - | i == currentTag s = s -- current +view i s = s { current = head s', visible = tail s' } + where + s' = map makeVisible (current s : visible s) - | 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 -- not a member of the stackset - - where equating f = \x y -> f x == f y + makeVisible scr + | Just x <- L.find ((i==) . tag) (screenHidden scr) = scr { screenWorkspace = x, screenHidden = (screenWorkspace scr) : L.deleteBy ((==) `on` tag) x (screenHidden scr)} + | otherwise = scr -- 'Catch'ing this might be hard. Relies on monotonically increasing -- workspace tags defined in 'new' @@ -240,14 +232,15 @@ view i s -- swapped. greedyView :: (Eq s, Eq i) => i -> StackSet i l a s sd -> StackSet i l a s sd -greedyView w ws +{-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 + where wTag = (w == ) . tag-} +greedyView = view -- --------------------------------------------------------------------- -- $xinerama @@ -255,7 +248,7 @@ greedyView w ws -- | 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 ] +lookupWorkspace sc w = listToMaybe [ tag i | Screen i _ s _ <- current w : visible w, s == sc ] -- --------------------------------------------------------------------- -- $stackOperations @@ -267,14 +260,14 @@ lookupWorkspace sc w = listToMaybe [ tag i | Screen i s _ <- current w : visible -- 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 +with dflt f = maybe dflt f . stack . screenWorkspace . 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 }}} + { screenWorkspace = (screenWorkspace (current s)) { stack = with d f s }}} -- | -- Apply a function to modify the current stack if it isn't empty, and we don't @@ -379,7 +372,13 @@ 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 +workspaces s = concatMap screenWorkspaces $ (current s) : (visible s) + +screenWorkspaces :: Screen i l a sid sd -> [Workspace i l a] +screenWorkspaces scr = screenWorkspace scr : screenHidden scr + +hidden :: StackSet i l a s sd -> [Workspace i l a] +hidden = concatMap screenHidden . screens -- | Get a list of all windows in the 'StackSet' in no particular order allWindows :: Eq a => StackSet i l a s sd -> [a] @@ -387,7 +386,7 @@ allWindows = L.nub . concatMap (integrate' . stack) . workspaces -- | Get the tag of the currently focused workspace. currentTag :: StackSet i l a s sd -> i -currentTag = tag . workspace . current +currentTag = tag . screenWorkspace . current -- | Is the given tag present in the 'StackSet'? tagMember :: Eq i => i -> StackSet i l a s sd -> Bool @@ -401,25 +400,24 @@ renameTag o n = mapWorkspace rename -- | 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 :: 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 + 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) } + , visible = map updScr (visible s) } + where updScr scr = scr { screenWorkspace = f (screenWorkspace scr), screenHidden = map f (screenHidden 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 +mapLayout f (StackSet v vs m) = StackSet (fScreen v) (map fScreen vs) m where - fScreen (Screen ws s sd) = Screen (fWorkspace ws) s sd + fScreen (Screen ws hd s sd) = Screen (fWorkspace ws) (map fWorkspace hd) s sd fWorkspace (Workspace t l s) = Workspace t (f l) s -- | /O(n)/. Is a window in the 'StackSet'? @@ -483,11 +481,8 @@ 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) } +delete' w s = mapWorkspace removeFromWorkspace s where removeFromWorkspace ws = ws { stack = stack ws >>= filter (/=w) } - removeFromScreen scr = scr { workspace = removeFromWorkspace (workspace scr) } ------------------------------------------------------------------------ -- cgit v1.2.3