blob: 962d45d67657797d1824897e30b684265f91fcd7 (
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
|
import Control.Monad
import Data.Maybe
import Graphics.XHB
import Graphics.XHB.Gen.Xproto
import qualified Graphics.XHB.Connection.Open as CO
import System.Exit
import Phi.X11.Atoms
import Phi.X11.Util
{-sYSTEM_TRAY_REQUEST_DOCK :: CInt
sYSTEM_TRAY_REQUEST_DOCK = 0
sYSTEM_TRAY_BEGIN_MESSAGE :: CInt
sYSTEM_TRAY_BEGIN_MESSAGE = 1
sYSTEM_TRAY_CANCEL_MESSAGE :: CInt
sYSTEM_TRAY_CANCEL_MESSAGE = 2
xEMBED_EMBEDDED_NOTIFY :: CInt
xEMBED_EMBEDDED_NOTIFY = 0-}
main :: IO ()
main = do
conn <- liftM fromJust connect
atoms <- initAtoms conn
let dispname = displayInfo conn
screen = (roots_Setup . connectionSetup $ conn) !! CO.screen dispname
xembedWindow <- initSystray conn atoms screen
return ()
initSystray :: Connection -> Atoms -> SCREEN -> IO WINDOW
initSystray conn atoms screen = do
currentSystrayWin <- getSelectionOwner conn (atom_NET_SYSTEM_TRAY_SCREEN atoms) >>= getReply' "initSystray: getSelectionOwner failed"
when (currentSystrayWin /= fromXid xidNone) $ do
putStrLn "PhiSystrayHelper: another systray is running."
exitFailure
let rootwin = root_SCREEN screen
depth = root_depth_SCREEN screen
visual = root_visual_SCREEN screen
xembedWin <- newResource conn
createWindow conn $ MkCreateWindow depth xembedWin rootwin (-1) (-1) 1 1 0 WindowClassInputOutput visual emptyValueParam
-- orient horizontally
changeProperty32 conn PropModeReplace xembedWin (atom_NET_SYSTEM_TRAY_ORIENTATION atoms) (atomCARDINAL atoms) [0]
-- set visual
changeProperty32 conn PropModeReplace xembedWin (atom_NET_SYSTEM_TRAY_VISUAL atoms) (atomVISUALID atoms) [fromIntegral visual]
setSelectionOwner conn $ MkSetSelectionOwner xembedWin (atom_NET_SYSTEM_TRAY_SCREEN atoms) 0
systrayWin <- getSelectionOwner conn (atom_NET_SYSTEM_TRAY_SCREEN atoms) >>= getReply' "initSystray: getSelectionOwner failed"
when (systrayWin /= xembedWin) $ do
destroyWindow conn xembedWin
putStrLn $ "PhiSystrayHelper: can't initialize systray."
exitFailure
sendEvent conn $ MkSendEvent False rootwin [EventMaskStructureNotify] $
serializeClientMessage $ MkClientMessageEvent 32 rootwin (atomMANAGER atoms) $
ClientData32 [0, fromXid . toXid $ atom_NET_SYSTEM_TRAY_SCREEN atoms, fromXid . toXid $ xembedWin, 0, 0]
return xembedWin
|
