diff --git a/CHANGES.md b/CHANGES.md index 8b75d296b3..089fd19bce 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -81,7 +81,14 @@ ### New Modules + * `XMonad.Layout.ConditionalLayout` + + - Provide conditional variants of `ModifiedLayout` and `Choose`, + so that modifications (specific layouts) are only applied when + a particular condition is met. + * `XMonad.Layout.CenterMainFluid` + - A three column layout with main column in the center and two stack column surrounding it. Master window will be on center column and spaces on the sides are reserved. diff --git a/XMonad/Layout/ConditionalLayout.hs b/XMonad/Layout/ConditionalLayout.hs new file mode 100644 index 0000000000..d1cc468243 --- /dev/null +++ b/XMonad/Layout/ConditionalLayout.hs @@ -0,0 +1,175 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} + +{- | + Module : XMonad.Layout.ConditionalLayout + Description : Conditionally apply layout and layout modifiers. + Copyright : (c) Ivan Malison , + Tomas Janousek + License : BSD + Maintainer : Tony Zorman + + This module provides conditional variants of 'ModifiedLayout' and 'Choose', + so that modifications (specific layouts) are only applied when a particular + condition is met. +-} +module XMonad.Layout.ConditionalLayout ( + -- * Usage + -- $usage + + -- * Combinators + condChoose, + conditional, + + -- * Building Conditions + ModifierCondition (shouldApply), + CondChoose, -- opaque + + -- * Utility functions + getWorkspace, + getWorkspaceWindows, + getScreen, +) where + +import XMonad hiding (hide) +import XMonad.Layout.LayoutModifier +import XMonad.Prelude +import XMonad.StackSet (Workspace) +import qualified XMonad.StackSet as W + +{- $usage + +You can use this module by importing it in your @xmonad.hs@ + +> import XMonad.Layout.ConditionalLayout + +and writing an appropriate condition. Then, when 'conditional' is used, +a layout modifier will be applied whenever the condition is true. +Alternatively, 'condChoose' can decide which of two given layouts is to +be applied. + +Defining a condition works by creating a new type, and making it an +instance of 'ModifierCondition'. For example, the following condition +checks whether there are a maximum of two windows on the current +workspace: + +> import Data.List +> +> import XMonad +> import XMonad.Layout.ConditionalLayout +> import qualified XMonad.StackSet as W +> +> data IfMax2 = IfMax2 deriving (Read, Show) +> +> instance ModifierCondition IfMax2 where +> shouldApply _ wsId = do +> wsWins <- getWorkspaceWindows wsId +> pure $ Just 2 >= (length <$> ws) + +the @IfMax2@ type can now be used with the provided combinators. To +apply tabs, one would write + +> import XMonad.Layout.Tabbed +> +> main :: IO () +> main = xmonad $ def +> { terminal = "urxvt" +> , layoutHook = conditional IfMax2 (addTabsAlways shrinkText def) $ layoutHook def +> } + +alternatively, to conditionally switch between two layouts: + +> -- Full for workspaces with more than 2 windows, Tall otherwise. +> , layoutHook = condChoose IfMax2 (Tall 1 (3/100) (1/2)) Full $ layoutHook def +-} + +-- | Conditionally apply a layout modifier. +-- +-- > conditional MyCond myModifier myLayout +conditional :: ModifierCondition c => c -> (l a -> l' a) -> l a -> CondChoose c l' l a +conditional c ml l = CondChoose True c (Choose CL (ml l) l) + +-- | Conditionally choose between two layouts. +-- +-- > condChoose MyCond myLayoutTrue myLayoutFalse +condChoose :: c -> l a -> r a -> CondChoose c l r a +condChoose c = CondChoose True c .: Choose CL + +-- The reason that this must exist as a type class and a simple function will +-- not suffice is that 'ModifierCondition's are used as parameters to +-- 'CondModifiedLayout', which must implement 'Read' and 'Show' in order to +-- also implement 'LayoutModifier'. By defining a new type for condition, we +-- sidestep the issue that functions can not implement these type classes. + +-- | A 'ModifierCondition' is a condition run in 'X' that takes a 'WorkspaceId' +-- as a parameter. +class (Read c, Show c) => ModifierCondition c where + shouldApply :: c -> WorkspaceId -> X Bool + +-- | 'ModifiedLayout' extended with a condition and its last evaluation result +-- (for methods that can't evaluate it). +data CondModifiedLayout c m l a = CondModifiedLayout !Bool !c !(ModifiedLayout m l a) + deriving (Read, Show) + +-- | 'Choose' extended with a condition. +data CondChoose c l r a = CondChoose !Bool !c !(Choose l r a) + deriving (Read, Show) + +instance (ModifierCondition c, LayoutClass l a, LayoutClass r a, Typeable c) + => LayoutClass (CondChoose c l r) a + where + runLayout :: (ModifierCondition c, LayoutClass l a, LayoutClass r a, Typeable c) + => Workspace WorkspaceId (CondChoose c l r a) a + -> Rectangle + -> X ([(a, Rectangle)], Maybe (CondChoose c l r a)) + runLayout (W.Workspace i cl@(CondChoose b c _) ms) rect = do + a <- shouldApply c i + cl' <- if a == b then pure Nothing else Just . switch <$> hide cl + fmap (<|> cl') <$> run (fromMaybe cl cl') + where + switch :: CondChoose c l r a -> CondChoose c l r a + switch (CondChoose b' c' ch') = CondChoose (not b') c' ch' + + run :: CondChoose c l r a -> X ([(a, Rectangle)], Maybe (CondChoose c l r a)) + run (CondChoose preferLeft c' (Choose _ l r)) = + fmap (fmap (CondChoose preferLeft c')) + <$> runLayout (W.Workspace i (Choose (decideSide preferLeft) l r) ms) rect + + handleMessage :: CondChoose c l r a -> SomeMessage -> X (Maybe (CondChoose c l r a)) + handleMessage (CondChoose a c ch@(Choose _ l r)) m + | Just ReleaseResources <- fromMessage m = + fmap (CondChoose a c) <$> handleMessage ch m + | Just NextLayout <- fromMessage m = + fmap (CondChoose a c) <$> handleMessage ch m + | otherwise = + fmap (CondChoose a c) <$> handleMessage (Choose (decideSide a) l r) m + + description :: CondChoose c l r a -> String + description (CondChoose a _ (Choose _ l r)) + | a = description l + | otherwise = description r + +------------------------------------------------------------------------ +-- Util + +decideSide :: Bool -> CLR +decideSide = \case + True -> CL + False -> CR + +hide :: LayoutClass l a => l a -> X (l a) +hide x = fromMaybe x <$> handleMessage x (SomeMessage Hide) + +getWorkspace :: WorkspaceId -> X (Maybe WindowSpace) +getWorkspace wsId = gets $ find ((wsId ==) . W.tag) . W.workspaces . windowset + +getWorkspaceWindows :: WorkspaceId -> X (Maybe [Window]) +getWorkspaceWindows wsId = fmap (W.integrate' . W.stack) <$> getWorkspace wsId + +getScreen :: WorkspaceId -> X (Maybe WindowScreen) +getScreen wsId = + find (\s -> wsId == W.tag (W.workspace s)) <$> gets (W.screens . windowset) diff --git a/XMonad/Layout/IfMax.hs b/XMonad/Layout/IfMax.hs index 889efddf0b..e64093f364 100644 --- a/XMonad/Layout/IfMax.hs +++ b/XMonad/Layout/IfMax.hs @@ -1,3 +1,9 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE PatternGuards #-} + ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.IfMax @@ -15,8 +21,6 @@ -- ----------------------------------------------------------------------------- -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, PatternGuards #-} - module XMonad.Layout.IfMax ( -- * Usage -- $usage @@ -29,6 +33,7 @@ import qualified Data.List as L import qualified Data.Map as M import XMonad +import XMonad.Layout.ConditionalLayout import XMonad.Prelude import qualified XMonad.StackSet as W @@ -42,7 +47,7 @@ import qualified XMonad.StackSet as W -- -- Then add layouts to your layoutHook: -- --- > myLayoutHook = IfMax 2 Full (Tall ...) ||| ... +-- > myLayoutHook = ifMax 2 Full (Tall ...) ||| ... -- -- In this example, if there are 1 or 2 windows, Full layout will be used; -- otherwise, Tall layout will be used. @@ -50,6 +55,7 @@ import qualified XMonad.StackSet as W data IfMax l1 l2 w = IfMax Int (l1 w) (l2 w) deriving (Read, Show) +{-# DEPRECATED IfMax "Use ifMax instead." #-} instance (LayoutClass l1 Window, LayoutClass l2 Window) => LayoutClass (IfMax l1 l2) Window where @@ -85,10 +91,18 @@ instance (LayoutClass l1 Window, LayoutClass l2 Window) => LayoutClass (IfMax l1 description (IfMax n l1 l2) = "If number of windows is <= " ++ show n ++ ", then " ++ description l1 ++ ", else " ++ description l2 +newtype IfMaxN = IfMaxN Int deriving (Read, Show) + +instance ModifierCondition IfMaxN where + shouldApply :: IfMaxN -> WorkspaceId -> X Bool + shouldApply (IfMaxN n) wsId = do + ws <- fmap length <$> getWorkspaceWindows wsId + pure $ Just n >= ws + -- | Layout itself ifMax :: (LayoutClass l1 w, LayoutClass l2 w) => Int -- ^ Maximum number of windows for the first layout -> l1 w -- ^ First layout -> l2 w -- ^ Second layout - -> IfMax l1 l2 w -ifMax = IfMax + -> CondChoose IfMaxN l1 l2 w +ifMax n = condChoose (IfMaxN n) diff --git a/XMonad/Layout/PerScreen.hs b/XMonad/Layout/PerScreen.hs index b07d7429e4..b164c9e447 100644 --- a/XMonad/Layout/PerScreen.hs +++ b/XMonad/Layout/PerScreen.hs @@ -1,4 +1,6 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | @@ -24,9 +26,9 @@ module XMonad.Layout.PerScreen ) where import XMonad -import qualified XMonad.StackSet as W - +import XMonad.Layout.ConditionalLayout import XMonad.Prelude (fromMaybe) +import qualified XMonad.StackSet as W -- $usage -- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file: @@ -41,13 +43,23 @@ import XMonad.Prelude (fromMaybe) -- ifWider can also be used inside other layout combinators. ifWider :: (LayoutClass l1 a, LayoutClass l2 a) - => Dimension -- ^ target screen width - -> l1 a -- ^ layout to use when the screen is wide enough - -> l2 a -- ^ layout to use otherwise - -> PerScreen l1 l2 a -ifWider w = PerScreen w False + => Dimension -- ^ target screen width + -> l1 a -- ^ layout to use when the screen is wide enough + -> l2 a -- ^ layout to use otherwise + -> CondChoose PerScreenCond l1 l2 a +ifWider w = condChoose (PerScreenCond w) + +newtype PerScreenCond = PerScreenCond Dimension + deriving (Read, Show) + +instance ModifierCondition PerScreenCond where + shouldApply :: PerScreenCond -> WorkspaceId -> X Bool + shouldApply (PerScreenCond w) wsId = do + r <- fmap (rect_width . screenRect . W.screenDetail) <$> getScreen wsId + pure $ r > Just w data PerScreen l1 l2 a = PerScreen Dimension Bool (l1 a) (l2 a) deriving (Read, Show) +{-# DEPRECATED PerScreen "ifWider now uses X.L.ConditionalLayout internally." #-} -- | Construct new PerScreen values with possibly modified layouts. mkNewPerScreenT :: PerScreen l1 l2 a -> Maybe (l1 a) -> diff --git a/XMonad/Layout/PerWorkspace.hs b/XMonad/Layout/PerWorkspace.hs index 536a676282..f9c91ad222 100644 --- a/XMonad/Layout/PerWorkspace.hs +++ b/XMonad/Layout/PerWorkspace.hs @@ -1,4 +1,6 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | @@ -24,9 +26,9 @@ module XMonad.Layout.PerWorkspace ) where import XMonad -import qualified XMonad.StackSet as W - +import XMonad.Layout.ConditionalLayout import XMonad.Prelude (fromMaybe) +import qualified XMonad.StackSet as W -- $usage -- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file: @@ -52,6 +54,13 @@ import XMonad.Prelude (fromMaybe) -- -- > layoutHook = A ||| B ||| onWorkspace "foo" D C +newtype PerWorkspaceCond = PerWorkspaceCond [WorkspaceId] + deriving (Read, Show) + +instance ModifierCondition PerWorkspaceCond where + shouldApply :: PerWorkspaceCond -> WorkspaceId -> X Bool + shouldApply (PerWorkspaceCond ws) wsId = pure $ wsId `elem` ws + -- | 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. @@ -59,7 +68,7 @@ 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 + -> CondChoose PerWorkspaceCond l1 l2 a onWorkspace wsId = onWorkspaces [wsId] -- | Specify one layout to use on a particular set of workspaces, and @@ -68,7 +77,7 @@ 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 - -> PerWorkspace l1 l2 a + -> CondChoose PerWorkspaceCond l1 l2 a onWorkspaces wsIds = modWorkspaces wsIds . const -- | Specify a layout modifier to apply to a particular workspace; layouts @@ -77,18 +86,18 @@ modWorkspace :: (LayoutClass l1 a, LayoutClass l2 a) => WorkspaceId -- ^ tag of the workspace to match -> (l2 a -> l1 a) -- ^ the modifier to apply on the matching workspace -> l2 a -- ^ the base layout - -> PerWorkspace l1 l2 a + -> CondChoose PerWorkspaceCond l1 l2 a modWorkspace wsId = modWorkspaces [wsId] -- | Specify a layout modifier to apply to a particular set of -- workspaces; layouts on all other workspaces will remain -- unmodified. modWorkspaces :: (LayoutClass l1 a, LayoutClass l2 a) - => [WorkspaceId] -- ^ tags of the workspaces to match + => [WorkspaceId] -- ^ tags of the workspaces to match -> (l2 a -> l1 a) -- ^ the modifier to apply on the matching workspaces - -> l2 a -- ^ the base layout - -> PerWorkspace l1 l2 a -modWorkspaces wsIds f l = PerWorkspace wsIds False (f l) l + -> l2 a -- ^ the base layout + -> CondChoose PerWorkspaceCond l1 l2 a +modWorkspaces wsIds = conditional (PerWorkspaceCond wsIds) -- | Structure for representing a workspace-specific layout along with -- a layout for all other workspaces. We store the tags of workspaces @@ -99,6 +108,7 @@ data PerWorkspace l1 l2 a = PerWorkspace [WorkspaceId] (l1 a) (l2 a) deriving (Read, Show) +{-# DEPRECATED PerWorkspace "X.L.PerWorkspace now uses X.L.ConditionalLayout." #-} instance (LayoutClass l1 a, LayoutClass l2 a, Show a) => LayoutClass (PerWorkspace l1 l2) a where runLayout (W.Workspace i p@(PerWorkspace wsIds _ lt lf) ms) r diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal index 339ef5249c..a19b95bf5d 100644 --- a/xmonad-contrib.cabal +++ b/xmonad-contrib.cabal @@ -234,6 +234,7 @@ library XMonad.Layout.Circle XMonad.Layout.Column XMonad.Layout.Combo + XMonad.Layout.ConditionalLayout XMonad.Layout.ComboP XMonad.Layout.Cross XMonad.Layout.Decoration