Merge branch 'pr/rescreen'

This commit is contained in:
Tomas Janousek 2021-06-03 11:10:58 +01:00
commit 5230f038b3
7 changed files with 187 additions and 31 deletions

View File

@ -250,6 +250,13 @@
This lets them create custom hooks, ensure they hook into xmonad core only
once, and possibly more.
* `XMonad.Hooks.Rescreen`
Custom hooks for screen (xrandr) configuration changes. These can be used
to restart/reposition status bars or systrays automatically after xrandr,
as well as to actually invoke xrandr or autorandr when an output is
(dis)connected.
### Bug Fixes and Minor Changes
* Add support for GHC 9.0.1.

View File

@ -543,6 +543,12 @@ Here is a list of the modules found in @XMonad.Hooks@:
even if it was opened in a tiled layout initially. The EventHook makes sure
that windows are deleted from the PositionStore when they are closed.
* "XMonad.Hooks.Rescreen":
Custom hooks for screen (xrandr) configuration changes. These can be used
to restart/reposition status bars or systrays automatically after xrandr,
as well as to actually invoke xrandr or autorandr when an output is
(dis)connected.
* "XMonad.Hooks.RestoreMinimized":
(Deprecated: Use XMonad.Hooks.Minimize) Lets you restore minimized
windows (see "XMonad.Layout.Minimize") by selecting them on a

160
XMonad/Hooks/Rescreen.hs Normal file
View File

@ -0,0 +1,160 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RecordWildCards #-}
-- |
-- Module : XMonad.Hooks.Rescreen
-- Copyright : (c) 2021 Tomáš Janoušek <tomi@nomi.cz>
-- License : BSD3
-- Maintainer : Tomáš Janoušek <tomi@nomi.cz>
--
-- Custom hooks for screen (xrandr) configuration changes.
--
module XMonad.Hooks.Rescreen (
-- * Usage
-- $usage
RescreenConfig(..),
addAfterRescreenHook,
addRandrChangeHook,
rescreenHook,
) where
import Control.Monad (void)
import Data.Monoid (All(..))
import Graphics.X11.Xrandr
import XMonad
import qualified XMonad.Util.ExtensibleConf as XC
-- $usage
-- This module provides a replacement for the screen configuration change
-- handling in core that enables attaching custom hooks to screen (xrandr)
-- configuration change events. These can be used to restart/reposition status
-- bars or systrays automatically after xrandr, as well as to actually invoke
-- xrandr or autorandr when an output is (dis)connected.
--
-- You can use it by including the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Hooks.RescreenHook
--
-- defining your custom hooks:
--
-- > myAfterRescreenHook :: X ()
-- > myAfterRescreenHook = …
--
-- > myRandrChangeHook :: X ()
-- > myRandrChangeHook = …
--
-- > rescreenCfg = def{
-- > afterRescreenHook = myAfterRescreenHook,
-- > randrChangeHook = myRandrChangeHook
-- > }
--
-- and adding 'rescreenHook' to your 'xmonad' config:
--
-- > main = xmonad $ … . rescreenHook rescreenCfg . … $ def{…}
-- | Hook configuration for 'rescreenEventHook'.
data RescreenConfig = RescreenConfig
{ afterRescreenHook :: X () -- ^ hook to invoke after 'rescreen'
, randrChangeHook :: X () -- ^ hook for other randr changes, e.g. (dis)connects
}
instance Default RescreenConfig where
def = RescreenConfig
{ afterRescreenHook = mempty
, randrChangeHook = mempty
}
instance Semigroup RescreenConfig where
RescreenConfig arh rch <> RescreenConfig arh' rch' = RescreenConfig (arh <> arh') (rch <> rch')
instance Monoid RescreenConfig where
mempty = def
-- | Attach custom hooks to screen (xrandr) configuration change events.
-- Replaces the built-in rescreen handling of xmonad core with:
--
-- 1. listen to 'RRScreenChangeNotifyEvent' in addition to 'ConfigureEvent' on
-- the root window
-- 2. whenever such event is received:
-- 3. clear any other similar events (Xorg server emits them in bunches)
-- 4. if any event was 'ConfigureEvent', 'rescreen' and invoke 'afterRescreenHook'
-- 5. if there was no 'ConfigureEvent', invoke 'randrChangeHook' only
--
-- 'afterRescreenHook' is useful for restarting/repositioning status bars and
-- systray.
--
-- 'randrChangeHook' may be used to automatically trigger xrandr (or perhaps
-- autorandr) when outputs are (dis)connected.
--
-- Note that 'rescreenHook' is safe to use several times, 'rescreen' is still
-- done just once and hooks are invoked in sequence, also just once.
rescreenHook :: RescreenConfig -> XConfig a -> XConfig a
rescreenHook = XC.once $ \c -> c
{ startupHook = startupHook c <> rescreenStartupHook
, handleEventHook = handleEventHook c <> rescreenEventHook }
-- | Shortcut for 'rescreenHook'.
addAfterRescreenHook :: X () -> XConfig a -> XConfig a
addAfterRescreenHook h = rescreenHook def{ afterRescreenHook = h }
-- | Shortcut for 'rescreenHook'.
addRandrChangeHook :: X () -> XConfig a -> XConfig a
addRandrChangeHook h = rescreenHook def{ randrChangeHook = h }
-- | Startup hook to listen for @RRScreenChangeNotify@ events.
rescreenStartupHook :: X ()
rescreenStartupHook = do
dpy <- asks display
root <- asks theRoot
io $ xrrSelectInput dpy root rrScreenChangeNotifyMask
-- | Event hook with custom rescreen/randr hooks. See 'rescreenHook' for more.
rescreenEventHook :: Event -> X All
rescreenEventHook e = do
shouldHandle <- case e of
ConfigureEvent{ ev_window = w } -> isRoot w
RRScreenChangeNotifyEvent{ ev_window = w } -> isRoot w
_ -> pure False
if shouldHandle
then All False <$ handleEvent e
else mempty
handleEvent :: Event -> X ()
handleEvent e = XC.with $ \RescreenConfig{..} -> do
-- Xorg emits several events after every change, clear them to prevent
-- triggering the hook multiple times.
moreConfigureEvents <- clearTypedWindowEvents (ev_window e) configureNotify
_ <- clearTypedWindowRREvents (ev_window e) rrScreenChangeNotify
-- If there were any ConfigureEvents, this is an actual screen
-- configuration change, so rescreen and fire rescreenHook. Otherwise,
-- this is just a connect/disconnect, fire randrChangeHook.
if ev_event_type e == configureNotify || moreConfigureEvents
then rescreen >> afterRescreenHook
else randrChangeHook
-- | Remove all X events of a given window and type from the event queue,
-- return whether there were any.
clearTypedWindowEvents :: Window -> EventType -> X Bool
clearTypedWindowEvents w t = withDisplay $ \d -> io $ allocaXEvent (go d)
where
go d e' = do
sync d False
gotEvent <- checkTypedWindowEvent d w t e'
e <- if gotEvent then Just <$> getEvent e' else pure Nothing
gotEvent <$ if
| not gotEvent -> mempty
| (ev_window <$> e) == Just w -> void $ go d e'
-- checkTypedWindowEvent checks ev_event instead of ev_window, so
-- we may need to put some events back
| otherwise -> allocaXEvent (go d) >> io (putBackEvent d e')
clearTypedWindowRREvents :: Window -> EventType -> X Bool
clearTypedWindowRREvents w t =
rrEventBase >>= \case
Just base -> clearTypedWindowEvents w (base + t)
Nothing -> pure False
rrEventBase :: X (Maybe EventType)
rrEventBase = withDisplay $ \d ->
fmap (fromIntegral . fst) <$> io (xrrQueryExtension d)

View File

@ -75,11 +75,10 @@ import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Layout.LayoutModifier
import XMonad.Hooks.ManageDocks
import XMonad.Hooks.Rescreen
import XMonad.Hooks.StatusBar.PP
import qualified XMonad.StackSet as W
import Graphics.X11.Xrandr (xrrSelectInput)
-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
@ -360,7 +359,7 @@ statusBarPipe cmd xpp = do
-- >
-- > main = xmonad $ withSB (xmobarTop <> xmobarBottom <> xmobar1) myConfig
--
-- And here is an example of the related xmobar configuration for the multiple
-- And here is an example of the related xmobar configuration for the multiple
-- status bars mentioned above:
--
-- > xmobarrc_top
@ -440,13 +439,9 @@ instance ExtensionClass ActiveSBs where
--
-- Heavily inspired by "XMonad.Hooks.DynamicBars"
dynamicSBs :: (ScreenId -> IO StatusBarConfig) -> XConfig l -> XConfig l
dynamicSBs f conf = conf
{ startupHook = startupHook conf
>> setupEventHandler
>> killAllStatusBars
>> updateSBs f
, logHook = logHook conf >> logSBs
, handleEventHook = eventHookSBs f <> handleEventHook conf
dynamicSBs f conf = addAfterRescreenHook (updateSBs f) $ conf
{ startupHook = startupHook conf >> killAllStatusBars >> updateSBs f
, logHook = logHook conf >> logSBs
}
-- | Like 'dynamicSBs', but applies 'docks' to the
@ -475,23 +470,10 @@ updateSBs f = do
traverse_ (sbStartupHook . snd) added
XS.put (ASB (toKeep ++ added))
-- | Handles 'RRScreenChangeNotifyEvent' by updating the
-- status bars.
eventHookSBs :: (ScreenId -> IO StatusBarConfig) -> Event -> X All
eventHookSBs f RRScreenChangeNotifyEvent{} = updateSBs f >> return (All True)
eventHookSBs _ _ = return (All True)
-- | Run 'sbLogHook' for the saved 'StatusBarConfig's
logSBs :: X ()
logSBs = XS.get >>= traverse_ (sbLogHook . snd) . getASBs
-- | Subscribe to the 'RRScreenChangeNotifyEvent'
setupEventHandler :: X ()
setupEventHandler = do
dpy <- asks display
root <- asks theRoot
io $ xrrSelectInput dpy root rrScreenChangeNotifyMask
-- | Kill the given 'StatusBarConfig's from the given
-- list
cleanSBs :: [StatusBarConfig] -> X ()

View File

@ -113,16 +113,16 @@ add x = alter (<> Just x)
-- This can be used to implement a composable interface for modules that must
-- only hook into xmonad core once.
once :: forall a l. (Semigroup a, Typeable a)
=> a -- ^ configuration to add
-> (XConfig l -> XConfig l) -- ^ 'XConfig' modification done only once
=> (XConfig l -> XConfig l) -- ^ 'XConfig' modification done only once
-> a -- ^ configuration to add
-> XConfig l -> XConfig l
once x f c = add x $ maybe f (const id) (lookup @a c) c
once f x c = add x $ maybe f (const id) (lookup @a c) c
-- | Config-time: Applicative (monadic) variant of 'once', useful if the
-- 'XConfig' modification needs to do some 'IO' (e.g. create an
-- 'Data.IORef.IORef').
onceM :: forall a l m. (Applicative m, Semigroup a, Typeable a)
=> a -- ^ configuration to add
-> (XConfig l -> m (XConfig l)) -- ^ 'XConfig' modification done only once
=> (XConfig l -> m (XConfig l)) -- ^ 'XConfig' modification done only once
-> a -- ^ configuration to add
-> XConfig l -> m (XConfig l)
onceM x f c = add x <$> maybe f (const pure) (lookup @a c) c
onceM f x c = add x <$> maybe f (const pure) (lookup @a c) c

View File

@ -22,9 +22,9 @@ spec = do
XC.lookup (XC.add "a" (XC.add [1 :: Int] def)) `shouldBe` (Nothing :: Maybe ())
specify "once" $
borderWidth (XC.once "a" incBorderWidth def) `shouldBe` succ (borderWidth def)
borderWidth (XC.once incBorderWidth "a" def) `shouldBe` succ (borderWidth def)
specify "once . once" $
borderWidth (XC.once "b" incBorderWidth (XC.once "a" incBorderWidth def))
borderWidth (XC.once incBorderWidth "b" (XC.once incBorderWidth "a" def))
`shouldBe` succ (borderWidth def)
incBorderWidth :: XConfig l -> XConfig l

View File

@ -184,6 +184,7 @@ library
XMonad.Hooks.Place
XMonad.Hooks.PositionStoreHooks
XMonad.Hooks.RefocusLast
XMonad.Hooks.Rescreen
XMonad.Hooks.RestoreMinimized
XMonad.Hooks.ScreenCorners
XMonad.Hooks.Script