SystrayHelper: initialization

src/SystrayHelper.hs

@@ -0,0 +1,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