add sendMessageWithNoRefresh and have broadcastMessage use it

This patch:
- moves broadcastMessage and restart from Core to Operations (to avoid
  circular imports);
- in Operations introduces sendMessageWithNoRefresh and move
 updateLayout outside windows.
- broadcastMessage now uses sendMessageWithNoRefresh to obey to this
  rules:
  1. if handleMessage returns Nothing no action is taken;
  2. if handleMessage returns a Just ml *only* the layout field of the
     workspace record will be updated.

darcs-hash:20080223130702-32816-60d71cd8ac32cff1d4039947142332023274a725.gz

2 files changed, 37 insertions, 33 deletions

diff --git a/XMonad/Core.hs b/XMonad/Core.hs
index 1603034..ecbca29 100644
--- a/XMonad/Core.hs
+++ b/XMonad/Core.hs
@@ -25,8 +25,8 @@ module XMonad.Core (
     Layout(..), readsLayout, Typeable, Message,
     SomeMessage(..), fromMessage, LayoutMessages(..),
     runX, catchX, userCode, io, catchIO, doubleFork,
-    withDisplay, withWindowSet, isRoot, runOnWorkspaces, broadcastMessage,
-    getAtom, spawn, restart, getXMonadDir, recompile, trace, whenJust, whenX,
+    withDisplay, withWindowSet, isRoot, runOnWorkspaces,
+    getAtom, spawn, getXMonadDir, recompile, trace, whenJust, whenX,
     atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, ManageHook, Query(..), runQuery
   ) where
 
@@ -353,13 +353,6 @@ doubleFork m = io $ do
     getProcessStatus True False pid
     return ()
 
--- | 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 ()
-broadcastMessage a = runOnWorkspaces $ \w -> do
-    ml' <- handleMessage (layout w) (SomeMessage a) `catchX` return Nothing
-    return $ w { layout = maybe (layout w) id ml' }
-
 -- | This is basically a map function, running a function in the X monad on
 -- each workspace with the output of that function being the modified workspace.
 runOnWorkspaces :: (WindowSpace -> X WindowSpace) -> X ()
@@ -370,18 +363,6 @@ runOnWorkspaces job = do
              $ current ws : visible ws
     modify $ \s -> s { windowset = ws { current = c, visible = v, hidden = h } }
 
--- | @restart name resume@. Attempt to restart xmonad by executing the program
--- @name@.  If @resume@ is 'True', restart with the current window state.
--- When executing another window manager, @resume@ should be 'False'.
---
-restart :: String -> Bool -> X ()
-restart prog resume = do
-    broadcastMessage ReleaseResources
-    io . flush =<< asks display
-    args <- if resume then gets (("--resume":) . return . showWs . windowset) else return []
-    catchIO (executeFile prog True args Nothing)
- where showWs = show . mapLayout show
-
 -- | Return the path to @~\/.xmonad@.
 getXMonadDir :: MonadIO m => m String
 getXMonadDir = io $ getAppUserDataDirectory "xmonad"
diff --git a/XMonad/Operations.hs b/XMonad/Operations.hs
index 1953cb3..fed2643 100644
--- a/XMonad/Operations.hs
+++ b/XMonad/Operations.hs
@@ -36,6 +36,7 @@ import Control.Monad.State
 import qualified Control.Exception as C
 
 import System.IO
+import System.Posix.Process (executeFile)
 import Graphics.X11.Xlib
 import Graphics.X11.Xinerama (getScreenInfo)
 import Graphics.X11.Xlib.Extras
@@ -121,8 +122,8 @@ windows f = do
 
     -- notify non visibility
     let tags_oldvisible = map (W.tag . W.workspace) $ W.current old : W.visible old
-        gottenhidden    = filter (`elem` tags_oldvisible) $ map W.tag $ W.hidden ws
-    sendMessageToWorkspaces Hide gottenhidden
+        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
@@ -144,9 +145,7 @@ windows f = do
         -- now tile the windows on this workspace, modified by the gap
         (rs, ml') <- runLayout wsp { W.stack = tiled } viewrect`catchX` runLayout wsp { W.layout = Layout Full, W.stack = tiled } viewrect
         mapM_ (uncurry tileWindow) rs
-        whenJust ml' $ \l' -> runOnWorkspaces (\ww -> if W.tag ww == n
-                                                      then return $ ww { W.layout = l'}
-                                                      else return ww)
+        updateLayout n ml'
 
         -- now the floating windows:
         -- move/resize the floating windows, if there are any
@@ -338,13 +337,26 @@ sendMessage a = do
                                 { 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 $ \w ->
-   if W.tag w `elem` l
-      then do ml' <- handleMessage (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 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)
+
+-- | Send a message to a layout, without refreshing.
+sendMessageWithNoRefresh :: Message a => a -> W.Workspace WorkspaceId (Layout Window) Window -> X ()
+sendMessageWithNoRefresh a w =
+  handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing >>=
+  updateLayout  (W.tag    w)
+
+-- | Update the layout field of a workspace
+updateLayout :: WorkspaceId -> Maybe (Layout Window) -> X ()
+updateLayout i ml = whenJust ml $ \l ->
+                    runOnWorkspaces $ \ww -> if W.tag ww == i
+                                             then return $ ww { W.layout = l}
+                                             else return ww
 
 -- | Set the layout of the currently viewed workspace
 setLayout :: Layout Window -> X ()
@@ -387,6 +399,17 @@ initColor dpy c = C.handle (\_ -> return Nothing) $
     (Just . color_pixel . fst) <$> allocNamedColor dpy colormap c
     where colormap = defaultColormap dpy (defaultScreen dpy)
 
+-- | @restart name resume@. Attempt to restart xmonad by executing the program
+-- @name@.  If @resume@ is 'True', restart with the current window state.
+-- When executing another window manager, @resume@ should be 'False'.
+restart :: String -> Bool -> X ()
+restart prog resume = do
+    broadcastMessage ReleaseResources
+    io . flush =<< asks display
+    args <- if resume then gets (("--resume":) . return . showWs . windowset) else return []
+    catchIO (executeFile prog True args Nothing)
+ where showWs = show . W.mapLayout show
+
 ------------------------------------------------------------------------
 -- | Floating layer support