From e193f0357bf55e52d38289d786649272e813175e Mon Sep 17 00:00:00 2001
From: Adam Vogt <vogt.adam@gmail.com>
Date: Sun, 20 Dec 2009 19:35:29 +0100
Subject: Add --replace flag with documentation (issue 99).

Ignore-this: c56000295b75c66309913e29e1671d88

darcs-hash:20091220183529-1499c-3c77980c6e443252334c118e2284fa7ed4933bff
---
 Main.hs               |  1 +
 XMonad/Main.hsc       | 39 ++++++++++++++++++++++++++++++++++++++-
 man/xmonad.1.markdown |  3 +++
 3 files changed, 42 insertions(+), 1 deletion(-)

diff --git a/Main.hs b/Main.hs
index a2cf797..230155f 100644
--- a/Main.hs
+++ b/Main.hs
@@ -65,6 +65,7 @@ usage = do
         "  --help                       Print this message" :
         "  --version                    Print the version number" :
         "  --recompile                  Recompile your ~/.xmonad/xmonad.hs" :
+        "  --replace                    Request the running window manage to exit" :
         "  --restart                    Request a running xmonad process to restart" :
 #ifdef TESTING
         "  --run-tests                  Run the test suite" :
diff --git a/XMonad/Main.hsc b/XMonad/Main.hsc
index fd2bbdb..f68ebf5 100644
--- a/XMonad/Main.hsc
+++ b/XMonad/Main.hsc
@@ -18,6 +18,7 @@ module XMonad.Main (xmonad) where
 import Control.Arrow (second)
 import Data.Bits
 import Data.List ((\\))
+import Data.Function
 import qualified Data.Map as M
 import qualified Data.Set as S
 import Control.Monad.Reader
@@ -67,6 +68,10 @@ xmonad initxmc = do
 
     rootw  <- rootWindow dpy dflt
 
+    args <- getArgs
+
+    when ("--replace" `elem` args) $ replace dpy dflt rootw
+
     -- If another WM is running, a BadAccess error will be returned.  The
     -- default error handler will write the exception to stderr and exit with
     -- an error.
@@ -89,7 +94,6 @@ xmonad initxmc = do
                  return (fromMaybe fbc_ v)
 
     hSetBuffering stdout NoBuffering
-    args <- getArgs
 
     let layout = layoutHook xmc
         lreads = readsLayout layout
@@ -364,3 +368,36 @@ 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
diff --git a/man/xmonad.1.markdown b/man/xmonad.1.markdown
index 1099fdb..b8921c6 100644
--- a/man/xmonad.1.markdown
+++ b/man/xmonad.1.markdown
@@ -57,6 +57,9 @@ These flags are:
 --restart
 :   Causes the currently running _xmonad_ process to restart
 
+--replace
+:   Replace an existing window manager
+
 --version
 :   Display version of _xmonad_
 
-- 
cgit v1.2.3