    {-# LANGUAGE DeriveDataTypeable #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Util.Replace
    -- 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 Data.Function
    import Control.Monad

    -- $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 ""
        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 ("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
    /= 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
    $ "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]
    ++ " on display \""
                        String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (Display -> String
    displayString Display
    dpy) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "\" 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
    $ \attributes :: 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 (-100) (-100) 1 1 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 -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "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 -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "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
    $ \again :: 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
    $ \event :: 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 -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "done"
        Display -> IO ()
    closeDisplay Display
    dpy