From 0a23046a06d223caea4a02615201e05e88e0a255 Mon Sep 17 00:00:00 2001 From: Adam Vogt Date: Tue, 14 Apr 2015 20:48:21 +0200 Subject: Make ~/.xmonad/xmonad-$arch-$os handle args like /usr/bin/xmonad Ignore-this: add70a198fffaa94b14a35b585487eb3 darcs-hash:20150414184821-1499c-eebbc66c18dfc34d760357379ae5fbf224c6b7d1.gz --- Main.hs | 81 +--------------------------------- src/XMonad/Config.hs | 3 ++ src/XMonad/Core.hs | 2 + src/XMonad/Main.hs | 122 ++++++++++++++++++++++++++++++++++++++++++++++----- xmonad.cabal | 1 + 5 files changed, 119 insertions(+), 90 deletions(-) diff --git a/Main.hs b/Main.hs index 2fcfe13..28351d0 100644 --- a/Main.hs +++ b/Main.hs @@ -16,84 +16,5 @@ module Main (main) where import XMonad -import Control.Monad (unless) -import System.Info -import System.Environment -import System.Posix.Process (executeFile) -import System.Exit (exitFailure) - -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. main :: IO () -main = do - installSignalHandlers -- important to ignore SIGCHLD to avoid zombies - args <- getArgs - let launch = catchIO buildLaunch >> xmonad def - case args of - [] -> launch - ("--resume":_) -> launch - ["--help"] -> usage - ["--recompile"] -> recompile True >>= flip unless exitFailure - ["--replace"] -> launch - ["--restart"] -> sendRestart >> return () - ["--version"] -> putStrLn $ unwords shortVersion - ["--verbose-version"] -> putStrLn . unwords $ shortVersion ++ longVersion - _ -> fail "unrecognized flags" - 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 - executeFile (dir ++ "/xmonad-"++arch++"-"++os) False args Nothing - return () - -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 +main = xmonad def 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 diff --git a/xmonad.cabal b/xmonad.cabal index 9a7929e..47a81d5 100644 --- a/xmonad.cabal +++ b/xmonad.cabal @@ -52,6 +52,7 @@ library XMonad.ManageHook XMonad.Operations XMonad.StackSet + other-modules: Paths_xmonad build-depends: base < 5 && >=3, containers, -- cgit v1.2.3