Renamed binaries to lowercaseHEADmaster

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 ()