add support for extensible layouts.

darcs-hash:20070503144750-72aca-f44bca4573837e12fc1f89333b55e04abd52787c.gz

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