diff options
author | David Roundy <droundy@darcs.net> | 2007-08-13 16:40:07 +0200 |
---|---|---|
committer | David Roundy <droundy@darcs.net> | 2007-08-13 16:40:07 +0200 |
commit | f3b3fd9bf9b41a840bd1df02e03d3f6f09bea4cc (patch) | |
tree | b45bf87b7db71a8bbe9a75cfb9ce69f015567985 | |
parent | ecb2dbe7af23578144a8db0def9a674c8517e4f4 (diff) | |
download | XMonadContrib-f3b3fd9bf9b41a840bd1df02e03d3f6f09bea4cc.tar.gz XMonadContrib-f3b3fd9bf9b41a840bd1df02e03d3f6f09bea4cc.tar.xz XMonadContrib-f3b3fd9bf9b41a840bd1df02e03d3f6f09bea4cc.zip |
add DragPane.
darcs-hash:20070813144007-72aca-26f41720b70a4d938fae79c326a37a41c1e305cd.gz
Diffstat (limited to '')
-rw-r--r-- | DragPane.hs | 117 | ||||
-rw-r--r-- | MetaModule.hs | 1 |
2 files changed, 118 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 diff --git a/MetaModule.hs b/MetaModule.hs index cc433c0..39a8225 100644 --- a/MetaModule.hs +++ b/MetaModule.hs @@ -29,6 +29,7 @@ import XMonadContrib.Decoration () import XMonadContrib.DeManage () import XMonadContrib.DirectoryPrompt () import XMonadContrib.Dmenu () +import XMonadContrib.DragPane () import XMonadContrib.DwmPromote () import XMonadContrib.DynamicLog () import XMonadContrib.DynamicWorkspaces () |