From ab881a7fd12848509e2b1d1d5b5caa2707d01173 Mon Sep 17 00:00:00 2001
From: Andrea Rossato <andrea.rossato@unibz.it>
Date: Mon, 24 Sep 2007 21:35:13 +0200
Subject: 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.

darcs-hash:20070924193513-32816-481296e85ba2d62d2d5dacd8eb49435d381f9877.gz
---
 Operations.hs | 23 ++++++++++++++++-------
 1 file changed, 16 insertions(+), 7 deletions(-)

(limited to 'Operations.hs')

diff --git a/Operations.hs b/Operations.hs
index 62780a4..d1bcad2 100644
--- a/Operations.hs
+++ b/Operations.hs
@@ -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:
-- 
cgit v1.2.3