twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-08-01 20:51:52 -07:00
Code Issues Packages Projects Releases Wiki Activity

introduce new combineTwo layout combinator.

Browse Source 
This layout combinator is similar in spirit (and in code) to
the old combo combinator, but only allows two sublayouts.  As
a result, we don't need to wrap these in existentials, and reading
works seamlessly.  Also, we add the feature (which could also be
added to combo) of being able to change which sublayout a given
window is in through integration with WindowNavigation.

I envision combo being deprecated soon.  combineTwo isn't quite
so flexible, but it's much easier and is better-coded also.
This commit is contained in:
David Roundy
2007-10-20 19:17:48 +00:00
parent 73a5299fbe
commit 723e757910
2 changed files with 109 additions and 16 deletions
Download Patch File Download Diff File Expand all files Collapse all files

103
Combo.hs
View File

@@ -17,16 +17,17 @@
module XMonadContrib.Combo ( module XMonadContrib.Combo (
-- * Usage -- * Usage
-- $usage -- $usage
combo combo, combineTwo
) where ) where
import Control.Arrow ( first ) import Control.Arrow ( first )
import Data.List ( delete ) import Data.List ( delete, intersect, (\\) )
import Data.Maybe ( isJust ) import Data.Maybe ( isJust )
import XMonad import XMonad
import Operations ( LayoutMessages(ReleaseResources) ) import Operations ( LayoutMessages(ReleaseResources,Hide) )
import StackSet ( integrate, Stack(..) ) import StackSet ( integrate, Stack(..) )
import XMonadContrib.Invisible import XMonadContrib.Invisible
import XMonadContrib.WindowNavigation ( MoveWindowToWindow(..) )
import qualified StackSet as W ( differentiate ) import qualified StackSet as W ( differentiate )
-- $usage -- $usage
@@ -37,7 +38,11 @@ import qualified StackSet as W ( differentiate )
-- --
-- and add something like -- 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. -- 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 -- windows this section should hold. This number is ignored for the last
-- layout, which will hold any excess windows. -- 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 -- %import XMonadContrib.Combo
-- %layout , combo (twoPane 0.03 0.5) [(full,1),(tabbed shrinkText defaultTConf,1)] -- %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)) combo :: (Eq a, Show a, Read a, ReadableLayout a, LayoutClass l (Layout a, Int))
=> (l (Layout a, Int)) -> [(Layout a, Int)] -> Combo l a => (l (Layout a, Int)) -> [(Layout a, Int)] -> Combo l a
combo = Combo (I []) combo = Combo (I [])
@@ -76,12 +158,6 @@ instance (Eq a, ReadableLayout a, LayoutClass l (Layout a, Int))
foo (_, Nothing) x = x foo (_, Nothing) x = x
foo (_, Just l') (_, n) = (l', n) foo (_, Just l') (_, n) = (l', n)
return (concat $ map fst out, Just $ Combo (I f') super' origls') 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 = handleMessage (Combo (I f) super origls) m =
do mls <- broadcastPrivate m (map fst origls) do mls <- broadcastPrivate m (map fst origls)
let mls' = (\x->zipWith first (map const x) origls) `fmap` mls 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' Just [super'] -> return $ Just $ Combo (I f') super' $ maybe origls id mls'
_ -> return $ Combo (I f') super `fmap` 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 :: LayoutClass l b => SomeMessage -> [l b] -> X (Maybe [l b])
broadcastPrivate a ol = do nml <- mapM f ol broadcastPrivate a ol = do nml <- mapM f ol
if any isJust nml if any isJust nml

22
WindowNavigation.hs
View File

@@ -20,12 +20,14 @@ module XMonadContrib.WindowNavigation (
-- $usage -- $usage
windowNavigation, configurableNavigation, windowNavigation, configurableNavigation,
Navigate(..), Direction(..), Navigate(..), Direction(..),
MoveWindowToWindow(..),
navigateColor, navigateBrightness, navigateColor, navigateBrightness,
noNavigateBorders, defaultWNConfig noNavigateBorders, defaultWNConfig
) where ) where
import Graphics.X11.Xlib ( Rectangle(..), Window, Pixel, setWindowBorder ) import Graphics.X11.Xlib ( Rectangle(..), Window, Pixel, setWindowBorder )
import Control.Monad.Reader ( ask ) import Control.Monad.Reader ( ask )
import Control.Monad.State ( gets )
import Data.List ( nub, sortBy, (\\) ) import Data.List ( nub, sortBy, (\\) )
import XMonad import XMonad
import qualified StackSet as W import qualified StackSet as W
@@ -67,8 +69,10 @@ import XMonadContrib.XUtils
-- %layout -- or -- %layout -- or
-- %layout -- layoutHook = Layout $ configurableNavigation (navigateBorder "green") $ ... -- %layout -- layoutHook = Layout $ configurableNavigation (navigateBorder "green") $ ...
data MoveWindowToWindow a = MoveWindowToWindow a a deriving ( Read, Show, Typeable )
instance Typeable a => Message (MoveWindowToWindow a)
data Navigate = Go Direction | Swap Direction deriving ( Read, Show, Typeable ) data Navigate = Go Direction | Swap Direction | Move Direction deriving ( Read, Show, Typeable )
data Direction = U | D | R | L deriving ( Read, Show, Eq ) data Direction = U | D | R | L deriving ( Read, Show, Eq )
instance Message Navigate instance Message Navigate
@@ -136,12 +140,12 @@ instance LayoutModifier WindowNavigation Window where
mapM_ (\(win,c) -> sc c win) wnavigablec mapM_ (\(win,c) -> sc c win) wnavigablec
return (wrs, Just $ WindowNavigation conf $ I $ Just $ NS pt wnavigable) return (wrs, Just $ WindowNavigation conf $ I $ Just $ NS pt wnavigable)
handleMess (WindowNavigation conf (I (Just (NS pt wrs)))) m handleMessOrMaybeModifyIt (WindowNavigation conf (I (Just (NS pt wrs)))) m
| Just (Go d) <- fromMessage m = | Just (Go d) <- fromMessage m =
case sortby d $ filter (inr d pt . snd) wrs of case sortby d $ filter (inr d pt . snd) wrs of
[] -> return Nothing [] -> return Nothing
((w,r):_) -> do focus w ((w,r):_) -> do focus w
return $ Just $ WindowNavigation conf $ I $ Just $ return $ Just $ Left $ WindowNavigation conf $ I $ Just $
NS (centerd d pt r) wrs NS (centerd d pt r) wrs
| Just (Swap d) <- fromMessage m = | Just (Swap d) <- fromMessage m =
case sortby d $ filter (inr d pt . snd) wrs of case sortby d $ filter (inr d pt . snd) wrs of
@@ -159,13 +163,19 @@ instance LayoutModifier WindowNavigation Window where
, W.up = [] } , W.up = [] }
windows $ W.modify' swap windows $ W.modify' swap
return Nothing return Nothing
| Just (Move d) <- fromMessage m =
case sortby d $ filter (inr d pt . snd) wrs of
[] -> return Nothing
((w,_):_) -> do mst <- gets (W.stack . W.workspace . W.current . windowset)
return $ do st <- mst
Just $ Right $ SomeMessage $ MoveWindowToWindow (W.focus st) w
| Just Hide <- fromMessage m = | Just Hide <- fromMessage m =
do XConf { normalBorder = nbc } <- ask do XConf { normalBorder = nbc } <- ask
mapM_ (sc nbc . fst) wrs mapM_ (sc nbc . fst) wrs
return $ Just $ WindowNavigation conf $ I $ Just $ NS pt [] return $ Just $ Left $ WindowNavigation conf $ I $ Just $ NS pt []
| Just ReleaseResources <- fromMessage m = | Just ReleaseResources <- fromMessage m =
handleMess (WindowNavigation conf (I $ Just (NS pt wrs))) (SomeMessage Hide) handleMessOrMaybeModifyIt (WindowNavigation conf (I $ Just (NS pt wrs))) (SomeMessage Hide)
handleMess _ _ = return Nothing handleMessOrMaybeModifyIt _ _ = return Nothing
truncHead :: [a] -> [a] truncHead :: [a] -> [a]
truncHead (x:_) = [x] truncHead (x:_) = [x]