blob: 373214e252fcf647b6f5c3ba4ed006a019bbfe3c (
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
|
{-# LANGUAGE LambdaCase #-}
module XMonad.Stockholm.Shutdown
( newShutdownEventHandler
, shutdown
)
where
import Control.Concurrent (threadDelay)
import Control.Monad (forever, when)
import Data.Monoid (All(All))
import System.Exit (exitSuccess)
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
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 :: (Functor m, MonadIO m) => m 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
|
