runLayout is now a LayoutClass method and takes the Workspace and the screen Rectangle

This commit is contained in:
Andrea Rossato
2008-02-22 17:58:15 +00:00
parent 310c22694e
commit 669a162cfc
2 changed files with 12 additions and 12 deletions

View File

@@ -23,7 +23,7 @@ module XMonad.Core (
ScreenId(..), ScreenDetail(..), XState(..), ScreenId(..), ScreenDetail(..), XState(..),
XConf(..), XConfig(..), LayoutClass(..), XConf(..), XConfig(..), LayoutClass(..),
Layout(..), readsLayout, Typeable, Message, Layout(..), readsLayout, Typeable, Message,
SomeMessage(..), fromMessage, runLayout, LayoutMessages(..), SomeMessage(..), fromMessage, LayoutMessages(..),
runX, catchX, userCode, io, catchIO, doubleFork, runX, catchX, userCode, io, catchIO, doubleFork,
withDisplay, withWindowSet, isRoot, runOnWorkspaces, broadcastMessage, withDisplay, withWindowSet, isRoot, runOnWorkspaces, broadcastMessage,
getAtom, spawn, restart, getXMonadDir, recompile, trace, whenJust, whenX, getAtom, spawn, restart, getXMonadDir, recompile, trace, whenJust, whenX,
@@ -206,6 +206,11 @@ readsLayout (Layout l) s = [(Layout (asTypeOf x l), rs) | (x, rs) <- reads s]
-- --
class Show (layout a) => LayoutClass layout a where class Show (layout a) => LayoutClass layout a where
-- | This calls doLayout if there are any windows to be laid out, and
-- emptyLayout otherwise.
runLayout :: Workspace WorkspaceId (layout a) a -> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (Workspace _ l ms) r = maybe (emptyLayout l r) (doLayout l r) ms
-- | Given a Rectangle in which to place the windows, and a Stack -- | Given a Rectangle in which to place the windows, and a Stack
-- of windows, return a list of windows and their corresponding -- of windows, return a list of windows and their corresponding
-- Rectangles. If an element is not given a Rectangle by -- Rectangles. If an element is not given a Rectangle by
@@ -231,7 +236,6 @@ class Show (layout a) => LayoutClass layout a where
-- 'handleMessage' returns Nothing, then the layout did not respond to -- 'handleMessage' returns Nothing, then the layout did not respond to
-- that message and the screen is not refreshed. Otherwise, 'handleMessage' -- that message and the screen is not refreshed. Otherwise, 'handleMessage'
-- returns an updated 'Layout' and the screen is refreshed. -- returns an updated 'Layout' and the screen is refreshed.
--
handleMessage :: layout a -> SomeMessage -> X (Maybe (layout a)) handleMessage :: layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l = return . pureMessage l handleMessage l = return . pureMessage l
@@ -246,6 +250,7 @@ class Show (layout a) => LayoutClass layout a where
description = show description = show
instance LayoutClass Layout Window where instance LayoutClass Layout Window where
runLayout (Workspace i (Layout l) ms) r = fmap (fmap Layout) `fmap` runLayout (Workspace i l ms) r
doLayout (Layout l) r s = fmap (fmap Layout) `fmap` doLayout l r s doLayout (Layout l) r s = fmap (fmap Layout) `fmap` doLayout l r s
emptyLayout (Layout l) r = fmap (fmap Layout) `fmap` emptyLayout l r emptyLayout (Layout l) r = fmap (fmap Layout) `fmap` emptyLayout l r
handleMessage (Layout l) = fmap (fmap Layout) . handleMessage l handleMessage (Layout l) = fmap (fmap Layout) . handleMessage l
@@ -253,11 +258,6 @@ instance LayoutClass Layout Window where
instance Show (Layout a) where show (Layout l) = show l instance Show (Layout a) where show (Layout l) = show l
-- | This calls doLayout if there are any windows to be laid out, and
-- emptyLayout otherwise.
runLayout :: LayoutClass l a => l a -> Rectangle -> Maybe (Stack a) -> X ([(a, Rectangle)], Maybe (l a))
runLayout l r = maybe (emptyLayout l r) (doLayout l r)
-- | Based on ideas in /An Extensible Dynamically-Typed Hierarchy of Exceptions/, -- | Based on ideas in /An Extensible Dynamically-Typed Hierarchy of Exceptions/,
-- Simon Marlow, 2006. Use extensible messages to the handleMessage handler. -- Simon Marlow, 2006. Use extensible messages to the handleMessage handler.
-- --

View File

@@ -128,10 +128,10 @@ windows f = do
let allscreens = W.screens ws let allscreens = W.screens ws
summed_visible = scanl (++) [] $ map (W.integrate' . W.stack . W.workspace) allscreens summed_visible = scanl (++) [] $ map (W.integrate' . W.stack . W.workspace) allscreens
visible <- fmap concat $ forM (zip allscreens summed_visible) $ \ (w, vis) -> do visible <- fmap concat $ forM (zip allscreens summed_visible) $ \ (w, vis) -> do
let n = W.tag (W.workspace w) let wsp = W.workspace w
this = W.view n ws this = W.view n ws
l = W.layout (W.workspace w) n = W.tag wsp
flt = filter (flip M.member (W.floating ws)) (W.index this) flt = filter (flip M.member (W.floating ws)) (W.index this)
tiled = (W.stack . W.workspace . W.current $ this) tiled = (W.stack . W.workspace . W.current $ this)
>>= W.filter (`M.notMember` W.floating ws) >>= W.filter (`M.notMember` W.floating ws)
>>= W.filter (`notElem` vis) >>= W.filter (`notElem` vis)
@@ -142,7 +142,7 @@ windows f = do
-- just the tiled windows: -- just the tiled windows:
-- now tile the windows on this workspace, modified by the gap -- now tile the windows on this workspace, modified by the gap
(rs, ml') <- runLayout l viewrect tiled `catchX` runLayout (Layout Full) viewrect tiled (rs, ml') <- runLayout wsp { W.stack = tiled } viewrect`catchX` runLayout wsp { W.layout = Layout Full, W.stack = tiled } viewrect
mapM_ (uncurry tileWindow) rs mapM_ (uncurry tileWindow) rs
whenJust ml' $ \l' -> runOnWorkspaces (\ww -> if W.tag ww == n whenJust ml' $ \l' -> runOnWorkspaces (\ww -> if W.tag ww == n
then return $ ww { W.layout = l'} then return $ ww { W.layout = l'}