mirror of
https://github.com/xmonad/xmonad.git
synced 2025-08-05 06:31:54 -07:00
Added LayoutMessages
This patch adds some more messages to manage layout: Hide is sent to layouts in that are not visible anymore. ReleaseReasourses is sent before a restart.
This commit is contained in:
@@ -102,23 +102,24 @@ kill = withDisplay $ \d -> withFocused $ \w -> do
|
||||
-- ---------------------------------------------------------------------
|
||||
-- Managing windows
|
||||
|
||||
data UnDoLayout = UnDoLayout deriving ( Typeable, Eq )
|
||||
instance Message UnDoLayout
|
||||
data LayoutMessages = Hide | ReleaseResources deriving ( Typeable, Eq )
|
||||
instance Message LayoutMessages
|
||||
|
||||
|
||||
-- | windows. Modify the current window list with a pure function, and refresh
|
||||
windows :: (WindowSet -> WindowSet) -> X ()
|
||||
windows f = do
|
||||
-- Notify visible layouts to remove decorations etc
|
||||
-- We cannot use sendMessage because this must not call refresh ever,
|
||||
-- and must be called on all visible workspaces.
|
||||
broadcastMessage UnDoLayout
|
||||
XState { windowset = old } <- get
|
||||
let oldvisible = concatMap (W.integrate' . W.stack . W.workspace) $ W.current old : W.visible old
|
||||
ws = f old
|
||||
modify (\s -> s { windowset = ws })
|
||||
d <- asks display
|
||||
|
||||
-- notify non visibility
|
||||
let oldvistags = map (W.tag . W.workspace) $ W.current old : W.visible old
|
||||
gottenHidden = filter (\w -> elem w oldvistags) $ map W.tag $ W.hidden ws
|
||||
sendMessageToWorkspaces 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
|
||||
@@ -302,6 +303,14 @@ sendMessage a = do w <- (W.workspace . W.current) `fmap` gets windowset
|
||||
{ W.workspace = (W.workspace $ W.current ws)
|
||||
{ W.layout = l' }}}
|
||||
|
||||
-- | Send a message to a list of workspaces' layouts, without necessarily refreshing.
|
||||
sendMessageToWorkspaces :: Message a => a -> [WorkspaceId] -> X ()
|
||||
sendMessageToWorkspaces a l = runOnWorkspaces modw
|
||||
where modw w = if W.tag w `elem` l
|
||||
then do ml' <- modifyLayout (W.layout w) (SomeMessage a) `catchX` return Nothing
|
||||
return $ w { W.layout = maybe (W.layout w) id ml' }
|
||||
else return w
|
||||
|
||||
-- | Send a message to all visible layouts, without necessarily refreshing.
|
||||
-- This is how we implement the hooks, such as UnDoLayout.
|
||||
broadcastMessage :: Message a => a -> X ()
|
||||
@@ -350,7 +359,7 @@ instance ReadableSomeLayout a => Layout LayoutSelection a where
|
||||
rls' = reverse . rls . reverse
|
||||
j s zs = case partition (\z -> s == fst z) zs of
|
||||
(xs,ys) -> xs++ys
|
||||
switchl f = do ml' <- modifyLayout l (SomeMessage UnDoLayout)
|
||||
switchl f = do ml' <- modifyLayout l (SomeMessage Hide)
|
||||
return $ Just (LayoutSelection $ f $ (n,fromMaybe l ml'):ls)
|
||||
-- otherwise, or if we don't understand the message, pass it along to the real
|
||||
-- layout:
|
||||
|
Reference in New Issue
Block a user