aboutsummaryrefslogtreecommitdiffstats
path: root/XMonad/Layout/ComboP.hs
blob: e84e2b740ebf037d0efbbbef42a9e94a5352ed34 (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
{-# LANGUAGE TypeSynonymInstances, DeriveDataTypeable, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, PatternGuards #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.ComboP
-- Copyright   :  (c) Konstantin Sobolev <konstantin.sobolev@gmail.com>
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Konstantin Sobolev <konstantin.sobolev@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- A layout that combines multiple layouts and allows to specify where to put
-- new windows.
--
-----------------------------------------------------------------------------

module XMonad.Layout.ComboP (
                             -- * Usage
                             -- $usage
                             combineTwoP,
                             CombineTwoP,
                             SwapWindow(..),
                             Property(..)
                            ) where

import Data.List ( delete, intersect, (\\) )
import Data.Maybe ( isJust )
import Control.Monad
import XMonad hiding (focus)
import XMonad.StackSet ( integrate, Workspace (..), Stack(..) )
import XMonad.Layout.WindowNavigation
import XMonad.Util.WindowProperties
import qualified XMonad.StackSet as W

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Layout.ComboP
--
-- and add something like
--
-- > combineTwoP (TwoPane 0.03 0.5) (tabbed shrinkText defaultTConf) (tabbed shrinkText defaultTConf) (ClassName "Firefox")
--
-- to your layouts. This way all windows with class = \"Firefox\" will always go
-- to the left pane, all others - to the right.
--
-- For more detailed instructions on editing the layoutHook see:
--
-- "XMonad.Doc.Extending#Editing_the_layout_hook"
--
-- 'combineTwoP' is a simple layout combinator based on 'combineTwo' from Combo, with
-- addition of a 'Property' which tells where to put new windows. Windows mathing
-- the property will go into the first part, all others will go into the second
-- part. It supports @Move@ messages as 'combineTwo' does, but it also introduces
-- 'SwapWindow' message which sends focused window to the other part. It is
-- required because @Move@ commands don't work when one of the parts is empty.
-- To use it, import \"XMonad.Layout.WindowNavigation\", and add the following key
-- bindings (or something similar):
--
-- >    , ((modMask x .|. controlMask .|. shiftMask, xK_Right), sendMessage $ Move R)
-- >    , ((modMask x .|. controlMask .|. shiftMask, xK_Left ), sendMessage $ Move L)
-- >    , ((modMask x .|. controlMask .|. shiftMask, xK_Up   ), sendMessage $ Move U)
-- >    , ((modMask x .|. controlMask .|. shiftMask, xK_Down ), sendMessage $ Move D)
-- >    , ((modMask x .|. controlMask .|. shiftMask, xK_s    ), sendMessage $ SwapWindow)
--
-- For detailed instruction on editing the key binding see
-- "XMonad.Doc.Extending#Editing_key_bindings".

data SwapWindow =  SwapWindow        -- ^ Swap window between panes
                 | SwapWindowN Int   -- ^ Swap window between panes in the N-th nested ComboP. @SwapWindowN 0@ equals to SwapWindow
                 deriving (Read, Show, Typeable)
instance Message SwapWindow

data CombineTwoP l l1 l2 a = C2P [a] [a] [a] l (l1 a) (l2 a) Property
                                deriving (Read, Show)

combineTwoP :: (LayoutClass super(), LayoutClass l1 Window, LayoutClass l2 Window) =>
                super () -> l1 Window -> l2 Window -> Property -> CombineTwoP (super ()) l1 l2 Window
combineTwoP = C2P [] [] []

instance (LayoutClass l (), LayoutClass l1 Window, LayoutClass l2 Window) =>
    LayoutClass (CombineTwoP (l ()) l1 l2) Window where
    doLayout (C2P f w1 w2 super l1 l2 prop) rinput s =
        let origws = W.integrate s           -- passed in windows
            w1c = origws `intersect` w1      -- current windows in the first pane
            w2c = origws `intersect` w2      -- current windows in the second pane
            new = origws \\ (w1c ++ w2c)     -- new windows
            superstack = Just Stack { focus=(), up=[], down=[()] }
            f' = focus s:delete (focus s) f  -- list of focused windows, contains 2 elements at most
        in do
            matching <- (hasProperty prop) `filterM` new  -- new windows matching predecate
            let w1' = w1c ++ matching                     -- updated first pane windows
                w2' = w2c ++ (new \\ matching)            -- updated second pane windows
                s1 = differentiate f' w1'                 -- first pane stack
                s2 = differentiate f' w2'                 -- second pane stack
            ([((),r1),((),r2)], msuper') <- runLayout (Workspace "" super superstack) rinput
            (wrs1, ml1') <- runLayout (Workspace "" l1 s1) r1
            (wrs2, ml2') <- runLayout (Workspace "" l2 s2) r2
            return  (wrs1++wrs2, Just $ C2P f' w1' w2' (maybe super id msuper')
                (maybe l1 id ml1') (maybe l2 id ml2') prop)

    handleMessage us@(C2P f ws1 ws2 super l1 l2 prop) m
        | Just SwapWindow      <- fromMessage m = swap us
        | Just (SwapWindowN 0) <- fromMessage m = swap us
        | Just (SwapWindowN n) <- fromMessage m = forwardToFocused us $ SomeMessage $ SwapWindowN $ n-1

        | Just (MoveWindowToWindow w1 w2) <- fromMessage m,
          w1 `elem` ws1,
          w2 `elem` ws2 = return $ Just $ C2P f (delete w1 ws1) (w1:ws2) super l1 l2 prop

        | Just (MoveWindowToWindow w1 w2) <- fromMessage m,
          w1 `elem` ws2,
          w2 `elem` ws1 = return $ Just $ C2P f (w1:ws1) (delete w1 ws2) super l1 l2 prop

        | otherwise = do ml1' <- handleMessage l1 m
                         ml2' <- handleMessage l2 m
                         msuper' <- handleMessage super m
                         if isJust msuper' || isJust ml1' || isJust ml2'
                            then return $ Just $ C2P f ws1 ws2
                                                 (maybe super id msuper')
                                                 (maybe l1 id ml1')
                                                 (maybe l2 id ml2') prop
                            else return Nothing

    description (C2P _ _ _ super l1 l2 prop) = "combining " ++ description l1 ++ " and "++
                                description l2 ++ " with " ++ description super ++ " using "++ (show prop)

-- send focused window to the other pane. Does nothing if we don't
-- own the focused window
swap :: (LayoutClass s a, LayoutClass l1 Window, LayoutClass l2 Window) =>
        CombineTwoP (s a) l1 l2 Window -> X (Maybe (CombineTwoP (s a) l1 l2 Window))
swap (C2P f ws1 ws2 super l1 l2 prop) = do
    mst <- gets (W.stack . W.workspace . W.current . windowset)
    let (ws1', ws2') = case mst of
            Nothing -> (ws1, ws2)
            Just st -> if foc `elem` ws1
                           then (foc `delete` ws1, foc:ws2)
                           else if foc `elem` ws2
                               then (foc:ws1, foc `delete` ws2)
                               else (ws1, ws2)
                       where foc = W.focus st
    if (ws1,ws2) == (ws1',ws2')
        then return Nothing
        else return $ Just $ C2P f ws1' ws2' super l1 l2 prop


-- forwards the message to the sublayout which contains the focused window
forwardToFocused :: (LayoutClass l1 Window, LayoutClass l2 Window, LayoutClass s a) =>
                    CombineTwoP (s a) l1 l2 Window -> SomeMessage -> X (Maybe (CombineTwoP (s a) l1 l2 Window))
forwardToFocused (C2P f ws1 ws2 super l1 l2 prop) m = do
    ml1 <- forwardIfFocused l1 ws1 m
    ml2 <- forwardIfFocused l2 ws2 m
    ms <- if isJust ml1 || isJust ml2
            then return Nothing
            else handleMessage super m
    if isJust ml1 || isJust ml2 || isJust ms
        then return $ Just $ C2P f ws1 ws2 (maybe super id ms) (maybe l1 id ml1) (maybe l2 id ml2) prop
        else return Nothing

-- forwards message m to layout l if focused window is among w
forwardIfFocused :: (LayoutClass l Window) => l Window -> [Window] -> SomeMessage -> X (Maybe (l Window))
forwardIfFocused l w m = do
    mst <- gets (W.stack . W.workspace . W.current . windowset)
    maybe (return Nothing) send mst where
    send st = if (W.focus st) `elem` w
                then handleMessage l m
                else return Nothing

-- code from CombineTwo
-- given two sets of zs and xs takes the first z from zs that also belongs to xs
-- and turns xs into a stack with z being current element. Acts as
-- StackSet.differentiate if zs and xs don't intersect
differentiate :: Eq q => [q] -> [q] -> Maybe (Stack q)
differentiate (z:zs) xs | z `elem` xs = Just $ Stack { focus=z
                                                     , up = reverse $ takeWhile (/=z) xs
                                                     , down = tail $ dropWhile (/=z) xs }
                        | otherwise = differentiate zs xs
differentiate [] xs = W.differentiate xs

-- vim:ts=4:shiftwidth=4:softtabstop=4:expandtab:foldlevel=20: