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

XMonad.hs

@@ -51,7 +51,12 @@ data XConf = XConf
     , config        :: !XConfig       -- ^ initial user configuration
     , theRoot       :: !Window        -- ^ the root window
     , normalBorder  :: !Pixel         -- ^ border color of unfocused windows
-    , focusedBorder :: !Pixel     }   -- ^ border color of the focused window
+    , focusedBorder :: !Pixel         -- ^ border color of the focused window
+    , keyActions    :: !(M.Map (KeyMask, KeySym) (X ()))
+                                      -- ^ a mapping of key presses to actions
+    , buttonActions :: !(M.Map (KeyMask, Button) (Window -> X ()))
+                                      -- ^ a mapping of button presses to actions
+    }
 
 -- todo, better name
 data XConfig = XConfig { normalBorderColor :: !String
@@ -61,9 +66,10 @@ data XConfig = XConfig { normalBorderColor :: !String
                        , manageHook :: !(Window -> String -> String -> String -> X (WindowSet -> WindowSet))
                        , workspaces :: ![String]
                        , defaultGaps :: ![(Int,Int,Int,Int)]
-                       , numlockMask :: KeyMask
+                       , numlockMask :: !KeyMask
-                       , keys :: !(M.Map (ButtonMask,KeySym) (X ()))
+                       , modMask :: !KeyMask
-                       , mouseBindings :: !(M.Map (ButtonMask, Button) (Window -> X ()))
+                       , keys :: !(XConfig -> M.Map (ButtonMask,KeySym) (X ()))
+                       , mouseBindings :: !(XConfig -> M.Map (ButtonMask, Button) (Window -> X ()))
                        , borderWidth :: !Dimension
                        , logHook :: !(X ()) }
 

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
+defaultModMask :: KeyMask
-modMask = mod1Mask
+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 :: XConfig -> M.Map (KeyMask, KeySym) (X ())
-keys = M.fromList $
+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)
+    , ((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
-                                              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
 
     -- 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 :: XConfig -> M.Map (KeyMask, Button) (Window -> X ())
-mouseBindings = M.fromList $
+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.

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
+            grabKeys
-            grabButtons xmc
+            grabButtons
 
             io $ sync dpy False
 
@@ -109,6 +111,7 @@ 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.
@@ -126,7 +129,8 @@ makeMain xmc = do
     | t == keyPress = withDisplay $ \dpy -> do
         s  <- io $ keycodeToKeysym dpy code 0
         mClean <- cleanMask m
-                    userCode $ whenJust (M.lookup (mClean, s) (keys xmc)) id
+        ks <- asks keyActions
+        userCode $ whenJust (M.lookup (mClean, s) ks) id
 
 -- manage a new window
 handle (MapRequestEvent    {ev_window = w}) = withDisplay $ \dpy -> do
@@ -150,7 +154,7 @@ makeMain xmc = do
 -- set keyboard mapping
 handle e@(MappingNotifyEvent {}) = do
     io $ refreshKeyboardMapping e
-                when (ev_request e == mappingKeyboard) (grabKeys xmc)
+    when (ev_request e == mappingKeyboard) grabKeys
 
 -- handle button release, which may finish dragging.
 handle e@(ButtonEvent {ev_event_type = t})
@@ -175,7 +179,8 @@ makeMain xmc = do
     -- 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)
+    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.
 
@@ -195,6 +200,8 @@ makeMain xmc = 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
@@ -202,7 +209,7 @@ makeMain xmc = do
                     , wc_y            = ev_y e
                     , wc_width        = ev_width e
                     , wc_height       = ev_height e
-                                , wc_border_width = fromIntegral (borderWidth xmc)
+                    , wc_border_width = fromIntegral bw
                     , wc_sibling      = ev_above e
                     , wc_stack_mode   = ev_detail e }
                 when (member w ws) (float w)
@@ -219,7 +226,7 @@ makeMain xmc = do
 
 -- property notify
 handle PropertyEvent { ev_event_type = t, ev_atom = a }
-                | t == propertyNotify && a == wM_NAME = userCode $ logHook xmc
+    | 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 :: X ()
-grabKeys xmc = do
+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 :: X ()
-grabButtons xmc = do
+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)