add catchX to catch exceptions.

This commit is contained in:
David Roundy
2007-06-12 15:42:53 +00:00
parent 5f8202e79e
commit 194a934c37
2 changed files with 16 additions and 4 deletions

View File

@@ -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

View File

@@ -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