[xmonad] Patch: improved support for replacing an existing window manager

Jan Vornberger Jan.Vornberger at Informatik.Uni-Oldenburg.DE
Thu Sep 17 15:07:44 EDT 2009


Hi there!

First patch from Bluetile's repository for consideration to go into
xmonad mainline. This is the original patch (see
http://osdir.com/ml/xmonad@haskell.org/2009-05/msg00010.html) plus two
more patches, which

  * make this take effect only if the '--replace' flag is given
  * add a config option 'alwaysReplace' to override the --replace flag

Best regards!

Jan
-------------- next part --------------
Sat Apr 18 00:25:09 CEST 2009  Jan Vornberger <jan.vornberger at informatik.uni-oldenburg.de>
  * half-implemented support for replacing an existing window manager

Thu Sep 17 20:47:14 CEST 2009  Jan Vornberger <jan.vornberger at informatik.uni-oldenburg.de>
  * Only replace existing window manager when given '--replace' flag

Thu Sep 17 20:56:56 CEST 2009  Jan Vornberger <jan.vornberger at informatik.uni-oldenburg.de>
  * Add config option 'alwaysReplace' to replace window managers regardless off --replace flag

New patches:

[half-implemented support for replacing an existing window manager
Jan Vornberger <jan.vornberger at informatik.uni-oldenburg.de>**20090417222509
 Ignore-this: 17d9f72ef7a5d84b5fa6ac319566602b
] {
hunk ./XMonad/Main.hsc 42
 import XMonad.Operations
 
 import System.IO
+--import System.Exit
 
 ------------------------------------------------------------------------
 -- Locale support
hunk ./XMonad/Main.hsc 70
 
     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."
+        -- exitFailure
+
+        -- 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"
+
     -- 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.
}
[Only replace existing window manager when given '--replace' flag
Jan Vornberger <jan.vornberger at informatik.uni-oldenburg.de>**20090917184714
 Ignore-this: 3da99cbf6dbd835b38f42d5181a0d44a
] {
hunk ./Main.hs 43
     case args of
         []                    -> launch
         ["--resume", _]       -> launch
+        ["--replace"]         -> launch
         ["--help"]            -> usage
         ["--recompile"]       -> recompile True >>= flip unless exitFailure
         ["--restart"]         -> sendRestart >> return ()
hunk ./Main.hs 63
         "  --version                    Print the version number" :
         "  --recompile                  Recompile your ~/.xmonad/xmonad.hs" :
         "  --restart                    Request a running xmonad process to restart" :
+        "  --replace                    Replace an existing window manager" :
 #ifdef TESTING
         "  --run-tests                  Run the test suite" :
 #endif
hunk ./XMonad/Main.hsc 42
 import XMonad.Operations
 
 import System.IO
---import System.Exit
+import System.Exit
 
 ------------------------------------------------------------------------
 -- Locale support
hunk ./XMonad/Main.hsc 69
     let dflt = defaultScreen dpy
 
     rootw  <- rootWindow dpy dflt
+    args <- getArgs
 
     -- check for other WM
     wmSnAtom <- internAtom dpy ("WM_S" ++ (show dflt)) False
hunk ./XMonad/Main.hsc 77
     when (currentWmSnOwner /= 0) $ do
         putStrLn $ "Screen " ++ (show dflt) ++ " on display \""
                     ++ (displayString dpy) ++ "\" already has a window manager."
-        -- exitFailure
+        if (args /= ["--replace"])
+            then do
+                    putStrLn $ "Try providing the flag --replace."
+                    exitFailure
+            else putStrLn $ "Replacing existing window manager..."
 
         -- prepare to receive destroyNotify for old WM
         selectInput dpy currentWmSnOwner structureNotifyMask
hunk ./XMonad/Main.hsc 96
             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
hunk ./XMonad/Main.hsc 133
                  return (fromMaybe fbc_ v)
 
     hSetBuffering stdout NoBuffering
-    args <- getArgs
 
     let layout = layoutHook xmc
         lreads = readsLayout layout
}
[Add config option 'alwaysReplace' to replace window managers regardless off --replace flag
Jan Vornberger <jan.vornberger at informatik.uni-oldenburg.de>**20090917185656
 Ignore-this: d766e2acf73c5ceebe7717a751725b8e
] {
hunk ./XMonad/Config.hs 30
 import XMonad.Core as XMonad hiding
     (workspaces,manageHook,numlockMask,keys,logHook,startupHook,borderWidth,mouseBindings
     ,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor,focusFollowsMouse
-    ,handleEventHook)
+    ,alwaysReplace,handleEventHook)
 import qualified XMonad.Core as XMonad
     (workspaces,manageHook,numlockMask,keys,logHook,startupHook,borderWidth,mouseBindings
     ,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor,focusFollowsMouse
hunk ./XMonad/Config.hs 34
-    ,handleEventHook)
+    ,alwaysReplace,handleEventHook)
 
 import XMonad.Layout
 import XMonad.Operations
hunk ./XMonad/Config.hs 176
 focusFollowsMouse :: Bool
 focusFollowsMouse = True
 
+-- | Whether to always replace existing window managers
+alwaysReplace :: Bool
+alwaysReplace = False
+
 -- | The xmonad key bindings. Add, modify or remove key bindings here.
 --
 -- (The comment formatting character is used when generating the manpage)
hunk ./XMonad/Config.hs 271
     , XMonad.mouseBindings      = mouseBindings
     , XMonad.manageHook         = manageHook
     , XMonad.handleEventHook    = handleEventHook
-    , XMonad.focusFollowsMouse  = focusFollowsMouse }
+    , XMonad.focusFollowsMouse  = focusFollowsMouse
+    , XMonad.alwaysReplace      = alwaysReplace
+    }
hunk ./XMonad/Core.hs 106
     , logHook            :: !(X ())              -- ^ The action to perform when the windows set is changed
     , startupHook        :: !(X ())              -- ^ The action to perform on startup
     , focusFollowsMouse  :: !Bool                -- ^ Whether window entry events can change focus
+    , alwaysReplace      :: !Bool                -- ^ Whether to always replace existing window managers
     }
 
 
hunk ./XMonad/Main.hsc 77
     when (currentWmSnOwner /= 0) $ do
         putStrLn $ "Screen " ++ (show dflt) ++ " on display \""
                     ++ (displayString dpy) ++ "\" already has a window manager."
-        if (args /= ["--replace"])
-            then do
+        if (args == ["--replace"]) || (alwaysReplace initxmc)
+            then putStrLn $ "Replacing existing window manager..."
+            else do
                     putStrLn $ "Try providing the flag --replace."
                     exitFailure
hunk ./XMonad/Main.hsc 82
-            else putStrLn $ "Replacing existing window manager..."
 
         -- prepare to receive destroyNotify for old WM
         selectInput dpy currentWmSnOwner structureNotifyMask
}

Context:

[man_xmonad.hs: import Data.Monoid for mempty, keybinding edits
wirtwolff at gmail.com**20090320024624
 Ignore-this: dc8477ffcfdd404f4f60d2cdaf3812d9
 Bring mempty into scope. Add commented ToggleStruts binding.
 Replace shadowed modMask in keybindings with modm instead.
] 
[Only watch mtime for .hs, .lhs, .hsc for ~/.xmonad/lib
Adam Vogt <vogt.adam at gmail.com>**20090503235415
 Ignore-this: e3b1847edf3e07a8182f7fcfc23b00c8
 
 Previously xmonad would force a recompile due to the object files being too
 new, so only look at files which may contain haskell code.
] 
[Add lib to ghc searchpath with recompilation check
Adam Vogt <vogt.adam at gmail.com>**20090321232907
 Ignore-this: 8827fb02fe1101d7b66f05d363bef038
] 
[Remove tabs from ManageHook.hs
Adam Vogt <vogt.adam at gmail.com>**20090710011424
 Ignore-this: 13903f39b052c025a7bfa50fb701959c
] 
[Set infix 0 --> to reduce parentheses in ManageHooks
Adam Vogt <vogt.adam at gmail.com>**20090710011308
 Ignore-this: 75804147fffeceddd328869cbca0d20f
 
 What was previously:
 > (appName ?= x <&&> classname ?= y) --> (doFloat <+> doIgnore)
 
 Can now be:
 > appName ?= x <&&> classname ?= y --> doFloat <+> doIgnore
] 
[Pester the user with one (not two) xmessages on config errors
Adam Vogt <vogt.adam at gmail.com>**20090321233736
 Ignore-this: f481f7d3ba5fca5c53a0b3a87daa32bb
] 
[Minor bugfix in the creation of new StackSets.
Wouter Swierstra <wouter at chalmers.se>**20090503154321] 
[Avoid deadly cycle in man/xmonad.hs
Spencer Janssen <spencerjanssen at gmail.com>**20090319081918
 Ignore-this: adcba110caad465a2cbb4b9dca7cb612
] 
[X.Config.hs, ./man/xmonad.hs: update Event Hook doc
wirtwolff at gmail.com**20090209183837
 Ignore-this: 3792043278932e371e3e2858913a2b17
] 
[Use records to document Tall's arguments
Spencer Janssen <spencerjanssen at gmail.com>**20090221230628
 Ignore-this: 253c09de793715c18a029406795a42fd
] 
[Fix possible head []
Joachim Breitner <mail at joachim-breitner.de>**20090106192026
 This seems to be a rare case, but I just got hit by it.
] 
[ManageHook.doShift: use shiftWin instead of shift
Spencer Janssen <spencerjanssen at gmail.com>**20090219041458
 Ignore-this: 4d7f348d6d394c581ab2809bbc45a2c6
] 
[Express shift in terms of shiftWin
Spencer Janssen <spencerjanssen at gmail.com>**20090217235343
 Ignore-this: 8f213bca20065a39e7c16027f7b398cf
] 
[Use standard -fforce-recomp instead of undocumented -no-recomp
Don Stewart <dons at galois.com>**20090208165518] 
[Support for custom event hooks
Daniel Schoepe <asgaroth_ at gmx.de>**20090203155536
 Ignore-this: f22f1a7ae2d958ba1b3625aa923b7efd
] 
[Make X an instance of Typeable
Daniel Schoepe <asgaroth_ at gmx.de>**20090128215406
 Ignore-this: bb155e62ea4e451460e3b94508dc49d2
] 
[Add uninstallSignalHandlers, use in spawn
Spencer Janssen <spencerjanssen at gmail.com>**20090122002643
 Ignore-this: d91bde6f965341a2619fe2dde83cc099
] 
[Create a new session for forked processes
Spencer Janssen <spencerjanssen at gmail.com>**20090122000423
 Ignore-this: f5d9cf254a0b07ddbf204457b7783880
] 
[TAG 0.8.1
Spencer Janssen <spencerjanssen at gmail.com>**20090118083910] 
[Close stdin in spawned processes
Spencer Janssen <spencerjanssen at gmail.com>**20090117040024
 Ignore-this: 2e372ed6215160adae8da1c44cdede3d
] 
[Document spawnPID
Spencer Janssen <spencerjanssen at gmail.com>**20090117035907
 Ignore-this: 1641bdcf5055b2ec7b9455265f5b1d52
] 
[Asynchronously recompile/restart xmonad on mod-q
Spencer Janssen <spencerjanssen at gmail.com>**20090117035300
 Ignore-this: 753d8746034f818b81df79003ae5ee0d
] 
[Add --restart, a command line flag to cause a running xmonad process to restart
Spencer Janssen <spencerjanssen at gmail.com>**20090117034959
 Ignore-this: 45c8c8aba7cc7391b95c7e3fb01e5bf9
] 
[Bump version to 0.8.1
Spencer Janssen <spencerjanssen at gmail.com>**20090116223621
 Ignore-this: 2e8e9dc7b6ca725542f4afe04253dc57
] 
[Remove doubleFork, handle SIGCHLD
Spencer Janssen <spencerjanssen at gmail.com>**20090116204742
 Ignore-this: f9b1a65b4f0622922f80ad2ab6c5a52f
 This is a rather big change.  Rather than make spawned processes become
 children of init, we handle them in xmonad.  As a side effect of this change,
 we never need to use waitForProcess in any contrib module -- in fact, doing so
 will raise an exception.  The main benefit to handling SIGCHLD is that xmonad
 can now be started with 'exec', and will correctly clean up after inherited
 child processes.
] 
[Main.hs: escape / in Haddocks
gwern0 at gmail.com**20081207020915
 Ignore-this: 2c4525280fbe73c46f3abd8fc13628e9
 This lets haddocks for Main.hs, at least, to build with 2.3.0.
] 
[More flexible userCode function
Daniel Schoepe <asgaroth_ at gmx.de>**20090110221852] 
[Call logHook as the very last action in windows
Spencer Janssen <spencerjanssen at gmail.com>**20081209233700
 Ignore-this: 4396ad891b607780f8e4b3b6bbce87e
] 
[Accept inferior crossing events.  This patch enables fmouse-focus-follows-screen
Spencer Janssen <spencerjanssen at gmail.com>**20081205045130
 Ignore-this: 3ac329fb92839827aed0a4370784cabd
] 
[Tile all windows at once
Spencer Janssen <spencerjanssen at gmail.com>**20081118074447] 
[Factor rational rect scaling into a separate function
Spencer Janssen <spencerjanssen at gmail.com>**20081118072849] 
[Change screen focus by clicking on the root window.
Spencer Janssen <spencerjanssen at gmail.com>**20081106224031
 This is a modification of a patch from Joachim Breitner.
] 
[Fix #192.
Spencer Janssen <spencerjanssen at gmail.com>**20081021220059] 
[select base < 4 for building on ghc 6.10
Adam Vogt <vogt.adam at gmail.com>**20081013214509] 
[add killWindow function
Joachim Breitner <mail at joachim-breitner.de>**20081005001804
 This is required to kill anything that is not focused, without
 having to focus it first.
] 
[add'l documentation
Devin Mullins <me at twifkak.com>**20080927234639] 
[Regression: ungrab buttons on *non* root windows
Spencer Janssen <spencerjanssen at gmail.com>**20081007214351] 
[Partial fix for #40
Spencer Janssen <spencerjanssen at gmail.com>**20081007212053
 Improvements:
  - clicking on the root will change focus to that screen
  - moving the mouse from a window on a screen to an empty screen changes focus
    to that screen
 The only remaining issue is that moving the mouse between two empty screens
 does not change focus.  In order to solve this, we'd have to select motion events
 on the root window, which is potentially expensive.
] 
[Track mouse position via events received
Spencer Janssen <spencerjanssen at gmail.com>**20081007203953] 
[Fix haddock
Spencer Janssen <spencerjanssen at gmail.com>**20081007094641] 
[Move screen locating code into pointScreen
Spencer Janssen <spencerjanssen at gmail.com>**20081007094207] 
[Make pointWithin a top-level binding
Spencer Janssen <spencerjanssen at gmail.com>**20081007090229] 
[sp README, CONFIG, STYLE, TODO
gwern0 at gmail.com**20080913024457] 
[Use the same X11 dependency as xmonad-contrib
Spencer Janssen <spencerjanssen at gmail.com>**20080921061508] 
[Export focusUp' and focusDown' -- work entirely on stacks
Spencer Janssen <spencerjanssen at gmail.com>**20080911214803] 
[add W.shiftMaster, fix float/tile-reordering bug
Devin Mullins <me at twifkak.com>**20080911053909] 
[TAG 0.8
Spencer Janssen <spencerjanssen at gmail.com>**20080905195412] 
Patch bundle hash:
ef57bd55abf3113dcbbcc056df2923ad6dfcf35a


More information about the xmonad mailing list