mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 03:20:21 -07:00
Merge branch 'pr/rescreen'
This commit is contained in:
commit
5230f038b3
@ -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.
|
||||
|
@ -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
160
XMonad/Hooks/Rescreen.hs
Normal 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)
|
@ -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 ()
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
x
Reference in New Issue
Block a user