From 0614ffb65c15658bf9fe9375ab95a18d2b26a8cb Mon Sep 17 00:00:00 2001
From: "L. S. Leary" <LSLeary@users.noreply.github.com>
Date: Wed, 1 Aug 2018 00:45:41 +1200
Subject: [PATCH] `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.
---
src/XMonad/Operations.hs | 29 +++++++++++++++++++++++++----
1 file changed, 25 insertions(+), 4 deletions(-)
diff --git a/src/XMonad/Operations.hs b/src/XMonad/Operations.hs
index 05e100a..2845a6e 100644
--- a/src/XMonad/Operations.hs
+++ b/src/XMonad/Operations.hs
@@ -21,7 +21,7 @@ import XMonad.Layout (Full(..))
import qualified XMonad.StackSet as W
import Data.Maybe
-import Data.Monoid (Endo(..))
+import Data.Monoid (Endo(..),Any(..))
import Data.List (nub, (\\), find)
import Data.Bits ((.|.), (.&.), complement, testBit)
import Data.Ratio
@@ -30,6 +30,7 @@ import qualified Data.Set as S
import Control.Applicative((<$>), (<*>))
import Control.Arrow (second)
+import Control.Monad (void)
import Control.Monad.Reader
import Control.Monad.State
import qualified Control.Exception.Extensible as C
@@ -176,6 +177,25 @@ windows f = do
unless isMouseFocused $ clearEvents enterWindowMask
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.
scaleRationalRect :: Rectangle -> W.RationalRect -> Rectangle
scaleRationalRect (Rectangle sx sy sw sh) (W.RationalRect rx ry rw rh)
@@ -371,15 +391,16 @@ setFocusX w = withWindowSet $ \ws -> do
-- Message handling
-- | 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 a = do
+sendMessage a = windowBracket_ $ do
w <- W.workspace . W.current <$> gets windowset
ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing
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.layout = l' }}}
+ return (Any $ isJust ml')
-- | Send a message to all layouts, without refreshing.
broadcastMessage :: Message a => a -> X ()