More flexible userCode function

This commit is contained in:
Daniel Schoepe 2009-01-10 22:18:52 +00:00
parent 314ba78335
commit 5e7df396b9
3 changed files with 14 additions and 8 deletions

View File

@ -24,7 +24,7 @@ module XMonad.Core (
XConf(..), XConfig(..), LayoutClass(..), XConf(..), XConfig(..), LayoutClass(..),
Layout(..), readsLayout, Typeable, Message, Layout(..), readsLayout, Typeable, Message,
SomeMessage(..), fromMessage, LayoutMessages(..), SomeMessage(..), fromMessage, LayoutMessages(..),
runX, catchX, userCode, io, catchIO, doubleFork, runX, catchX, userCode, userCodeDef, io, catchIO, doubleFork,
withDisplay, withWindowSet, isRoot, runOnWorkspaces, withDisplay, withWindowSet, isRoot, runOnWorkspaces,
getAtom, spawn, getXMonadDir, recompile, trace, whenJust, whenX, getAtom, spawn, getXMonadDir, recompile, trace, whenJust, whenX,
atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, ManageHook, Query(..), runQuery 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 Graphics.X11.Xlib.Extras (Event)
import Data.Typeable import Data.Typeable
import Data.Monoid import Data.Monoid
import Data.Maybe (fromMaybe)
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.Set as S import qualified Data.Set as S
@ -163,8 +164,13 @@ catchX job errcase = do
-- | Execute the argument, catching all exceptions. Either this function or -- | Execute the argument, catching all exceptions. Either this function or
-- 'catchX' should be used at all callsites of user customized code. -- 'catchX' should be used at all callsites of user customized code.
userCode :: X () -> X () userCode :: X a -> X (Maybe a)
userCode a = catchX (a >> return ()) (return ()) 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 -- Convenient wrappers to state

View File

@ -176,7 +176,7 @@ handle (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code})
s <- io $ keycodeToKeysym dpy code 0 s <- io $ keycodeToKeysym dpy code 0
mClean <- cleanMask m mClean <- cleanMask m
ks <- asks keyActions ks <- asks keyActions
userCode $ whenJust (M.lookup (mClean, s) ks) id userCodeDef () $ whenJust (M.lookup (mClean, s) ks) id
-- manage a new window -- manage a new window
handle (MapRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do handle (MapRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do
@ -279,7 +279,7 @@ handle (ConfigureEvent {ev_window = w}) = whenX (isRoot w) rescreen
-- property notify -- property notify
handle PropertyEvent { ev_event_type = t, ev_atom = a } 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 handle e = broadcastMessage e -- trace (eventName e) -- ignoring

View File

@ -23,7 +23,7 @@ import XMonad.Layout (Full(..))
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
import Data.Maybe import Data.Maybe
import Data.Monoid (appEndo) import Data.Monoid (Endo(..))
import Data.List (nub, (\\), find) import Data.List (nub, (\\), find)
import Data.Bits ((.|.), (.&.), complement) import Data.Bits ((.|.), (.&.), complement)
import Data.Ratio 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 where i = W.tag $ W.workspace $ W.current ws
mh <- asks (manageHook . config) 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) windows (g . f)
-- | unmanage. A window no longer exists, remove it from the window -- | unmanage. A window no longer exists, remove it from the window
@ -169,7 +169,7 @@ windows f = do
isMouseFocused <- asks mouseFocused isMouseFocused <- asks mouseFocused
unless isMouseFocused $ clearEvents enterWindowMask 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. -- | Produce the actual rectangle from a screen and a ratio on that screen.
scaleRationalRect :: Rectangle -> W.RationalRect -> Rectangle scaleRationalRect :: Rectangle -> W.RationalRect -> Rectangle