aboutsummaryrefslogtreecommitdiffstats
path: root/XMonad
diff options
context:
space:
mode:
authorAndrea Rossato <andrea.rossato@unibz.it>2008-01-29 20:29:03 +0100
committerAndrea Rossato <andrea.rossato@unibz.it>2008-01-29 20:29:03 +0100
commitbbc8c39af8c4c2810de8fef985737c5c86acd06f (patch)
tree23a3186fedb0d31e407612797e56dc0f24a3a01f /XMonad
parent10126d6a3de14c93ee13f646e7ede0a6cc14871d (diff)
downloadXMonadContrib-bbc8c39af8c4c2810de8fef985737c5c86acd06f.tar.gz
XMonadContrib-bbc8c39af8c4c2810de8fef985737c5c86acd06f.tar.xz
XMonadContrib-bbc8c39af8c4c2810de8fef985737c5c86acd06f.zip
Add a LayoutCombinator class and a CombinedLayout and port PerWorkspace to the new system
darcs-hash:20080129192903-32816-de07daf3f32a823c1f3a0e593ff6229b78ae0494.gz
Diffstat (limited to 'XMonad')
-rw-r--r--XMonad/Layout/LayoutCombinators.hs124
-rw-r--r--XMonad/Layout/PerWorkspace.hs78
2 files changed, 109 insertions, 93 deletions
diff --git a/XMonad/Layout/LayoutCombinators.hs b/XMonad/Layout/LayoutCombinators.hs
index c4e36f3..ad3cba8 100644
--- a/XMonad/Layout/LayoutCombinators.hs
+++ b/XMonad/Layout/LayoutCombinators.hs
@@ -13,37 +13,40 @@
-- A module for combining other layouts.
-----------------------------------------------------------------------------
-module XMonad.Layout.LayoutCombinators (
- -- * Usage
- -- $usage
-
- -- * Combinators using DragPane vertical
- -- $dpv
- (*||*), (**||*),(***||*),(****||*),(***||**),(****||***),
- (***||****),(*||****),(**||***),(*||***),(*||**),
-
- -- * Combinators using DragPane horizontal
- -- $dph
- (*//*), (**//*),(***//*),(****//*),(***//**),(****//***),
- (***//****),(*//****),(**//***),(*//***),(*//**),
-
- -- * Combinators using Tall (vertical)
- -- $tv
- (*|*), (**|*),(***|*),(****|*),(***|**),(****|***),
- (***|****),(*|****),(**|***),(*|***),(*|**),
-
- -- * Combinators using Mirror Tall (horizontal)
- -- $mth
- (*/*), (**/*),(***/*),(****/*),(***/**),(****/***),
- (***/****),(*/****),(**/***),(*/***),(*/**),
-
- -- * A new combinator
- -- $nc
- (|||),
- JumpToLayout(JumpToLayout)
+module XMonad.Layout.LayoutCombinators
+ ( -- * Usage
+ -- $usage
+
+ -- * Combinators using DragPane vertical
+ -- $dpv
+ (*||*), (**||*),(***||*),(****||*),(***||**),(****||***)
+ , (***||****),(*||****),(**||***),(*||***),(*||**)
+
+ -- * Combinators using DragPane horizontal
+ -- $dph
+ , (*//*), (**//*),(***//*),(****//*),(***//**),(****//***)
+ , (***//****),(*//****),(**//***),(*//***),(*//**)
+
+ -- * Combinators using Tall (vertical)
+ -- $tv
+ , (*|*), (**|*),(***|*),(****|*),(***|**),(****|***)
+ , (***|****),(*|****),(**|***),(*|***),(*|**)
+
+ -- * Combinators using Mirror Tall (horizontal)
+ -- $mth
+ , (*/*), (**/*),(***/*),(****/*),(***/**),(****/***)
+ , (***/****),(*/****),(**/***),(*/***),(*/**)
+
+ -- * A new combinator
+ -- $nc
+ , (|||)
+ , JumpToLayout(JumpToLayout)
+ , LayoutCombinator (..)
+ , CombinedLayout (..)
+ , ComboType (..)
) where
-import Data.Maybe ( isJust, isNothing )
+import Data.Maybe ( fromMaybe, isJust, isNothing )
import XMonad hiding ((|||))
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' 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
diff --git a/XMonad/Layout/PerWorkspace.hs b/XMonad/Layout/PerWorkspace.hs
index bc51a96..448e3ab 100644
--- a/XMonad/Layout/PerWorkspace.hs
+++ b/XMonad/Layout/PerWorkspace.hs
@@ -31,8 +31,7 @@ module XMonad.Layout.PerWorkspace (
import XMonad
import qualified XMonad.StackSet as W
-import Data.Maybe (fromMaybe)
-
+import XMonad.Layout.LayoutCombinators
-- $usage
-- 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
-- to use on all others. The second layout can be another call to
-- 'onWorkspace', and so on.
-onWorkspace :: (LayoutClass l1 a, LayoutClass l2 a)
- => WorkspaceId -- ^ the tag of the workspace to match
- -> (l1 a) -- ^ layout to use on the matched workspace
- -> (l2 a) -- ^ layout to use everywhere else
- -> PerWorkspace l1 l2 a
-onWorkspace wsId l1 l2 = PerWorkspace [wsId] Nothing l1 l2
+onWorkspace :: WorkspaceId -- ^ tags of workspaces to match
+ -> (l1 a) -- ^ layout to use on matched workspaces
+ -> (l2 a) -- ^ layout to use everywhere else
+ -> CombinedLayout PerWorkspace l1 l2 a
+onWorkspace wsId l1 l2 = CombinedLayout (PerWorkspace [wsId]) l1 l2
-- | Specify one layout to use on a particular set of workspaces, and
-- another to use on all other workspaces.
-onWorkspaces :: (LayoutClass l1 a, LayoutClass l2 a)
- => [WorkspaceId] -- ^ tags of workspaces to match
+onWorkspaces :: [WorkspaceId] -- ^ tags of workspaces to match
-> (l1 a) -- ^ layout to use on matched workspaces
-> (l2 a) -- ^ layout to use everywhere else
- -> PerWorkspace l1 l2 a
-onWorkspaces wsIds l1 l2 = PerWorkspace wsIds Nothing l1 l2
+ -> CombinedLayout PerWorkspace l1 l2 a
+onWorkspaces wsIds l1 l2 = CombinedLayout (PerWorkspace wsIds) l1 l2
-- | Structure for representing a workspace-specific layout along with
-- 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
-- LayoutClass, since a call to description is not able to query the
-- WM state to find out which workspace it was called in.
-data PerWorkspace l1 l2 a = PerWorkspace [WorkspaceId]
- (Maybe Bool)
- (l1 a)
- (l2 a)
- deriving (Read, Show)
-
-instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (PerWorkspace l1 l2) a where
+data PerWorkspace a = PerWorkspace [WorkspaceId] deriving (Read, Show)
- -- 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
+instance LayoutCombinator PerWorkspace a where
+ chooser (PerWorkspace wsIds) = do
t <- getCurrentTag
- doLayout (PerWorkspace wsIds (Just $ t `elem` wsIds) l1 l2) r s
-
- -- 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'
+ return $ if t `elem` wsIds then DoFirst else DoSecond
+ doFirst (PerWorkspace _) = True
-- | Get the tag of the currently active workspace. Note that this
-- is only guaranteed to be the same workspace for which doLayout