From 3a4f45364645a772ddb8a8831845d4c856de70f0 Mon Sep 17 00:00:00 2001 From: Joscha Loos Date: Thu, 16 Feb 2023 23:10:50 +0100 Subject: [PATCH 1/6] feat: take focused window with you to new context --- XMonad/Actions/Contexts.hs | 35 ++++++++++++++++++++++++++++++----- 1 file changed, 30 insertions(+), 5 deletions(-) diff --git a/XMonad/Actions/Contexts.hs b/XMonad/Actions/Contexts.hs index 2bdfb16..a1b4a7a 100644 --- a/XMonad/Actions/Contexts.hs +++ b/XMonad/Actions/Contexts.hs @@ -9,11 +9,11 @@ module XMonad.Actions.Contexts ( deleteContext, showCurrentContextName, listContextNames, + moveWindowToContext, defaultContextName, showContextStorage ) where - import Control.Monad (when) import Data.Foldable (for_) import qualified Data.Map.Strict as Map @@ -50,15 +50,15 @@ defaultContextName = "default" switchContext :: Read (Layout Window) => ContextName -> X Bool switchContext name = do ctxStorage <- XS.get :: X ContextStorage - let (maybeNewCtx, newCtxMap) = findAndDelete name (ctxMap ctxStorage) + let (maybeNewCtx, newCtxMap) = findAndDelete name (ctxMap ctxStorage) -- get old case maybeNewCtx of Nothing -> return False Just newCtx -> do xstate <- get let currentCtx = Context (windowset xstate) - newCtxMap' = Map.insert (currentCtxName ctxStorage) currentCtx newCtxMap - XS.put $ ContextStorage name newCtxMap' - windows (const $ ctxWS newCtx) + newCtxMap' = Map.insert (currentCtxName ctxStorage) currentCtx newCtxMap -- store current in map + XS.put $ ContextStorage name newCtxMap' -- store map + windows (const $ ctxWS newCtx) -- load new context return True createAndSwitchContext :: Read (Layout Window) => ContextName -> X () @@ -67,6 +67,30 @@ createAndSwitchContext name = do _ <- switchContext name return () + +-- switch to new context while taking the current active window with you +moveWindowToContext :: Read (Layout Window) => ContextName -> X Bool +moveWindowToContext name = do + ctxStorage <- XS.get :: X ContextStorage + let (maybeNewCtx, newCtxMap) = findAndDelete name (ctxMap ctxStorage) + case maybeNewCtx of + Nothing -> return False -- context not found + Just newCtx -> do + maybeWindow <- W.peek <$> gets windowset -- get current active window + case maybeWindow of + Nothing -> return False -- no active window found + Just window -> do + xstate <- get + + let currentCtxModified = Context $ W.delete window (windowset xstate) -- remove focused window from window set of current contxt + modifiedCtxMap = Map.insert (currentCtxName ctxStorage) currentCtxModified newCtxMap -- store current but modified context + XS.put $ ContextStorage name modifiedCtxMap -- store + + let newCtxModified = Context $ W.insertUp window (ctxWS newCtx) -- insert focused window in new context + windows (const $ ctxWS newCtxModified) -- load new context? + + return True + createContext :: Read (Layout Window) => ContextName -> X () createContext name = do ctxStorage <- XS.get :: X ContextStorage @@ -112,6 +136,7 @@ newWS = withDisplay $ \dpy -> do sds = map SD xinesc return $ W.new layout workspaces' sds + findAndDelete :: ContextName -> ContextMap -> (Maybe Context, ContextMap) findAndDelete = Map.updateLookupWithKey (\_ _ -> Nothing) From 7cd9f3eb16eb356b2653f189267210283e926964 Mon Sep 17 00:00:00 2001 From: Joscha Loos Date: Sat, 18 Feb 2023 14:58:23 +0100 Subject: [PATCH 2/6] feat: store names of workspaces per context --- XMonad/Actions/Contexts.hs | 85 +++++++++++++++++++++++++++++++------- 1 file changed, 69 insertions(+), 16 deletions(-) diff --git a/XMonad/Actions/Contexts.hs b/XMonad/Actions/Contexts.hs index a1b4a7a..55a67ca 100644 --- a/XMonad/Actions/Contexts.hs +++ b/XMonad/Actions/Contexts.hs @@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE TupleSections #-} module XMonad.Actions.Contexts ( createContext, @@ -14,20 +15,28 @@ module XMonad.Actions.Contexts ( showContextStorage ) where +import System.IO + import Control.Monad (when) import Data.Foldable (for_) import qualified Data.Map.Strict as Map +import Data.Maybe (fromMaybe) import XMonad import qualified XMonad.StackSet as W import qualified XMonad.Util.ExtensibleState as XS +import XMonad.Actions.WorkspaceNames (setWorkspaceName, getWorkspaceName) type ContextName = String type ContextMap = Map.Map ContextName Context -newtype Context = Context - { ctxWS :: WindowSet +type WorkspaceNames = [(WorkspaceId, String)] + +data Context = Context + { ctxWS :: WindowSet + -- , workspaceNames :: WorkspaceNames + , workspaceNames :: WorkspaceNames } deriving Show deriving instance Read (Layout Window) => Read Context @@ -44,21 +53,27 @@ instance Read (Layout Window) => ExtensionClass ContextStorage where extensionType = PersistentExtension defaultContextName :: ContextName -defaultContextName = "default" +defaultContextName = "main" ------------------------------------------------------------------------------- switchContext :: Read (Layout Window) => ContextName -> X Bool -switchContext name = do +switchContext newContextName = do ctxStorage <- XS.get :: X ContextStorage - let (maybeNewCtx, newCtxMap) = findAndDelete name (ctxMap ctxStorage) -- get old + let (maybeNewCtx, contextMap) = findAndDelete newContextName (ctxMap ctxStorage) -- get new case maybeNewCtx of Nothing -> return False Just newCtx -> do xstate <- get - let currentCtx = Context (windowset xstate) - newCtxMap' = Map.insert (currentCtxName ctxStorage) currentCtx newCtxMap -- store current in map - XS.put $ ContextStorage name newCtxMap' -- store map - windows (const $ ctxWS newCtx) -- load new context + wsMap <- currentWorkspaceMap -- list of current workspaces + + let ctxMap' = Map.insert oldContextName oldContext contextMap -- store current context in map + where oldContext = Context (windowset xstate) wsMap -- current Context, including current names of workspaces + oldContextName = currentCtxName ctxStorage + + XS.put $ ContextStorage newContextName ctxMap' -- store context + + setWindowsAndWorkspaces newCtx + return True createAndSwitchContext :: Read (Layout Window) => ContextName -> X () @@ -68,11 +83,40 @@ createAndSwitchContext name = do return () + +-- set the window set and apply the workspaceNames +setWindowsAndWorkspaces :: Context -> X () +setWindowsAndWorkspaces ctx = do + let Context ctxWS workspaceNames = ctx + windows $ const ctxWS -- hide old windows and show windows from new context + mapM_ (uncurry setWorkspaceName) workspaceNames + + +-- Returns a map that contains all workspaces +currentWorkspaceMap :: X WorkspaceNames +currentWorkspaceMap = do + ws <- asks (workspaces . config) -- get list of Workspace tags + + -- helper function to load the current name of the workspace + let f :: WorkspaceId -> X (WorkspaceId, String) + f tag = do + name <- getWorkspaceName tag :: X (Maybe String) + return (tag, fromMaybe "" name) + + traverse f ws :: X WorkspaceNames -- traverse: Applies the functions and converts from [X (WorkspaceId, String)] to X [ (WorkspaceId, String) ] + +-- return the default workspace map +defaultWorkspaces :: X WorkspaceNames +defaultWorkspaces = do + ws <- asks (workspaces . config) + return $ map (,"") ws -- set every name to "" + + -- switch to new context while taking the current active window with you moveWindowToContext :: Read (Layout Window) => ContextName -> X Bool moveWindowToContext name = do ctxStorage <- XS.get :: X ContextStorage - let (maybeNewCtx, newCtxMap) = findAndDelete name (ctxMap ctxStorage) + let (maybeNewCtx, contextMap) = findAndDelete name (ctxMap ctxStorage) case maybeNewCtx of Nothing -> return False -- context not found Just newCtx -> do @@ -81,16 +125,24 @@ moveWindowToContext name = do Nothing -> return False -- no active window found Just window -> do xstate <- get + wsMap <- currentWorkspaceMap -- list of current workspaces + + let ctxMap' = Map.insert oldContextName oldContext contextMap -- store current context in map + where newWindowSet = W.delete window (windowset xstate) + oldContext = Context newWindowSet wsMap -- current Context, including current names of workspaces + oldContextName = currentCtxName ctxStorage + + XS.put $ ContextStorage name ctxMap' -- store changes - let currentCtxModified = Context $ W.delete window (windowset xstate) -- remove focused window from window set of current contxt - modifiedCtxMap = Map.insert (currentCtxName ctxStorage) currentCtxModified newCtxMap -- store current but modified context - XS.put $ ContextStorage name modifiedCtxMap -- store + let newCtx' = Context newWindowSet newWorkspaceNames -- insert focused window in new context + where newWindowSet = W.insertUp window (ctxWS newCtx) + newWorkspaceNames = workspaceNames newCtx - let newCtxModified = Context $ W.insertUp window (ctxWS newCtx) -- insert focused window in new context - windows (const $ ctxWS newCtxModified) -- load new context? + setWindowsAndWorkspaces newCtx' -- load new context return True +-- Creates a new context if not already existant createContext :: Read (Layout Window) => ContextName -> X () createContext name = do ctxStorage <- XS.get :: X ContextStorage @@ -98,7 +150,8 @@ createContext name = do && name /= currentCtxName ctxStorage && name `Map.notMember` ctxMap ctxStorage) $ do newWS' <- newWS - let newCtx = Context newWS' + defWs <- defaultWorkspaces + let newCtx = Context newWS' defWs -- create new context with new workspace names newCtxMap = Map.insert name newCtx (ctxMap ctxStorage) XS.put $ ctxStorage { ctxMap = newCtxMap } From 723a35ca2c91bb4572e6951e4495a31b99b3c603 Mon Sep 17 00:00:00 2001 From: Joscha Loos Date: Sat, 18 Feb 2023 15:04:52 +0100 Subject: [PATCH 3/6] refactor: change some variable names --- XMonad/Actions/Contexts.hs | 36 +++++++++++++++++------------------- 1 file changed, 17 insertions(+), 19 deletions(-) diff --git a/XMonad/Actions/Contexts.hs b/XMonad/Actions/Contexts.hs index 55a67ca..c755da2 100644 --- a/XMonad/Actions/Contexts.hs +++ b/XMonad/Actions/Contexts.hs @@ -34,8 +34,7 @@ type ContextMap = Map.Map ContextName Context type WorkspaceNames = [(WorkspaceId, String)] data Context = Context - { ctxWS :: WindowSet - -- , workspaceNames :: WorkspaceNames + { windowSet :: WindowSet , workspaceNames :: WorkspaceNames } deriving Show @@ -43,7 +42,7 @@ deriving instance Read (Layout Window) => Read Context data ContextStorage = ContextStorage { currentCtxName :: !ContextName - , ctxMap :: !ContextMap + , contextMap :: !ContextMap } deriving Show deriving instance Read (Layout Window) => Read ContextStorage @@ -53,20 +52,20 @@ instance Read (Layout Window) => ExtensionClass ContextStorage where extensionType = PersistentExtension defaultContextName :: ContextName -defaultContextName = "main" +defaultContextName = "Main" ------------------------------------------------------------------------------- switchContext :: Read (Layout Window) => ContextName -> X Bool switchContext newContextName = do ctxStorage <- XS.get :: X ContextStorage - let (maybeNewCtx, contextMap) = findAndDelete newContextName (ctxMap ctxStorage) -- get new + let (maybeNewCtx, ctxMap) = findAndDelete newContextName (contextMap ctxStorage) -- get new case maybeNewCtx of Nothing -> return False Just newCtx -> do xstate <- get wsMap <- currentWorkspaceMap -- list of current workspaces - let ctxMap' = Map.insert oldContextName oldContext contextMap -- store current context in map + let ctxMap' = Map.insert oldContextName oldContext ctxMap -- store current context in map where oldContext = Context (windowset xstate) wsMap -- current Context, including current names of workspaces oldContextName = currentCtxName ctxStorage @@ -83,12 +82,11 @@ createAndSwitchContext name = do return () - -- set the window set and apply the workspaceNames setWindowsAndWorkspaces :: Context -> X () setWindowsAndWorkspaces ctx = do - let Context ctxWS workspaceNames = ctx - windows $ const ctxWS -- hide old windows and show windows from new context + let Context windowSet workspaceNames = ctx + windows $ const windowSet -- hide old windows and show windows from new context mapM_ (uncurry setWorkspaceName) workspaceNames @@ -116,7 +114,7 @@ defaultWorkspaces = do moveWindowToContext :: Read (Layout Window) => ContextName -> X Bool moveWindowToContext name = do ctxStorage <- XS.get :: X ContextStorage - let (maybeNewCtx, contextMap) = findAndDelete name (ctxMap ctxStorage) + let (maybeNewCtx, ctxMap) = findAndDelete name (contextMap ctxStorage) case maybeNewCtx of Nothing -> return False -- context not found Just newCtx -> do @@ -127,7 +125,7 @@ moveWindowToContext name = do xstate <- get wsMap <- currentWorkspaceMap -- list of current workspaces - let ctxMap' = Map.insert oldContextName oldContext contextMap -- store current context in map + let ctxMap' = Map.insert oldContextName oldContext ctxMap -- store current context in map where newWindowSet = W.delete window (windowset xstate) oldContext = Context newWindowSet wsMap -- current Context, including current names of workspaces oldContextName = currentCtxName ctxStorage @@ -135,7 +133,7 @@ moveWindowToContext name = do XS.put $ ContextStorage name ctxMap' -- store changes let newCtx' = Context newWindowSet newWorkspaceNames -- insert focused window in new context - where newWindowSet = W.insertUp window (ctxWS newCtx) + where newWindowSet = W.insertUp window (windowSet newCtx) newWorkspaceNames = workspaceNames newCtx setWindowsAndWorkspaces newCtx' -- load new context @@ -148,24 +146,24 @@ createContext name = do ctxStorage <- XS.get :: X ContextStorage when (not (null name) && name /= currentCtxName ctxStorage - && name `Map.notMember` ctxMap ctxStorage) $ do + && name `Map.notMember` contextMap ctxStorage) $ do newWS' <- newWS defWs <- defaultWorkspaces let newCtx = Context newWS' defWs -- create new context with new workspace names - newCtxMap = Map.insert name newCtx (ctxMap ctxStorage) - XS.put $ ctxStorage { ctxMap = newCtxMap } + newCtxMap = Map.insert name newCtx (contextMap ctxStorage) + XS.put $ ctxStorage { contextMap = newCtxMap } deleteContext :: Read (Layout Window) => ContextName -> X Bool deleteContext name = do ctxStorage <- XS.get :: X ContextStorage - let (maybeCtx, newCtxMap) = findAndDelete name (ctxMap ctxStorage) + let (maybeCtx, newCtxMap) = findAndDelete name (contextMap ctxStorage) case maybeCtx of Nothing -> return False Just ctx -> do -- Kill all windows in that context - let windows' = W.allWindows $ ctxWS ctx + let windows' = W.allWindows $ windowSet ctx for_ windows' killWindow - XS.put $ ctxStorage { ctxMap = newCtxMap } + XS.put $ ctxStorage { contextMap = newCtxMap } return True showCurrentContextName :: Read (Layout Window) => X String @@ -176,7 +174,7 @@ showCurrentContextName = do listContextNames :: Read (Layout Window) => X [ContextName] listContextNames = do ctxStorage <- XS.get :: X ContextStorage - return $ Map.keys (ctxMap ctxStorage) + return $ Map.keys (contextMap ctxStorage) newWS :: X WindowSet newWS = withDisplay $ \dpy -> do From d450f66c1dfef76437fc9ff5e371606b372c6b91 Mon Sep 17 00:00:00 2001 From: jooooscha <57965027+jooooscha@users.noreply.github.com> Date: Sun, 9 Apr 2023 11:24:10 +0200 Subject: [PATCH 4/6] feat: specify fixed workspaces that are shared between all contexts (#3) --- XMonad/Actions/Contexts.hs | 92 +++++++++++++++++++++++++++++++------- 1 file changed, 75 insertions(+), 17 deletions(-) diff --git a/XMonad/Actions/Contexts.hs b/XMonad/Actions/Contexts.hs index c755da2..55e4353 100644 --- a/XMonad/Actions/Contexts.hs +++ b/XMonad/Actions/Contexts.hs @@ -6,11 +6,14 @@ module XMonad.Actions.Contexts ( createContext, switchContext, + switchContextFixedWs, createAndSwitchContext, + createAndSwitchContextFixedWs, deleteContext, showCurrentContextName, listContextNames, moveWindowToContext, + moveWindowToContextFixedWs, defaultContextName, showContextStorage ) where @@ -21,6 +24,7 @@ import Control.Monad (when) import Data.Foldable (for_) import qualified Data.Map.Strict as Map import Data.Maybe (fromMaybe) +import Data.List as L import XMonad import qualified XMonad.StackSet as W @@ -34,7 +38,7 @@ type ContextMap = Map.Map ContextName Context type WorkspaceNames = [(WorkspaceId, String)] data Context = Context - { windowSet :: WindowSet + { windowSet :: WindowSet , workspaceNames :: WorkspaceNames } deriving Show @@ -42,7 +46,7 @@ deriving instance Read (Layout Window) => Read Context data ContextStorage = ContextStorage { currentCtxName :: !ContextName - , contextMap :: !ContextMap + , contextMap :: !ContextMap } deriving Show deriving instance Read (Layout Window) => Read ContextStorage @@ -56,7 +60,10 @@ defaultContextName = "Main" ------------------------------------------------------------------------------- switchContext :: Read (Layout Window) => ContextName -> X Bool -switchContext newContextName = do +switchContext = switchContextFixedWs [] + +switchContextFixedWs :: Read (Layout Window) => [WorkspaceId] -> ContextName -> X Bool +switchContextFixedWs fixedWs newContextName = do ctxStorage <- XS.get :: X ContextStorage let (maybeNewCtx, ctxMap) = findAndDelete newContextName (contextMap ctxStorage) -- get new case maybeNewCtx of @@ -65,27 +72,76 @@ switchContext newContextName = do xstate <- get wsMap <- currentWorkspaceMap -- list of current workspaces + let oldContext = Context (windowset xstate) wsMap -- current Context, including current names of workspaces + let ctxMap' = Map.insert oldContextName oldContext ctxMap -- store current context in map - where oldContext = Context (windowset xstate) wsMap -- current Context, including current names of workspaces - oldContextName = currentCtxName ctxStorage + where oldContextName = currentCtxName ctxStorage XS.put $ ContextStorage newContextName ctxMap' -- store context - setWindowsAndWorkspaces newCtx + setWindowsAndWorkspaces fixedWs oldContext newCtx return True createAndSwitchContext :: Read (Layout Window) => ContextName -> X () -createAndSwitchContext name = do +createAndSwitchContext = createAndSwitchContextFixedWs [] + +createAndSwitchContextFixedWs :: Read (Layout Window) => [WorkspaceId] -> ContextName -> X () +createAndSwitchContextFixedWs fixedWs name = do createContext name - _ <- switchContext name + _ <- switchContextFixedWs fixedWs name return () +-- merge windows from second set into first set if the +-- corresponding workspace id is in the list +-- First Contxt is old; Second context is new +-- Note: visible, hidden, and current workspace(s) have to be handled separately +mergeContexts :: [WorkspaceId] -> Context -> Context -> Context +mergeContexts ids ctxOld ctxNew = do + + let stackNew = windowSet ctxNew -- Workspaces of new context + + -- first, merge hidden workspaces + let newHidden = map selectWorkspace (W.hidden stackNew) + + -- secondly, we merge visible workspaces + let newVisible = map selectScreen (W.visible stackNew) + + -- finally, we handle the currently focused workspace + let newFocused = selectScreen (W.current stackNew) + + -- update workspaces + let mergedStack = stackNew { + W.hidden = newHidden, + W.visible = newVisible, + W.current = newFocused + } + + Context mergedStack (workspaceNames ctxNew) + + where + selectScreen screen = do + let ws = W.workspace screen + screen { W.workspace = selectWorkspace ws } + + selectWorkspace ws = if W.tag ws `elem` ids then oldWs ws else ws + + workspacesOld = W.workspaces (windowSet ctxOld) + + {- oldWs :: W.Workspace i l a -> W.Workspace i l a -} + oldWs ws = fromMaybe ws (find (\x -> W.tag ws == W.tag x) workspacesOld) -- if tag is not found in workspacesOld, return new ws + -- set the window set and apply the workspaceNames -setWindowsAndWorkspaces :: Context -> X () -setWindowsAndWorkspaces ctx = do - let Context windowSet workspaceNames = ctx +setWindowsAndWorkspaces :: [WorkspaceId] -> Context -> Context -> X () +setWindowsAndWorkspaces fixedWs oldContext newContext = do + + -- copy fixed workspaces from curren context + let mergedContext = mergeContexts fixedWs oldContext newContext + + -- let Context windowSet workspaceNames = mergeContexts + let Context windowSet workspaceNames = mergedContext + windows $ const windowSet -- hide old windows and show windows from new context mapM_ (uncurry setWorkspaceName) workspaceNames @@ -109,10 +165,12 @@ defaultWorkspaces = do ws <- asks (workspaces . config) return $ map (,"") ws -- set every name to "" +moveWindowToContext :: Read (Layout Window) => ContextName -> X Bool +moveWindowToContext = moveWindowToContextFixedWs [] -- switch to new context while taking the current active window with you -moveWindowToContext :: Read (Layout Window) => ContextName -> X Bool -moveWindowToContext name = do +moveWindowToContextFixedWs :: Read (Layout Window) => [WorkspaceId] -> ContextName -> X Bool +moveWindowToContextFixedWs fixedWs name = do ctxStorage <- XS.get :: X ContextStorage let (maybeNewCtx, ctxMap) = findAndDelete name (contextMap ctxStorage) case maybeNewCtx of @@ -125,10 +183,10 @@ moveWindowToContext name = do xstate <- get wsMap <- currentWorkspaceMap -- list of current workspaces + let newWindowSet = W.delete window (windowset xstate) + let oldContext = Context newWindowSet wsMap -- current Context, including current names of workspaces let ctxMap' = Map.insert oldContextName oldContext ctxMap -- store current context in map - where newWindowSet = W.delete window (windowset xstate) - oldContext = Context newWindowSet wsMap -- current Context, including current names of workspaces - oldContextName = currentCtxName ctxStorage + where oldContextName = currentCtxName ctxStorage XS.put $ ContextStorage name ctxMap' -- store changes @@ -136,7 +194,7 @@ moveWindowToContext name = do where newWindowSet = W.insertUp window (windowSet newCtx) newWorkspaceNames = workspaceNames newCtx - setWindowsAndWorkspaces newCtx' -- load new context + setWindowsAndWorkspaces fixedWs oldContext newCtx' -- load new context return True From d222705e710667549309eda80f6dab49abba99fc Mon Sep 17 00:00:00 2001 From: Joscha Loos Date: Sun, 9 Apr 2023 11:28:28 +0200 Subject: [PATCH 5/6] feat: when using fixed workspaces, also copy workspace names --- XMonad/Actions/Contexts.hs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/XMonad/Actions/Contexts.hs b/XMonad/Actions/Contexts.hs index 55e4353..494ae92 100644 --- a/XMonad/Actions/Contexts.hs +++ b/XMonad/Actions/Contexts.hs @@ -118,7 +118,10 @@ mergeContexts ids ctxOld ctxNew = do W.current = newFocused } - Context mergedStack (workspaceNames ctxNew) + -- copy workspace names + let mergedWsNames = zipWith selectWsName (workspaceNames ctxOld) (workspaceNames ctxNew) + + Context mergedStack mergedWsNames where selectScreen screen = do @@ -129,9 +132,12 @@ mergeContexts ids ctxOld ctxNew = do workspacesOld = W.workspaces (windowSet ctxOld) - {- oldWs :: W.Workspace i l a -> W.Workspace i l a -} oldWs ws = fromMaybe ws (find (\x -> W.tag ws == W.tag x) workspacesOld) -- if tag is not found in workspacesOld, return new ws + + selectWsName (tag, nameOld) (_, nameNew) = if tag `elem` ids then (tag, nameOld) else (tag, nameNew) + + -- set the window set and apply the workspaceNames setWindowsAndWorkspaces :: [WorkspaceId] -> Context -> Context -> X () setWindowsAndWorkspaces fixedWs oldContext newContext = do From a05fe2fd80ff98d611d4d6a65ba905fac37911df Mon Sep 17 00:00:00 2001 From: Joscha Loos Date: Sun, 9 Apr 2023 23:01:06 +0200 Subject: [PATCH 6/6] feat: when deleting contexts, only kill windows that are not on fixed workspaces --- XMonad/Actions/Contexts.hs | 28 +++++++++++++++++++--------- 1 file changed, 19 insertions(+), 9 deletions(-) diff --git a/XMonad/Actions/Contexts.hs b/XMonad/Actions/Contexts.hs index 494ae92..2e62391 100644 --- a/XMonad/Actions/Contexts.hs +++ b/XMonad/Actions/Contexts.hs @@ -10,6 +10,7 @@ module XMonad.Actions.Contexts ( createAndSwitchContext, createAndSwitchContextFixedWs, deleteContext, + deleteContextFixedWs, showCurrentContextName, listContextNames, moveWindowToContext, @@ -134,7 +135,7 @@ mergeContexts ids ctxOld ctxNew = do oldWs ws = fromMaybe ws (find (\x -> W.tag ws == W.tag x) workspacesOld) -- if tag is not found in workspacesOld, return new ws - + selectWsName (tag, nameOld) (_, nameNew) = if tag `elem` ids then (tag, nameOld) else (tag, nameNew) @@ -217,18 +218,27 @@ createContext name = do newCtxMap = Map.insert name newCtx (contextMap ctxStorage) XS.put $ ctxStorage { contextMap = newCtxMap } + deleteContext :: Read (Layout Window) => ContextName -> X Bool -deleteContext name = do +deleteContext = deleteContextFixedWs [] + +deleteContextFixedWs :: Read (Layout Window) => [WorkspaceId] -> ContextName -> X Bool +deleteContextFixedWs ids name = do ctxStorage <- XS.get :: X ContextStorage let (maybeCtx, newCtxMap) = findAndDelete name (contextMap ctxStorage) case maybeCtx of - Nothing -> return False - Just ctx -> do - -- Kill all windows in that context - let windows' = W.allWindows $ windowSet ctx - for_ windows' killWindow - XS.put $ ctxStorage { contextMap = newCtxMap } - return True + Nothing -> return False + Just ctx -> do + -- Kill windows in that context that are not on fixed workspaces + let workspaces' = filter (\ws -> W.tag ws `notElem` ids) $ W.workspaces $ windowSet ctx + + for_ workspaces' killWindowsOnWs + XS.put $ ctxStorage { contextMap = newCtxMap } + return True + + where + getWindows = W.integrate' . W.stack + killWindowsOnWs ws = for_ (getWindows ws) killWindow showCurrentContextName :: Read (Layout Window) => X String showCurrentContextName = do