diff --git a/CHANGES.md b/CHANGES.md index 7da89b5411..e08eebbca9 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -134,6 +134,12 @@ Layout modifier for user provided per-window aspect ratios. + * `XMonad.Layout.ConditionModifier` + + This module provides a LayoutModifier that modifies an existing + LayoutModifier so that its modifications are only applied when a particular + condition is met. + * `XMonad.Hooks.TaffybarPagerHints` Add a module that exports information about XMonads internal state that is diff --git a/XMonad/Layout/ConditionalLayout.hs b/XMonad/Layout/ConditionalLayout.hs new file mode 100644 index 0000000000..f40815befb --- /dev/null +++ b/XMonad/Layout/ConditionalLayout.hs @@ -0,0 +1,103 @@ +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TupleSections #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.ConditionalLayout +-- Copyright : (c) Ivan Malison +-- License : BSD +-- +-- Maintainer : none +-- Stability : unstable +-- Portability : portable +-- +-- This module provides a LayoutModifier combinator that modifies an existing +-- ModifiedLayout so that its modifications are only applied when a particular +-- condition is met. +----------------------------------------------------------------------------- + +module XMonad.Layout.ConditionalLayout where + +import XMonad +import XMonad.Layout.LayoutModifier +import qualified XMonad.StackSet as W + +-- | A 'ModifierCondition' is a condition run in 'X' that takes a 'WorkspaceId' +-- as a parameter. 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 'ConditionalLayoutModifier', 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 +-- typeclasses. +class (Read c, Show c) => ModifierCondition c where + shouldApply :: c -> WorkspaceId -> X Bool + +-- | 'ConditionalLayoutModifier' takes a condition implemented as a +-- 'ModifierCondition' together with a 'LayoutModifier' and builds a new +-- 'LayoutModifier' that is exactly like the provided 'LayoutModifier', except +-- that it is only applied when the provided condition evalutes to True. +data ConditionalLayoutModifier m c a = (Read (m a), Show (m a), ModifierCondition c) => + ConditionalLayoutModifier c (m a) + +deriving instance (Read (m a), Show (m a), ModifierCondition c) => + Show (ConditionalLayoutModifier m c a) +deriving instance (Read (m a), Show (m a), ModifierCondition c) => + Read (ConditionalLayoutModifier m c a) + +data NoOpModifier a = NoOpModifier deriving (Read, Show) + +instance LayoutModifier NoOpModifier a + +instance (ModifierCondition c, LayoutModifier m Window) => + LayoutModifier (ConditionalLayoutModifier m c) Window where + + modifyLayout (ConditionalLayoutModifier condition originalModifier) w r = do + applyModifier <- shouldApply condition $ W.tag w + if applyModifier + then modifyLayout originalModifier w r + else modifyLayout NoOpModifier w r + + modifyLayoutWithUpdate (ConditionalLayoutModifier condition originalModifier) w r = do + applyModifier <- shouldApply condition $ W.tag w + if applyModifier + then do + (res, updatedModifier) <- modifyLayoutWithUpdate originalModifier w r + let updatedModifiedModifier = + ConditionalLayoutModifier condition <$> updatedModifier + return (res, updatedModifiedModifier) + else (, Nothing) . fst <$> modifyLayoutWithUpdate NoOpModifier w r + + -- This function is not allowed to have any effect on layout, so we always + -- pass the message along to the original modifier to ensure that it is + -- allowed to update its internal state appropriately. This is particularly + -- important for messages like 'Hide' or 'ReleaseResources'. + handleMessOrMaybeModifyIt + (ConditionalLayoutModifier condition originalModifier) mess = do + result <- handleMessOrMaybeModifyIt originalModifier mess + return $ case result of + Nothing -> Nothing + Just (Left updated) -> + Just $ Left $ + ConditionalLayoutModifier condition updated + Just (Right message) -> Just $ Right message + + redoLayoutWithWorkspace (ConditionalLayoutModifier condition originalModifier) + w r ms wrs = do + applyModifier <- shouldApply condition $ W.tag w + if applyModifier + then do + (res, updatedModifier) <- redoLayout originalModifier r ms wrs + let updatedModifiedModifier = + ConditionalLayoutModifier condition <$> updatedModifier + return (res, updatedModifiedModifier) + else (, Nothing) . fst <$> redoLayout NoOpModifier r ms wrs + + modifyDescription (ConditionalLayoutModifier _ originalModifier) l = + modifyDescription originalModifier l + + diff --git a/XMonad/Layout/LayoutModifier.hs b/XMonad/Layout/LayoutModifier.hs index f2e7cf603c..0ad39cae2b 100644 --- a/XMonad/Layout/LayoutModifier.hs +++ b/XMonad/Layout/LayoutModifier.hs @@ -188,11 +188,27 @@ class (Show (m a), Read (m a)) => LayoutModifier m a where redoLayout :: m a -- ^ the layout modifier -> Rectangle -- ^ screen rectangle -> Maybe (Stack a) -- ^ current window stack - -> [(a, Rectangle)] -- ^ (window,rectangle) pairs returned + -> [(a, Rectangle)] -- ^ (window, rectangle) pairs returned -- by the underlying layout -> X ([(a, Rectangle)], Maybe (m a)) redoLayout m r ms wrs = do hook m; return $ pureModifier m r ms wrs + -- | 'redoLayoutWithWorkspace' is exactly like 'redoLayout', execept + -- that the original workspace is also provided as an argument + redoLayoutWithWorkspace :: m a + -- ^ the layout modifier + -> Workspace WorkspaceId (ModifiedLayout m l a) a + -- ^ The original workspace that is being laid out + -> Rectangle + -- ^ screen rectangle + -> Maybe (Stack a) + -- ^ current window stack + -> [(a, Rectangle)] + -- ^ (window, rectangle) pairs returned by the + -- underlying layout + -> X ([(a, Rectangle)], Maybe (m a)) + redoLayoutWithWorkspace m _ = redoLayout m + -- | 'pureModifier' allows you to intercept a call to 'runLayout' -- /after/ it is called on the underlying layout, in order to -- modify the list of window\/rectangle pairings it has returned, @@ -251,9 +267,9 @@ class (Show (m a), Read (m a)) => LayoutModifier m a where -- | The 'LayoutClass' instance for a 'ModifiedLayout' defines the -- semantics of a 'LayoutModifier' applied to an underlying layout. instance (LayoutModifier m a, LayoutClass l a, Typeable m) => LayoutClass (ModifiedLayout m l) a where - runLayout (Workspace i (ModifiedLayout m l) ms) r = + runLayout w@(Workspace i (ModifiedLayout m l) ms) r = do ((ws, ml'),mm') <- modifyLayoutWithUpdate m (Workspace i l ms) r - (ws', mm'') <- redoLayout (fromMaybe m mm') r ms ws + (ws', mm'') <- redoLayoutWithWorkspace (fromMaybe m mm') w r ms ws let ml'' = case mm'' `mplus` mm' of Just m' -> Just $ ModifiedLayout m' $ fromMaybe l ml' Nothing -> ModifiedLayout m <$> ml' diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal index 3946c684d7..4aa45c1b59 100644 --- a/xmonad-contrib.cabal +++ b/xmonad-contrib.cabal @@ -213,6 +213,7 @@ library XMonad.Layout.Column XMonad.Layout.Combo XMonad.Layout.ComboP + XMonad.Layout.ConditionalLayout XMonad.Layout.Cross XMonad.Layout.Decoration XMonad.Layout.DecorationAddons