diff options
Diffstat (limited to 'lib/Phi/Widgets')
| -rw-r--r-- | lib/Phi/Widgets/Clock.hs | 2 | ||||
| -rw-r--r-- | lib/Phi/Widgets/Systray.hs | 137 | ||||
| -rw-r--r-- | lib/Phi/Widgets/Taskbar.hs | 27 |
3 files changed, 151 insertions, 15 deletions
diff --git a/lib/Phi/Widgets/Clock.hs b/lib/Phi/Widgets/Clock.hs index 7172f77..492d807 100644 --- a/lib/Phi/Widgets/Clock.hs +++ b/lib/Phi/Widgets/Clock.hs @@ -55,7 +55,7 @@ instance WidgetClass Clock where return $ ClockState time - minSize (Clock config ) = clockSize config + minSize (Clock config) _ _ = clockSize config render (Clock config) (ClockState time) w h _ = do time <- liftIO getZonedTime diff --git a/lib/Phi/Widgets/Systray.hs b/lib/Phi/Widgets/Systray.hs new file mode 100644 index 0000000..26ff0a4 --- /dev/null +++ b/lib/Phi/Widgets/Systray.hs @@ -0,0 +1,137 @@ +{-# LANGUAGE TypeFamilies, DeriveDataTypeable #-} + +module Phi.Widgets.Systray ( systray + ) where + +import Control.Concurrent +import Control.Monad + +import Data.Maybe + +import Foreign.C.Types + +import Graphics.X11.Xlib hiding (Display) +import qualified Graphics.X11.Xlib as Xlib +import Graphics.X11.Xlib.Extras + +import Phi.Bindings.Util + +import Phi.Phi +import Phi.Types +import Phi.Widget +import Phi.X11.Atoms + + +data SystrayIconState = SystrayIconState deriving Show + +data SystrayState = SystrayState [SystrayIconState] deriving Show + +data Systray = Systray deriving Show + + +instance WidgetClass Systray where + type WidgetData Systray = SystrayState + + initWidget (Systray) phi dispvar = do + forkIO $ systrayRunner phi dispvar + + return $ SystrayState [] + + minSize _ (SystrayState icons) height = (length icons)*height + weight _ = 0 + + render Systray (SystrayState icons) w h screen = do + return () + + +systrayRunner :: Phi -> Display -> IO () +systrayRunner phi dispvar = do + let atoms = getAtoms dispvar + initSuccess <- withDisplay dispvar $ flip initSystray atoms + + case initSuccess of + Just xembedWindow -> forever $ do + m <- receiveMessage phi + case (fromMessage m) of + Just event -> + handleEvent event phi dispvar xembedWindow + _ -> + return () + Nothing -> + return () + + +initSystray :: Xlib.Display -> Atoms -> IO (Maybe Window) +initSystray disp atoms = do + currentSystrayWin <- xGetSelectionOwner disp $ atom_NET_SYSTEM_TRAY_SCREEN atoms + + if currentSystrayWin /= 0 then do + pid <- liftM (fromMaybe "" . fmap (\pid -> " (pid" ++ show (fromIntegral pid :: CUShort) ++ ")") . join . fmap listToMaybe) $ + getWindowProperty16 disp (atom_NET_WM_PID atoms) currentSystrayWin + + putStrLn $ "Phi: another systray is running." ++ pid + + return Nothing + else do + xembedWin <- createSimpleWindow disp (defaultRootWindow disp) (-1) (-1) 1 1 0 0 0 + + -- orient horizontally + changeProperty32 disp xembedWin (atom_NET_SYSTEM_TRAY_ORIENTATION atoms) cARDINAL propModeReplace [0] + + -- set visual + let rootwin = defaultRootWindow disp + screen = defaultScreen disp + visual = defaultVisual disp screen + visualID = visualIDFromVisual visual + changeProperty32 disp xembedWin (atom_NET_SYSTEM_TRAY_VISUAL atoms) vISUALID propModeReplace [fromIntegral visualID] + + xSetSelectionOwner disp (atom_NET_SYSTEM_TRAY_SCREEN atoms) xembedWin currentTime + systrayWin <- xGetSelectionOwner disp $ atom_NET_SYSTEM_TRAY_SCREEN atoms + if systrayWin /= xembedWin then do + destroyWindow disp xembedWin + putStrLn $ "Phi: can't initialize systray." + return Nothing + + else do + allocaXEvent $ \event -> do + putClientMessage event rootwin (atomMANAGER atoms) [fromIntegral currentTime, fromIntegral (atom_NET_SYSTEM_TRAY_SCREEN atoms), fromIntegral xembedWin, 0, 0] + sendEvent disp rootwin False structureNotifyMask event + + return $ Just xembedWin + + +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 + + +handleEvent :: Event -> Phi -> Display -> Window -> IO () +handleEvent ClientMessageEvent { ev_message_type = message_type, ev_data = messageData, ev_window = window } phi dispvar xembedWindow = do + let atoms = getAtoms dispvar + when (window == xembedWindow && message_type == atom_NET_SYSTEM_TRAY_OPCODE atoms) $ do + case messageData of + (_:opcode:iconID:_) -> do + case True of + _ | opcode == sYSTEM_TRAY_REQUEST_DOCK -> do + return () + + | opcode == sYSTEM_TRAY_BEGIN_MESSAGE || opcode == sYSTEM_TRAY_CANCEL_MESSAGE -> do + return () + + | otherwise -> do + return () + + + _ -> + return () + + +handleEvent _ _ _ _ = return () + +systray :: Widget +systray = Widget $ Systray diff --git a/lib/Phi/Widgets/Taskbar.hs b/lib/Phi/Widgets/Taskbar.hs index caa7599..bd45add 100644 --- a/lib/Phi/Widgets/Taskbar.hs +++ b/lib/Phi/Widgets/Taskbar.hs @@ -121,8 +121,8 @@ data TaskbarState = TaskbarState { taskbarActiveWindow :: !Window , taskbarCurrentDesktop :: !Int , taskbarWindows :: ![Window] , taskbarWindowStates :: !(M.Map Window WindowState) - , taskbarWindowIcons :: !(M.Map Window [(Int, Surface)]) - , taskbarWindowScreens :: !(M.Map Window Xlib.Rectangle) + , taskbarWindowIcons :: !(M.Map Window [(Int, Surface)]) + , taskbarWindowScreens :: !(M.Map Window Xlib.Rectangle) } deriving Show data WindowState = WindowState { windowTitle :: !String @@ -145,7 +145,7 @@ instance WidgetClass Taskbar where return $ TaskbarState 0 0 (-1) [] M.empty M.empty M.empty - minSize _ = 0 + minSize _ _ _ = 0 weight _ = 1 render (Taskbar config) TaskbarState { taskbarActiveWindow = activeWindow @@ -294,15 +294,14 @@ handleEvent phi dispvar XExtras.PropertyEvent {XExtras.ev_atom = atom, XExtras.e let atoms = getAtoms dispvar let screens = getScreens dispvar - when (elem atom $ map ($ atoms) [ atom_NET_ACTIVE_WINDOW - , atom_NET_NUMBER_OF_DESKTOPS - , atom_NET_CURRENT_DESKTOP - , atom_NET_CLIENT_LIST - , atom_NET_WM_ICON - , atom_NET_WM_NAME - , atomWM_NAME - , atom_NET_WM_DESKTOP - , atom_NET_WM_STATE + when (elem atom $ Xlib.wM_NAME : map ($ atoms) [ atom_NET_ACTIVE_WINDOW + , atom_NET_NUMBER_OF_DESKTOPS + , atom_NET_CURRENT_DESKTOP + , atom_NET_CLIENT_LIST + , atom_NET_WM_ICON + , atom_NET_WM_NAME + , atom_NET_WM_DESKTOP + , atom_NET_WM_STATE ]) $ withDisplay dispvar $ \disp -> do let rootwin = Xlib.defaultRootWindow disp if (window == rootwin) @@ -414,7 +413,7 @@ getWindowState disp atoms window = do netwmname <- liftM (fmap (decode . map fromIntegral)) $ XExtras.getWindowProperty8 disp (atom_NET_WM_NAME atoms) window wmname <- case netwmname of Just name -> return name - Nothing -> liftM (map unsignedChr . fromMaybe []) $ XExtras.getWindowProperty8 disp (atomWM_NAME atoms) window + Nothing -> liftM (map unsignedChr . fromMaybe []) $ XExtras.getWindowProperty8 disp Xlib.wM_NAME window workspace <- liftM (fromIntegral . fromMaybe 0xFFFFFFFF . join . fmap listToMaybe) $ XExtras.getWindowProperty32 disp (atom_NET_WM_DESKTOP atoms) window @@ -434,7 +433,7 @@ readIcons (width:height:iconData) = do let (thisIcon, rest) = splitAt (fromIntegral (width*height)) iconData icon <- createImageSurface FormatARGB32 (fromIntegral width) (fromIntegral height) surfaceData <- imageSurfaceGetPixels icon :: IO (SurfaceData Int Word32) - forM_ (zip thisIcon [1..]) $ \(e, i) -> writeArray surfaceData i $ premultiply $ fromIntegral e + forM_ (zip thisIcon [0..]) $ \(e, i) -> writeArray surfaceData i $ premultiply $ fromIntegral e surfaceMarkDirty icon |