Expose buildLaunch, sendRestart, and sendReplace

+ Move sendRestart and sendRestart to X.Operations, as this seems like a
  better fit.

Closes: https://github.com/xmonad/xmonad/issues/416
This commit is contained in:
Tony Zorman 2022-09-10 09:41:04 +02:00
parent fd9de8903f
commit 3d8238b35d
3 changed files with 59 additions and 54 deletions

View File

@ -6,6 +6,10 @@
### Enhancements
* Exported `sendRestart` and `sendReplace` from `XMonad.Operations`.
* Exported `buildLaunch` from `XMonad.Main`.
### Bug Fixes
## 0.17.1 (September 3, 2022)

View File

@ -15,14 +15,13 @@
--
-----------------------------------------------------------------------------
module XMonad.Main (xmonad, launch) where
module XMonad.Main (xmonad, buildLaunch, launch) where
import System.Locale.SetLocale
import qualified Control.Exception as E
import Data.Bits
import Data.List ((\\))
import Data.Foldable (traverse_)
import Data.Function
import qualified Data.Map as M
import qualified Data.Set as S
import Control.Monad.Reader
@ -131,25 +130,6 @@ buildLaunch dirs = do
args <- getArgs
executeFile bin False args Nothing
sendRestart :: IO ()
sendRestart = do
dpy <- openDisplay ""
rw <- rootWindow dpy $ defaultScreen dpy
xmonad_restart <- internAtom dpy "XMONAD_RESTART" False
allocaXEvent $ \e -> do
setEventType e clientMessage
setClientMessageEvent' e rw xmonad_restart 32 []
sendEvent dpy rw False structureNotifyMask e
sync dpy False
-- | a wrapper for 'replace'
sendReplace :: IO ()
sendReplace = do
dpy <- openDisplay ""
let dflt = defaultScreen dpy
rootw <- rootWindow dpy dflt
replace dpy dflt rootw
-- | Entry point into xmonad for custom builds.
--
-- This function isn't meant to be called by the typical xmonad user
@ -484,36 +464,3 @@ grabButtons = do
ems <- extraModifiers
ba <- asks buttonActions
mapM_ (\(m,b) -> mapM_ (grab b . (m .|.)) ems) (M.keys ba)
-- | @replace@ to signals compliant window managers to exit.
replace :: Display -> ScreenNumber -> Window -> IO ()
replace dpy dflt rootw = do
-- check for other WM
wmSnAtom <- internAtom dpy ("WM_S" ++ show dflt) False
currentWmSnOwner <- xGetSelectionOwner dpy wmSnAtom
when (currentWmSnOwner /= 0) $ do
-- prepare to receive destroyNotify for old WM
selectInput dpy currentWmSnOwner structureNotifyMask
-- create off-screen window
netWmSnOwner <- allocaSetWindowAttributes $ \attributes -> do
set_override_redirect attributes True
set_event_mask attributes propertyChangeMask
let screen = defaultScreenOfDisplay dpy
visual = defaultVisualOfScreen screen
attrmask = cWOverrideRedirect .|. cWEventMask
createWindow dpy rootw (-100) (-100) 1 1 0 copyFromParent copyFromParent visual attrmask attributes
-- try to acquire wmSnAtom, this should signal the old WM to terminate
xSetSelectionOwner dpy wmSnAtom netWmSnOwner currentTime
-- SKIPPED: check if we acquired the selection
-- SKIPPED: send client message indicating that we are now the WM
-- wait for old WM to go away
fix $ \again -> do
evt <- allocaXEvent $ \event -> do
windowEvent dpy currentWmSnOwner structureNotifyMask event
get_EventType event
when (evt /= destroyNotify) again

View File

@ -37,6 +37,7 @@ module XMonad.Operations (
-- * Messages
sendMessage, broadcastMessage, sendMessageWithNoRefresh,
sendRestart, sendReplace,
-- * Save and Restore State
StateFile (..), writeStateToFile, readStateFile, restart,
@ -518,6 +519,59 @@ setLayout l = do
handleMessage (W.layout ws) (SomeMessage ReleaseResources)
windows $ const $ ss{ W.current = c{ W.workspace = ws{ W.layout = l } } }
-- | Signal xmonad to restart itself.
sendRestart :: IO ()
sendRestart = do
dpy <- openDisplay ""
rw <- rootWindow dpy $ defaultScreen dpy
xmonad_restart <- internAtom dpy "XMONAD_RESTART" False
allocaXEvent $ \e -> do
setEventType e clientMessage
setClientMessageEvent' e rw xmonad_restart 32 []
sendEvent dpy rw False structureNotifyMask e
sync dpy False
-- | Signal compliant window managers to exit.
sendReplace :: IO ()
sendReplace = do
dpy <- openDisplay ""
let dflt = defaultScreen dpy
rootw <- rootWindow dpy dflt
replace dpy dflt rootw
-- | Signal compliant window managers to exit.
replace :: Display -> ScreenNumber -> Window -> IO ()
replace dpy dflt rootw = do
-- check for other WM
wmSnAtom <- internAtom dpy ("WM_S" ++ show dflt) False
currentWmSnOwner <- xGetSelectionOwner dpy wmSnAtom
when (currentWmSnOwner /= 0) $ do
-- prepare to receive destroyNotify for old WM
selectInput dpy currentWmSnOwner structureNotifyMask
-- create off-screen window
netWmSnOwner <- allocaSetWindowAttributes $ \attributes -> do
set_override_redirect attributes True
set_event_mask attributes propertyChangeMask
let screen = defaultScreenOfDisplay dpy
visual = defaultVisualOfScreen screen
attrmask = cWOverrideRedirect .|. cWEventMask
createWindow dpy rootw (-100) (-100) 1 1 0 copyFromParent copyFromParent visual attrmask attributes
-- try to acquire wmSnAtom, this should signal the old WM to terminate
xSetSelectionOwner dpy wmSnAtom netWmSnOwner currentTime
-- SKIPPED: check if we acquired the selection
-- SKIPPED: send client message indicating that we are now the WM
-- wait for old WM to go away
fix $ \again -> do
evt <- allocaXEvent $ \event -> do
windowEvent dpy currentWmSnOwner structureNotifyMask event
get_EventType event
when (evt /= destroyNotify) again
------------------------------------------------------------------------
-- Utilities