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
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
|
{-# LANGUAGE TypeSynonymInstances, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, PatternGuards, DeriveDataTypeable, ScopedTypeVariables #-}
-----------------------------------------------------------------------------
-- |
-- Module : LayoutBuilderP
-- Copyright : (c) 2009 Anders Engstrom <ankaan@gmail.com>, 2011 Ilya Portnov <portnov84@rambler.ru>
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : Ilya Portnov <portnov84@rambler.ru>
-- Stability : unstable
-- Portability : unportable
--
-- A layout combinator that sends windows matching given predicate to one rectangle
-- and the rest to another.
--
-----------------------------------------------------------------------------
module XMonad.Layout.LayoutBuilderP (
LayoutP (..),
layoutP, layoutAll,
B.relBox, B.absBox,
PropertyRE (..)
) where
import Control.Monad
import Data.Maybe (isJust)
import XMonad
import qualified XMonad.StackSet as W
import XMonad.Util.WindowProperties
import qualified XMonad.Layout.LayoutBuilder as B
-- | Type class for predicates. This enables us to manage not only Windows,
-- but any objects, for which instance Predicate is defined.
-- We assume that for all w checkPredicate (alwaysTrue undefined) == return True.
class Predicate p w where
alwaysTrue :: w -> p -- ^ A predicate that is always True. First argument is dummy, we always set it to undefined
checkPredicate :: p -> w -> X Bool -- ^ Check if given object (window or smth else) matches that predicate
-- | A wrapper for X.U.WindowProperties.Property.
-- Checks using regular expression.
data PropertyRE = RE Property
deriving (Show,Read,Typeable)
-- | Data type for our layout.
data LayoutP p l1 l2 a =
LayoutP (Maybe a) (Maybe a) p B.SubBox (Maybe B.SubBox) (l1 a) (Maybe (l2 a))
deriving (Show,Read)
-- | Use the specified layout in the described area windows that match given predicate and send the rest of the windows to the next layout in the chain.
-- It is possible to supply an alternative area that will then be used instead, if there are no windows to send to the next layout.
layoutP :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a, LayoutClass l3 a, Predicate p a) =>
p
-> B.SubBox -- ^ The box to place the windows in
-> Maybe B.SubBox -- ^ Possibly an alternative box that is used when this layout handles all windows that are left
-> l1 a -- ^ The layout to use in the specified area
-> LayoutP p l2 l3 a -- ^ Where to send the remaining windows
-> LayoutP p l1 (LayoutP p l2 l3) a -- ^ The resulting layout
layoutP prop box mbox sub next = LayoutP Nothing Nothing prop box mbox sub (Just next)
-- | Use the specified layout in the described area for all remaining windows.
layoutAll :: forall l1 p a. (Read a, Eq a, LayoutClass l1 a, Predicate p a) =>
B.SubBox -- ^ The box to place the windows in
-> l1 a -- ^ The layout to use in the specified area
-> LayoutP p l1 Full a -- ^ The resulting layout
layoutAll box sub =
let a = alwaysTrue (undefined :: a)
in LayoutP Nothing Nothing a box Nothing sub Nothing
instance (LayoutClass l1 w, LayoutClass l2 w, Predicate p w, Show w, Read w, Eq w, Typeable w, Show p) =>
LayoutClass (LayoutP p l1 l2) w where
-- | Update window locations.
runLayout (W.Workspace _ (LayoutP subf nextf prop box mbox sub next) s) rect
= do (subs,nexts,subf',nextf') <- splitStack s prop subf nextf
let selBox = if isJust nextf'
then box
else maybe box id mbox
(sublist,sub') <- handle sub subs $ calcArea selBox rect
(nextlist,next') <- case next of Nothing -> return ([],Nothing)
Just n -> do (res,l) <- handle n nexts rect
return (res,Just l)
return (sublist++nextlist, Just $ LayoutP subf' nextf' prop box mbox sub' next' )
where
handle l s' r = do (res,ml) <- runLayout (W.Workspace "" l s') r
l' <- return $ maybe l id ml
return (res,l')
-- | Propagate messages.
handleMessage l m
| Just (IncMasterN _) <- fromMessage m = sendFocus l m
| Just (Shrink) <- fromMessage m = sendFocus l m
| Just (Expand) <- fromMessage m = sendFocus l m
| otherwise = sendBoth l m
-- | Descriptive name for layout.
description (LayoutP _ _ _ _ _ sub (Just next)) = "layoutP "++ description sub ++" "++ description next
description (LayoutP _ _ _ _ _ sub Nothing) = "layoutP "++ description sub
sendSub :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a)
=> LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
sendSub (LayoutP subf nextf prop box mbox sub next) m =
do sub' <- handleMessage sub m
return $ if isJust sub'
then Just $ LayoutP subf nextf prop box mbox (maybe sub id sub') next
else Nothing
sendBoth :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a)
=> LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
sendBoth l@(LayoutP _ _ _ _ _ _ Nothing) m = sendSub l m
sendBoth (LayoutP subf nextf prop box mbox sub (Just next)) m =
do sub' <- handleMessage sub m
next' <- handleMessage next m
return $ if isJust sub' || isJust next'
then Just $ LayoutP subf nextf prop box mbox (maybe sub id sub') (Just $ maybe next id next')
else Nothing
sendNext :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a)
=> LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
sendNext (LayoutP _ _ _ _ _ _ Nothing) _ = return Nothing
sendNext (LayoutP subf nextf prop box mbox sub (Just next)) m =
do next' <- handleMessage next m
return $ if isJust next'
then Just $ LayoutP subf nextf prop box mbox sub next'
else Nothing
sendFocus :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a)
=> LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
sendFocus l@(LayoutP subf _ _ _ _ _ _) m = do foc <- isFocus subf
if foc then sendSub l m
else sendNext l m
isFocus :: (Show a) => Maybe a -> X Bool
isFocus Nothing = return False
isFocus (Just w) = do ms <- (W.stack . W.workspace . W.current) `fmap` gets windowset
return $ maybe False (\s -> show w == (show $ W.focus s)) ms
-- | Split given list of objects (i.e. windows) using predicate.
splitBy :: (Predicate p w) => p -> [w] -> X ([w], [w])
splitBy prop ws = foldM step ([], []) ws
where
step (good, bad) w = do
ok <- checkPredicate prop w
return $ if ok
then (w:good, bad)
else (good, w:bad)
splitStack :: (Predicate p w, Eq w) => Maybe (W.Stack w) -> p -> Maybe w -> Maybe w -> X (Maybe (W.Stack w),Maybe (W.Stack w),Maybe w,Maybe w)
splitStack Nothing _ _ _ = return (Nothing,Nothing,Nothing,Nothing)
splitStack (Just s) prop subf nextf = do
let ws = W.integrate s
(good, other) <- splitBy prop ws
let subf' = foc good subf
nextf' = foc other nextf
return ( differentiate' subf' good
, differentiate' nextf' other
, subf'
, nextf'
)
where
foc [] _ = Nothing
foc l f = if W.focus s `elem` l
then Just $ W.focus s
else if maybe False (`elem` l) f
then f
else Just $ head l
calcArea :: B.SubBox -> Rectangle -> Rectangle
calcArea (B.SubBox xpos ypos width height) rect = Rectangle (rect_x rect + fromIntegral xpos') (rect_y rect + fromIntegral ypos') width' height'
where
xpos' = calc False xpos $ rect_width rect
ypos' = calc False ypos $ rect_height rect
width' = calc True width $ rect_width rect - xpos'
height' = calc True height $ rect_height rect - ypos'
calc zneg val tot = fromIntegral $ min (fromIntegral tot) $ max 0 $
case val of B.Rel v -> floor $ v * fromIntegral tot
B.Abs v -> if v<0 || (zneg && v==0)
then (fromIntegral tot)+v
else v
differentiate' :: Eq q => Maybe q -> [q] -> Maybe (W.Stack q)
differentiate' _ [] = Nothing
differentiate' Nothing w = W.differentiate w
differentiate' (Just f) w
| f `elem` w = Just $ W.Stack { W.focus = f
, W.up = reverse $ takeWhile (/=f) w
, W.down = tail $ dropWhile (/=f) w
}
| otherwise = W.differentiate w
instance Predicate Property Window where
alwaysTrue _ = Const True
checkPredicate = hasProperty
|
