mirror of
https://github.com/xmonad/xmonad.git
synced 2025-08-01 20:51:55 -07:00
move Layout stuff into class (hokey first cut).
This commit is contained in:
@@ -92,10 +92,10 @@ borderWidth = 1
|
||||
-- |
|
||||
-- The default set of tiling algorithms
|
||||
--
|
||||
defaultLayouts :: [Layout Window]
|
||||
defaultLayouts = [ tiled
|
||||
, mirror tiled
|
||||
, full
|
||||
defaultLayouts :: [SomeLayout Window]
|
||||
defaultLayouts = [ SomeLayout tiled
|
||||
, SomeLayout $ mirror tiled
|
||||
, SomeLayout full
|
||||
|
||||
-- Extension-provided layouts
|
||||
]
|
||||
|
2
Main.hs
2
Main.hs
@@ -55,7 +55,7 @@ main = do
|
||||
| otherwise = new workspaces $ zipWith SD xinesc gaps
|
||||
gaps = take (length xinesc) $ defaultGaps ++ repeat (0,0,0,0)
|
||||
|
||||
safeLayouts = case defaultLayouts of [] -> (full, []); (x:xs) -> (x,xs)
|
||||
safeLayouts = case defaultLayouts of [] -> (SomeLayout full, []); (x:xs) -> (x,xs)
|
||||
cf = XConf
|
||||
{ display = dpy
|
||||
, theRoot = rootw
|
||||
|
@@ -138,7 +138,7 @@ windows f = do
|
||||
|
||||
-- just the tiled windows:
|
||||
-- now tile the windows on this workspace, modified by the gap
|
||||
(rs, ml') <- runLayout l viewrect tiled `catchX` runLayout full viewrect tiled
|
||||
(rs, ml') <- runLayout l viewrect tiled `catchX` runLayout (SomeLayout full) viewrect tiled
|
||||
mapM_ (uncurry tileWindow) rs
|
||||
whenJust ml' $ \l' -> modify $ \ss ->
|
||||
ss { layouts = M.adjust (first (const l')) n (layouts ss) }
|
||||
@@ -351,18 +351,18 @@ instance Message IncMasterN
|
||||
|
||||
-- simple fullscreen mode, just render all windows fullscreen.
|
||||
-- a plea for tuple sections: map . (,sc)
|
||||
full :: Layout a
|
||||
full = Layout { doLayout = \sc (W.Stack f _ _) -> return ([(f, sc)],Nothing)
|
||||
, modifyLayout = const (return Nothing) } -- no changes
|
||||
full :: OldLayout a
|
||||
full = OldLayout { doLayout' = \sc (W.Stack f _ _) -> return ([(f, sc)],Nothing)
|
||||
, modifyLayout' = const (return Nothing) } -- no changes
|
||||
|
||||
--
|
||||
-- The tiling mode of xmonad, and its operations.
|
||||
--
|
||||
tall :: Int -> Rational -> Rational -> Layout a
|
||||
tall :: Int -> Rational -> Rational -> OldLayout a
|
||||
tall nmaster delta frac =
|
||||
Layout { doLayout = \r -> return . (\x->(x,Nothing)) .
|
||||
OldLayout { doLayout' = \r -> return . (\x->(x,Nothing)) .
|
||||
ap zip (tile frac r nmaster . length) . W.integrate
|
||||
, modifyLayout = \m -> return $ msum [fmap resize (fromMessage m)
|
||||
, modifyLayout' = \m -> return $ msum [fmap resize (fromMessage m)
|
||||
,fmap incmastern (fromMessage m)] }
|
||||
|
||||
where resize Shrink = tall nmaster delta (max 0 $ frac-delta)
|
||||
@@ -374,11 +374,11 @@ mirrorRect :: Rectangle -> Rectangle
|
||||
mirrorRect (Rectangle rx ry rw rh) = (Rectangle ry rx rh rw)
|
||||
|
||||
-- | Mirror a layout, compute its 90 degree rotated form.
|
||||
mirror :: Layout a -> Layout a
|
||||
mirror (Layout { doLayout = dl, modifyLayout = ml }) =
|
||||
Layout { doLayout = \sc w -> do (wrs, ml') <- dl (mirrorRect sc) w
|
||||
mirror :: Layout l a => l a -> OldLayout a
|
||||
mirror l =
|
||||
OldLayout { doLayout' = \sc w -> do (wrs, ml') <- doLayout l (mirrorRect sc) w
|
||||
return (map (second mirrorRect) wrs, mirror `fmap` ml')
|
||||
, modifyLayout = fmap (fmap mirror) . ml }
|
||||
, modifyLayout' = fmap (fmap mirror) . modifyLayout l }
|
||||
|
||||
-- | tile. Compute the positions for windows using the default 2 pane tiling algorithm.
|
||||
--
|
||||
|
27
XMonad.hs
27
XMonad.hs
@@ -15,7 +15,7 @@
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad (
|
||||
X, WindowSet, WorkspaceId, ScreenId(..), ScreenDetail(..), XState(..), XConf(..), Layout(..),
|
||||
X, WindowSet, WorkspaceId, ScreenId(..), ScreenDetail(..), XState(..), XConf(..), Layout(..), OldLayout(..), SomeLayout(..),
|
||||
Typeable, Message, SomeMessage(..), fromMessage, runLayout,
|
||||
runX, catchX, io, catchIO, withDisplay, withWindowSet, isRoot, getAtom, spawn, restart, trace, whenJust, whenX,
|
||||
atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW
|
||||
@@ -43,7 +43,7 @@ data XState = XState
|
||||
{ windowset :: !WindowSet -- ^ workspace list
|
||||
, mapped :: !(S.Set Window) -- ^ the Set of mapped windows
|
||||
, waitingUnmap :: !(M.Map Window Int) -- ^ the number of expected UnmapEvents
|
||||
, layouts :: !(M.Map WorkspaceId (Layout Window, [Layout Window]))
|
||||
, layouts :: !(M.Map WorkspaceId (SomeLayout Window, [SomeLayout Window]))
|
||||
-- ^ mapping of workspaces to descriptions of their layouts
|
||||
, dragging :: !(Maybe (Position -> Position -> X (), X ())) }
|
||||
data XConf = XConf
|
||||
@@ -131,10 +131,27 @@ atom_WM_STATE = getAtom "WM_STATE"
|
||||
-- that message and the screen is not refreshed. Otherwise, 'modifyLayout'
|
||||
-- returns an updated 'Layout' and the screen is refreshed.
|
||||
--
|
||||
data Layout a = Layout { doLayout :: Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (Layout a))
|
||||
, modifyLayout :: SomeMessage -> X (Maybe (Layout a)) }
|
||||
data OldLayout a =
|
||||
OldLayout { doLayout' :: Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (OldLayout a))
|
||||
, modifyLayout' :: SomeMessage -> X (Maybe (OldLayout a)) }
|
||||
|
||||
runLayout :: Layout a -> Rectangle -> StackOrNot a -> X ([(a, Rectangle)], Maybe (Layout a))
|
||||
data SomeLayout a = forall l. Layout l a => SomeLayout (l a)
|
||||
|
||||
class Layout layout a where
|
||||
doLayout :: layout a -> Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (layout a))
|
||||
modifyLayout :: layout a -> SomeMessage -> X (Maybe (layout a))
|
||||
|
||||
instance Layout OldLayout a where
|
||||
doLayout = doLayout'
|
||||
modifyLayout = modifyLayout'
|
||||
|
||||
instance Layout SomeLayout a where
|
||||
doLayout (SomeLayout l) r s = do (ars, ml') <- doLayout l r s
|
||||
return (ars, SomeLayout `fmap` ml' )
|
||||
modifyLayout (SomeLayout l) m = do ml' <- modifyLayout l m
|
||||
return (SomeLayout `fmap` ml')
|
||||
|
||||
runLayout :: Layout l a => l a -> Rectangle -> StackOrNot a -> X ([(a, Rectangle)], Maybe (l a))
|
||||
runLayout l r = maybe (return ([], Nothing)) (doLayout l r)
|
||||
|
||||
-- | Based on ideas in /An Extensible Dynamically-Typed Hierarchy of Exceptions/,
|
||||
|
Reference in New Issue
Block a user