mirror of
https://github.com/xmonad/xmonad.git
synced 2025-08-01 20:51:55 -07:00
runLayout is now a LayoutClass method and takes the Workspace and the screen Rectangle
This commit is contained in:
@@ -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.
|
||||||
--
|
--
|
||||||
|
@@ -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'}
|
||||||
|
Reference in New Issue
Block a user