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
|
{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses,
UndecidableInstances, PatternGuards #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Layout.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 XMonad.Layout.Combo (
-- * Usage
-- $usage
combineTwo,
CombineTwo
) where
import Data.List ( delete, intersect, (\\) )
import Data.Maybe ( isJust )
import XMonad hiding (focus)
import XMonad.StackSet ( integrate, Workspace (..), Stack(..) )
import XMonad.Layout.WindowNavigation ( MoveWindowToWindow(..) )
import qualified XMonad.StackSet as W ( differentiate )
-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Layout.Combo
--
-- and add something like
--
-- > combineTwo (TwoPane 0.03 0.5) (tabbed shrinkText defaultTConf) (tabbed shrinkText defaultTConf)
--
-- to your layouts.
--
-- For more detailed instructions on editing the layoutHook see:
--
-- "XMonad.Doc.Extending#Editing_the_layout_hook"
--
-- combineTwo is a new simple layout combinator. It allows the
-- combination of two layouts using a third to split the screen
-- between the two, 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 "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)
--
-- For detailed instruction on editing the key binding see
-- "XMonad.Doc.Extending#Editing_key_bindings".
--
-- 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 separately, and this is ugly. If you don't like this,
-- lobby for hierarchical stacks in core xmonad or go reimplement the core of
-- xmonad yourself.
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 ReleaseResources)
l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage ReleaseResources)
super' <- maybe super id `fmap`
handleMessage super (SomeMessage ReleaseResources)
return ([], Just $ C2 [] [] super' l1' l2')
arrange [w] = do l1' <- maybe l1 id `fmap` handleMessage l1 (SomeMessage ReleaseResources)
l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage ReleaseResources)
super' <- maybe super id `fmap`
handleMessage super (SomeMessage ReleaseResources)
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') <- runLayout (Workspace "" super (Just superstack)) rinput
(wrs1, ml1') <- runLayout (Workspace "" l1 s1) r1
(wrs2, ml2') <- runLayout (Workspace "" l2 s2) r2
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
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
|
