Make ~/.xmonad/xmonad-$arch-$os handle args like /usr/bin/xmonad

Ignore-this: add70a198fffaa94b14a35b585487eb3

darcs-hash:20150414184821-1499c-eebbc66c18dfc34d760357379ae5fbf224c6b7d1.gz

3 files changed, 117 insertions, 10 deletions

diff --git a/src/XMonad/Config.hs b/src/XMonad/Config.hs
index a39e1a1..4f90b8a 100644
--- a/src/XMonad/Config.hs
+++ b/src/XMonad/Config.hs
@@ -271,6 +271,9 @@ instance (a ~ Choose Tall (Choose (Mirror Tall) Full)) => Default (XConfig a) wh
     , XMonad.clickJustFocuses       = clickJustFocuses
     , XMonad.clientMask         = clientMask
     , XMonad.rootMask           = rootMask
+    , XMonad.handleExtraArgs = \ xs theConf -> case xs of
+                [] -> return theConf
+                _ -> fail ("unrecognized flags:" ++ show xs)
     }
 
 -- | The default set of configuration values itself
diff --git a/src/XMonad/Core.hs b/src/XMonad/Core.hs
index eb02704..066b8d4 100644
--- a/src/XMonad/Core.hs
+++ b/src/XMonad/Core.hs
@@ -114,6 +114,8 @@ data XConfig l = XConfig
     , clickJustFocuses   :: !Bool                -- ^ False to make a click which changes focus to be additionally passed to the window
     , clientMask         :: !EventMask           -- ^ The client events that xmonad is interested in
     , rootMask           :: !EventMask           -- ^ The root events that xmonad is interested in
+    , handleExtraArgs    :: !([String] -> XConfig Layout -> IO (XConfig Layout))
+                                                 -- ^ Modify the configuration, complain about extra arguments etc. with arguments that are not handled by default
     }
 
 
diff --git a/src/XMonad/Main.hs b/src/XMonad/Main.hs
index 8a8ce88..3da7bb4 100644
--- a/src/XMonad/Main.hs
+++ b/src/XMonad/Main.hs
@@ -27,8 +27,6 @@ import Control.Monad.State
 import Data.Maybe (fromMaybe)
 import Data.Monoid (getAll)
 
-import System.Environment (getArgs)
-
 import Graphics.X11.Xlib hiding (refreshKeyboardMapping)
 import Graphics.X11.Xlib.Extras
 
@@ -40,13 +38,121 @@ import XMonad.Operations
 
 import System.IO
 
+import System.Info
+import System.Environment
+import System.Posix.Process (executeFile)
+import System.Exit (exitFailure)
+import System.FilePath
+
+import Paths_xmonad (version)
+import Data.Version (showVersion)
+
+import Graphics.X11.Xinerama (compiledWithXinerama)
+
 ------------------------------------------------------------------------
 
+
+-- |
+-- | The entry point into xmonad. Attempts to compile any custom main
+-- for xmonad, and if it doesn't find one, just launches the default.
+xmonad :: (LayoutClass l Window, Read (l Window)) => XConfig l -> IO ()
+xmonad conf = do
+    installSignalHandlers -- important to ignore SIGCHLD to avoid zombies
+
+    let launch serializedWinset serializedExtState args = do
+              catchIO buildLaunch
+              conf' @ XConfig { layoutHook = Layout l }
+                  <- handleExtraArgs conf args conf{ layoutHook = Layout (layoutHook conf) }
+              withArgs [] $
+                xmonadNoargs (conf' { layoutHook = l })
+                              serializedWinset
+                              serializedExtState
+
+    args <- getArgs
+    case args of
+        ("--resume": ws : xs : args') -> launch (Just ws) (Just xs) args'
+        ["--help"]            -> usage
+        ["--recompile"]       -> recompile True >>= flip unless exitFailure
+        ["--restart"]         -> sendRestart
+        ["--version"]         -> putStrLn $ unwords shortVersion
+        ["--verbose-version"] -> putStrLn . unwords $ shortVersion ++ longVersion
+        "--replace" : args'   -> do
+                                  sendReplace
+                                  launch Nothing Nothing args'
+        _                     -> launch Nothing Nothing args
+ where
+    shortVersion = ["xmonad", showVersion version]
+    longVersion  = [ "compiled by", compilerName, showVersion compilerVersion
+                   , "for",  arch ++ "-" ++ os
+                   , "\nXinerama:", show compiledWithXinerama ]
+
+usage :: IO ()
+usage = do
+    self <- getProgName
+    putStr . unlines $
+        concat ["Usage: ", self, " [OPTION]"] :
+        "Options:" :
+        "  --help                       Print this message" :
+        "  --version                    Print the version number" :
+        "  --recompile                  Recompile your ~/.xmonad/xmonad.hs" :
+        "  --replace                    Replace the running window manager with xmonad" :
+        "  --restart                    Request a running xmonad process to restart" :
+        []
+
+-- | Build "~\/.xmonad\/xmonad.hs" with ghc, then execute it.  If there are no
+-- errors, this function does not return.  An exception is raised in any of
+-- these cases:
+--
+--   * ghc missing
+--
+--   * both "~\/.xmonad\/xmonad.hs" and "~\/.xmonad\/xmonad-$arch-$os" missing
+--
+--   * xmonad.hs fails to compile
+--
+--      ** wrong ghc in path (fails to compile)
+--
+--      ** type error, syntax error, ..
+--
+--   * Missing XMonad\/XMonadContrib modules due to ghc upgrade
+--
+buildLaunch ::  IO ()
+buildLaunch = do
+    recompile False
+    dir  <- getXMonadDir
+    args <- getArgs
+    whoami <- getProgName
+    let compiledConfig = "xmonad-"++arch++"-"++os
+    unless (whoami == compiledConfig) $
+      executeFile (dir </> compiledConfig) False args Nothing
+
+sendRestart :: IO ()
+sendRestart = do
+    dpy <- openDisplay ""
+    rw <- rootWindow dpy $ defaultScreen dpy
+    xmonad_restart <- internAtom dpy "XMONAD_RESTART" False
+    allocaXEvent $ \e -> do
+        setEventType e clientMessage
+        setClientMessageEvent e rw xmonad_restart 32 0 currentTime
+        sendEvent dpy rw False structureNotifyMask e
+    sync dpy False
+
+-- | a wrapper for 'replace'
+sendReplace :: IO ()
+sendReplace = do
+    dpy <- openDisplay ""
+    let dflt = defaultScreen dpy
+    rootw  <- rootWindow dpy dflt
+    replace dpy dflt rootw
+
+
 -- |
 -- The main entry point
 --
-xmonad :: (LayoutClass l Window, Read (l Window)) => XConfig l -> IO ()
-xmonad initxmc = do
+xmonadNoargs :: (LayoutClass l Window, Read (l Window)) => XConfig l
+    -> Maybe String -- ^ serialized windowset
+    -> Maybe String -- ^ serialized extensible state
+    -> IO ()
+xmonadNoargs initxmc serializedWinset serializedExtstate = do
     -- setup locale information from environment
     setLocale LC_ALL (Just "")
     -- ignore SIGPIPE and SIGCHLD
@@ -58,10 +164,6 @@ 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.
@@ -93,12 +195,12 @@ xmonad initxmc = do
                                 _         -> Nothing
 
         winset = fromMaybe initialWinset $ do
-                    ("--resume" : s : _) <- return args
+                    s                    <- serializedWinset
                     ws                   <- maybeRead reads s
                     return . W.ensureTags layout (workspaces xmc)
                            $ W.mapLayout (fromMaybe layout . maybeRead lreads) ws
         extState = fromMaybe M.empty $ do
-                     ("--resume" : _ : dyns : _) <- return args
+                     dyns                        <- serializedExtstate
                      vals                        <- maybeRead reads dyns
                      return . M.fromList . map (second Left) $ vals