45 lines
2 KiB
Diff
45 lines
2 KiB
Diff
|
--- xmonad-0.11/XMonad/Core.hs 2013-01-01 01:31:47.000000000 +0000
|
||
|
|
+++ new-xmonad/XMonad/Core.hs 2013-12-23 17:36:40.862146910 +0000
|
||
|
|
@@ -47,6 +47,7 @@
|
||
|
|
import System.Process
|
||
|
|
import System.Directory
|
||
|
|
import System.Exit
|
||
|
|
+import System.Environment (lookupEnv)
|
||
|
|
import Graphics.X11.Xlib
|
||
|
|
import Graphics.X11.Xlib.Extras (Event)
|
||
|
|
import Data.Typeable
|
||
|
|
@@ -452,6 +453,7 @@
|
||
|
|
err = base ++ ".errors"
|
||
|
|
src = base ++ ".hs"
|
||
|
|
lib = dir </> "lib"
|
||
|
|
+ ghc <- fromMaybe "ghc" <$> liftIO (lookupEnv "XMONAD_GHC")
|
||
|
|
libTs <- mapM getModTime . Prelude.filter isSource =<< allFiles lib
|
||
|
|
srcT <- getModTime src
|
||
|
|
binT <- getModTime bin
|
||
|
|
@@ -460,7 +462,7 @@
|
||
|
|
-- temporarily disable SIGCHLD ignoring:
|
||
|
|
uninstallSignalHandlers
|
||
|
|
status <- bracket (openFile err WriteMode) hClose $ \h ->
|
||
|
|
- waitForProcess =<< runProcess "ghc" ["--make", "xmonad.hs", "-i", "-ilib", "-fforce-recomp", "-v0", "-o",binn] (Just dir)
|
||
|
|
+ waitForProcess =<< runProcess ghc ["--make", "xmonad.hs", "-i", "-ilib", "-fforce-recomp", "-v0", "-o",binn] (Just dir)
|
||
|
|
Nothing Nothing Nothing (Just h)
|
||
|
|
|
||
|
|
-- re-enable SIGCHLD:
|
||
|
|
@@ -469,6 +471,7 @@
|
||
|
|
-- now, if it fails, run xmessage to let the user know:
|
||
|
|
when (status /= ExitSuccess) $ do
|
||
|
|
ghcErr <- readFile err
|
||
|
|
+ xmessage <- fromMaybe "xmessage" <$> liftIO (lookupEnv "XMONAD_XMESSAGE")
|
||
|
|
let msg = unlines $
|
||
|
|
["Error detected while loading xmonad configuration file: " ++ src]
|
||
|
|
++ lines (if null ghcErr then show status else ghcErr)
|
||
|
|
@@ -476,7 +479,7 @@
|
||
|
|
-- nb, the ordering of printing, then forking, is crucial due to
|
||
|
|
-- lazy evaluation
|
||
|
|
hPutStrLn stderr msg
|
||
|
|
- forkProcess $ executeFile "xmessage" True ["-default", "okay", msg] Nothing
|
||
|
|
+ forkProcess $ executeFile xmessage True ["-default", "okay", msg] Nothing
|
||
|
|
return ()
|
||
|
|
return (status == ExitSuccess)
|
||
|
|
else return True
|