aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorDavid Roundy <droundy@darcs.net>2007-09-14 23:59:59 +0200
committerDavid Roundy <droundy@darcs.net>2007-09-14 23:59:59 +0200
commit2bf1915b692ac6ba1078367e2f490ff44b37b791 (patch)
tree36a2db2018d52bf48ec4b3649f3bc1b5e15f772f
parentb3eeaf92837efb054cc9a4514044341c1918bcb6 (diff)
downloadxmonad-2bf1915b692ac6ba1078367e2f490ff44b37b791.tar.gz
xmonad-2bf1915b692ac6ba1078367e2f490ff44b37b791.tar.xz
xmonad-2bf1915b692ac6ba1078367e2f490ff44b37b791.zip
move Layout stuff into class (hokey first cut).
darcs-hash:20070914215959-72aca-3feae03a6560a70908ad37d28f47c8d47321008e.gz
-rw-r--r--Config.hs8
-rw-r--r--Main.hs2
-rw-r--r--Operations.hs24
-rw-r--r--XMonad.hs27
4 files changed, 39 insertions, 22 deletions
diff --git a/Config.hs b/Config.hs
index 9b02a92..8c55961 100644
--- a/Config.hs
+++ b/Config.hs
@@ -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
]
diff --git a/Main.hs b/Main.hs
index ead2a96..8ed3555 100644
--- a/Main.hs
+++ b/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
diff --git a/Operations.hs b/Operations.hs
index f2a6be7..bc939ac 100644
--- a/Operations.hs
+++ b/Operations.hs
@@ -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,19 +351,19 @@ 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)
- ,fmap incmastern (fromMessage m)] }
+ , modifyLayout' = \m -> return $ msum [fmap resize (fromMessage m)
+ ,fmap incmastern (fromMessage m)] }
where resize Shrink = tall nmaster delta (max 0 $ frac-delta)
resize Expand = tall nmaster delta (min 1 $ 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.
--
diff --git a/XMonad.hs b/XMonad.hs
index 64232f6..97f4ee1 100644
--- a/XMonad.hs
+++ b/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/,