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
|
{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonadContrib.Combo
-- Copyright : (c) David Roundy <droundy@darcs.net>
-- License : BSD-style (see LICENSE)
--
-- Maintainer : David Roundy <droundy@darcs.net>
-- Stability : unstable
-- Portability : unportable
--
-- A layout that combines multiple layouts.
--
-----------------------------------------------------------------------------
module XMonadContrib.Combo (
-- * Usage
-- $usage
combo, combineTwo,
CombineTwo
) where
import Control.Arrow ( first )
import Data.List ( delete, intersect, (\\) )
import Data.Maybe ( isJust )
import XMonad
import Operations ( LayoutMessages(ReleaseResources,Hide) )
import StackSet ( integrate, Stack(..) )
import XMonadContrib.Invisible
import XMonadContrib.WindowNavigation ( MoveWindowToWindow(..) )
import qualified StackSet as W ( differentiate )
-- $usage
--
-- To use this layout write, in your Config.hs:
--
-- > import XMonadContrib.Combo
--
-- and add something like
--
-- > combo (TwoPane 0.03 0.5) [(Layout Full,1),(Layout $ tabbed shrinkText defaultTConf,1)]
--
-- or alternatively
--
-- > combineTwo (TwoPane 0.03 0.5) (tabbed shrinkText defaultTConf) (tabbed shrinkText defaultTConf)
--
-- to your layouts.
--
-- The first argument to combo is a layout that will divide the screen into
-- one or more subscreens. The second argument is a list of layouts which
-- will be used to lay out the contents of each of those subscreens.
-- Paired with each of these layouts is an integer giving the number of
-- windows this section should hold. This number is ignored for the last
-- layout, which will hold any excess windows.
-- combineTwo is a new simpler (and yet in some ways more powerful) layout
-- combinator. It only allows the combination of two layouts, but has the
-- advantage of allowing you to dynamically adjust the layout, in terms of
-- the number of windows in each sublayout. To do this, use
-- WindowNavigation, and add the following key bindings (or something similar):
-- , ((modMask .|. controlMask .|. shiftMask, xK_Right), sendMessage $ Move R)
-- , ((modMask .|. controlMask .|. shiftMask, xK_Left), sendMessage $ Move L)
-- , ((modMask .|. controlMask .|. shiftMask, xK_Up), sendMessage $ Move U)
-- , ((modMask .|. controlMask .|. shiftMask, xK_Down), sendMessage $ Move D)
-- These bindings will move a window into the sublayout that is
-- up/down/left/right of its current position. Note that there is some
-- weirdness in combineTwo, in that the mod-tab focus order is not very
-- closely related to the layout order. This is because we're forced to
-- keep track of the window positions sparately, and this is ugly. If you
-- don't like this, lobby for hierarchical stacks in core xmonad or go
-- reimelement the core of xmonad yourself.
-- %import XMonadContrib.Combo
-- %layout , combo (twoPane 0.03 0.5) [(full,1),(tabbed shrinkText defaultTConf,1)]
data CombineTwo l l1 l2 a = C2 [a] [a] (l ()) (l1 a) (l2 a)
deriving (Read, Show)
combineTwo :: (Read a, Eq a, LayoutClass super (), LayoutClass l1 a, LayoutClass l2 a) =>
super () -> l1 a -> l2 a -> CombineTwo super l1 l2 a
combineTwo = C2 [] []
instance (LayoutClass l (), LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a)
=> LayoutClass (CombineTwo l l1 l2) a where
doLayout (C2 f w2 super l1 l2) rinput s = arrange (integrate s)
where arrange [] = do l1' <- maybe l1 id `fmap` handleMessage l1 (SomeMessage Hide)
l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage Hide)
return ([], Just $ C2 [] [] super l1' l2')
arrange [w] = do l1' <- maybe l1 id `fmap` handleMessage l1 (SomeMessage Hide)
l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage Hide)
return ([(w,rinput)], Just $ C2 [w] [w] super l1' l2')
arrange origws =
do let w2' = case origws `intersect` w2 of [] -> [head origws]
[x] -> [x]
x -> case origws \\ x of
[] -> init x
_ -> x
superstack = if focus s `elem` w2'
then Stack { focus=(), up=[], down=[()] }
else Stack { focus=(), up=[], down=[()] }
s1 = differentiate f' (origws \\ w2')
s2 = differentiate f' w2'
f' = focus s:delete (focus s) f
([((),r1),((),r2)], msuper') <- doLayout super rinput superstack
(wrs1, ml1') <- runLayout l1 r1 s1
(wrs2, ml2') <- runLayout l2 r2 s2
return (wrs1++wrs2, Just $ C2 f' w2'
(maybe super id msuper') (maybe l1 id ml1') (maybe l2 id ml2'))
handleMessage (C2 f ws2 super l1 l2) m
| Just (MoveWindowToWindow w1 w2) <- fromMessage m,
w1 `notElem` ws2,
w2 `elem` ws2 = do l1' <- maybe l1 id `fmap` handleMessage l1 m
l2' <- maybe l2 id `fmap` handleMessage l2 m
return $ Just $ C2 f (w1:ws2) super l1' l2'
| Just (MoveWindowToWindow w1 w2) <- fromMessage m,
w1 `elem` ws2,
w2 `notElem` ws2 = do l1' <- maybe l1 id `fmap` handleMessage l1 m
l2' <- maybe l2 id `fmap` handleMessage l2 m
let ws2' = case delete w1 ws2 of [] -> [w2]
x -> x
return $ Just $ C2 f ws2' super l1' l2'
| otherwise = do ml1' <- broadcastPrivate m [l1]
ml2' <- broadcastPrivate m [l2]
msuper' <- broadcastPrivate m [super]
if isJust msuper' || isJust ml1' || isJust ml2'
then return $ Just $ C2 f ws2
(maybe super head msuper')
(maybe l1 head ml1')
(maybe l2 head ml2')
else return Nothing
description (C2 _ _ super l1 l2) = "combining "++ description l1 ++" and "++
description l2 ++" with "++ description super
combo :: (Eq a, Show a, Read a, ReadableLayout a, LayoutClass l (Layout a, Int))
=> (l (Layout a, Int)) -> [(Layout a, Int)] -> Combo l a
combo = Combo (I [])
data Combo l a = Combo (Invisible [] a) (l (Layout a, Int)) [(Layout a, Int)]
deriving (Show, Read)
instance (Eq a, ReadableLayout a, LayoutClass l (Layout a, Int))
=> LayoutClass (Combo l) a where
doLayout (Combo (I f) super origls) rinput s = arrange (integrate s)
where arrange [] = return ([], Just $ Combo (I []) super origls)
arrange [w] = return ([(w,rinput)], Just $ Combo (I [w]) super origls)
arrange origws =
do (lrs, msuper') <- runLayout super rinput (W.differentiate $ take (length origws) origls)
let super' = maybe super id msuper'
f' = focus s:delete (focus s) f
lwrs [] _ = []
lwrs [((l,_),r)] ws = [((l,r),differentiate f' ws)]
lwrs (((l,n),r):xs) ws = ((l,r),differentiate f' $ take len1 ws) : lwrs xs (drop len1 ws)
where len1 = min n (length ws - length xs)
out <- mapM (uncurry $ uncurry runLayout) $ lwrs lrs origws
let origls' = zipWith foo (out++repeat ([],Nothing)) origls
foo (_, Nothing) x = x
foo (_, Just l') (_, n) = (l', n)
return (concat $ map fst out, Just $ Combo (I f') super' origls')
handleMessage (Combo (I f) super origls) m =
do mls <- broadcastPrivate m (map fst origls)
let mls' = (\x->zipWith first (map const x) origls) `fmap` mls
f' = case fromMessage m of
Just ReleaseResources -> []
_ -> f
msuper <- broadcastPrivate m [super]
case msuper of
Just [super'] -> return $ Just $ Combo (I f') super' $ maybe origls id mls'
_ -> return $ Combo (I f') super `fmap` mls'
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
broadcastPrivate :: LayoutClass l b => SomeMessage -> [l b] -> X (Maybe [l b])
broadcastPrivate a ol = do nml <- mapM f ol
if any isJust nml
then return $ Just $ zipWith ((flip maybe) id) ol nml
else return Nothing
where f l = handleMessage l a `catchX` return Nothing
|
