Renamed binaries to lowercase

lib/Phi/X11.hs

@@ -167,12 +167,14 @@ runPhi xconfig config widget = do
     
     forM_ panels $ liftIO . mapWindow conn . panelWindow
     
-    liftIO $ forkIO $ receiveEvents phi conn
+    liftIO $ do
+      forkIO $ receiveEvents phi conn
+      forkIO $ receiveErrors phi conn
     
     forever $ do
       available <- messageAvailable phi
       repaint <- gets phiRepaint
-      when (not available && repaint) $ liftIO $ threadDelay 30000
+      when (not available && repaint) $ liftIO $ threadDelay 20000
       
       available <- messageAvailable phi
       when (not available && repaint) $ do
@@ -311,6 +313,10 @@ receiveEvents :: Phi -> Connection -> IO ()
 receiveEvents phi conn =
   forever $ receiveEvents' conn >>= sendMessages phi
 
+receiveErrors :: Phi -> Connection -> IO ()
+receiveErrors phi conn =
+  forever $ waitForError conn >>= putStrLn . ("XHB error: " ++) . show
+
 updatePanels :: (Widget w s c X11) => PhiX w s c ()
 updatePanels = do
   X11 conn _ screen <- asks phiX11

lib/Phi/X11/AtomList.hs

@@ -48,6 +48,7 @@ atoms = [ "ATOM"
         , "_XEMBED"
         , "_XROOTPMAP_ID"
         , "_XROOTMAP_ID"
+        , "PHI_SYSTRAY_HELPER"
         ]
 
 -- the expression must have the type (ConnectionClass c => c -> String)

phi.cabal

@@ -20,17 +20,17 @@ library
   other-modules:     Phi.X11.AtomList, Phi.Bindings.Cairo, Phi.X11.Atoms, Phi.X11.Util
   include-dirs:      include
   hs-source-dirs:    lib
-  pkgconfig-depends: xcb, cairo >= 1.2.0, cairo-xcb
+  pkgconfig-depends: cairo >= 1.2.0, cairo-xcb
   ghc-options:       -fspec-constr-count=16 -threaded
 
-executable PhiSystrayHelper
+executable phi-systray-helper
-  build-depends:     base >= 4, template-haskell, xhb >= 0.5, xhb-xcb
+  build-depends:     base >= 4, template-haskell, mtl, xhb >= 0.5, xhb-xcb
   hs-source-dirs:    src, lib
   main-is:           SystrayHelper.hs
   other-modules:     Phi.X11.AtomList, Phi.X11.Atoms, Phi.X11.Util
   ghc-options:       -threaded
 
-executable Phi
+executable phi
   build-depends:     base >= 4, phi
   hs-source-dirs:    src
   main-is:           Phi.hs

src/Phi.hs

@@ -48,9 +48,9 @@ main = do
       
       --theSystray = systray
       
-      theClock = clock defaultClockConfig { clockFormat = "<span font='Sans 8'>%R</span>\n<span font='Sans 6'>%a, %b %d</span>"
+      theClock = clock defaultClockConfig { clockFormat = "<span font='Sans 7'>%R</span>\n<span font='Sans 6'>%a, %b %d</span>"
-                                          , lineSpacing = (-3)
+                                          , lineSpacing = (-1)
-                                          , clockSize = 60
+                                          , clockSize = 55
                                           }
       brightBorder :: (Widget w s c d) => w -> Border w s c d
       brightBorder = border normalDesktopBorder

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 :: Word32
-xEMBED_EMBEDDED_NOTIFY = 0-}
+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 ()