twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-05-19 11:30:22 -07:00
Code Issues Packages Projects Releases Wiki Activity

Add a LayoutCombinator class and a CombinedLayout and port PerWorkspace to the new system

Browse Source
This commit is contained in:
Andrea Rossato 2008-01-29 19:29:03 +00:00
parent f23a87f4e6
commit 055a6b1232
2 changed files with 104 additions and 88 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

114
XMonad/Layout/LayoutCombinators.hs
View File

@ -13,37 +13,40 @@
-- A module for combining other layouts. -- A module for combining other layouts.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module XMonad.Layout.LayoutCombinators ( module XMonad.Layout.LayoutCombinators
-- * Usage ( -- * Usage
-- $usage -- $usage
-- * Combinators using DragPane vertical -- * Combinators using DragPane vertical
-- $dpv -- $dpv
(*||*), (**||*),(***||*),(****||*),(***||**),(****||***), (*||*), (**||*),(***||*),(****||*),(***||**),(****||***)
(***||****),(*||****),(**||***),(*||***),(*||**), , (***||****),(*||****),(**||***),(*||***),(*||**)
-- * Combinators using DragPane horizontal -- * Combinators using DragPane horizontal
-- $dph -- $dph
(*//*), (**//*),(***//*),(****//*),(***//**),(****//***), , (*//*), (**//*),(***//*),(****//*),(***//**),(****//***)
(***//****),(*//****),(**//***),(*//***),(*//**), , (***//****),(*//****),(**//***),(*//***),(*//**)
-- * Combinators using Tall (vertical) -- * Combinators using Tall (vertical)
-- $tv -- $tv
(*|*), (**|*),(***|*),(****|*),(***|**),(****|***), , (*|*), (**|*),(***|*),(****|*),(***|**),(****|***)
(***|****),(*|****),(**|***),(*|***),(*|**), , (***|****),(*|****),(**|***),(*|***),(*|**)
-- * Combinators using Mirror Tall (horizontal) -- * Combinators using Mirror Tall (horizontal)
-- $mth -- $mth
(*/*), (**/*),(***/*),(****/*),(***/**),(****/***), , (*/*), (**/*),(***/*),(****/*),(***/**),(****/***)
(***/****),(*/****),(**/***),(*/***),(*/**), , (***/****),(*/****),(**/***),(*/***),(*/**)
-- * A new combinator -- * A new combinator
-- $nc -- $nc
(|||), , (|||)
JumpToLayout(JumpToLayout) , JumpToLayout(JumpToLayout)
, LayoutCombinator (..)
, CombinedLayout (..)
, ComboType (..)
) where ) where
import Data.Maybe ( isJust, isNothing ) import Data.Maybe ( fromMaybe, isJust, isNothing )
import XMonad hiding ((|||)) import XMonad hiding ((|||))
import XMonad.Layout.Combo import XMonad.Layout.Combo
@ -218,3 +221,66 @@ passOnM m (NewSelect False lt lf) = do mlf' <- handleMessage lf m
when' :: Monad m => (a -> Bool) -> m a -> m a -> m a when' :: Monad m => (a -> Bool) -> m a -> m a -> m a
when' f a b = do a1 <- a; if f a1 then b else return a1 when' f a b = do a1 <- a; if f a1 then b else return a1
data ComboType = DoFirst | DoSecond | DoBoth deriving ( Eq, Show )
class (Read (lc a), Show (lc a)) => LayoutCombinator lc a where
chooser :: lc a -> X ComboType
chooser lc = return $ pureChooser lc
pureChooser :: lc a -> ComboType
pureChooser _ = DoFirst
-- doFirst lc = if (chooser lc) == DoSecond then False else True
doFirst :: lc a -> Bool
combineResult :: lc a -> [(a,Rectangle)] -> [(a,Rectangle)] -> [(a,Rectangle)]
combineResult _ wrs1 wrs2 = wrs1 ++ wrs2
comboHandleMess :: (LayoutClass l1 a, LayoutClass l2 a) => lc a -> l1 a -> l2 a -> SomeMessage -> X (lc a)
comboHandleMess lc l1 l2 m = return $ pureComboHandleMess lc l1 l2 m
pureComboHandleMess :: (LayoutClass l1 a, LayoutClass l2 a) => lc a -> l1 a -> l2 a -> SomeMessage -> lc a
pureComboHandleMess lc _ _ _ = lc
sendToOther :: (LayoutClass l a) => lc a -> l a -> SomeMessage
sendToOther _ _ = SomeMessage Hide
comboName :: lc a -> String
comboName = show
comboDescription :: (LayoutClass l1 a, LayoutClass l2 a) => lc a -> l1 a -> l2 a -> String
comboDescription lc l1 l2 = show lc <> if doFirst lc then description l1 else description l2
where "" <> x = x
x <> y = x ++ " " ++ y
data CombinedLayout lc l1 l2 a = CombinedLayout (lc a) (l1 a) (l2 a) deriving ( Show, Read )
instance (LayoutClass l1 a, LayoutClass l2 a, LayoutCombinator lc a) => LayoutClass (CombinedLayout lc l1 l2) a where
doLayout (CombinedLayout lc l1 l2) r s = do
choose <- chooser lc
case choose of
DoSecond -> do (wrs, nl2) <- doLayout l2 r s
return (wrs, Just $ CombinedLayout lc l1 (fromMaybe l2 nl2))
DoBoth -> do (wrs1, nl1) <- doLayout l1 r s
(wrs2, nl2) <- doLayout l2 r s
return (combineResult lc wrs1 wrs2 , Just $ CombinedLayout lc (fromMaybe l1 nl1) (fromMaybe l2 nl2))
_ -> do (wrs, nl1) <- doLayout l1 r s
return (wrs, Just $ CombinedLayout lc (fromMaybe l1 nl1) l2)
emptyLayout (CombinedLayout lc l1 l2) r = do
choose <- chooser lc
case choose of
DoSecond -> do (wrs, nl2) <- emptyLayout l2 r
return (wrs, Just $ CombinedLayout lc l1 (fromMaybe l2 nl2))
DoBoth -> do (wrs1, nl1) <- emptyLayout l1 r
(wrs2, nl2) <- emptyLayout l2 r
return (combineResult lc wrs1 wrs2 , Just $ CombinedLayout lc (fromMaybe l1 nl1) (fromMaybe l2 nl2))
_ -> do (wrs, nl1) <- emptyLayout l1 r
return (wrs, Just $ CombinedLayout lc (fromMaybe l1 nl1) l2)
handleMessage (CombinedLayout lc l1 l2) m = do
nc <- comboHandleMess lc l1 l2 m
choose <- chooser nc
case choose of
DoFirst -> do nl1 <- handleMessage l1 m
nl2 <- handleMessage l2 (sendToOther nc l2)
return $ Just $ CombinedLayout nc (fromMaybe l1 nl1) (fromMaybe l2 nl2)
DoSecond -> do nl1 <- handleMessage l1 (sendToOther nc l1)
nl2 <- handleMessage l2 m
return $ Just $ CombinedLayout nc (fromMaybe l1 nl1) (fromMaybe l2 nl2)
DoBoth -> do nl1 <- handleMessage l1 m
nl2 <- handleMessage l2 m
return $ Just $ CombinedLayout nc (fromMaybe l1 nl1) (fromMaybe l2 nl2)
description (CombinedLayout lc l1 l2) = comboDescription lc l1 l2

78
XMonad/Layout/PerWorkspace.hs
View File

@ -31,8 +31,7 @@ module XMonad.Layout.PerWorkspace (
import XMonad import XMonad
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
import Data.Maybe (fromMaybe) import XMonad.Layout.LayoutCombinators
-- $usage -- $usage
-- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file: -- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file:
-- --
@ -59,21 +58,19 @@ import Data.Maybe (fromMaybe)
-- | Specify one layout to use on a particular workspace, and another -- | Specify one layout to use on a particular workspace, and another
-- to use on all others. The second layout can be another call to -- to use on all others. The second layout can be another call to
-- 'onWorkspace', and so on. -- 'onWorkspace', and so on.
onWorkspace :: (LayoutClass l1 a, LayoutClass l2 a) onWorkspace :: WorkspaceId -- ^ tags of workspaces to match
=> WorkspaceId -- ^ the tag of the workspace to match -> (l1 a) -- ^ layout to use on matched workspaces
-> (l1 a) -- ^ layout to use on the matched workspace -> (l2 a) -- ^ layout to use everywhere else
-> (l2 a) -- ^ layout to use everywhere else -> CombinedLayout PerWorkspace l1 l2 a
-> PerWorkspace l1 l2 a onWorkspace wsId l1 l2 = CombinedLayout (PerWorkspace [wsId]) l1 l2
onWorkspace wsId l1 l2 = PerWorkspace [wsId] Nothing l1 l2
-- | Specify one layout to use on a particular set of workspaces, and -- | Specify one layout to use on a particular set of workspaces, and
-- another to use on all other workspaces. -- another to use on all other workspaces.
onWorkspaces :: (LayoutClass l1 a, LayoutClass l2 a) onWorkspaces :: [WorkspaceId] -- ^ tags of workspaces to match
=> [WorkspaceId] -- ^ tags of workspaces to match
-> (l1 a) -- ^ layout to use on matched workspaces -> (l1 a) -- ^ layout to use on matched workspaces
-> (l2 a) -- ^ layout to use everywhere else -> (l2 a) -- ^ layout to use everywhere else
-> PerWorkspace l1 l2 a -> CombinedLayout PerWorkspace l1 l2 a
onWorkspaces wsIds l1 l2 = PerWorkspace wsIds Nothing l1 l2 onWorkspaces wsIds l1 l2 = CombinedLayout (PerWorkspace wsIds) l1 l2
-- | Structure for representing a workspace-specific layout along with -- | Structure for representing a workspace-specific layout along with
-- a layout for all other workspaces. We store the tags of workspaces -- a layout for all other workspaces. We store the tags of workspaces
@ -83,60 +80,13 @@ onWorkspaces wsIds l1 l2 = PerWorkspace wsIds Nothing l1 l2
-- to be able to correctly implement the 'description' method of -- to be able to correctly implement the 'description' method of
-- LayoutClass, since a call to description is not able to query the -- LayoutClass, since a call to description is not able to query the
-- WM state to find out which workspace it was called in. -- WM state to find out which workspace it was called in.
data PerWorkspace l1 l2 a = PerWorkspace [WorkspaceId] data PerWorkspace a = PerWorkspace [WorkspaceId] deriving (Read, Show)
(Maybe Bool)
(l1 a)
(l2 a)
deriving (Read, Show)
instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (PerWorkspace l1 l2) a where instance LayoutCombinator PerWorkspace a where
chooser (PerWorkspace wsIds) = do
-- do layout with l1, then return a modified PerWorkspace caching
-- the fact that we're in the matched workspace.
doLayout p@(PerWorkspace _ (Just True) lt _) r s = do
(wrs, mlt') <- doLayout lt r s
return (wrs, Just $ mkNewPerWorkspaceT p mlt')
-- do layout with l1, then return a modified PerWorkspace caching
-- the fact that we're not in the matched workspace.
doLayout p@(PerWorkspace _ (Just False) _ lf) r s = do
(wrs, mlf') <- doLayout lf r s
return (wrs, Just $ mkNewPerWorkspaceF p mlf')
-- figure out which layout to use based on the current workspace.
doLayout (PerWorkspace wsIds Nothing l1 l2) r s = do
t <- getCurrentTag t <- getCurrentTag
doLayout (PerWorkspace wsIds (Just $ t `elem` wsIds) l1 l2) r s return $ if t `elem` wsIds then DoFirst else DoSecond
doFirst (PerWorkspace _) = True
-- handle messages; same drill as doLayout.
handleMessage p@(PerWorkspace _ (Just True) lt _) m = do
mlt' <- handleMessage lt m
return . Just $ mkNewPerWorkspaceT p mlt'
handleMessage p@(PerWorkspace _ (Just False) _ lf) m = do
mlf' <- handleMessage lf m
return . Just $ mkNewPerWorkspaceF p mlf'
handleMessage (PerWorkspace _ Nothing _ _) _ = return Nothing
description (PerWorkspace _ (Just True ) l1 _) = description l1
description (PerWorkspace _ (Just False) _ l2) = description l2
-- description's result is not in the X monad, so we have to wait
-- until a doLayout for the information about which workspace
-- we're in to get cached.
description _ = "PerWorkspace"
-- | Construct new PerWorkspace values with possibly modified layouts.
mkNewPerWorkspaceT :: PerWorkspace l1 l2 a -> Maybe (l1 a) ->
PerWorkspace l1 l2 a
mkNewPerWorkspaceT (PerWorkspace wsIds b lt lf) mlt' =
(\lt' -> PerWorkspace wsIds b lt' lf) $ fromMaybe lt mlt'
mkNewPerWorkspaceF :: PerWorkspace l1 l2 a -> Maybe (l2 a) ->
PerWorkspace l1 l2 a
mkNewPerWorkspaceF (PerWorkspace wsIds b lt lf) mlf' =
(\lf' -> PerWorkspace wsIds b lt lf') $ fromMaybe lf mlf'
-- | Get the tag of the currently active workspace. Note that this -- | Get the tag of the currently active workspace. Note that this
-- is only guaranteed to be the same workspace for which doLayout -- is only guaranteed to be the same workspace for which doLayout