mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-18 19:10:21 -07:00
120 lines
6.2 KiB
Haskell
120 lines
6.2 KiB
Haskell
-----------------------------------------------------------------------------
|
|
-- |
|
|
-- 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 "" (fromRational delta) (fromRational delta)
|
|
|
|
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 ())
|
|
|
|
ml' <- if length wrs > 1 then Just `fmap` handle (dragPane ident delta split)
|
|
else return Nothing
|
|
return (wrs, ml')
|
|
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 ())
|
|
|
|
ml' <- if length wrs > 1 then Just `fmap` handle (dragUpDownPane ident delta split)
|
|
else return Nothing
|
|
return (wrs, ml')
|
|
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
|