-----------------------------------------------------------------------------
-- |
-- 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
    Display
dpy   <- String -> IO Display
openDisplay String
""
    let dflt :: ScreenNumber
dflt = Display -> ScreenNumber
defaultScreen Display
dpy

    Window
rootw  <- Display -> ScreenNumber -> IO Window
rootWindow Display
dpy ScreenNumber
dflt

    -- check for other WM
    Window
wmSnAtom <- Display -> String -> Bool -> IO Window
internAtom Display
dpy (String
"WM_S" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ScreenNumber -> String
forall a. Show a => a -> String
show ScreenNumber
dflt) Bool
False
    Window
currentWmSnOwner <- Display -> Window -> IO Window
xGetSelectionOwner Display
dpy Window
wmSnAtom
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Window
currentWmSnOwner Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
/= Window
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Screen " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ScreenNumber -> String
forall a. Show a => a -> String
show ScreenNumber
dflt String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" on display \""
                    String -> String -> String
forall a. [a] -> [a] -> [a]
++ Display -> String
displayString Display
dpy String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\" already has a window manager."

        -- prepare to receive destroyNotify for old WM
        Display -> Window -> Window -> IO ()
selectInput Display
dpy Window
currentWmSnOwner Window
structureNotifyMask

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

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

            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ScreenNumber
evt ScreenNumber -> ScreenNumber -> Bool
forall a. Eq a => a -> a -> Bool
/= ScreenNumber
destroyNotify) IO ()
again
        String -> IO ()
putStrLn String
"done"
    Display -> IO ()
closeDisplay Display
dpy