|
| 1 | +{-# LANGUAGE LambdaCase #-} |
| 2 | +-- | |
| 3 | +-- Module : XMonad.Hooks.FloatConfigureReq |
| 4 | +-- Description : Customize handling of floating windows' move\/resize\/restack requests (ConfigureRequest). |
| 5 | +-- Copyright : (c) 2024 Tomáš Janoušek <[email protected]> |
| 6 | +-- License : BSD3 |
| 7 | +-- Maintainer : Tomáš Janoušek <[email protected]> |
| 8 | +-- |
| 9 | +-- xmonad normally honours those requests by doing exactly what the client |
| 10 | +-- application asked, and refreshing. There are some misbehaving clients, |
| 11 | +-- however, that: |
| 12 | +-- |
| 13 | +-- * try to move their window to the last known absolute position regardless |
| 14 | +-- of the current xrandr/xinerama layout |
| 15 | +-- |
| 16 | +-- * move their window to 0, 0 for no particular reason (e.g. rxvt-unicode) |
| 17 | +-- |
| 18 | +-- * issue lots of no-op requests causing flickering (e.g. Steam) |
| 19 | +-- |
| 20 | +-- This module provides a replacement handler for 'ConfigureRequestEvent' to |
| 21 | +-- work around such misbehaviours. |
| 22 | +-- |
| 23 | +module XMonad.Hooks.FloatConfigureReq ( |
| 24 | + -- * Usage |
| 25 | + -- $usage |
| 26 | + MaybeMaybeManageHook, |
| 27 | + floatConfReqHook, |
| 28 | + ) where |
| 29 | + |
| 30 | +import qualified Data.Map.Strict as M |
| 31 | +import XMonad |
| 32 | +import XMonad.Hooks.ManageHelpers |
| 33 | +import XMonad.Prelude |
| 34 | +import qualified XMonad.StackSet as W |
| 35 | + |
| 36 | +-- $usage |
| 37 | +-- To use this, include the following in your @xmonad.hs@: |
| 38 | +-- |
| 39 | +-- > import XMonad.Hooks.FloatConfigureReq |
| 40 | +-- > import XMonad.Hooks.ManageHelpers |
| 41 | +-- |
| 42 | +-- > myFloatConfReqHook :: MaybeMaybeManageHook |
| 43 | +-- > myFloatConfReqHook = composeAll |
| 44 | +-- > [ … ] |
| 45 | +-- |
| 46 | +-- > myEventHook :: Event -> X All |
| 47 | +-- > myEventHook = mconcat |
| 48 | +-- > [ … |
| 49 | +-- > , floatConfReqHook myFloatConfReqHook |
| 50 | +-- > , … ] |
| 51 | +-- |
| 52 | +-- > main = xmonad $ … |
| 53 | +-- > $ def{ handleEventHook = myEventHook |
| 54 | +-- > , … } |
| 55 | +-- |
| 56 | +-- Then fill the @myFloatConfReqHook@ with whatever custom rules you need. |
| 57 | +-- |
| 58 | +-- As an example, the following will prevent rxvt-unicode from moving its |
| 59 | +-- (floating) window to 0, 0 after a font change but still ensure its size |
| 60 | +-- increment hints are respected: |
| 61 | +-- |
| 62 | +-- > className =? "URxvt" -?> pure <$> doFloat |
| 63 | +-- |
| 64 | +-- Another example that avoids flickering and xmonad slowdowns caused by the |
| 65 | +-- Steam client (completely ignore all its requests, none of which are |
| 66 | +-- meaningful in the context of a tiling WM): |
| 67 | +-- |
| 68 | +-- > map toLower `fmap` className =? "steam" -?> mempty |
| 69 | + |
| 70 | +-- | A variant of 'MaybeManageHook' that additionally may or may not make |
| 71 | +-- changes to the 'WindowSet'. |
| 72 | +type MaybeMaybeManageHook = Query (Maybe (Maybe (Endo WindowSet))) |
| 73 | + |
| 74 | +-- | Customizable handler for a 'ConfigureRequestEvent'. If the event's |
| 75 | +-- 'ev_window' is a managed floating window, the provided |
| 76 | +-- 'MaybeMaybeManageHook' is consulted and its result interpreted as follows: |
| 77 | +-- |
| 78 | +-- * @Nothing@ - no match, fall back to the default handler |
| 79 | +-- |
| 80 | +-- * @Just Nothing@ - match but ignore, no refresh, just send ConfigureNotify |
| 81 | +-- |
| 82 | +-- * @Just (Just a)@ - match, modify 'WindowSet', refresh, send ConfigureNotify |
| 83 | +floatConfReqHook :: MaybeMaybeManageHook -> Event -> X All |
| 84 | +floatConfReqHook mh ConfigureRequestEvent{ev_window = w} = |
| 85 | + runQuery (join <$> (isFloatQ -?> mh)) w >>= \case |
| 86 | + Nothing -> mempty |
| 87 | + Just e -> do |
| 88 | + whenJust e (windows . appEndo) |
| 89 | + sendConfEvent |
| 90 | + pure (All False) |
| 91 | + where |
| 92 | + sendConfEvent = withDisplay $ \dpy -> |
| 93 | + withWindowAttributes dpy w $ \wa -> do |
| 94 | + io . allocaXEvent $ \ev -> do |
| 95 | + -- We may have made no changes to the window size/position |
| 96 | + -- and thus the X server didn't emit any ConfigureNotify, |
| 97 | + -- so we need to send the ConfigureNotify ourselves to make |
| 98 | + -- sure there is a reply to this ConfigureRequestEvent and the |
| 99 | + -- window knows we (possibly) ignored its request. |
| 100 | + setEventType ev configureNotify |
| 101 | + setConfigureEvent ev w w |
| 102 | + (wa_x wa) (wa_y wa) (wa_width wa) |
| 103 | + (wa_height wa) (wa_border_width wa) none (wa_override_redirect wa) |
| 104 | + sendEvent dpy w False 0 ev |
| 105 | +floatConfReqHook _ _ = mempty |
| 106 | + |
| 107 | +-- | A 'Query' to determine if a window is floating. |
| 108 | +isFloatQ :: Query Bool |
| 109 | +isFloatQ = ask >>= \w -> liftX . gets $ M.member w . W.floating . windowset |
0 commit comments