blob: 44fe4f9f7e56a3bcf3197ac0379e0b6f193af070 (
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
|
{-# LANGUAGE DeriveDataTypeable, CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module : Signal
-- Copyright : (c) Andrea Rosatto
-- : (c) Jose A. Ortega Ruiz
-- : (c) Jochen Keil
-- License : BSD-style (see LICENSE)
--
-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>
-- Stability : unstable
-- Portability : unportable
--
-- Signal handling, including DBUS when available
--
-----------------------------------------------------------------------------
module Signal where
import Data.Typeable (Typeable)
import Control.Concurrent.STM
import Control.Exception hiding (handle)
import System.Posix.Signals
#ifdef DBUS
import DBus (IsVariant(..))
import Control.Monad ((>=>))
#endif
import Plugins.Utils (safeHead)
data WakeUp = WakeUp deriving (Show,Typeable)
instance Exception WakeUp
data SignalType = Wakeup
| Reposition
| ChangeScreen
| Hide
| Reveal
| Toggle
| TogglePersistent
deriving (Read, Show)
#ifdef DBUS
instance IsVariant SignalType where
toVariant = toVariant . show
fromVariant = fromVariant >=> parseSignalType
#endif
parseSignalType :: String -> Maybe SignalType
parseSignalType = fmap fst . safeHead . reads
-- | Signal handling
setupSignalHandler :: IO (TMVar SignalType)
setupSignalHandler = do
tid <- newEmptyTMVarIO
installHandler sigUSR2 (Catch $ updatePosHandler tid) Nothing
installHandler sigUSR1 (Catch $ changeScreenHandler tid) Nothing
return tid
updatePosHandler :: TMVar SignalType -> IO ()
updatePosHandler sig = do
atomically $ putTMVar sig Reposition
return ()
changeScreenHandler :: TMVar SignalType -> IO ()
changeScreenHandler sig = do
atomically $ putTMVar sig ChangeScreen
return ()
|
