diff options
| -rw-r--r-- | Config.hs | 8 | ||||
| -rw-r--r-- | Main.hs | 2 | ||||
| -rw-r--r-- | Operations.hs | 24 | ||||
| -rw-r--r-- | XMonad.hs | 27 |
4 files changed, 39 insertions, 22 deletions
@@ -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 ] @@ -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. -- @@ -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/, |