From 9af00af707377a3881ec98b568e71e24f09aee7d Mon Sep 17 00:00:00 2001
From: Adam Vogt <vogt.adam@gmail.com>
Date: Mon, 12 Oct 2009 07:23:06 +0200
Subject: Add U.Replace which implements a --replace behavior.

Ignore-this: bd519abe3250a01507f225a29c08048a

darcs-hash:20091012052306-1499c-117e10e2e25fe1c5b643026ae3052bbd114dfef0.gz
---
 XMonad/Util/Replace.hs | 116 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 116 insertions(+)
 create mode 100644 XMonad/Util/Replace.hs

(limited to 'XMonad')

diff --git a/XMonad/Util/Replace.hs b/XMonad/Util/Replace.hs
new file mode 100644
index 0000000..49f4011
--- /dev/null
+++ b/XMonad/Util/Replace.hs
@@ -0,0 +1,116 @@
+{-# 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 $ defaultConfig { .... }
+--
+
+-- $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 $ defaultConfig { .... }
+--
+--
+-- 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 = do
+    dpy   <- openDisplay ""
+    let dflt = defaultScreen 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 $ \attributes -> do
+            set_override_redirect attributes True
+            set_event_mask attributes propertyChangeMask
+            let screen = defaultScreenOfDisplay dpy
+            let visual = defaultVisualOfScreen screen
+            let 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
+        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 $ \again -> do
+            evt <- allocaXEvent $ \event -> do
+                windowEvent dpy currentWmSnOwner structureNotifyMask event
+                get_EventType event
+
+            when (evt /= destroyNotify) again
+        putStrLn $ "done"
+    closeDisplay dpy
-- 
cgit v1.2.3