summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorAndrea Rossato <andrea.rossato@unibz.it>2008-02-23 14:07:02 +0100
committerAndrea Rossato <andrea.rossato@unibz.it>2008-02-23 14:07:02 +0100
commit128621bef7d80ea9bab9195eecc22bed8510c95f (patch)
treeb6e79e9f72637146917b3287286c28a327bd0c9b
parent3b07ee0b8a303bd305772336d716257b86e7c598 (diff)
downloadmetatile-128621bef7d80ea9bab9195eecc22bed8510c95f.tar
metatile-128621bef7d80ea9bab9195eecc22bed8510c95f.zip
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
-rw-r--r--XMonad/Core.hs23
-rw-r--r--XMonad/Operations.hs47
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