From 3a7af24ccb821b88613736f2f3d5ff049cfac02b Mon Sep 17 00:00:00 2001 From: David Roundy Date: Thu, 3 May 2007 16:47:50 +0200 Subject: add support for extensible layouts. darcs-hash:20070503144750-72aca-f44bca4573837e12fc1f89333b55e04abd52787c.gz --- Config.hs | 17 +++++------------ Config.hs-boot | 4 ++-- Main.hs | 2 +- Operations.hs | 48 ++++++++++++++++++++++++++++++------------------ XMonad.hs | 16 +++++----------- 5 files changed, 43 insertions(+), 44 deletions(-) diff --git a/Config.hs b/Config.hs index 79dbb6f..59d2c38 100644 --- a/Config.hs +++ b/Config.hs @@ -133,16 +133,9 @@ focusedBorderColor = "#ff0000" borderWidth :: Dimension borderWidth = 2 --- A LayoutDesc specifies two things: --- * what layout mode to use by default --- * what default screen ratio of master/slave areas are used when tiling --- --- See LayoutDesc and friends in XMonad.hs for options. --- -defaultLayoutDesc :: LayoutDesc -defaultLayoutDesc = - LayoutDesc { layoutType = Full - , tileFraction = 2%3 } +-- The default set of Layouts: +defaultLayouts :: [Layout] +defaultLayouts = [ full, tall defaultDelta (2%3), wide defaultDelta (2%3) ] -- -- The key bindings list. @@ -161,8 +154,8 @@ keys = M.fromList $ , ((modMask, xK_j ), raise GT) , ((modMask, xK_k ), raise LT) - , ((modMask, xK_h ), changeSplit (negate defaultDelta)) - , ((modMask, xK_l ), changeSplit defaultDelta) + , ((modMask, xK_h ), layoutMsg Expand) + , ((modMask, xK_l ), layoutMsg Shrink) , ((modMask .|. shiftMask, xK_c ), kill) diff --git a/Config.hs-boot b/Config.hs-boot index 7fd4cee..5a03488 100644 --- a/Config.hs-boot +++ b/Config.hs-boot @@ -1,5 +1,5 @@ module Config where -import XMonad (LayoutDesc) +import XMonad (Layout) import Graphics.X11.Xlib.Types (Dimension) -defaultLayoutDesc :: LayoutDesc +defaultLayouts :: [Layout] borderWidth :: Dimension diff --git a/Main.hs b/Main.hs index 2bf17c3..81e286c 100644 --- a/Main.hs +++ b/Main.hs @@ -59,7 +59,7 @@ main = do } st = XState { workspace = W.empty workspaces (length xinesc) - , layoutDescs = M.empty + , layouts = M.empty } xSetErrorHandler -- in C, I'm too lazy to write the binding diff --git a/Operations.hs b/Operations.hs index 2207e2b..1fd3482 100644 --- a/Operations.hs +++ b/Operations.hs @@ -1,3 +1,4 @@ +{-# OPTIONS -fglasgow-exts #-} ----------------------------------------------------------------------------- -- | -- Module : Operations.hs @@ -15,6 +16,7 @@ module Operations where import Data.List import Data.Maybe import Data.Bits +import Data.Dynamic ( Typeable, toDyn, fromDynamic ) import qualified Data.Map as M import Control.Monad.State @@ -41,18 +43,13 @@ import qualified StackSet as W -- screen and raises the window. refresh :: X () refresh = do - XState { workspace = ws, layoutDescs = fls } <- get + XState { workspace = ws, layouts = fls } <- get XConf { xineScreens = xinesc, display = d } <- ask -- neat, eh? flip mapM_ (M.assocs (W.screen2ws ws)) $ \(scn, n) -> do let sc = genericIndex xinesc scn -- temporary coercion! - fl = M.findWithDefault defaultLayoutDesc n fls - mapM_ (\(w, rect) -> io $ moveWindowInside d w rect) $ - -- likely this should just dispatch on the current layout algo - case layoutType fl of - Full -> fmap (flip (,) sc) $ maybeToList $ W.peekStack n ws - Tall -> tile (tileFraction fl) sc $ W.index n ws - Wide -> vtile (tileFraction fl) sc $ W.index n ws + (l:_) = case M.findWithDefault defaultLayouts n fls of {[] -> defaultLayouts; l -> l} + mapM_ (\(w, rect) -> io $ moveWindowInside d w rect) $ (doLayout l) sc $ W.index n ws whenJust (W.peekStack n ws) (io . raiseWindow d) whenJust (W.peek ws) setFocus clearEnterEvents @@ -100,22 +97,37 @@ flipRect (Rectangle rx ry rw rh) = (Rectangle ry rx rh rw) -- switching back , the focused window is uppermost. -- switchLayout :: X () -switchLayout = layout $ \fl -> fl { layoutType = rotateLayout (layoutType fl) } +switchLayout = layout rotateList where rotateList [] = [] + rotateList xs = last xs : init xs --- | changeSplit. Changes the window split. -changeSplit :: Rational -> X () -changeSplit delta = layout $ \fl -> - fl { tileFraction = min 1 (max 0 (tileFraction fl + delta)) } +data ShrinkOrExpand = Shrink | Expand deriving ( Typeable, Eq ) + +layoutMsg :: Typeable a => a -> X () -- FIXME: The below shouldn't refresh on Nothing +layoutMsg a = layout $ \(l:ls) -> case modifyLayout l (toDyn a) of Nothing -> l:ls + Just l' -> l':ls + +full :: Layout +full = Layout { doLayout = \sc -> map (\w -> (w,sc)), modifyLayout = const Nothing } + +tall, wide :: Rational -> Rational -> Layout +tall delta tileFrac = Layout { doLayout = \sc -> tile tileFrac sc + , modifyLayout = (fmap m) . fromDynamic } + where m Shrink = tall delta (tileFrac-delta) + m Expand = tall delta (tileFrac+delta) + +wide delta tileFrac = Layout { doLayout = \sc -> vtile tileFrac sc + , modifyLayout = (fmap m) . fromDynamic } + where m Shrink = wide delta (tileFrac-delta) + m Expand = wide delta (tileFrac+delta) -- | layout. Modify the current workspace's layout with a pure -- function and refresh. -layout :: (LayoutDesc -> LayoutDesc) -> X () +layout :: ([Layout] -> [Layout]) -> X () layout f = do modify $ \s -> - let fls = layoutDescs s - n = W.current . workspace $ s - fl = M.findWithDefault defaultLayoutDesc n fls - in s { layoutDescs = M.insert n (f fl) fls } + let n = W.current . workspace $ s + fl = M.findWithDefault defaultLayouts n $ layouts s + in s { layouts = M.insert n (f fl) (layouts s) } refresh -- | windows. Modify the current window list with a pure function, and refresh diff --git a/XMonad.hs b/XMonad.hs index beddaef..9f1a0ca 100644 --- a/XMonad.hs +++ b/XMonad.hs @@ -17,7 +17,7 @@ module XMonad ( X, WindowSet, WorkspaceId(..), ScreenId(..), XState(..), XConf(..), Layout(..), - LayoutDesc(..), runX, io, withDisplay, isRoot, spawn, trace, whenJust, rotateLayout + runX, io, withDisplay, isRoot, spawn, trace, whenJust ) where import StackSet (StackSet) @@ -28,6 +28,7 @@ import System.IO import System.Posix.Process (executeFile, forkProcess, getProcessStatus) import System.Exit import Graphics.X11.Xlib +import Data.Dynamic ( Dynamic ) import qualified Data.Map as M @@ -35,7 +36,7 @@ import qualified Data.Map as M -- Just the display, width, height and a window list data XState = XState { workspace :: !WindowSet -- ^ workspace list - , layoutDescs :: !(M.Map WorkspaceId LayoutDesc) -- ^ mapping of workspaces + , layouts :: !(M.Map WorkspaceId [Layout]) -- ^ mapping of workspaces -- to descriptions of their layouts } @@ -93,15 +94,8 @@ isRoot w = liftM (w==) (asks theRoot) -- Layout handling -- | The different layout modes -data Layout = Full | Tall | Wide deriving (Enum, Bounded, Eq) - --- | 'rot' for Layout. -rotateLayout :: Layout -> Layout -rotateLayout x = if x == maxBound then minBound else succ x - --- | A full description of a particular workspace's layout parameters. -data LayoutDesc = LayoutDesc { layoutType :: !Layout - , tileFraction :: !Rational } +data Layout = Layout { doLayout :: Rectangle -> [Window] -> [(Window, Rectangle)] + , modifyLayout :: Dynamic -> Maybe Layout } -- --------------------------------------------------------------------- -- Utilities -- cgit v1.2.3