summaryrefslogtreecommitdiffstats
path: root/src/SystrayHelper.hs
diff options
context:
space:
mode:
authorMatthias Schiffer <mschiffer@universe-factory.net>2011-10-17 21:16:01 +0200
committerMatthias Schiffer <mschiffer@universe-factory.net>2011-10-17 21:16:01 +0200
commit3e1ca8091269fcd30a7d89cbe2f9d68d7447b0fc (patch)
tree59e9e0ea07f945e53034203125f19dcf91a38956 /src/SystrayHelper.hs
parent33cd402ae968587d256e11004dac9ed52d1c3cc5 (diff)
downloadphi-master.tar
phi-master.zip
Renamed binaries to lowercaseHEADmaster
Diffstat (limited to 'src/SystrayHelper.hs')
-rw-r--r--src/SystrayHelper.hs56
1 files changed, 46 insertions, 10 deletions
diff --git a/src/SystrayHelper.hs b/src/SystrayHelper.hs
index 02d97df..f39176f 100644
--- a/src/SystrayHelper.hs
+++ b/src/SystrayHelper.hs
@@ -1,5 +1,8 @@
+import Control.Concurrent
import Control.Monad
+import Control.Monad.State.Strict
+import Data.Word
import Data.Maybe
import Graphics.XHB
@@ -12,38 +15,55 @@ import Phi.X11.Atoms
import Phi.X11.Util
-{-sYSTEM_TRAY_REQUEST_DOCK :: CInt
+sYSTEM_TRAY_REQUEST_DOCK :: Word32
sYSTEM_TRAY_REQUEST_DOCK = 0
-sYSTEM_TRAY_BEGIN_MESSAGE :: CInt
+sYSTEM_TRAY_BEGIN_MESSAGE :: Word32
sYSTEM_TRAY_BEGIN_MESSAGE = 1
-sYSTEM_TRAY_CANCEL_MESSAGE :: CInt
+sYSTEM_TRAY_CANCEL_MESSAGE :: Word32
sYSTEM_TRAY_CANCEL_MESSAGE = 2
-xEMBED_EMBEDDED_NOTIFY :: CInt
-xEMBED_EMBEDDED_NOTIFY = 0-}
+xEMBED_EMBEDDED_NOTIFY :: Word32
+xEMBED_EMBEDDED_NOTIFY = 0
+
+
+data SystrayState = SystrayState
+ { systrayIcons :: [(WINDOW, WINDOW)]
+ }
main :: IO ()
main = do
conn <- liftM fromJust connect
+ forkIO $ receiveErrors conn
+
atoms <- initAtoms conn
let screen = (roots_Setup . connectionSetup $ conn) !! connectionScreen conn
- xembedWindow <- initSystray conn atoms screen
+ (xembedWin, systrayWin) <- initSystray conn atoms screen
+
+ execStateT (runSystray xembedWin systrayWin) $ SystrayState []
return ()
+receiveErrors :: Connection -> IO ()
+receiveErrors conn =
+ forever $ waitForError conn >>= putStrLn . ("XHB error: " ++) . show
-initSystray :: Connection -> Atoms -> SCREEN -> IO WINDOW
+initSystray :: Connection -> Atoms -> SCREEN -> IO (WINDOW, 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."
+ putStrLn "phi-systray-helper: another systray is running."
exitFailure
+ currentSystrayHelperWin <- getSelectionOwner conn (atomPHI_SYSTRAY_HELPER atoms) >>= getReply' "initSystray: getSelectionOwner failed"
+ when (currentSystrayHelperWin /= fromXid xidNone) $ do
+ putStrLn "phi-systray-helper: another systray helper is running."
+ exitFailure
+
let rootwin = root_SCREEN screen
depth = root_depth_SCREEN screen
visual = root_visual_SCREEN screen
@@ -60,11 +80,27 @@ initSystray conn atoms screen = do
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."
+ putStrLn $ "phi-systray-helper: can't initialize systray."
exitFailure
+ systrayWin <- newResource conn
+ createWindow conn $ MkCreateWindow depth systrayWin rootwin (-1) (-1) 1 1 0 WindowClassInputOutput visual emptyValueParam
+
+ setSelectionOwner conn $ MkSetSelectionOwner systrayWin (atomPHI_SYSTRAY_HELPER atoms) 0
+ systrayHelperWin <- getSelectionOwner conn (atomPHI_SYSTRAY_HELPER atoms) >>= getReply' "initSystray: getSelectionOwner failed"
+ when (systrayHelperWin /= systrayWin) $ do
+ destroyWindow conn systrayHelperWin
+ destroyWindow conn xembedWin
+ putStrLn $ "phi-systray-helper: can't initialize systray helper."
+ 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
+ return (xembedWin, systrayWin)
+
+
+runSystray :: WINDOW -> WINDOW -> StateT SystrayState IO ()
+runSystray xembedWin systrayWin = do
+ return ()