diff options
| -rw-r--r-- | XMonad/Layout/LayoutCombinators.hs | 67 | ||||
| -rw-r--r-- | XMonad/Layout/PerWorkspace.hs | 77 |
2 files changed, 65 insertions, 79 deletions
diff --git a/XMonad/Layout/LayoutCombinators.hs b/XMonad/Layout/LayoutCombinators.hs index d21af6d..67c09b0 100644 --- a/XMonad/Layout/LayoutCombinators.hs +++ b/XMonad/Layout/LayoutCombinators.hs @@ -41,12 +41,9 @@ module XMonad.Layout.LayoutCombinators -- $nc , (|||) , JumpToLayout(JumpToLayout) - , LayoutCombinator (..) - , CombinedLayout (..) - , ComboChooser (..) ) where -import Data.Maybe ( fromMaybe, isJust, isNothing ) +import Data.Maybe ( isJust, isNothing ) import XMonad hiding ((|||)) import XMonad.Layout.Combo @@ -220,65 +217,3 @@ 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 ComboChooser = DoFirst | DoSecond | DoBoth deriving ( Eq, Show ) - -class (Read (lc a), Show (lc a)) => LayoutCombinator lc a where - chooser :: lc a -> X ComboChooser - chooser lc = return $ pureChooser lc - pureChooser :: lc a -> ComboChooser - pureChooser _ = DoFirst - 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 - comboDescription :: lc a -> String - comboDescription _ = "Combine" - combineDescription :: (LayoutClass l1 a, LayoutClass l2 a) => lc a -> l1 a -> l2 a -> String - combineDescription lc l1 l2 = comboDescription lc <> description l1 <> 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) = combineDescription lc l1 l2 diff --git a/XMonad/Layout/PerWorkspace.hs b/XMonad/Layout/PerWorkspace.hs index b734819..bc51a96 100644 --- a/XMonad/Layout/PerWorkspace.hs +++ b/XMonad/Layout/PerWorkspace.hs @@ -31,7 +31,8 @@ module XMonad.Layout.PerWorkspace ( import XMonad import qualified XMonad.StackSet as W -import XMonad.Layout.LayoutCombinators +import Data.Maybe (fromMaybe) + -- $usage -- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file: -- @@ -58,19 +59,21 @@ import XMonad.Layout.LayoutCombinators -- | 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 :: 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 = CombinedLayout (PerWorkspace [wsId]) +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 -- | Specify one layout to use on a particular set of workspaces, and -- another to use on all other workspaces. -onWorkspaces :: [WorkspaceId] -- ^ tags of workspaces to match +onWorkspaces :: (LayoutClass l1 a, LayoutClass l2 a) + => [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 -onWorkspaces wsIds = CombinedLayout (PerWorkspace wsIds) + -> PerWorkspace l1 l2 a +onWorkspaces wsIds l1 l2 = PerWorkspace wsIds Nothing l1 l2 -- | Structure for representing a workspace-specific layout along with -- a layout for all other workspaces. We store the tags of workspaces @@ -80,12 +83,60 @@ onWorkspaces wsIds = CombinedLayout (PerWorkspace wsIds) -- 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 a = PerWorkspace [WorkspaceId] deriving (Read, Show) +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 -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 - return $ if t `elem` wsIds then DoFirst else DoSecond + 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' -- | Get the tag of the currently active workspace. Note that this -- is only guaranteed to be the same workspace for which doLayout |