Float handler out of makeMain, make keys and mouseBindings dependent on XConfig for easy modMask switching

darcs-hash:20071102025924-a5988-bbddb07ed8c00cb4279db059f2513eba4ce3ecb5

2 files changed, 140 insertions, 131 deletions

diff --git a/XMonad/DefaultConfig.hs b/XMonad/DefaultConfig.hs
index 3f96f74..bd41696 100644
--- a/XMonad/DefaultConfig.hs
+++ b/XMonad/DefaultConfig.hs
@@ -50,8 +50,8 @@ workspaces = map show [1 .. 9 :: Int]
 -- ("right alt"), which does not conflict with emacs keybindings. The
 -- "windows key" is usually mod4Mask.
 --
-modMask :: KeyMask
-modMask = mod1Mask
+defaultModMask :: KeyMask
+defaultModMask = mod1Mask
 
 -- | The mask for the numlock key. Numlock status is "masked" from the
 -- current modifier status, so the keybindings will work with numlock on or
@@ -153,10 +153,10 @@ layout = tiled ||| Mirror tiled ||| Full
 --
 -- (The comment formatting character is used when generating the manpage)
 --
-keys :: M.Map (KeyMask, KeySym) (X ())
-keys = M.fromList $
+keys :: XConfig -> M.Map (KeyMask, KeySym) (X ())
+keys conf@(XConfig {modMask = modMask}) = M.fromList $
     -- launching and killing programs
-    [ ((modMask .|. shiftMask, xK_Return), asks (terminal . config) >>= spawn) -- %! Launch terminal
+    [ ((modMask .|. shiftMask, xK_Return), spawn $ terminal conf) -- %! Launch terminal
     , ((modMask,               xK_p     ), spawn "exe=`dmenu_path | dmenu` && eval \"exec $exe\"") -- %! Launch dmenu
     , ((modMask .|. shiftMask, xK_p     ), spawn "gmrun") -- %! Launch gmrun
     , ((modMask .|. shiftMask, xK_c     ), kill) -- %! Close the focused window
@@ -189,8 +189,7 @@ keys = M.fromList $
     , ((modMask              , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area
 
     -- toggle the status bar gap
-    , ((modMask              , xK_b     ), do gs <- asks (defaultGaps . config)
-                                              modifyGap (\i n -> let x = (gs ++ repeat (0,0,0,0)) !! i in if n == x then (0,0,0,0) else x)) -- %! Toggle the status bar gap
+    , ((modMask              , xK_b     ), modifyGap (\i n -> let x = (defaultGaps conf ++ repeat (0,0,0,0)) !! i in if n == x then (0,0,0,0) else x)) -- %! Toggle the status bar gap
 
     -- quit, or restart
     , ((modMask .|. shiftMask, xK_q     ), io (exitWith ExitSuccess)) -- %! Quit xmonad
@@ -215,8 +214,8 @@ keys = M.fromList $
 
 -- | Mouse bindings: default actions bound to mouse events
 --
-mouseBindings :: M.Map (KeyMask, Button) (Window -> X ())
-mouseBindings = M.fromList $
+mouseBindings :: XConfig -> M.Map (KeyMask, Button) (Window -> X ())
+mouseBindings (XConfig {modMask = modMask}) = M.fromList $
     -- mod-button1 %! Set the window to floating mode and move by dragging
     [ ((modMask, button1), (\w -> focus w >> mouseMoveWindow w))
     -- mod-button2 %! Raise the window to the top of the stack
@@ -245,6 +244,7 @@ defaultConfig = XConfig { borderWidth = 1 -- Width of the window border in pixel
                         , normalBorderColor = "#dddddd" -- Border color for unfocused windows.
                         , focusedBorderColor = "#ff0000" -- Border color for focused windows.
                         , XMonad.numlockMask = numlockMask
+                        , modMask = defaultModMask
                         , XMonad.keys = XMonad.DefaultConfig.keys
                         , XMonad.mouseBindings = XMonad.DefaultConfig.mouseBindings
                         -- | Perform an arbitrary action on each internal state change or X event.
diff --git a/XMonad/EventLoop.hs b/XMonad/EventLoop.hs
index 9bfb588..eba8e9d 100644
--- a/XMonad/EventLoop.hs
+++ b/XMonad/EventLoop.hs
@@ -71,7 +71,9 @@ makeMain xmc = do
             , config        = xmc
             , theRoot       = rootw
             , normalBorder  = nbc
-            , focusedBorder = fbc }
+            , focusedBorder = fbc
+            , keyActions    = keys xmc xmc
+            , buttonActions = mouseBindings xmc xmc }
         st = XState
             { windowset     = initialWinset
             , mapped        = S.empty
@@ -88,8 +90,8 @@ makeMain xmc = do
     allocaXEvent $ \e ->
         runX cf st $ do
 
-            grabKeys xmc
-            grabButtons xmc
+            grabKeys
+            grabButtons
 
             io $ sync dpy False
 
@@ -109,119 +111,124 @@ makeMain xmc = do
     return ()
       where forever_ a = a >> forever_ a
 
-            -- ---------------------------------------------------------------------
-            -- | Event handler. Map X events onto calls into Operations.hs, which
-            -- modify our internal model of the window manager state.
-            --
-            -- Events dwm handles that we don't:
-            --
-            --    [ButtonPress]    = buttonpress,
-            --    [Expose]         = expose,
-            --    [PropertyNotify] = propertynotify,
-            --
-            handle :: Event -> X ()
-
-            -- run window manager command
-            handle (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code})
-                | t == keyPress = withDisplay $ \dpy -> do
-                    s  <- io $ keycodeToKeysym dpy code 0
-                    mClean <- cleanMask m
-                    userCode $ whenJust (M.lookup (mClean, s) (keys xmc)) id
-
-            -- manage a new window
-            handle (MapRequestEvent    {ev_window = w}) = withDisplay $ \dpy -> do
-                wa <- io $ getWindowAttributes dpy w -- ignore override windows
-                -- need to ignore mapping requests by managed windows not on the current workspace
-                managed <- isClient w
-                when (not (wa_override_redirect wa) && not managed) $ do manage w
-
-            -- window destroyed, unmanage it
-            -- window gone,      unmanage it
-            handle (DestroyWindowEvent {ev_window = w}) = whenX (isClient w) $ unmanage w
-
-            -- We track expected unmap events in waitingUnmap.  We ignore this event unless
-            -- it is synthetic or we are not expecting an unmap notification from a window.
-            handle (UnmapEvent {ev_window = w, ev_send_event = synthetic}) = whenX (isClient w) $ do
-                e <- gets (fromMaybe 0 . M.lookup w . waitingUnmap)
-                if (synthetic || e == 0)
-                    then unmanage w
-                    else modify (\s -> s { waitingUnmap = M.adjust pred w (waitingUnmap s) })
-
-            -- set keyboard mapping
-            handle e@(MappingNotifyEvent {}) = do
-                io $ refreshKeyboardMapping e
-                when (ev_request e == mappingKeyboard) (grabKeys xmc)
-
-            -- handle button release, which may finish dragging.
-            handle e@(ButtonEvent {ev_event_type = t})
-                | t == buttonRelease = do
-                drag <- gets dragging
-                case drag of
-                    -- we're done dragging and have released the mouse:
-                    Just (_,f) -> modify (\s -> s { dragging = Nothing }) >> f
-                    Nothing    -> broadcastMessage e
-
-            -- handle motionNotify event, which may mean we are dragging.
-            handle e@(MotionEvent {ev_event_type = _t, ev_x = x, ev_y = y}) = do
-                drag <- gets dragging
-                case drag of
-                    Just (d,_) -> d (fromIntegral x) (fromIntegral y) -- we're dragging
-                    Nothing -> broadcastMessage e
-
-            -- click on an unfocused window, makes it focused on this workspace
-            handle e@(ButtonEvent {ev_window = w,ev_event_type = t,ev_button = b })
-                | t == buttonPress = do
-                -- If it's the root window, then it's something we
-                -- grabbed in grabButtons. Otherwise, it's click-to-focus.
-                isr <- isRoot w
-                m <- cleanMask $ ev_state e
-                if isr then userCode $ whenJust (M.lookup (m, b) $ mouseBindings xmc) ($ ev_subwindow e)
-                       else focus w
-                sendMessage e -- Always send button events.
-
-            -- entered a normal window, makes this focused.
-            handle e@(CrossingEvent {ev_window = w, ev_event_type = t})
-                | t == enterNotify && ev_mode   e == notifyNormal
-                                   && ev_detail e /= notifyInferior = focus w
-
-            -- left a window, check if we need to focus root
-            handle e@(CrossingEvent {ev_event_type = t})
-                | t == leaveNotify
-                = do rootw <- asks theRoot
-                     when (ev_window e == rootw && not (ev_same_screen e)) $ setFocusX rootw
-
-            -- configure a window
-            handle e@(ConfigureRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do
-                ws <- gets windowset
-                wa <- io $ getWindowAttributes dpy w
-
-                if M.member w (floating ws)
-                    || not (member w ws)
-                    then do io $ configureWindow dpy w (ev_value_mask e) $ WindowChanges
-                                { wc_x            = ev_x e
-                                , wc_y            = ev_y e
-                                , wc_width        = ev_width e
-                                , wc_height       = ev_height e
-                                , wc_border_width = fromIntegral (borderWidth xmc)
-                                , wc_sibling      = ev_above e
-                                , wc_stack_mode   = ev_detail e }
-                            when (member w ws) (float w)
-                    else io $ allocaXEvent $ \ev -> do
-                             setEventType ev configureNotify
-                             setConfigureEvent ev w w
-                                 (wa_x wa) (wa_y wa) (wa_width wa)
-                                 (wa_height wa) (ev_border_width e) none (wa_override_redirect wa)
-                             sendEvent dpy w False 0 ev
-                io $ sync dpy False
-
-            -- configuration changes in the root may mean display settings have changed
-            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 $ logHook xmc
-
-            handle e = broadcastMessage e -- trace (eventName e) -- ignoring
+
+-- ---------------------------------------------------------------------
+-- | Event handler. Map X events onto calls into Operations.hs, which
+-- modify our internal model of the window manager state.
+--
+-- Events dwm handles that we don't:
+--
+--    [ButtonPress]    = buttonpress,
+--    [Expose]         = expose,
+--    [PropertyNotify] = propertynotify,
+--
+handle :: Event -> X ()
+
+-- run window manager command
+handle (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code})
+    | t == keyPress = withDisplay $ \dpy -> do
+        s  <- io $ keycodeToKeysym dpy code 0
+        mClean <- cleanMask m
+        ks <- asks keyActions
+        userCode $ whenJust (M.lookup (mClean, s) ks) id
+
+-- manage a new window
+handle (MapRequestEvent    {ev_window = w}) = withDisplay $ \dpy -> do
+    wa <- io $ getWindowAttributes dpy w -- ignore override windows
+    -- need to ignore mapping requests by managed windows not on the current workspace
+    managed <- isClient w
+    when (not (wa_override_redirect wa) && not managed) $ do manage w
+
+-- window destroyed, unmanage it
+-- window gone,      unmanage it
+handle (DestroyWindowEvent {ev_window = w}) = whenX (isClient w) $ unmanage w
+
+-- We track expected unmap events in waitingUnmap.  We ignore this event unless
+-- it is synthetic or we are not expecting an unmap notification from a window.
+handle (UnmapEvent {ev_window = w, ev_send_event = synthetic}) = whenX (isClient w) $ do
+    e <- gets (fromMaybe 0 . M.lookup w . waitingUnmap)
+    if (synthetic || e == 0)
+        then unmanage w
+        else modify (\s -> s { waitingUnmap = M.adjust pred w (waitingUnmap s) })
+
+-- set keyboard mapping
+handle e@(MappingNotifyEvent {}) = do
+    io $ refreshKeyboardMapping e
+    when (ev_request e == mappingKeyboard) grabKeys
+
+-- handle button release, which may finish dragging.
+handle e@(ButtonEvent {ev_event_type = t})
+    | t == buttonRelease = do
+    drag <- gets dragging
+    case drag of
+        -- we're done dragging and have released the mouse:
+        Just (_,f) -> modify (\s -> s { dragging = Nothing }) >> f
+        Nothing    -> broadcastMessage e
+
+-- handle motionNotify event, which may mean we are dragging.
+handle e@(MotionEvent {ev_event_type = _t, ev_x = x, ev_y = y}) = do
+    drag <- gets dragging
+    case drag of
+        Just (d,_) -> d (fromIntegral x) (fromIntegral y) -- we're dragging
+        Nothing -> broadcastMessage e
+
+-- click on an unfocused window, makes it focused on this workspace
+handle e@(ButtonEvent {ev_window = w,ev_event_type = t,ev_button = b })
+    | t == buttonPress = do
+    -- If it's the root window, then it's something we
+    -- grabbed in grabButtons. Otherwise, it's click-to-focus.
+    isr <- isRoot w
+    m <- cleanMask $ ev_state e
+    ba <- asks buttonActions
+    if isr then userCode $ whenJust (M.lookup (m, b) ba) ($ ev_subwindow e)
+           else focus w
+    sendMessage e -- Always send button events.
+
+-- entered a normal window, makes this focused.
+handle e@(CrossingEvent {ev_window = w, ev_event_type = t})
+    | t == enterNotify && ev_mode   e == notifyNormal
+                       && ev_detail e /= notifyInferior = focus w
+
+-- left a window, check if we need to focus root
+handle e@(CrossingEvent {ev_event_type = t})
+    | t == leaveNotify
+    = do rootw <- asks theRoot
+         when (ev_window e == rootw && not (ev_same_screen e)) $ setFocusX rootw
+
+-- configure a window
+handle e@(ConfigureRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do
+    ws <- gets windowset
+    wa <- io $ getWindowAttributes dpy w
+
+    bw <- asks (borderWidth . config)
+
+    if M.member w (floating ws)
+        || not (member w ws)
+        then do io $ configureWindow dpy w (ev_value_mask e) $ WindowChanges
+                    { wc_x            = ev_x e
+                    , wc_y            = ev_y e
+                    , wc_width        = ev_width e
+                    , wc_height       = ev_height e
+                    , wc_border_width = fromIntegral bw
+                    , wc_sibling      = ev_above e
+                    , wc_stack_mode   = ev_detail e }
+                when (member w ws) (float w)
+        else io $ allocaXEvent $ \ev -> do
+                 setEventType ev configureNotify
+                 setConfigureEvent ev w w
+                     (wa_x wa) (wa_y wa) (wa_width wa)
+                     (wa_height wa) (ev_border_width e) none (wa_override_redirect wa)
+                 sendEvent dpy w False 0 ev
+    io $ sync dpy False
+
+-- configuration changes in the root may mean display settings have changed
+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)
+
+handle e = broadcastMessage e -- trace (eventName e) -- ignoring
 
 
 -- ---------------------------------------------------------------------
@@ -246,23 +253,25 @@ scan dpy rootw = do
                          && (wa_map_state wa == waIsViewable || ic)
 
 -- | Grab the keys back
-grabKeys :: XConfig -> X ()
-grabKeys xmc = do
+grabKeys :: X ()
+grabKeys = do
     XConf { display = dpy, theRoot = rootw } <- ask
     let grab kc m = io $ grabKey dpy kc m rootw True grabModeAsync grabModeAsync
     io $ ungrabKey dpy anyKey anyModifier rootw
-    forM_ (M.keys $ keys xmc) $ \(mask,sym) -> do
+    ks <- asks keyActions
+    forM_ (M.keys ks) $ \(mask,sym) -> do
          kc <- io $ keysymToKeycode dpy sym
          -- "If the specified KeySym is not defined for any KeyCode,
          -- XKeysymToKeycode() returns zero."
          when (kc /= '\0') $ mapM_ (grab kc . (mask .|.)) =<< extraModifiers
 
 -- | XXX comment me
-grabButtons :: XConfig -> X ()
-grabButtons xmc = do
+grabButtons :: X ()
+grabButtons = do
     XConf { display = dpy, theRoot = rootw } <- ask
     let grab button mask = io $ grabButton dpy button mask rootw False buttonPressMask
                                            grabModeAsync grabModeSync none none
     io $ ungrabButton dpy anyButton anyModifier rootw
     ems <- extraModifiers
-    mapM_ (\(m,b) -> mapM_ (grab b . (m .|.)) ems) (M.keys $ mouseBindings xmc)
+    ba <- asks buttonActions
+    mapM_ (\(m,b) -> mapM_ (grab b . (m .|.)) ems) (M.keys $ ba)