eliminate ugly OldLayout.

This commit is contained in:
David Roundy 2007-09-20 15:52:37 +00:00
parent 3f03dcb5c1
commit 0e5f8b03e8
4 changed files with 26 additions and 33 deletions

View File

@ -94,14 +94,14 @@ borderWidth = 1
-- --
defaultLayouts :: [SomeLayout Window] defaultLayouts :: [SomeLayout Window]
defaultLayouts = [ SomeLayout tiled defaultLayouts = [ SomeLayout tiled
, SomeLayout $ mirror tiled , SomeLayout $ Mirror tiled
, SomeLayout full , SomeLayout Full
-- Extension-provided layouts -- Extension-provided layouts
] ]
where where
-- default tiling algorithm partitions the screen into two panes -- default tiling algorithm partitions the screen into two panes
tiled = tall nmaster delta ratio tiled = Tall nmaster delta ratio
-- The default number of windows in the master pane -- The default number of windows in the master pane
nmaster = 1 nmaster = 1

View File

@ -55,7 +55,7 @@ main = do
| otherwise = new workspaces $ zipWith SD xinesc gaps | otherwise = new workspaces $ zipWith SD xinesc gaps
gaps = take (length xinesc) $ defaultGaps ++ repeat (0,0,0,0) gaps = take (length xinesc) $ defaultGaps ++ repeat (0,0,0,0)
safeLayouts = case defaultLayouts of [] -> (SomeLayout full, []); (x:xs) -> (x,xs) safeLayouts = case defaultLayouts of [] -> (SomeLayout Full, []); (x:xs) -> (x,xs)
cf = XConf cf = XConf
{ display = dpy { display = dpy
, theRoot = rootw , theRoot = rootw

View File

@ -138,7 +138,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 (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' -> modify $ \ss ->
ss { layouts = M.adjust (first (const l')) n (layouts ss) } ss { layouts = M.adjust (first (const l')) n (layouts ss) }
@ -351,34 +351,35 @@ instance Message IncMasterN
-- simple fullscreen mode, just render all windows fullscreen. -- simple fullscreen mode, just render all windows fullscreen.
-- a plea for tuple sections: map . (,sc) -- a plea for tuple sections: map . (,sc)
full :: OldLayout a data Full a = Full
full = OldLayout { doLayout' = \sc (W.Stack f _ _) -> return ([(f, sc)],Nothing) instance Layout Full a where
, modifyLayout' = const (return Nothing) } -- no changes doLayout Full sc (W.Stack f _ _) = return ([(f, sc)], Nothing)
modifyLayout Full _ = return Nothing -- no changes
-- --
-- The tiling mode of xmonad, and its operations. -- The tiling mode of xmonad, and its operations.
-- --
tall :: Int -> Rational -> Rational -> OldLayout a data Tall a = Tall Int Rational Rational
tall nmaster delta frac = instance Layout Tall a where
OldLayout { doLayout' = \r -> return . (\x->(x,Nothing)) . doLayout (Tall nmaster _ frac) r =
ap zip (tile frac r nmaster . length) . W.integrate return . (\x->(x,Nothing)) .
, modifyLayout' = \m -> return $ msum [fmap resize (fromMessage m) ap zip (tile frac r nmaster . length) . W.integrate
,fmap incmastern (fromMessage m)] } modifyLayout (Tall nmaster delta frac) m =
return $ msum [fmap resize (fromMessage m)
where resize Shrink = tall nmaster delta (max 0 $ frac-delta) ,fmap incmastern (fromMessage m)]
resize Expand = tall nmaster delta (min 1 $ frac+delta) where resize Shrink = Tall nmaster delta (max 0 $ frac-delta)
incmastern (IncMasterN d) = tall (max 0 (nmaster+d)) delta frac resize Expand = Tall nmaster delta (min 1 $ frac+delta)
incmastern (IncMasterN d) = Tall (max 0 (nmaster+d)) delta frac
-- | Mirror a rectangle -- | Mirror a rectangle
mirrorRect :: Rectangle -> Rectangle mirrorRect :: Rectangle -> Rectangle
mirrorRect (Rectangle rx ry rw rh) = (Rectangle ry rx rh rw) mirrorRect (Rectangle rx ry rw rh) = (Rectangle ry rx rh rw)
-- | Mirror a layout, compute its 90 degree rotated form. -- | Mirror a layout, compute its 90 degree rotated form.
mirror :: Layout l a => l a -> OldLayout a data Mirror a = forall l. Layout l a => Mirror (l a)
mirror l = instance Layout Mirror a where
OldLayout { doLayout' = \sc w -> do (wrs, ml') <- doLayout l (mirrorRect sc) w doLayout (Mirror l) r s = do (wrs, ml') <- doLayout l (mirrorRect r) s
return (map (second mirrorRect) wrs, mirror `fmap` ml') return (map (second mirrorRect) wrs, Mirror `fmap` ml')
, modifyLayout' = fmap (fmap mirror) . modifyLayout l } modifyLayout (Mirror l) = fmap (fmap Mirror) . modifyLayout l
-- | tile. Compute the positions for windows using the default 2 pane tiling algorithm. -- | tile. Compute the positions for windows using the default 2 pane tiling algorithm.
-- --

View File

@ -15,7 +15,7 @@
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module XMonad ( module XMonad (
X, WindowSet, WorkspaceId, ScreenId(..), ScreenDetail(..), XState(..), XConf(..), Layout(..), OldLayout(..), SomeLayout(..), X, WindowSet, WorkspaceId, ScreenId(..), ScreenDetail(..), XState(..), XConf(..), Layout(..), SomeLayout(..),
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
@ -131,20 +131,12 @@ atom_WM_STATE = getAtom "WM_STATE"
-- that message and the screen is not refreshed. Otherwise, 'modifyLayout' -- that message and the screen is not refreshed. Otherwise, 'modifyLayout'
-- returns an updated 'Layout' and the screen is refreshed. -- returns an updated 'Layout' and the screen is refreshed.
-- --
data OldLayout a =
OldLayout { doLayout' :: Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (OldLayout a))
, modifyLayout' :: SomeMessage -> X (Maybe (OldLayout a)) }
data SomeLayout a = forall l. Layout l a => SomeLayout (l a) data SomeLayout a = forall l. Layout l a => SomeLayout (l a)
class Layout layout a where class Layout layout a where
doLayout :: layout a -> Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (layout a)) doLayout :: layout a -> Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (layout a))
modifyLayout :: layout a -> SomeMessage -> X (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 instance Layout SomeLayout a where
doLayout (SomeLayout l) r s = do (ars, ml') <- doLayout l r s doLayout (SomeLayout l) r s = do (ars, ml') <- doLayout l r s
return (ars, SomeLayout `fmap` ml' ) return (ars, SomeLayout `fmap` ml' )