add DragPane.

darcs-hash:20070813144007-72aca-26f41720b70a4d938fae79c326a37a41c1e305cd.gz

1 files changed, 117 insertions, 0 deletions

diff --git a/DragPane.hs b/DragPane.hs
new file mode 100644
index 0000000..94101bc
--- /dev/null
+++ b/DragPane.hs
@@ -0,0 +1,117 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonadContrib.DragPane
+-- Copyright   :  (c) Spencer Janssen <sjanssen@cse.unl.edu>
+--                    David Roundy <droundy@darcs.net>,
+-- License     :  BSD3-style (see LICENSE)
+-- 
+-- Maintainer  :  David Roundy <droundy@darcs.net>
+-- Stability   :  unstable
+-- Portability :  unportable
+
+-- Layouts that splits the screen either horizontally or vertically and
+-- shows two windows.  The first window is always the master window, and
+-- the other is either the currently focused window or the second window in
+-- layout order.
+
+-----------------------------------------------------------------------------
+
+module XMonadContrib.DragPane (
+                               -- * Usage
+                               -- $usage
+                               dragPane, dragUpDownPane
+                              ) where
+
+import Control.Monad.Reader ( asks )
+import Graphics.X11.Xlib ( Rectangle( Rectangle ) )
+import XMonad
+import XMonadContrib.Decoration ( newDecoration )
+import Operations ( Resize(..), splitHorizontallyBy, splitVerticallyBy, initColor, mouseDrag, sendMessage )
+import StackSet ( focus, up, down)
+
+-- $usage
+--
+-- You can use this module with the following in your Config.hs file:
+--
+-- > import XMonadContrib.DragPane
+--
+--  and add, to the list of layouts:
+--
+-- > dragPane defaultDelta (1%2)
+
+halfHandleWidth :: Integral a => a
+halfHandleWidth = 2
+
+handleColor :: String
+handleColor = "#000000"
+
+dragPane :: String -> Double -> Double -> Layout a
+dragPane ident delta split = Layout { doLayout = dolay, modifyLayout = return . message }
+ where
+    dolay r s = do handlec <- withDisplay $ \dpy -> io $ initColor dpy handleColor
+                   root <- asks theRoot
+                   let (left', right') = splitHorizontallyBy split r
+                       leftmost = fromIntegral $ case r of Rectangle x _ _ _ -> x
+                       widt = fromIntegral $ case r of Rectangle _ _ w _ -> w
+                       left = case left' of Rectangle x y w h -> Rectangle x y (w-halfHandleWidth) h
+                       right = case right' of
+                               Rectangle x y w h -> Rectangle (x+halfHandleWidth) y (w-halfHandleWidth) h
+                       handr = case left' of
+                               Rectangle x y w h ->
+                                 Rectangle (x + fromIntegral w - halfHandleWidth) y (2*halfHandleWidth) h
+                       wrs = case reverse (up s) of
+                             (master:_) -> [(master,left),(focus s,right)]
+                             [] -> case down s of
+                                   (next:_) -> [(focus s,left),(next,right)]
+                                   [] -> [(focus s, r)]
+                       handle = newDecoration root handr 0 handlec handlec
+                                "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
+                                (const $ const $ const $ const $ return ()) (doclick)
+                       doclick = mouseDrag (\ex _ ->
+                                        sendMessage (SetFrac ident ((fromIntegral ex - leftmost)/widt)))
+                                        (return ())
+                                        
+                   l' <- handle (dragPane ident delta split)
+                   return (wrs, Just l')
+    message x | Just Shrink <- fromMessage x = Just (dragPane ident delta (split - delta))
+              | Just Expand <- fromMessage x = Just (dragPane ident delta (split + delta))
+              | Just (SetFrac ident' frac) <- fromMessage x, ident' == ident =
+                                              Just (dragPane ident delta frac)
+    message _ = Nothing
+
+dragUpDownPane :: String -> Double -> Double -> Layout a
+dragUpDownPane ident delta split = Layout { doLayout = dolay, modifyLayout = return . message }
+ where
+    dolay r s = do handlec <- withDisplay $ \dpy -> io $ initColor dpy handleColor
+                   root <- asks theRoot
+                   let (left', right') = splitVerticallyBy split r
+                       leftmost = fromIntegral $ case r of Rectangle _ x _ _ -> x
+                       widt = fromIntegral $ case r of Rectangle _ _ _ w -> w
+                       left = case left' of Rectangle x y w h -> Rectangle x y w (h-halfHandleWidth)
+                       right = case right' of
+                               Rectangle x y w h -> Rectangle x (y+halfHandleWidth) w (h-halfHandleWidth)
+                       handr = case left' of
+                               Rectangle x y w h ->
+                                 Rectangle x (y + fromIntegral h - halfHandleWidth) w (2*halfHandleWidth)
+                       wrs = case reverse (up s) of
+                             (master:_) -> [(master,left),(focus s,right)]
+                             [] -> case down s of
+                                   (next:_) -> [(focus s,left),(next,right)]
+                                   [] -> [(focus s, r)]
+                       handle = newDecoration root handr 0 handlec handlec
+                                "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
+                                (const $ const $ const $ const $ return ()) (doclick)
+                       doclick = mouseDrag (\_ ey ->
+                                        sendMessage (SetFrac ident ((fromIntegral ey - leftmost)/widt)))
+                                        (return ())
+                                        
+                   l' <- handle (dragUpDownPane ident delta split)
+                   return (wrs, Just l')
+    message x | Just Shrink <- fromMessage x = Just (dragUpDownPane ident delta (split - delta))
+              | Just Expand <- fromMessage x = Just (dragUpDownPane ident delta (split + delta))
+              | Just (SetFrac ident' frac) <- fromMessage x, ident' == ident =
+                                              Just (dragUpDownPane ident delta frac)
+    message _ = Nothing
+
+data SetFrac = SetFrac String Double deriving ( Show, Read, Eq, Typeable )
+instance Message SetFrac