diff options
Diffstat (limited to '')
-rw-r--r-- | Combo.hs | 103 |
1 files changed, 93 insertions, 10 deletions
@@ -17,16 +17,17 @@ module XMonadContrib.Combo ( -- * Usage -- $usage - combo + combo, combineTwo ) where import Control.Arrow ( first ) -import Data.List ( delete ) +import Data.List ( delete, intersect, (\\) ) import Data.Maybe ( isJust ) import XMonad -import Operations ( LayoutMessages(ReleaseResources) ) +import Operations ( LayoutMessages(ReleaseResources,Hide) ) import StackSet ( integrate, Stack(..) ) import XMonadContrib.Invisible +import XMonadContrib.WindowNavigation ( MoveWindowToWindow(..) ) import qualified StackSet as W ( differentiate ) -- $usage @@ -37,7 +38,11 @@ import qualified StackSet as W ( differentiate ) -- -- and add something like -- --- > combo (TwoPane 0.03 0.5) [(Full,1),(tabbed shrinkText defaultTConf,1)] +-- > 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. -- @@ -48,9 +53,86 @@ import qualified StackSet as W ( differentiate ) -- 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 []) @@ -76,12 +158,6 @@ instance (Eq a, ReadableLayout a, LayoutClass l (Layout a, Int)) foo (_, Nothing) x = x foo (_, Just l') (_, n) = (l', n) return (concat $ map fst out, Just $ Combo (I f') super' origls') - 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 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 @@ -93,6 +169,13 @@ instance (Eq a, ReadableLayout a, LayoutClass l (Layout a, Int)) 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 |