From 4866f2e367dfcf22a9591231ba40948826a1b438 Mon Sep 17 00:00:00 2001 From: Spencer Janssen Date: Thu, 1 Nov 2007 21:10:59 +0100 Subject: Hierarchify darcs-hash:20071101201059-a5988-fc1f1262bec1b69e13ba18ae7cefeafc8c4471d4.gz --- Combo.hs | 139 --------------------------------------------------------------- 1 file changed, 139 deletions(-) delete mode 100644 Combo.hs (limited to 'Combo.hs') diff --git a/Combo.hs b/Combo.hs deleted file mode 100644 index 15c7155..0000000 --- a/Combo.hs +++ /dev/null @@ -1,139 +0,0 @@ -{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-} - ------------------------------------------------------------------------------ --- | --- Module : XMonadContrib.Combo --- Copyright : (c) David Roundy --- License : BSD-style (see LICENSE) --- --- Maintainer : David Roundy --- Stability : unstable --- Portability : unportable --- --- A layout that combines multiple layouts. --- ------------------------------------------------------------------------------ - -module XMonadContrib.Combo ( - -- * Usage - -- $usage - combineTwo, - CombineTwo - ) where - -import Control.Arrow ( first ) -import Data.List ( delete, intersect, (\\) ) -import Data.Maybe ( isJust ) -import XMonad -import XMonad.StackSet ( integrate, Stack(..) ) -import XMonadContrib.Invisible -import XMonadContrib.WindowNavigation ( MoveWindowToWindow(..) ) -import qualified XMonad.StackSet as W ( differentiate ) - --- $usage --- --- To use this layout write, in your Config.hs: --- --- > import XMonadContrib.Combo --- --- and add something like --- --- > combineTwo (TwoPane 0.03 0.5) (tabbed shrinkText defaultTConf) (tabbed shrinkText defaultTConf) --- --- to your layouts. - --- 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 --- 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 , combineTwo (TwoPane 0.03 0.5) (tabbed shrinkText defaultTConf) (tabbed shrinkText defaultTConf) - -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 - - -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 -- cgit v1.2.3