diff options
author | Matthias Schiffer <mschiffer@universe-factory.net> | 2011-10-17 21:16:01 +0200 |
---|---|---|
committer | Matthias Schiffer <mschiffer@universe-factory.net> | 2011-10-17 21:16:01 +0200 |
commit | 3e1ca8091269fcd30a7d89cbe2f9d68d7447b0fc (patch) | |
tree | 59e9e0ea07f945e53034203125f19dcf91a38956 /src | |
parent | 33cd402ae968587d256e11004dac9ed52d1c3cc5 (diff) | |
download | phi-master.tar phi-master.zip |
Diffstat (limited to 'src')
-rw-r--r-- | src/Phi.hs | 6 | ||||
-rw-r--r-- | src/SystrayHelper.hs | 56 |
2 files changed, 49 insertions, 13 deletions
@@ -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>" - , lineSpacing = (-3) - , clockSize = 60 + theClock = clock defaultClockConfig { clockFormat = "<span font='Sans 7'>%R</span>\n<span font='Sans 6'>%a, %b %d</span>" + , 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 () |