Add userCode function for the popular m `catchX` return ()

darcs-hash:20071012014217-a5988-06b6f1519b5f87fcbc8220ad5bd69181c721635a

3 files changed, 10 insertions, 7 deletions

diff --git a/Main.hs b/Main.hs
index 8a99a53..06b0162 100644
--- a/Main.hs
+++ b/Main.hs
@@ -164,8 +164,7 @@ handle :: Event -> X ()
 handle (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code})
     | t == keyPress = withDisplay $ \dpy -> do
         s  <- io $ keycodeToKeysym dpy code 0
-        whenJust (M.lookup (cleanMask m,s) keys) id
-                     `catchX` return ()
+        userCode $ whenJust (M.lookup (cleanMask m,s) keys) id
 
 -- manage a new window
 handle (MapRequestEvent    {ev_window = w}) = withDisplay $ \dpy -> do
@@ -213,8 +212,7 @@ handle e@(ButtonEvent {ev_window = w,ev_event_type = t,ev_button = b })
     -- If it's the root window, then it's something we
     -- grabbed in grabButtons. Otherwise, it's click-to-focus.
     isr <- isRoot w
-    if isr then whenJust (M.lookup (cleanMask (ev_state e), b) mouseBindings) ($ ev_subwindow e)
-                      `catchX` return ()
+    if isr then userCode $ whenJust (M.lookup (cleanMask (ev_state e), b) mouseBindings) ($ ev_subwindow e)
            else focus w
     sendMessage e -- Always send button events.
 
@@ -258,6 +256,6 @@ handle (ConfigureEvent {ev_window = w}) = whenX (isRoot w) rescreen
 
 -- property notify
 handle PropertyEvent { ev_event_type = t, ev_atom = a }
-    | t == propertyNotify && a == wM_NAME = logHook `catchX` return ()
+    | t == propertyNotify && a == wM_NAME = userCode logHook
 
 handle e = broadcastMessage e -- trace (eventName e) -- ignoring
diff --git a/Operations.hs b/Operations.hs
index d153d43..f2f6b47 100644
--- a/Operations.hs
+++ b/Operations.hs
@@ -169,7 +169,7 @@ windows f = do
 
     whenJust (W.peek ws) $ \w -> io $ setWindowBorder d w fbc
     setTopFocus
-    logHook `catchX` return ()
+    userCode logHook
     -- io performGC -- really helps, but seems to trigger GC bugs?
 
     -- hide every window that was potentially visible before, but is not
diff --git a/XMonad.hs b/XMonad.hs
index 4cc4607..cf72908 100644
--- a/XMonad.hs
+++ b/XMonad.hs
@@ -18,7 +18,7 @@
 module XMonad (
     X, WindowSet, WindowSpace, WorkspaceId, ScreenId(..), ScreenDetail(..), XState(..), XConf(..), LayoutClass(..), Layout(..), ReadableLayout(..),
     Typeable, Message, SomeMessage(..), fromMessage, runLayout,
-    runX, catchX, io, catchIO, withDisplay, withWindowSet, isRoot, getAtom, spawn, restart, trace, whenJust, whenX,
+    runX, catchX, userCode, io, catchIO, withDisplay, withWindowSet, isRoot, getAtom, spawn, restart, trace, whenJust, whenX,
     atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW
   ) where
 
@@ -95,6 +95,11 @@ catchX (X job) (X errcase) = do
     put s'
     return a
 
+-- | Execute the argument, catching all exceptions.  Either this function or
+-- catchX should be used at all callsites of user customized code.
+userCode :: X () -> X ()
+userCode a = catchX a (return ())
+
 -- ---------------------------------------------------------------------
 -- Convenient wrappers to state