move Layout into StackSet.

WARNING! This changes the format of StackSet, and
will definitely mess up your xmonad state, requiring
at minimum a restart!
This commit is contained in:
David Roundy
2007-09-20 22:12:48 +00:00
parent 70282f23dc
commit fe397edf4a
3 changed files with 25 additions and 27 deletions

View File

@@ -63,7 +63,6 @@ main = do
, focusedBorder = fbc } , focusedBorder = fbc }
st = XState st = XState
{ windowset = winset { windowset = winset
, layouts = M.fromList [(w, safeLayouts) | w <- workspaces]
, mapped = S.empty , mapped = S.empty
, waitingUnmap = M.empty , waitingUnmap = M.empty
, dragging = Nothing } , dragging = Nothing }

View File

@@ -29,15 +29,13 @@ import qualified Data.Set as S
import Control.Monad.State import Control.Monad.State
import Control.Monad.Reader import Control.Monad.Reader
import Control.Arrow ((***), first, second) import Control.Arrow ((***), second)
import System.IO import System.IO
import Graphics.X11.Xlib import Graphics.X11.Xlib
import Graphics.X11.Xinerama (getScreenInfo) import Graphics.X11.Xinerama (getScreenInfo)
import Graphics.X11.Xlib.Extras import Graphics.X11.Xlib.Extras
import qualified Data.Traversable as T
-- --------------------------------------------------------------------- -- ---------------------------------------------------------------------
-- | -- |
-- Window manager operations -- Window manager operations
@@ -114,7 +112,7 @@ windows f = do
-- We cannot use sendMessage because this must not call refresh ever, -- We cannot use sendMessage because this must not call refresh ever,
-- and must be called on all visible workspaces. -- and must be called on all visible workspaces.
broadcastMessage UnDoLayout broadcastMessage UnDoLayout
XState { windowset = old, layouts = fls } <- get XState { windowset = old } <- get
let oldvisible = concatMap (W.integrate' . W.stack . W.workspace) $ W.current old : W.visible old let oldvisible = concatMap (W.integrate' . W.stack . W.workspace) $ W.current old : W.visible old
ws = f old ws = f old
modify (\s -> s { windowset = ws }) modify (\s -> s { windowset = ws })
@@ -126,7 +124,7 @@ windows f = do
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 n = W.tag (W.workspace w)
this = W.view n ws this = W.view n ws
Just l = fmap fst $ M.lookup n fls l = W.layout (W.workspace w)
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 (not . flip M.member (W.floating ws)) >>= W.filter (not . flip M.member (W.floating ws))
@@ -140,8 +138,9 @@ windows f = do
-- 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 (SomeLayout Full) viewrect tiled (rs, ml') <- runLayout l viewrect tiled `catchX` runLayout (SomeLayout Full) viewrect tiled
mapM_ (uncurry tileWindow) rs mapM_ (uncurry tileWindow) rs
whenJust ml' $ \l' -> modify $ \ss -> whenJust ml' $ \l' -> runOnWorkspaces (\ww -> if W.tag ww == n
ss { layouts = M.adjust (first (const l')) n (layouts ss) } then return $ ww { W.layout = l'}
else return ww)
-- now the floating windows: -- now the floating windows:
-- move/resize the floating windows, if there are any -- move/resize the floating windows, if there are any
@@ -304,31 +303,32 @@ setFocusX w = withWindowSet $ \ws -> do
-- Note that the new layout's deconstructor will be called, so it should be -- Note that the new layout's deconstructor will be called, so it should be
-- idempotent. -- idempotent.
switchLayout :: X () switchLayout :: X ()
switchLayout = do switchLayout = return ()
broadcastMessage UnDoLayout -- calling refresh now would defeat the point of deconstruction
n <- gets (W.tag . W.workspace . W.current . windowset)
modify $ \s -> s { layouts = M.adjust switch n (layouts s) }
refresh
where switch (x, xs) = let xs' = xs ++ [x] in (head xs', tail xs')
-- | Throw a message to the current Layout possibly modifying how we -- | Throw a message to the current Layout possibly modifying how we
-- layout the windows, then refresh. -- layout the windows, then refresh.
-- --
sendMessage :: Message a => a -> X () sendMessage :: Message a => a -> X ()
sendMessage a = do n <- (W.tag . W.workspace . W.current) `fmap` gets windowset sendMessage a = do w <- (W.workspace . W.current) `fmap` gets windowset
Just (l,ls) <- M.lookup n `fmap` gets layouts ml' <- modifyLayout (W.layout w) (SomeMessage a) `catchX` return Nothing
ml' <- modifyLayout l (SomeMessage a) `catchX` return (Just l) whenJust ml' $ \l' ->
whenJust ml' $ \l' -> do modify $ \s -> s { layouts = M.insert n (l',ls) (layouts s) } do windows $ \ws -> ws { W.current = (W.current ws)
refresh { W.workspace = (W.workspace $ W.current ws)
{ W.layout = l' }}}
-- | Send a message to all visible layouts, without necessarily refreshing. -- | Send a message to all visible layouts, without necessarily refreshing.
-- This is how we implement the hooks, such as UnDoLayout. -- This is how we implement the hooks, such as UnDoLayout.
broadcastMessage :: Message a => a -> X () broadcastMessage :: Message a => a -> X ()
broadcastMessage a = do broadcastMessage a = runOnWorkspaces modw
ol <- gets layouts where modw w = do ml' <- modifyLayout (W.layout w) (SomeMessage a) `catchX` return Nothing
nl <- T.forM ol $ \ (l,ls) -> maybe (l,ls) (flip (,) ls) `fmap` return $ w { W.layout = maybe (W.layout w) id ml' }
(modifyLayout l (SomeMessage a) `catchX` return (Just l))
modify $ \s -> s { layouts = nl } runOnWorkspaces :: (WindowSpace -> X WindowSpace) -> X ()
runOnWorkspaces job = do ws <- gets windowset
h <- mapM job $ W.hidden ws
c:v <- mapM (\s -> fmap (\w -> s { W.workspace = w}) $ job (W.workspace s))
$ W.current ws : W.visible ws
modify $ \s -> s { windowset = ws { W.current = c, W.visible = v, W.hidden = h } }
instance Message Event instance Message Event

View File

@@ -15,7 +15,7 @@
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module XMonad ( module XMonad (
X, WindowSet, WorkspaceId, ScreenId(..), ScreenDetail(..), XState(..), XConf(..), Layout(..), SomeLayout(..), readLayout, X, WindowSet, WindowSpace, WorkspaceId, ScreenId(..), ScreenDetail(..), XState(..), XConf(..), Layout(..), SomeLayout(..), readLayout,
Typeable, Message, SomeMessage(..), fromMessage, runLayout, Typeable, Message, SomeMessage(..), fromMessage, runLayout,
runX, catchX, io, catchIO, withDisplay, withWindowSet, isRoot, getAtom, spawn, restart, trace, whenJust, whenX, runX, catchX, io, catchIO, withDisplay, withWindowSet, isRoot, getAtom, spawn, restart, trace, whenJust, whenX,
atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW
@@ -43,8 +43,6 @@ data XState = XState
{ windowset :: !WindowSet -- ^ workspace list { windowset :: !WindowSet -- ^ workspace list
, mapped :: !(S.Set Window) -- ^ the Set of mapped windows , mapped :: !(S.Set Window) -- ^ the Set of mapped windows
, waitingUnmap :: !(M.Map Window Int) -- ^ the number of expected UnmapEvents , waitingUnmap :: !(M.Map Window Int) -- ^ the number of expected UnmapEvents
, layouts :: !(M.Map WorkspaceId (SomeLayout Window, [SomeLayout Window]))
-- ^ mapping of workspaces to descriptions of their layouts
, dragging :: !(Maybe (Position -> Position -> X (), X ())) } , dragging :: !(Maybe (Position -> Position -> X (), X ())) }
data XConf = XConf data XConf = XConf
{ display :: Display -- ^ the X11 display { display :: Display -- ^ the X11 display
@@ -53,6 +51,7 @@ data XConf = XConf
, focusedBorder :: !Pixel } -- ^ border color of the focused window , focusedBorder :: !Pixel } -- ^ border color of the focused window
type WindowSet = StackSet WorkspaceId (SomeLayout Window) Window ScreenId ScreenDetail type WindowSet = StackSet WorkspaceId (SomeLayout Window) Window ScreenId ScreenDetail
type WindowSpace = Workspace WorkspaceId (SomeLayout Window) Window
-- | Virtual workspace indicies -- | Virtual workspace indicies
type WorkspaceId = String type WorkspaceId = String