aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--Operations.hs7
-rw-r--r--XMonad.hs13
2 files changed, 16 insertions, 4 deletions
diff --git a/Operations.hs b/Operations.hs
index e03c0fd..fd85106 100644
--- a/Operations.hs
+++ b/Operations.hs
@@ -153,7 +153,7 @@ windows f = do
-- just the tiled windows:
-- now tile the windows on this workspace, modified by the gap
- rs <- runLayout l viewrect tiled -- `mplus` doLayout full viewrect tiled
+ rs <- runLayout l viewrect tiled `catchX` runLayout full viewrect tiled
mapM_ (uncurry tileWindow) rs
-- now the floating windows:
@@ -353,7 +353,7 @@ switchLayout = do
sendMessage :: Message a => a -> X ()
sendMessage a = do n <- (W.tag . W.workspace . W.current) `fmap` gets windowset
Just (l,ls) <- M.lookup n `fmap` gets layouts
- ml' <- modifyLayout l (SomeMessage a)
+ ml' <- modifyLayout l (SomeMessage a) `catchX` return (Just l)
whenJust ml' $ \l' -> do modify $ \s -> s { layouts = M.insert n (l',ls) (layouts s) }
refresh
@@ -362,7 +362,8 @@ sendMessage a = do n <- (W.tag . W.workspace . W.current) `fmap` gets windowset
broadcastMessage :: Message a => a -> X ()
broadcastMessage a = do
ol <- gets layouts
- nl <- T.forM ol $ \ (l,ls) -> maybe (l,ls) (flip (,) ls) `fmap` modifyLayout l (SomeMessage a)
+ nl <- T.forM ol $ \ (l,ls) -> maybe (l,ls) (flip (,) ls) `fmap`
+ (modifyLayout l (SomeMessage a) `catchX` return (Just l))
modify $ \s -> s { layouts = nl }
instance Message Event
diff --git a/XMonad.hs b/XMonad.hs
index b296a38..49c577e 100644
--- a/XMonad.hs
+++ b/XMonad.hs
@@ -17,7 +17,7 @@
module XMonad (
X, WindowSet, WorkspaceId(..), ScreenId(..), XState(..), XConf(..), Layout(..),
Typeable, Message, SomeMessage(..), fromMessage, runLayout,
- runX, io, catchIO, withDisplay, withWindowSet, isRoot, spawn, restart, trace, whenJust, whenX,
+ runX, catchX, io, catchIO, withDisplay, withWindowSet, isRoot, spawn, restart, trace, whenJust, whenX,
atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW
) where
@@ -76,6 +76,17 @@ newtype X a = X (ReaderT XConf (StateT XState IO) a)
runX :: XConf -> XState -> X a -> IO ()
runX c st (X a) = runStateT (runReaderT a c) st >> return ()
+-- | Run in the X monad, and in case of exception, and catch it and log it
+-- to stderr, and run the error case.
+catchX :: X a -> X a -> X a
+catchX (X job) (X errcase) =
+ do st <- get
+ c <- ask
+ (a,s') <- io ((runStateT (runReaderT job c) st) `catch`
+ \e -> (do hPutStrLn stderr (show e); runStateT (runReaderT errcase c) st))
+ put s'
+ return a
+
-- ---------------------------------------------------------------------
-- Convenient wrappers to state