Correctly handle resize requests

4 files changed, 39 insertions, 33 deletions

diff --git a/XMonad/Config.hs b/XMonad/Config.hs
index 7524368..1405fd1 100644
--- a/XMonad/Config.hs
+++ b/XMonad/Config.hs
@@ -28,11 +28,11 @@ module XMonad.Config (defaultConfig, Default(..)) where
 import XMonad.Core as XMonad hiding
     (workspaces,manageHook,keys,logHook,startupHook,mouseBindings
     ,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor,defaultBorderWidth,focusFollowsMouse
-    ,handleEventHook,clickJustFocuses,rootMask,clientMask)
+    ,handleEventHook,clickJustFocuses,rootMask,frameMask,clientMask)
 import qualified XMonad.Core as XMonad
     (workspaces,manageHook,keys,logHook,startupHook,mouseBindings
     ,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor,defaultBorderWidth,focusFollowsMouse
-    ,handleEventHook,clickJustFocuses,rootMask,clientMask)
+    ,handleEventHook,clickJustFocuses,rootMask,frameMask,clientMask)
 
 import XMonad.Layout
 import XMonad.Operations
@@ -149,6 +149,10 @@ layout = tiled ||| Mirror tiled ||| Full
 clientMask :: EventMask
 clientMask = structureNotifyMask .|. enterWindowMask .|. propertyChangeMask
 
+-- | The frame events that xmonad is interested in
+frameMask :: EventMask
+frameMask =  substructureRedirectMask .|. substructureNotifyMask
+
 -- | The root events that xmonad is interested in
 rootMask :: EventMask
 rootMask =  substructureRedirectMask .|. substructureNotifyMask
@@ -254,8 +258,9 @@ instance (a ~ Choose Tall (Choose (Mirror Tall) Full)) => Default (XConfig a) wh
     , XMonad.manageHook         = manageHook
     , XMonad.handleEventHook    = handleEventHook
     , XMonad.focusFollowsMouse  = focusFollowsMouse
-    , XMonad.clickJustFocuses       = clickJustFocuses
+    , XMonad.clickJustFocuses   = clickJustFocuses
     , XMonad.clientMask         = clientMask
+    , XMonad.frameMask          = frameMask
     , XMonad.rootMask           = rootMask
     }
 
diff --git a/XMonad/Core.hs b/XMonad/Core.hs
index 91defbf..18ca213 100644
--- a/XMonad/Core.hs
+++ b/XMonad/Core.hs
@@ -132,6 +132,7 @@ data XConfig l = XConfig
     , focusFollowsMouse  :: !Bool                -- ^ Whether window entry events can change focus
     , clickJustFocuses   :: !Bool                -- ^ False to make a click which changes focus to be additionally passed to the window
     , clientMask         :: !EventMask           -- ^ The client events that xmonad is interested in
+    , frameMask          :: !EventMask           -- ^ The frame events that xmonad is interested in
     , rootMask           :: !EventMask           -- ^ The root events that xmonad is interested in
     }
 
diff --git a/XMonad/Main.hsc b/XMonad/Main.hsc
index ed904ac..706c5a0 100644
--- a/XMonad/Main.hsc
+++ b/XMonad/Main.hsc
@@ -275,7 +275,6 @@ handle e@(CrossingEvent {ev_event_type = t})
 -- configure a window
 handle e@(ConfigureRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do
     ws <- gets windowset
-    wa <- io $ getWindowAttributes dpy w
 
     if not (member w ws)
         then do io $ configureWindow dpy w (ev_value_mask e) $ WindowChanges
@@ -286,12 +285,7 @@ handle e@(ConfigureRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do
                     , wc_border_width = 0
                     , wc_sibling      = ev_above e
                     , wc_stack_mode   = ev_detail e }
-        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
+        else configureClientWindow w
     io $ sync dpy False
 
 -- configuration changes in the root may mean display settings have changed
@@ -315,14 +309,16 @@ reparent :: Window -> X ()
 reparent w = withDisplay $ \dpy -> do
     rootw <- asks theRoot
     p <- asks normalBorder
+    fMask <- asks (frameMask . config)
     noFrame <- getsWindowState ((==none) . wsFrame) w
     when noFrame $ do
         trace $ "reparent: " ++ show w
         frame <- io $ allocaSetWindowAttributes $ \swa -> do
             set_background_pixel swa p
             set_border_pixel swa p
+            set_event_mask swa fMask
             set_override_redirect swa True
-            createWindow dpy rootw (-1) (-1) 1 1 0 copyFromParent inputOutput (Visual nullPtr) (cWBackPixel.|.cWBorderPixel.|.cWOverrideRedirect) swa
+            createWindow dpy rootw (-1) (-1) 1 1 0 copyFromParent inputOutput (Visual nullPtr) (cWBackPixel.|.cWBorderPixel.|.cWEventMask.|.cWOverrideRedirect) swa
         io $ do
             unmapWindow dpy w
             addToSaveSet dpy w
diff --git a/XMonad/Operations.hs b/XMonad/Operations.hs
index 1723ed8..294d4a8 100644
--- a/XMonad/Operations.hs
+++ b/XMonad/Operations.hs
@@ -169,12 +169,12 @@ setWMState w v = withDisplay $ \dpy -> do
 -- | hide. Hide a window by unmapping it, and setting Iconified.
 hide :: Window -> X ()
 hide w = whenX (getsWindowState wsMapped w) $ withDisplay $ \d -> do
-    cMask <- asks $ clientMask . config
+    (cMask,fMask) <- asks $ (clientMask &&& frameMask) . config
     frame <- getsWindowState wsFrame w
     io $ do selectInput d w (cMask .&. complement structureNotifyMask)
-            selectInput d frame (cMask .&. complement structureNotifyMask)
+            selectInput d frame (fMask .&. complement structureNotifyMask)
             unmapWindow d frame
-            selectInput d frame cMask
+            selectInput d frame fMask
             selectInput d w cMask
     setWMState w iconicState
     -- this part is key: we increment the waitingUnmap counter to distinguish
@@ -182,6 +182,26 @@ hide w = whenX (getsWindowState wsMapped w) $ withDisplay $ \d -> do
     modifyWindowState (\ws -> ws { wsMapped       = False
                                  , wsWaitingUnmap = (wsWaitingUnmap ws) + 1 }) w
 
+configureClientWindow :: Window -> X ()
+configureClientWindow w = withDisplay $ \d -> do
+    (frame, bw) <- getsWindowState (wsFrame &&& wsBorderWidth) w
+    (_, x, y, width, height, _, _) <- io $ getGeometry d frame
+    let least1 n = max 1 n
+        x' = x + (fi $ bwLeft bw)
+        y' = y + (fi $ bwTop bw)
+        width' = least1 (width - bwLeft bw - bwRight bw)
+        height' = least1 (height - bwTop bw - bwBottom bw)
+    io $ do
+        moveResizeWindow d w (fi $ bwLeft bw) (fi $ bwTop bw) width' height'
+        -- send absolute ConfigureNotify
+        allocaXEvent $ \event -> do
+            setEventType event configureNotify
+            setConfigureEvent event w w (fi x') (fi y') (fi width') (fi height') 0 none False
+            sendEvent d w False 0 event
+  where
+    fi :: (Integral a, Num b) => a -> b
+    fi = fromIntegral
+
 -- | reveal. Show a window by mapping it and setting Normal
 -- this is harmless if the window was already visible
 reveal :: Window -> X ()
@@ -189,25 +209,9 @@ reveal w = withDisplay $ \d -> do
     setWMState w normalState
     io $ mapWindow d w
     whenX (isClient w) $ do
-      (frame, bw) <- getsWindowState (wsFrame &&& wsBorderWidth) w
-      io $ do
-        mapWindow d frame
-        (_, x, y, width, height, _, _) <- getGeometry d frame
-        let least1 n = max 1 n
-            x' = x + (fi $ bwLeft bw)
-            y' = y + (fi $ bwTop bw)
-            width' = least1 (width - bwLeft bw - bwRight bw)
-            height' = least1 (height - bwTop bw - bwBottom bw)
-        moveResizeWindow d w (fi $ bwLeft bw) (fi $ bwTop bw) width' height'
-        -- send absolute ConfigureNotify
-        allocaXEvent $ \event -> do
-          setEventType event configureNotify
-          setConfigureEvent event w w (fi x') (fi y') (fi width') (fi height') 0 none False
-          sendEvent d w False structureNotifyMask event
-      modifyWindowState (\ws -> ws { wsMapped = True }) w
-  where
-    fi :: (Integral a, Num b) => a -> b
-    fi = fromIntegral
+        configureClientWindow w
+        getsWindowState wsFrame w >>= io . mapWindow d
+        modifyWindowState (\ws -> ws { wsMapped = True }) w
 
 -- | Set some properties when we initially gain control of a window
 setInitialProperties :: Window -> X ()