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/Operations.hs | 48 ++++++++++++++++++++++-------------------------- 1 file changed, 22 insertions(+), 26 deletions(-) (limited to 'XMonad/Operations.hs') 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) -- cgit v1.2.3