1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Layout.DragPane
-- Copyright : (c) Spencer Janssen <sjanssen@cse.unl.edu>
-- David Roundy <droundy@darcs.net>,
-- Andrea Rossato <andrea.rossato@unibz.it>
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : David Roundy <droundy@darcs.net>
-- Andrea Rossato <andrea.rossato@unibz.it>
-- 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 XMonad.Layout.DragPane (
-- * Usage
-- $usage
dragPane
, DragPane, DragType (..)
) where
import XMonad
import Data.Unique
import qualified XMonad.StackSet as W
import XMonad.Util.Invisible
import XMonad.Util.XUtils
-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Layout.DragPane
--
-- Then edit your @layoutHook@ by adding the DragPane layout:
--
-- > myLayouts = dragPane Horizontal 0.1 0.5 ||| Full ||| etc..
-- > main = xmonad defaultConfig { layoutHook = myLayouts }
--
-- For more detailed instructions on editing the layoutHook see:
--
-- "XMonad.Doc.Extending#Editing_the_layout_hook"
halfHandleWidth :: Integral a => a
halfHandleWidth = 1
handleColor :: String
handleColor = "#000000"
dragPane :: DragType -> Double -> Double -> DragPane a
dragPane t x y = DragPane (I Nothing) t x y
data DragPane a =
DragPane (Invisible Maybe (Window,Rectangle,Int)) DragType Double Double
deriving ( Show, Read )
data DragType = Horizontal | Vertical deriving ( Show, Read )
instance LayoutClass DragPane a where
doLayout d@(DragPane _ Vertical _ _) = doLay id d
doLayout d@(DragPane _ Horizontal _ _) = doLay mirrorRect d
handleMessage = handleMess
data SetFrac = SetFrac Int Double deriving ( Show, Read, Eq, Typeable )
instance Message SetFrac
handleMess :: DragPane a -> SomeMessage -> X (Maybe (DragPane a))
handleMess d@(DragPane mb@(I (Just (win,_,ident))) ty delta split) x
| Just e <- fromMessage x :: Maybe Event = do handleEvent d e
return Nothing
| Just Hide <- fromMessage x = do hideWindow win
return $ Just (DragPane mb ty delta split)
| Just ReleaseResources <- fromMessage x = do deleteWindow win
return $ Just (DragPane (I Nothing) ty delta split)
-- layout specific messages
| Just Shrink <- fromMessage x = return $ Just (DragPane mb ty delta (split - delta))
| Just Expand <- fromMessage x = return $ Just (DragPane mb ty delta (split + delta))
| Just (SetFrac ident' frac) <- fromMessage x, ident' == ident = do
return $ Just (DragPane mb ty delta frac)
handleMess _ _ = return Nothing
handleEvent :: DragPane a -> Event -> X ()
handleEvent (DragPane (I (Just (win,r,ident))) ty _ _)
(ButtonEvent {ev_window = thisw, ev_subwindow = thisbw, ev_event_type = t })
| t == buttonPress && thisw == win || thisbw == win = do
mouseDrag (\ex ey -> do
let frac = case ty of
Vertical -> (fromIntegral ex - (fromIntegral $ rect_x r))/(fromIntegral $ rect_width r)
Horizontal -> (fromIntegral ey - (fromIntegral $ rect_x r))/(fromIntegral $ rect_width r)
sendMessage (SetFrac ident frac))
(return ())
handleEvent _ _ = return ()
doLay :: (Rectangle -> Rectangle) -> DragPane a -> Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (DragPane a))
doLay mirror (DragPane mw ty delta split) r s = do
let r' = mirror r
(left', right') = splitHorizontallyBy split r'
left = case left' of Rectangle x y w h ->
mirror $ Rectangle x y (w-halfHandleWidth) h
right = case right' of
Rectangle x y w h ->
mirror $ Rectangle (x+halfHandleWidth) y (w-halfHandleWidth) h
handr = case left' of
Rectangle x y w h ->
mirror $ Rectangle (x + fromIntegral w - halfHandleWidth) y (2*halfHandleWidth) h
wrs = case reverse (W.up s) of
(master:_) -> [(master,left),(W.focus s,right)]
[] -> case W.down s of
(next:_) -> [(W.focus s,left),(next,right)]
[] -> [(W.focus s, r)]
if length wrs > 1
then case mw of
I (Just (w,_,ident)) -> do
w' <- deleteWindow w >> newDragWin handr
return (wrs, Just $ DragPane (I $ Just (w',r',ident)) ty delta split)
I Nothing -> do
w <- newDragWin handr
i <- io $ newUnique
return (wrs, Just $ DragPane (I $ Just (w,r',hashUnique i)) ty delta split)
else return (wrs, Nothing)
newDragWin :: Rectangle -> X Window
newDragWin r = do
let mask = Just $ exposureMask .|. buttonPressMask
w <- createNewWindow r mask handleColor False
showWindow w
d <- asks display
liftIO $ lowerWindow d w
return w
|
