From 0de6932e70ef3120c3830943d88484b06df9354a Mon Sep 17 00:00:00 2001
From: Daniel Schoepe <asgaroth_@gmx.de>
Date: Sat, 10 Jan 2009 23:18:52 +0100
Subject: More flexible userCode function

darcs-hash:20090110221852-cb1c6-80f042287c9c6b704a37a2704e29841416aeca9b.gz
---
 XMonad/Core.hs       | 12 +++++++++---
 XMonad/Main.hsc      |  4 ++--
 XMonad/Operations.hs |  6 +++---
 3 files changed, 14 insertions(+), 8 deletions(-)

(limited to 'XMonad')

diff --git a/XMonad/Core.hs b/XMonad/Core.hs
index f31cd74..b2eb959 100644
--- a/XMonad/Core.hs
+++ b/XMonad/Core.hs
@@ -24,7 +24,7 @@ module XMonad.Core (
     XConf(..), XConfig(..), LayoutClass(..),
     Layout(..), readsLayout, Typeable, Message,
     SomeMessage(..), fromMessage, LayoutMessages(..),
-    runX, catchX, userCode, io, catchIO, doubleFork,
+    runX, catchX, userCode, userCodeDef, io, catchIO, doubleFork,
     withDisplay, withWindowSet, isRoot, runOnWorkspaces,
     getAtom, spawn, getXMonadDir, recompile, trace, whenJust, whenX,
     atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, ManageHook, Query(..), runQuery
@@ -47,6 +47,7 @@ import Graphics.X11.Xlib
 import Graphics.X11.Xlib.Extras (Event)
 import Data.Typeable
 import Data.Monoid
+import Data.Maybe (fromMaybe)
 
 import qualified Data.Map as M
 import qualified Data.Set as S
@@ -163,8 +164,13 @@ catchX job errcase = do
 
 -- | 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 ()) (return ())
+userCode :: X a -> X (Maybe a)
+userCode a = catchX (Just `liftM` a) (return Nothing)
+
+-- | Same as userCode but with a default argument to return instead of using
+-- Maybe, provided for convenience.
+userCodeDef :: a -> X a -> X a
+userCodeDef def a = fromMaybe def `liftM` userCode a
 
 -- ---------------------------------------------------------------------
 -- Convenient wrappers to state
diff --git a/XMonad/Main.hsc b/XMonad/Main.hsc
index 8e3eea8..531939e 100644
--- a/XMonad/Main.hsc
+++ b/XMonad/Main.hsc
@@ -176,7 +176,7 @@ handle (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code})
         s  <- io $ keycodeToKeysym dpy code 0
         mClean <- cleanMask m
         ks <- asks keyActions
-        userCode $ whenJust (M.lookup (mClean, s) ks) id
+        userCodeDef () $ whenJust (M.lookup (mClean, s) ks) id
 
 -- manage a new window
 handle (MapRequestEvent    {ev_window = w}) = withDisplay $ \dpy -> do
@@ -279,7 +279,7 @@ 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 = userCode =<< asks (logHook . config)
+    | t == propertyNotify && a == wM_NAME = userCodeDef () =<< asks (logHook . config)
 
 handle e = broadcastMessage e -- trace (eventName e) -- ignoring
 
diff --git a/XMonad/Operations.hs b/XMonad/Operations.hs
index 8cc1710..fe124f3 100644
--- a/XMonad/Operations.hs
+++ b/XMonad/Operations.hs
@@ -23,7 +23,7 @@ import XMonad.Layout (Full(..))
 import qualified XMonad.StackSet as W
 
 import Data.Maybe
-import Data.Monoid          (appEndo)
+import Data.Monoid          (Endo(..))
 import Data.List            (nub, (\\), find)
 import Data.Bits            ((.|.), (.&.), complement)
 import Data.Ratio
@@ -68,7 +68,7 @@ manage w = whenX (not <$> isClient w) $ withDisplay $ \d -> do
             where i = W.tag $ W.workspace $ W.current ws
 
     mh <- asks (manageHook . config)
-    g <- fmap appEndo (runQuery mh w) `catchX` return id
+    g <- fmap appEndo $ userCodeDef (Endo id) (runQuery mh w)
     windows (g . f)
 
 -- | unmanage. A window no longer exists, remove it from the window
@@ -169,7 +169,7 @@ windows f = do
 
     isMouseFocused <- asks mouseFocused
     unless isMouseFocused $ clearEvents enterWindowMask
-    asks (logHook . config) >>= userCode
+    asks (logHook . config) >>= userCodeDef ()
 
 -- | Produce the actual rectangle from a screen and a ratio on that screen.
 scaleRationalRect :: Rectangle -> W.RationalRect -> Rectangle
-- 
cgit v1.2.3