From 060583dd3919eeeb565123c4f2ff7cbd2c999288 Mon Sep 17 00:00:00 2001
From: David Roundy <droundy@darcs.net>
Date: Fri, 22 Jun 2007 16:29:50 +0200
Subject: add new LayoutHelpers module.

darcs-hash:20070622142950-72aca-6dc011f903d12a056b1124752fc37f23368f898e.gz
---
 LayoutHelpers.hs | 62 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 Square.hs        | 23 +++++++++------------
 2 files changed, 72 insertions(+), 13 deletions(-)
 create mode 100644 LayoutHelpers.hs

diff --git a/LayoutHelpers.hs b/LayoutHelpers.hs
new file mode 100644
index 0000000..e134deb
--- /dev/null
+++ b/LayoutHelpers.hs
@@ -0,0 +1,62 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonadContrib.LayoutHelpers
+-- Copyright    : (c) David Roundy <droundy@darcs.net>
+-- License      : BSD
+--
+-- Maintainer   : David Roundy <droundy@darcs.net>
+-- Stability    : unstable
+-- Portability  : portable
+--
+-- Make layouts respect size hints.
+-----------------------------------------------------------------------------
+
+module XMonadContrib.LayoutHelpers (
+    -- * usage
+    -- $usage
+    DoLayout, ModDo, ModMod, ModLay,
+    layoutModify,
+    l2lModDo,
+    idModMod,
+    ) where
+
+import Graphics.X11.Xlib ( Rectangle )
+import XMonad
+import StackSet ( Stack, integrate )
+
+-- $usage
+-- Use LayoutHelpers to help write easy Layouts.
+
+--type DoLayout a = Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (Layout a))
+type DoLayout a = Rectangle -> Stack a -> X [(a, Rectangle)]
+type ModifyLayout a = SomeMessage -> X (Maybe (Layout a))
+
+type ModDo a = Rectangle -> Stack a -> [(a, Rectangle)] -> X ([(a, Rectangle)], Maybe (ModLay a))
+type ModMod a = SomeMessage -> X (Maybe (ModLay a))
+
+type ModLay a = Layout a -> Layout a
+
+layoutModify :: ModDo a -> ModMod a -> ModLay a
+layoutModify fdo fmod l = Layout { doLayout = dl, modifyLayout = modl }
+    where dl r s = do --(ws, ml') <- doLayout l r s
+                      ws <- doLayout l r s
+                      (ws', mmod') <- fdo r s ws
+                      --let ml'' = case mmod' of
+                      --           Just mod' -> Just $ mod' $ maybe l id ml'
+                      --           Nothing -> layoutModify fdo mod `fmap` ml'
+                      --return (ws', ml'')
+                      case mmod' of
+                        Just _ -> fail "Sorry, can't yet safely modify layouts in doLayout."
+                        Nothing -> return ws'
+          modl m = do ml' <- modifyLayout l m
+                      mmod' <- fmod m
+                      return $ case mmod' of
+                               Just mod' -> Just $ mod' $ maybe l id ml'
+                               Nothing -> layoutModify fdo fmod `fmap` ml'
+
+l2lModDo :: (Rectangle -> [a] -> [(a,Rectangle)]) -> DoLayout a
+--l2lModDo dl r s = return (dl r $ integrate s, Nothing)
+l2lModDo dl r s = return (dl r $ integrate s)
+
+idModMod :: ModMod a
+idModMod _ = return Nothing
diff --git a/Square.hs b/Square.hs
index 4250410..43e80b6 100644
--- a/Square.hs
+++ b/Square.hs
@@ -22,14 +22,10 @@ module XMonadContrib.Square (
                              -- $usage
                              square ) where
 
-import XMonad
-import Graphics.X11.Xlib
-import StackSet ( integrate )
-
 -- $usage
 -- You can use this module with the following in your Config.hs file:
 --
--- >   import XMonadContrib.Spiral
+-- >   import XMonadContrib.Square
 --
 -- An example layout using square together with "XMonadContrib.Combo"
 -- to make the very last area square:
@@ -39,16 +35,17 @@ import StackSet ( integrate )
 -- >                    ,(combo [(twoPane 0.03 0.8,1),(square,1)]
 -- >                                (mirror $ twoPane 0.03 0.85),1)] (twoPane 0.03 0.5) )
 
+import XMonad
+import Graphics.X11.Xlib
+import StackSet ( integrate )
+import XMonadContrib.LayoutHelpers ( l2lModDo )
 
 square :: Layout a
-square = Layout { doLayout = \r s -> arrange r (integrate s), modifyLayout = message }
- where
-    arrange rect ws@(_:_) = do
-        let (rest, sq) = splitSquare rect
-        return (map (\w->(w,rest)) (init ws) ++ [(last ws,sq)])
-    arrange _ [] = return []
-
-    message _ = return Nothing
+square = Layout { doLayout = l2lModDo arrange, modifyLayout = const (return Nothing) }
+ where arrange :: Rectangle -> [a] -> [(a, Rectangle)]
+       arrange rect ws@(_:_) = map (\w->(w,rest)) (init ws) ++ [(last ws,sq)]
+                 where (rest, sq) = splitSquare rect
+       arrange _ [] = []
 
 splitSquare :: Rectangle -> (Rectangle, Rectangle)
 splitSquare (Rectangle x y w h)
-- 
cgit v1.2.3