Use xmessage to present a failure message to users when the config file cannot be loaded

This commit is contained in:
Don Stewart
2007-11-19 02:24:29 +00:00
parent c2ae7a8c71
commit 31ce83d04e

View File

@@ -33,7 +33,7 @@ module XMonad.Core (
import XMonad.StackSet import XMonad.StackSet
import Prelude hiding ( catch ) import Prelude hiding ( catch )
import Control.Exception (catch, throw, Exception(ExitException)) import Control.Exception (catch, bracket, throw, Exception(ExitException))
import Control.Monad.State import Control.Monad.State
import Control.Monad.Reader import Control.Monad.Reader
import System.IO import System.IO
@@ -299,19 +299,35 @@ restart mprog resume = do
-- --
-- The file is only recompiled if it is newer than its binary. -- The file is only recompiled if it is newer than its binary.
-- --
-- In the event of an error, signalled with GHC returning non-zero exit
-- status, any stderr produced by GHC, written to the file xmonad.errors,
-- will be displayed to the user with xmessage
--
recompile :: IO () recompile :: IO ()
recompile = do recompile = do
dir <- liftM (++ "/.xmonad") getHomeDirectory dir <- liftM (++ "/.xmonad") getHomeDirectory
let bin = dir ++ "/" ++ "xmonad" let bin = dir ++ "/" ++ "xmonad"
err = bin ++ ".errors"
src = bin ++ ".hs" src = bin ++ ".hs"
yes <- doesFileExist src yes <- doesFileExist src
when yes $ do when yes $ do
srcT <- getModificationTime src srcT <- getModificationTime src
binT <- getModificationTime bin binT <- getModificationTime bin
when (srcT > binT) $ do when (srcT > binT) $ do
waitForProcess =<< runProcess "ghc" ["--make", "xmonad.hs", "-i"] (Just dir) status <- bracket (openFile err WriteMode) hClose $ \h -> do
Nothing Nothing Nothing Nothing waitForProcess =<< runProcess "ghc" ["--make", "xmonad.hs", "-i", "-v0"] (Just dir)
return () Nothing Nothing Nothing (Just h)
-- now, if it fails, run xmessage to let the user know:
when (status /= ExitSuccess) $ do
ghcErr <- readFile err
let msg = unlines $
["Error detected while loading xmonad configuration file: " ++ src]
++ lines ghcErr ++ ["","Please check the file for errors."]
waitForProcess =<< runProcess "xmessage" [msg]
Nothing Nothing Nothing Nothing Nothing
return ()
-- | Run a side effecting action with the current workspace. Like 'when' but -- | Run a side effecting action with the current workspace. Like 'when' but
whenJust :: Monad m => Maybe a -> (a -> m ()) -> m () whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()