mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 03:20:21 -07:00
145 lines
7.5 KiB
Haskell
145 lines
7.5 KiB
Haskell
{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses,
|
|
UndecidableInstances, PatternGuards #-}
|
|
|
|
-----------------------------------------------------------------------------
|
|
-- |
|
|
-- Module : XMonad.Layout.Combo
|
|
-- Copyright : (c) David Roundy <droundy@darcs.net>
|
|
-- License : BSD-style (see LICENSE)
|
|
--
|
|
-- Maintainer : none
|
|
-- 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
|
|
runLayout (Workspace _ (C2 f w2 super l1 l2) s) rinput = 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 = Stack { focus=(), up=[], down=[()] }
|
|
s1 = differentiate f' (origws \\ w2')
|
|
s2 = differentiate f' w2'
|
|
f' = case s of (Just s') -> focus s':delete (focus s') f
|
|
Nothing -> 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
|