aboutsummaryrefslogtreecommitdiffstats
path: root/XMonad/Layout/LayoutBuilderP.hs
blob: 7702a4f57900434fcc55f587c7884c74f9a413ae (plain) (blame)
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