diff options
| -rw-r--r-- | Operations.hs | 7 | ||||
| -rw-r--r-- | XMonad.hs | 13 |
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 @@ -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 |