mirror of
https://github.com/xmonad/xmonad.git
synced 2025-08-01 20:51:55 -07:00
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:
1
Main.hs
1
Main.hs
@@ -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 }
|
||||||
|
@@ -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
|
||||||
|
|
||||||
|
@@ -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
|
||||||
|
Reference in New Issue
Block a user