summaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/SystrayHelper.hs71
1 files changed, 71 insertions, 0 deletions
diff --git a/src/SystrayHelper.hs b/src/SystrayHelper.hs
new file mode 100644
index 0000000..962d45d
--- /dev/null
+++ b/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