aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorAdam Vogt <vogt.adam@gmail.com>2015-04-14 20:48:21 +0200
committerAdam Vogt <vogt.adam@gmail.com>2015-04-14 20:48:21 +0200
commit0a23046a06d223caea4a02615201e05e88e0a255 (patch)
tree29ea14e187a0b8375244e664e6f0d5cf042519c8 /src
parenta19946c22fc87796adb6c6c2ef4d23c5a1983c17 (diff)
downloadxmonad-0a23046a06d223caea4a02615201e05e88e0a255.tar.gz
xmonad-0a23046a06d223caea4a02615201e05e88e0a255.tar.xz
xmonad-0a23046a06d223caea4a02615201e05e88e0a255.zip
Make ~/.xmonad/xmonad-$arch-$os handle args like /usr/bin/xmonad
Ignore-this: add70a198fffaa94b14a35b585487eb3 darcs-hash:20150414184821-1499c-eebbc66c18dfc34d760357379ae5fbf224c6b7d1.gz
Diffstat (limited to '')
-rw-r--r--src/XMonad/Config.hs3
-rw-r--r--src/XMonad/Core.hs2
-rw-r--r--src/XMonad/Main.hs122
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