summaryrefslogtreecommitdiffstats
path: root/lib/Phi/Widgets
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Phi/Widgets')
-rw-r--r--lib/Phi/Widgets/Taskbar.hs202
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