mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 03:20:21 -07:00
Add a LayoutCombinator class and a CombinedLayout and port PerWorkspace to the new system
This commit is contained in:
Andrea Rossato
parent
f23a87f4e6
commit
055a6b1232
@ -13,37 +13,40 @@
|
||||
-- A module for combining other layouts.
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Layout.LayoutCombinators (
|
||||
-- * Usage
|
||||
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)
|
||||
, (|||)
|
||||
, 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
|
||||
|
||||
@ -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
|
||||
onWorkspace :: 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
|
||||
onWorkspace wsId l1 l2 = PerWorkspace [wsId] Nothing l1 l2
|
||||
-> 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)
|
||||
data PerWorkspace a = PerWorkspace [WorkspaceId] deriving (Read, Show)
|
||||
|
||||
instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (PerWorkspace l1 l2) a where
|
||||
|
||||
-- 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
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user