diff options
-rw-r--r-- | XMonad/Config.hs | 11 | ||||
-rw-r--r-- | XMonad/Core.hs | 1 | ||||
-rw-r--r-- | XMonad/Main.hsc | 12 | ||||
-rw-r--r-- | XMonad/Operations.hs | 48 |
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 () |