mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-07-27 10:11:52 -07:00
XMonad
Actions
Config
Doc
Hooks
Layout
Accordion.hs
Circle.hs
Combo.hs
Decoration.hs
DecorationMadness.hs
Dishes.hs
DragPane.hs
DwmStyle.hs
Grid.hs
HintedTile.hs
LayoutCombinators.hs
LayoutHints.hs
LayoutModifier.hs
LayoutScreens.hs
MagicFocus.hs
Magnifier.hs
Maximize.hs
Mosaic.hs
MosaicAlt.hs
MultiToggle.hs
Named.hs
NoBorders.hs
PerWorkspace.hs
Reflect.hs
ResizableTile.hs
ResizeScreen.hs
Roledex.hs
ShowWName.hs
SimpleDecoration.hs
SimpleFloat.hs
Simplest.hs
Spiral.hs
Square.hs
Tabbed.hs
ThreeColumns.hs
ToggleLayouts.hs
TwoPane.hs
WindowArranger.hs
WindowNavigation.hs
WorkspaceDir.hs
Prompt
Util
Doc.hs
Prompt.hs
scripts
tests
LICENSE
README
Setup.lhs
xmonad-contrib.cabal
146 lines
7.5 KiB
Haskell
146 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 : 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, 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') <- 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
|
|
|
|
|
|
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
|