diff options
| -rw-r--r-- | XMonad/Layout/LayoutCombinators.hs | 124 | ||||
| -rw-r--r-- | XMonad/Layout/PerWorkspace.hs | 78 |
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 |