71 lines
2.3 KiB
Haskell
71 lines
2.3 KiB
Haskell
import Control.Monad
|
|
|
|
import Data.Maybe
|
|
|
|
import Graphics.XHB
|
|
import Graphics.XHB.Gen.Xproto
|
|
import qualified Graphics.XHB.Connection.Open as CO
|
|
|
|
import System.Exit
|
|
|
|
import Phi.X11.Atoms
|
|
import Phi.X11.Util
|
|
|
|
|
|
{-sYSTEM_TRAY_REQUEST_DOCK :: CInt
|
|
sYSTEM_TRAY_REQUEST_DOCK = 0
|
|
|
|
sYSTEM_TRAY_BEGIN_MESSAGE :: CInt
|
|
sYSTEM_TRAY_BEGIN_MESSAGE = 1
|
|
|
|
sYSTEM_TRAY_CANCEL_MESSAGE :: CInt
|
|
sYSTEM_TRAY_CANCEL_MESSAGE = 2
|
|
|
|
xEMBED_EMBEDDED_NOTIFY :: CInt
|
|
xEMBED_EMBEDDED_NOTIFY = 0-}
|
|
|
|
|
|
main :: IO ()
|
|
main = do
|
|
conn <- liftM fromJust connect
|
|
atoms <- initAtoms conn
|
|
|
|
let dispname = displayInfo conn
|
|
screen = (roots_Setup . connectionSetup $ conn) !! CO.screen dispname
|
|
|
|
xembedWindow <- initSystray conn atoms screen
|
|
|
|
return ()
|
|
|
|
|
|
initSystray :: Connection -> Atoms -> SCREEN -> IO 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."
|
|
exitFailure
|
|
|
|
let rootwin = root_SCREEN screen
|
|
depth = root_depth_SCREEN screen
|
|
visual = root_visual_SCREEN screen
|
|
xembedWin <- newResource conn
|
|
createWindow conn $ MkCreateWindow depth xembedWin rootwin (-1) (-1) 1 1 0 WindowClassInputOutput visual emptyValueParam
|
|
|
|
-- orient horizontally
|
|
changeProperty32 conn PropModeReplace xembedWin (atom_NET_SYSTEM_TRAY_ORIENTATION atoms) (atomCARDINAL atoms) [0]
|
|
|
|
-- set visual
|
|
changeProperty32 conn PropModeReplace xembedWin (atom_NET_SYSTEM_TRAY_VISUAL atoms) (atomVISUALID atoms) [fromIntegral visual]
|
|
|
|
setSelectionOwner conn $ MkSetSelectionOwner xembedWin (atom_NET_SYSTEM_TRAY_SCREEN atoms) 0
|
|
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."
|
|
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
|