-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Util.Replace
-- Description :  Implements a @--replace@ flag outside of core.
-- Copyright   :  (c) Jan Vornberger 2009
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Adam Vogt <vogt.adam@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Implements a @--replace@ behavior outside of core.
--
-----------------------------------------------------------------------------

-- refer to core patches:
-- http://article.gmane.org/gmane.comp.lang.haskell.xmonad/8358
module XMonad.Util.Replace
    ( -- * Usage
      -- $usage
      replace

      -- * Notes
      -- $shortcomings

      -- ** Implementing a @--replace@ flag
      -- $getArgs
    ) where

import XMonad
import XMonad.Prelude

-- $usage
-- You must run the 'replace' action before starting xmonad proper, this
-- results in xmonad replacing the currently running WM regardless of the
-- arguments it is run with:
--
-- > import XMonad
-- > import XMonad.Util.Replace
-- > main = do
-- >    replace
-- >    xmonad $ def { .... }
--

-- $shortcomings
-- This doesn't seem to work for replacing WMs that have been started
-- from within xmonad, such as with @'restart' "openbox" False@, but no other
-- WMs that implements --replace manage this either. 'replace' works for
-- replacing metacity when the full gnome-session is started at least.

-- $getArgs
-- You can use 'System.Environment.getArgs' to watch for an explicit
-- @--replace@ flag:
--
-- > import XMonad
-- > import XMonad.Util.Replace (replace)
-- > import Control.Monad (when)
-- > import System.Environment (getArgs)
-- >
-- > main = do
-- >    args <- getArgs
-- >    when ("--replace" `elem` args) replace
-- >    xmonad $ def { .... }
--
--
-- Note that your @~\/.xmonad/xmonad-$arch-$os@ binary is not run with the same
-- flags as the @xmonad@ binary that calls it. You may be able to work around
-- this by running your @~\/.xmonad/xmonad-$arch-$os@ binary directly, which is
-- otherwise not recommended.

-- | @replace@ must be run before xmonad starts to signals to compliant window
-- managers that they must exit and let xmonad take over.
replace :: IO ()
replace :: IO ()
replace = do
    dpy   <- String -> IO Display
openDisplay String
""
    let dflt = Display -> ScreenNumber
defaultScreen Display
dpy

    rootw  <- rootWindow dpy dflt

    -- check for other WM
    wmSnAtom <- internAtom dpy ("WM_S" ++ show dflt) False
    currentWmSnOwner <- xGetSelectionOwner dpy wmSnAtom
    when (currentWmSnOwner /= 0) $ do
        putStrLn $ "Screen " ++ show dflt ++ " on display \""
                    ++ displayString dpy ++ "\" already has a window manager."

        -- prepare to receive destroyNotify for old WM
        selectInput dpy currentWmSnOwner structureNotifyMask

        -- create off-screen window
        netWmSnOwner <- allocaSetWindowAttributes $ \Ptr SetWindowAttributes
attributes -> do
            Ptr SetWindowAttributes -> Bool -> IO ()
set_override_redirect Ptr SetWindowAttributes
attributes Bool
True
            Ptr SetWindowAttributes -> ScreenNumber -> IO ()
set_event_mask Ptr SetWindowAttributes
attributes ScreenNumber
propertyChangeMask
            let screen :: Screen
screen = Display -> Screen
defaultScreenOfDisplay Display
dpy
            let visual :: Visual
visual = Screen -> Visual
defaultVisualOfScreen Screen
screen
            let attrmask :: ScreenNumber
attrmask = ScreenNumber
cWOverrideRedirect ScreenNumber -> ScreenNumber -> ScreenNumber
forall a. Bits a => a -> a -> a
.|. ScreenNumber
cWEventMask
            Display
-> ScreenNumber
-> Position
-> Position
-> ScreenNumber
-> ScreenNumber
-> CInt
-> CInt
-> CInt
-> Visual
-> ScreenNumber
-> Ptr SetWindowAttributes
-> IO ScreenNumber
createWindow Display
dpy ScreenNumber
rootw (-Position
100) (-Position
100) ScreenNumber
1 ScreenNumber
1 CInt
0 CInt
copyFromParent CInt
copyFromParent Visual
visual ScreenNumber
attrmask Ptr SetWindowAttributes
attributes

        -- try to acquire wmSnAtom, this should signal the old WM to terminate
        putStrLn "Replacing existing window manager..."
        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
        putStr "Waiting for other window manager to terminate... "
        fix $ \IO ()
again -> do
            evt <- (XEventPtr -> IO ScreenNumber) -> IO ScreenNumber
forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent ((XEventPtr -> IO ScreenNumber) -> IO ScreenNumber)
-> (XEventPtr -> IO ScreenNumber) -> IO ScreenNumber
forall a b. (a -> b) -> a -> b
$ \XEventPtr
event -> do
                Display -> ScreenNumber -> ScreenNumber -> XEventPtr -> IO ()
windowEvent Display
dpy ScreenNumber
currentWmSnOwner ScreenNumber
structureNotifyMask XEventPtr
event
                XEventPtr -> IO ScreenNumber
get_EventType XEventPtr
event

            when (evt /= destroyNotify) again
        putStrLn "done"
    closeDisplay dpy