blob: d4a4d93cff387ac2d90920ad805bb0e09de3da78 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
{-# LANGUAGE LambdaCase #-}
module Shutdown
( newShutdownEventHandler
, shutdown
)
where
import Control.Applicative ((<|>), empty)
import Control.Concurrent (threadDelay)
import Control.Monad (forever, guard, when)
import Data.Monoid (All(All))
import System.Directory (XdgDirectory(XdgData), createDirectoryIfMissing, doesFileExist, getAppUserDataDirectory, getXdgDirectory)
import System.Exit (exitSuccess)
import System.Environment (lookupEnv)
import System.FilePath ((</>))
import System.IO.Error (isDoesNotExistError, tryIOError)
import System.IO (hPutStrLn, stderr)
import System.Posix.Process (getProcessID)
import System.Posix.Signals (nullSignal, signalProcess)
import System.Posix.Types (ProcessID)
import XMonad hiding (getXMonadDataDir)
-- XXX this is for compatibility with both xmonad<0.17 and xmonad>=0.17
getXMonadDataDir :: IO String
getXMonadDataDir = xmEnvDir <|> xmDir <|> xdgDir
where
-- | Check for xmonad's environment variables first
xmEnvDir :: IO String
xmEnvDir =
maybe empty pure =<< lookupEnv "XMONAD_DATA_DIR"
-- | Check whether the config file or a build script is in the
-- @~\/.xmonad@ directory
xmDir :: IO String
xmDir = do
d <- getAppUserDataDirectory "xmonad"
conf <- doesFileExist $ d </> "xmonad.hs"
build <- doesFileExist $ d </> "build"
pid <- doesFileExist $ d </> "xmonad.pid"
-- Place *everything* in ~/.xmonad if yes
guard $ conf || build || pid
pure d
-- | Use XDG directories as a fallback
xdgDir :: IO String
xdgDir = do
d <- getXdgDirectory XdgData "xmonad"
d <$ createDirectoryIfMissing True d
newShutdownEventHandler :: IO (Event -> X All)
newShutdownEventHandler = do
writeProcessIDToFile
return handleShutdownEvent
handleShutdownEvent :: Event -> X All
handleShutdownEvent = \case
ClientMessageEvent { ev_message_type = mt } -> do
isShutdownEvent <- (mt ==) <$> getAtom "XMONAD_SHUTDOWN"
when isShutdownEvent $ do
broadcastMessage ReleaseResources
writeStateToFile
io exitSuccess >> return ()
return (All (not isShutdownEvent))
_ ->
return (All True)
sendShutdownEvent :: IO ()
sendShutdownEvent = do
dpy <- openDisplay ""
rw <- rootWindow dpy $ defaultScreen dpy
a <- internAtom dpy "XMONAD_SHUTDOWN" False
allocaXEvent $ \e -> do
setEventType e clientMessage
setClientMessageEvent e rw a 32 0 currentTime
sendEvent dpy rw False structureNotifyMask e
sync dpy False
shutdown :: IO ()
shutdown = do
pid <- readProcessIDFromFile
sendShutdownEvent
hPutStrLn stderr ("waiting for: " <> show pid)
result <- tryIOError (waitProcess pid)
if isSuccess result
then hPutStrLn stderr ("result: " <> show result <> " [AKA success^_^]")
else hPutStrLn stderr ("result: " <> show result)
where
isSuccess = either isDoesNotExistError (const False)
waitProcess :: ProcessID -> IO ()
waitProcess pid = forever (signalProcess nullSignal pid >> threadDelay 10000)
--
-- PID file stuff
--
getProcessIDFileName :: IO FilePath
getProcessIDFileName = (</> "xmonad.pid") <$> getXMonadDataDir
writeProcessIDToFile :: IO ()
writeProcessIDToFile = do
pidFileName <- getProcessIDFileName
pid <- getProcessID
writeFile pidFileName (show pid)
readProcessIDFromFile :: IO ProcessID
readProcessIDFromFile = do
pidFileName <- getProcessIDFileName
read <$> readFile pidFileName
|
