XMonad.Operations

* Add `windowBracket`: provide a means of handling windowset changes
   made during the course of arbitrary `X` actions. Buys composability.
 * Add `windowBracket_` variant.
 * Add `modifyWindowSet` utility for use with the above.
 * Re-implement `sendMessage` using `windowBracket_` so that its refresh
   handles changes made to the windowset by the message handler.
This commit is contained in:
L. S. Leary 2018-08-01 00:45:41 +12:00
parent 85b47fc3ac
commit 0614ffb65c

View File

@ -21,7 +21,7 @@ import XMonad.Layout (Full(..))
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
import Data.Maybe import Data.Maybe
import Data.Monoid (Endo(..)) import Data.Monoid (Endo(..),Any(..))
import Data.List (nub, (\\), find) import Data.List (nub, (\\), find)
import Data.Bits ((.|.), (.&.), complement, testBit) import Data.Bits ((.|.), (.&.), complement, testBit)
import Data.Ratio import Data.Ratio
@ -30,6 +30,7 @@ import qualified Data.Set as S
import Control.Applicative((<$>), (<*>)) import Control.Applicative((<$>), (<*>))
import Control.Arrow (second) import Control.Arrow (second)
import Control.Monad (void)
import Control.Monad.Reader import Control.Monad.Reader
import Control.Monad.State import Control.Monad.State
import qualified Control.Exception.Extensible as C import qualified Control.Exception.Extensible as C
@ -176,6 +177,25 @@ windows f = do
unless isMouseFocused $ clearEvents enterWindowMask unless isMouseFocused $ clearEvents enterWindowMask
asks (logHook . config) >>= userCodeDef () asks (logHook . config) >>= userCodeDef ()
-- | Modify the @WindowSet@ in state with no special handling.
modifyWindowSet :: (WindowSet -> WindowSet) -> X ()
modifyWindowSet f = modify $ \xst -> xst { windowset = f (windowset xst) }
-- | Perform an @X@ action and check its return value against a predicate p.
-- If p holds, unwind changes to the @WindowSet@ and replay them using @windows@.
windowBracket :: (a -> Bool) -> X a -> X a
windowBracket p action = withWindowSet $ \old -> do
a <- action
when (p a) . withWindowSet $ \new -> do
modifyWindowSet $ \_ -> old
windows $ \_ -> new
return a
-- | A version of @windowBracket@ that discards the return value, and handles an
-- @X@ action reporting its need for refresh via @Any@.
windowBracket_ :: X Any -> X ()
windowBracket_ = void . windowBracket getAny
-- | Produce the actual rectangle from a screen and a ratio on that screen. -- | Produce the actual rectangle from a screen and a ratio on that screen.
scaleRationalRect :: Rectangle -> W.RationalRect -> Rectangle scaleRationalRect :: Rectangle -> W.RationalRect -> Rectangle
scaleRationalRect (Rectangle sx sy sw sh) (W.RationalRect rx ry rw rh) scaleRationalRect (Rectangle sx sy sw sh) (W.RationalRect rx ry rw rh)
@ -371,15 +391,16 @@ setFocusX w = withWindowSet $ \ws -> do
-- Message handling -- Message handling
-- | Throw a message to the current 'LayoutClass' possibly modifying how we -- | Throw a message to the current 'LayoutClass' possibly modifying how we
-- layout the windows, then refresh. -- layout the windows, in which case changes are handled through a refresh.
sendMessage :: Message a => a -> X () sendMessage :: Message a => a -> X ()
sendMessage a = do sendMessage a = windowBracket_ $ do
w <- W.workspace . W.current <$> gets windowset w <- W.workspace . W.current <$> gets windowset
ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing
whenJust ml' $ \l' -> whenJust ml' $ \l' ->
windows $ \ws -> ws { W.current = (W.current ws) modifyWindowSet $ \ws -> ws { W.current = (W.current ws)
{ W.workspace = (W.workspace $ W.current ws) { W.workspace = (W.workspace $ W.current ws)
{ W.layout = l' }}} { W.layout = l' }}}
return (Any $ isJust ml')
-- | Send a message to all layouts, without refreshing. -- | Send a message to all layouts, without refreshing.
broadcastMessage :: Message a => a -> X () broadcastMessage :: Message a => a -> X ()