From 3e1ca8091269fcd30a7d89cbe2f9d68d7447b0fc Mon Sep 17 00:00:00 2001 From: Matthias Schiffer Date: Mon, 17 Oct 2011 21:16:01 +0200 Subject: Renamed binaries to lowercase --- lib/Phi/X11.hs | 10 +++++++-- lib/Phi/X11/AtomList.hs | 1 + phi.cabal | 8 +++---- src/Phi.hs | 6 +++--- src/SystrayHelper.hs | 56 ++++++++++++++++++++++++++++++++++++++++--------- 5 files changed, 62 insertions(+), 19 deletions(-) diff --git a/lib/Phi/X11.hs b/lib/Phi/X11.hs index af4cb0b..7a673c3 100644 --- a/lib/Phi/X11.hs +++ b/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 diff --git a/lib/Phi/X11/AtomList.hs b/lib/Phi/X11/AtomList.hs index cad753a..bc91efa 100644 --- a/lib/Phi/X11/AtomList.hs +++ b/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) diff --git a/phi.cabal b/phi.cabal index 5100bda..2938ee6 100644 --- a/phi.cabal +++ b/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 - build-depends: base >= 4, template-haskell, xhb >= 0.5, xhb-xcb +executable phi-systray-helper + 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 diff --git a/src/Phi.hs b/src/Phi.hs index e20ef97..3f476f8 100644 --- a/src/Phi.hs +++ b/src/Phi.hs @@ -48,9 +48,9 @@ main = do --theSystray = systray - theClock = clock defaultClockConfig { clockFormat = "%R\n%a, %b %d" - , lineSpacing = (-3) - , clockSize = 60 + theClock = clock defaultClockConfig { clockFormat = "%R\n%a, %b %d" + , lineSpacing = (-1) + , clockSize = 55 } brightBorder :: (Widget w s c d) => w -> Border w s c d brightBorder = border normalDesktopBorder 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 () -- cgit v1.2.3