diff options
Diffstat (limited to 'lib/Phi/Widgets')
| -rw-r--r-- | lib/Phi/Widgets/Taskbar.hs | 202 |
1 files changed, 191 insertions, 11 deletions
diff --git a/lib/Phi/Widgets/Taskbar.hs b/lib/Phi/Widgets/Taskbar.hs index a32c5d2..aa75258 100644 --- a/lib/Phi/Widgets/Taskbar.hs +++ b/lib/Phi/Widgets/Taskbar.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeFamilies, DeriveDataTypeable #-} module Phi.Widgets.Taskbar ( TaskbarConfig(..) , defaultTaskbarConfig @@ -7,45 +7,225 @@ module Phi.Widgets.Taskbar ( TaskbarConfig(..) import Control.Concurrent import Control.Monad +import Control.Monad.State +import Control.Monad.Trans +import Data.Char +import Data.Maybe import Data.Typeable -import Data.Time.LocalTime -import Data.Time.Format +import qualified Data.Map as M -import Graphics.Rendering.Cairo +import Foreign.C.Types +import Graphics.Rendering.Cairo import Graphics.Rendering.Pango.Cairo import Graphics.Rendering.Pango.Enums (PangoRectangle(..)) import Graphics.Rendering.Pango.Layout -import System.Locale +import Graphics.X11.Xlib (Window) +import qualified Graphics.X11.Xlib as Xlib +import qualified Graphics.X11.Xlib.Extras as XExtras + +import Codec.Binary.UTF8.String import Phi.Phi import Phi.Types +import Phi.Border import Phi.Widget +import Phi.X11.Atoms -data TaskbarConfig = TaskbarConfig deriving Show +data TaskbarConfig = TaskbarConfig { taskMaxSize :: !Int + , showDesktops :: !Bool + , taskBorder :: !BorderConfig + , activeTaskBorder :: !BorderConfig + } deriving Show defaultTaskbarConfig :: TaskbarConfig -defaultTaskbarConfig = TaskbarConfig +defaultTaskbarConfig = TaskbarConfig { taskMaxSize = 150 + , showDesktops = False + , taskBorder = defaultBorderConfig + , activeTaskBorder = defaultBorderConfig { borderColor = (1, 1, 1, 1) } + } data Taskbar = Taskbar TaskbarConfig deriving Show -data TaskbarState = TaskbarState deriving Show +data TaskbarState = TaskbarState { taskbarActiveWindow :: !Window + , taskbarDesktopCount :: !Int + , taskbarWindows :: ![Window] + , taskbarWindowStates :: !(M.Map Window WindowState) + } deriving Show + +data WindowState = WindowState { windowTitle :: !String + , windowDesktop :: !Int + , windowVisible :: !Bool + } deriving (Show, Eq) + +data TaskbarMessage = WindowListUpdate [Xlib.Window] (M.Map Window WindowState) + | DesktopCountUpdate Int + | ActiveWindowUpdate Window + deriving (Show, Typeable) instance WidgetClass Taskbar where type WidgetData Taskbar = TaskbarState initWidget (Taskbar _) phi dispvar = do - return TaskbarState + forkIO $ taskbarRunner phi dispvar + + return $ TaskbarState 0 0 [] M.empty minSize _ = 0 weight _ = 1 - render (Taskbar config) _ w h = do - return () + render (Taskbar config) TaskbarState {taskbarActiveWindow = activeWindow, taskbarDesktopCount = desktopCount, taskbarWindows = windows, taskbarWindowStates = windowStates} w h = do + let desktopWindows = map (\desktop -> (desktop, filter (fromMaybe False . fmap (windowOnDesktop desktop) . flip M.lookup windowStates) windows)) $ take desktopCount [0..] + windowCount = sum $ map (length . snd) $ desktopWindows + when (windowCount /= 0) $ do + let windowWidth = min (taskMaxSize config) (w `div` windowCount) + + forM_ (zip [0..] $ join $ map snd desktopWindows) $ \(i, window) -> do + let border = if window == activeWindow then activeTaskBorder config else taskBorder config + drawBorder border (i*windowWidth) 0 windowWidth h + + handleMessage _ priv m = case (fromMessage m) of + Just (WindowListUpdate windows windowStates) -> priv {taskbarWindows = windows, taskbarWindowStates = windowStates} + Just (DesktopCountUpdate count) -> priv {taskbarDesktopCount = count} + Just (ActiveWindowUpdate window) -> priv {taskbarActiveWindow = window} + _ -> priv + + +windowOnDesktop :: Int -> WindowState -> Bool +windowOnDesktop desktop state = (windowVisible state) && (desktop == windowDesktop state) + + +taskbarRunner :: Phi -> Display -> IO () +taskbarRunner phi dispvar = do + (windows, tasks) <- liftIO $ withDisplay dispvar $ \disp -> do + (windows, tasks) <- getWindowStates disp (getAtoms dispvar) [] M.empty + desktopCount <- getDesktopCount disp (getAtoms dispvar) + activeWindow <- getActiveWindow disp (getAtoms dispvar) + sendMessage phi $ WindowListUpdate windows tasks + sendMessage phi $ DesktopCountUpdate desktopCount + sendMessage phi $ ActiveWindowUpdate activeWindow + return (windows, tasks) + sendMessage phi Repaint + + flip evalStateT (windows, tasks) $ forever $ do + m <- receiveMessage phi + case (fromMessage m) of + Just event@XExtras.PropertyEvent {} -> + handlePropertyUpdate phi dispvar event + _ -> + return () + +handlePropertyUpdate :: Phi -> Display -> XExtras.Event -> StateT ([Window], M.Map Window WindowState) IO () +handlePropertyUpdate phi dispvar XExtras.PropertyEvent {XExtras.ev_atom = atom, XExtras.ev_window = window} = do + let atoms = getAtoms dispvar + + when (elem atom $ map ($ atoms) [ atom_NET_ACTIVE_WINDOW + , atom_NET_NUMBER_OF_DESKTOPS + , atom_NET_CLIENT_LIST + , atom_NET_WM_NAME + , atomWM_NAME + , atom_NET_WM_DESKTOP + , atom_NET_WM_STATE + ]) $ withDisplay dispvar $ \disp -> do + let rootwin = Xlib.defaultRootWindow disp + if (window == rootwin) + then do + when (atom == atom_NET_ACTIVE_WINDOW atoms) $ do + activeWindow <- liftIO $ getActiveWindow disp atoms + sendMessage phi $ ActiveWindowUpdate activeWindow + sendMessage phi Repaint + when (atom == atom_NET_NUMBER_OF_DESKTOPS atoms) $ do + desktopCount <- liftIO $ getDesktopCount disp atoms + sendMessage phi $ DesktopCountUpdate desktopCount + sendMessage phi Repaint + when (atom == atom_NET_CLIENT_LIST atoms) $ do + (windows, windowStates) <- get + (windows', windowStates') <- liftIO $ getWindowStates disp atoms windows windowStates + + when (windows /= windows' || windowStates /= windowStates') $ do + sendMessage phi $ WindowListUpdate windows' windowStates' + sendMessage phi Repaint + put (windows', windowStates') + + else do + (windows, windowStates) <- get + when (elem window windows) $ do + let windowState = M.lookup window windowStates + windowState' <- liftIO $ getWindowState disp atoms window + + when (windowState /= (Just windowState')) $ do + let windowStates' = M.insert window windowState' windowStates + sendMessage phi $ WindowListUpdate windows windowStates' + sendMessage phi Repaint + put (windows, windowStates') + +getDesktopCount :: Xlib.Display -> Atoms -> IO Int +getDesktopCount disp atoms = + liftM (fromIntegral . fromMaybe 0 . join . fmap listToMaybe) $ XExtras.getWindowProperty32 disp (atom_NET_NUMBER_OF_DESKTOPS atoms) $ Xlib.defaultRootWindow disp + +getActiveWindow :: Xlib.Display -> Atoms -> IO Window +getActiveWindow disp atoms = + liftM (fromIntegral . fromMaybe 0 . join . fmap listToMaybe) $ XExtras.getWindowProperty32 disp (atom_NET_ACTIVE_WINDOW atoms) $ Xlib.defaultRootWindow disp + +getWindowStates :: Xlib.Display -> Atoms -> [Window] -> M.Map Window WindowState -> IO ([Window], M.Map Window WindowState) +getWindowStates disp atoms oldWindows windowStates = do + windows <- getWindowList disp atoms oldWindows + + let windowStates' = map (\w -> (w, M.lookup w windowStates)) windows + + newWindowStates <- mapM getWindowState' windowStates' + + return (windows, M.fromList newWindowStates) + where + rootwin = Xlib.defaultRootWindow disp + + getWindowState' (window, Just windowState) = return (window, windowState) + getWindowState' (window, Nothing) = do + windowState <- getWindowState disp atoms window + return (window, windowState) + +getWindowState :: Xlib.Display -> Atoms -> Window -> IO WindowState +getWindowState disp atoms window = do + Xlib.selectInput disp window Xlib.propertyChangeMask + 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 + + workspace <- liftM (fromIntegral . fromMaybe 0xFFFFFFFF . join . fmap listToMaybe) $ XExtras.getWindowProperty32 disp (atom_NET_WM_DESKTOP atoms) window + + visible <- showWindow disp atoms window + + return $ WindowState wmname workspace visible + where + unsignedChr = chr . fromIntegral . (fromIntegral :: (CChar -> CUChar)) + +showWindow :: Xlib.Display -> Atoms -> Window -> IO Bool +showWindow disp atoms window = do + states <- liftM (map fromIntegral . fromMaybe []) $ XExtras.getWindowProperty32 disp (atom_NET_WM_STATE atoms) window + transientForHint <- XExtras.getTransientForHint disp window + windowType <- liftM (fromMaybe (atom_NET_WM_WINDOW_TYPE_NORMAL atoms) . fmap fromIntegral . join . fmap listToMaybe) $ XExtras.getWindowProperty32 disp (atom_NET_WM_STATE atoms) window + + return $ not $ or [ elem (atom_NET_WM_STATE_SKIP_TASKBAR atoms) states + , transientForHint /= Nothing + , elem windowType $ map ($ atoms) [ atom_NET_WM_WINDOW_TYPE_DOCK + , atom_NET_WM_WINDOW_TYPE_DESKTOP + , atom_NET_WM_WINDOW_TYPE_TOOLBAR + , atom_NET_WM_WINDOW_TYPE_MENU + , atom_NET_WM_WINDOW_TYPE_SPLASH + ] + ] + + +getWindowList :: Xlib.Display -> Atoms -> [Window] -> IO [Window] +getWindowList disp atoms windows = do + newWindows <- liftM (map fromIntegral . join . maybeToList) $ XExtras.getWindowProperty32 disp (atom_NET_CLIENT_LIST atoms) $ Xlib.defaultRootWindow disp + return $ (filter (flip elem newWindows) windows) ++ (filter (not . flip elem windows) newWindows) + taskbar :: TaskbarConfig -> Widget taskbar config = do |