Added X.L.Drawer

Ignore-this: c7973679b7b2702178ae06fc45396dda
X.L.Drawer provides a layout modifier for retracting windows which roll down
(like the Quake console) when they gain focus.

darcs-hash:20100308212752-a5338-92b3b8a0ec633333427a7b30aa379d7cf39f4864.gz

2 files changed, 129 insertions, 1 deletions

diff --git a/XMonad/Layout/Drawer.hs b/XMonad/Layout/Drawer.hs
new file mode 100644
index 0000000..ce6d901
--- /dev/null
+++ b/XMonad/Layout/Drawer.hs
@@ -0,0 +1,127 @@
+{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances, FlexibleContexts #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.Drawer
+-- Copyright   :  (c) 2009 Max Rabkin
+-- License     :  BSD-style (see xmonad/LICENSE)
+--
+-- Maintainer  :  max.rabkin@gmail.com
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A layout modifier that puts some windows in a "drawer" which retracts and
+-- expands depending on whether any window in it has focus.
+--
+-- Useful for music players, tool palettes, etc.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.Drawer
+    ( -- * Usage
+      -- $usage
+
+      -- * Drawers
+      simpleDrawer
+    , drawer
+
+      -- * Placing drawers
+      -- The drawer can be placed on any side of the screen with these functions
+    , onLeft, onTop, onRight, onBottom
+    ) where
+
+import XMonad
+import XMonad.Layout.LayoutModifier
+import XMonad.Util.WindowProperties
+import XMonad.StackSet as S
+import XMonad.Layout.Reflect
+
+-- $usage
+-- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@:
+--
+-- @
+-- import XMonad.Layout.Drawer
+-- import "XMonad.Util.WindowProperties"
+--
+-- myLayout = drawer \``onTop'\` (Tall 1 0.03 0.5) ||| Full ||| RandomOtherLayout...
+--     where
+--         drawer = 'simpleDrawer' 0.01 0.3 (ClassName \"Rhythmbox\" \`Or\` ClassName \"Xchat\")
+-- main = xmonad defaultConfig { layoutHook = myLayout }
+-- @
+--
+-- This will place the Rhythmbox and Xchat windows in at the top of the screen.
+-- See "XMonad.Util.WindowProperties" for more information on selecting windows.
+
+data Drawer l a = Drawer Rational Rational Property (l a)
+    deriving (Read, Show)
+
+-- | filter : filterM :: partition : partitionM
+partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a])
+partitionM _ [] = return ([], [])
+partitionM f (x:xs) = do
+    b <- f x
+    (ys, zs) <- partitionM f xs
+    return $ if b
+                then (x:ys, zs)
+                else (ys, x:zs)
+
+instance (LayoutClass l Window, Read (l Window)) => LayoutModifier (Drawer l) Window where
+    modifyLayout (Drawer rs rb p l) ws rect =
+        case stack ws of
+            Nothing -> runLayout ws rect
+            Just stk@(Stack { up=up_, down=down_, S.focus=w }) -> do
+                    (upD, upM) <- partitionM (hasProperty p) up_
+                    (downD, downM) <- partitionM (hasProperty p) down_
+                    b <- hasProperty p w
+
+                    let (rectD, stackD, stackM) = if b
+                                                    then ( rectB
+                                                         , Just $ stk { up=upD, down=downD }
+                                                         , mkStack upM downM )
+                                                    else ( rectS
+                                                         , mkStack upD downD
+                                                         , Just $ stk { up=upM, down=downM } )
+
+                    (winsD, _) <- runLayout (ws { layout=l , stack=stackD }) rectD
+                    (winsM, u') <- runLayout (ws { stack=stackM }) rectM
+                    return (winsD ++ winsM, u')
+      where
+        mkStack [] [] = Nothing
+        mkStack xs (y:ys) = Just (Stack { up=xs, S.focus=y, down=ys })
+        mkStack (x:xs) ys = Just (Stack { up=xs, S.focus=x, down=ys })
+
+        rectB = rect { rect_width=round $ fromIntegral (rect_width rect) * rb }
+        rectS = rectB { rect_x=round $ (rs - rb) * fromIntegral (rect_width rect) }
+        rectM = rect { rect_x=rect_x rect + round (fromIntegral (rect_width rect) * rs)
+                     , rect_width=rect_width rect - round (fromIntegral (rect_width rect) * rs) }
+
+type Reflected l = ModifiedLayout Reflect l
+
+-- | Construct a drawer with a simple layout of the windows inside
+simpleDrawer :: Rational -- ^ The portion of the screen taken up by the drawer when closed
+              -> Rational   -- ^ The portion of the screen taken up by the drawer when open
+              -> Property   -- ^ Which windows to put in the drawer
+              -> Drawer Tall a
+simpleDrawer rs rb p = Drawer rs rb p vertical
+    where
+        vertical = Tall 0 0 0
+
+-- Export a synonym for the constructor as a Haddock workaround
+-- | Construct a drawer with an arbitrary layout for windows inside
+drawer ::    Rational   -- ^ The portion of the screen taken up by the drawer when closed
+          -> Rational   -- ^ The portion of the screen taken up by the drawer when open
+          -> Property   -- ^ Which windows to put in the drawer
+          -> (l a)      -- ^ The layout of windows in the drawer
+          -> Drawer l a
+drawer = Drawer
+
+onLeft :: Drawer l a -> l' a -> ModifiedLayout (Drawer l) l' a
+onLeft = ModifiedLayout
+
+onRight :: Drawer l a -> l' a -> Reflected (ModifiedLayout (Drawer l) (Reflected l')) a
+onRight d = reflectHoriz . onLeft d . reflectHoriz
+
+onTop :: Drawer l a -> l' a -> Mirror (ModifiedLayout (Drawer l) (Mirror l')) a
+onTop d = Mirror . onLeft d . Mirror
+
+onBottom :: Drawer l a -> l' a -> Reflected (Mirror (ModifiedLayout (Drawer l) (Mirror (Reflected l')))) a
+onBottom d = reflectVert . onTop d . reflectVert
diff --git a/XMonad/Layout/Reflect.hs b/XMonad/Layout/Reflect.hs
index 03fd6b6..bd127ea 100644
--- a/XMonad/Layout/Reflect.hs
+++ b/XMonad/Layout/Reflect.hs
@@ -18,7 +18,8 @@ module XMonad.Layout.Reflect (
                                -- $usage
 
                                reflectHoriz, reflectVert,
-                               REFLECTX(..), REFLECTY(..)
+                               REFLECTX(..), REFLECTY(..),
+                               Reflect
 
                              ) where