mirror of
https://github.com/xmonad/xmonad.git
synced 2025-08-05 06:31:54 -07:00
add catchX to catch exceptions.
This commit is contained in:
@@ -153,7 +153,7 @@ windows f = do
|
|||||||
|
|
||||||
-- just the tiled windows:
|
-- just the tiled windows:
|
||||||
-- now tile the windows on this workspace, modified by the gap
|
-- 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
|
mapM_ (uncurry tileWindow) rs
|
||||||
|
|
||||||
-- now the floating windows:
|
-- now the floating windows:
|
||||||
@@ -353,7 +353,7 @@ switchLayout = do
|
|||||||
sendMessage :: Message a => a -> X ()
|
sendMessage :: Message a => a -> X ()
|
||||||
sendMessage a = do n <- (W.tag . W.workspace . W.current) `fmap` gets windowset
|
sendMessage a = do n <- (W.tag . W.workspace . W.current) `fmap` gets windowset
|
||||||
Just (l,ls) <- M.lookup n `fmap` gets layouts
|
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) }
|
whenJust ml' $ \l' -> do modify $ \s -> s { layouts = M.insert n (l',ls) (layouts s) }
|
||||||
refresh
|
refresh
|
||||||
|
|
||||||
@@ -362,7 +362,8 @@ sendMessage a = do n <- (W.tag . W.workspace . W.current) `fmap` gets windowset
|
|||||||
broadcastMessage :: Message a => a -> X ()
|
broadcastMessage :: Message a => a -> X ()
|
||||||
broadcastMessage a = do
|
broadcastMessage a = do
|
||||||
ol <- gets layouts
|
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 }
|
modify $ \s -> s { layouts = nl }
|
||||||
|
|
||||||
instance Message Event
|
instance Message Event
|
||||||
|
13
XMonad.hs
13
XMonad.hs
@@ -17,7 +17,7 @@
|
|||||||
module XMonad (
|
module XMonad (
|
||||||
X, WindowSet, WorkspaceId(..), ScreenId(..), XState(..), XConf(..), Layout(..),
|
X, WindowSet, WorkspaceId(..), ScreenId(..), XState(..), XConf(..), Layout(..),
|
||||||
Typeable, Message, SomeMessage(..), fromMessage, runLayout,
|
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
|
atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW
|
||||||
) where
|
) where
|
||||||
|
|
||||||
@@ -76,6 +76,17 @@ newtype X a = X (ReaderT XConf (StateT XState IO) a)
|
|||||||
runX :: XConf -> XState -> X a -> IO ()
|
runX :: XConf -> XState -> X a -> IO ()
|
||||||
runX c st (X a) = runStateT (runReaderT a c) st >> return ()
|
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
|
-- Convenient wrappers to state
|
||||||
|
|
||||||
|
Reference in New Issue
Block a user