summaryrefslogtreecommitdiffstats
path: root/lib/Phi/Widgets/Taskbar.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Phi/Widgets/Taskbar.hs')
-rw-r--r--lib/Phi/Widgets/Taskbar.hs71
1 files changed, 33 insertions, 38 deletions
diff --git a/lib/Phi/Widgets/Taskbar.hs b/lib/Phi/Widgets/Taskbar.hs
index da68c27..31d85ff 100644
--- a/lib/Phi/Widgets/Taskbar.hs
+++ b/lib/Phi/Widgets/Taskbar.hs
@@ -137,7 +137,8 @@ defaultTaskbarConfig = TaskbarConfig { taskMaxSize = 200
data Taskbar = Taskbar TaskbarConfig
-data TaskbarState = TaskbarState { taskbarActiveWindow :: !Window
+data TaskbarState = TaskbarState { taskbarScreens :: ![Xlib.Rectangle]
+ , taskbarActiveWindow :: !Window
, taskbarDesktopCount :: !Int
, taskbarCurrentDesktop :: !Int
, taskbarWindows :: ![Window]
@@ -154,11 +155,11 @@ createIcon size surface = do
return $ Icon id size surface
-data WindowState = WindowState { windowTitle :: !String
- , windowDesktop :: !Int
- , windowVisible :: !Bool
- , windowIcons :: ![Icon]
- , windowScreen :: !Xlib.Rectangle
+data WindowState = WindowState { windowTitle :: !String
+ , windowDesktop :: !Int
+ , windowVisible :: !Bool
+ , windowIcons :: ![Icon]
+ , windowGeometry :: !Xlib.Rectangle
} deriving (Eq, Show)
data WindowCache = WindowCache { createScaledIconCached :: !(IOCache ([Icon], Int) (Maybe Icon))
@@ -205,24 +206,26 @@ data TaskbarMessage = WindowListUpdate ![Xlib.Window] !(M.Map Window WindowState
deriving (Typeable, Show)
instance Widget Taskbar TaskbarState (M.Map Window WindowCache) where
- initWidget (Taskbar _) phi dispvar = do
+ initWidget (Taskbar _) phi dispvar screens = do
phi' <- dupPhi phi
forkIO $ taskbarRunner phi' dispvar
- return $ TaskbarState 0 0 (-1) [] M.empty
+ return $ TaskbarState (map fst screens) 0 0 (-1) [] M.empty
initCache _ = M.empty
minSize _ _ _ _ = 0
weight _ = 1
- render (Taskbar config) TaskbarState { taskbarActiveWindow = activeWindow
+ render (Taskbar config) TaskbarState { taskbarScreens = screens
+ , taskbarActiveWindow = activeWindow
, taskbarDesktopCount = desktopCount
, taskbarCurrentDesktop = currentDesktop
, taskbarWindows = windows
, taskbarWindowStates = windowStates
} _ _ w h screen = do
- let screenWindows = filter ((== Just screen) . fmap windowScreen . flip M.lookup windowStates) windows
+ let windowScreen w = maximumBy (compare `on` unionArea (windowGeometry w)) screens
+ screenWindows = filter ((== Just screen) . fmap windowScreen . flip M.lookup windowStates) windows
desktopNumbers = take desktopCount [0..]
desktops = map (\desktop -> (desktop, filter (fromMaybe False . fmap (windowOnDesktop desktop) . flip M.lookup windowStates) screenWindows)) desktopNumbers
@@ -301,7 +304,9 @@ instance Widget Taskbar TaskbarState (M.Map Window WindowCache) where
Just (DesktopCountUpdate count) -> priv {taskbarDesktopCount = count}
Just (CurrentDesktopUpdate current) -> priv {taskbarCurrentDesktop = current}
Just (ActiveWindowUpdate window) -> priv {taskbarActiveWindow = window}
- _ -> priv
+ _ -> case (fromMessage m) of
+ Just (UpdateScreens screens) -> priv {taskbarScreens = map fst screens}
+ _ -> priv
renderText :: String -> Int -> Int -> Int -> Int -> String -> Render ()
@@ -390,9 +395,8 @@ windowOnDesktop desktop state = (windowVisible state) && (desktop == windowDeskt
taskbarRunner :: Phi -> Display -> IO ()
taskbarRunner phi dispvar = do
- let screens = getScreens dispvar
(windows, states) <- liftIO $ withDisplay dispvar $ \disp -> do
- (windows, states) <- getWindowStates disp screens (getAtoms dispvar) M.empty
+ (windows, states) <- getWindowStates disp (getAtoms dispvar) M.empty
desktopCount <- getDesktopCount disp (getAtoms dispvar)
current <- getCurrentDesktop disp (getAtoms dispvar)
activeWindow <- getActiveWindow disp (getAtoms dispvar)
@@ -406,7 +410,7 @@ taskbarRunner phi dispvar = do
flip evalStateT (windows, states) $ forever $ do
m <- receiveMessage phi
case (fromMessage m) of
- Just event ->
+ Just event ->
handleEvent phi dispvar event
_ ->
return ()
@@ -414,7 +418,6 @@ taskbarRunner phi dispvar = do
handleEvent :: Phi -> Display -> XExtras.Event -> StateT ([Window], M.Map Window WindowState) IO ()
handleEvent phi dispvar XExtras.PropertyEvent {XExtras.ev_atom = atom, XExtras.ev_window = window} = do
let atoms = getAtoms dispvar
- let screens = getScreens dispvar
when (elem atom $ Xlib.wM_NAME : map ($ atoms) [ atom_NET_ACTIVE_WINDOW
, atom_NET_NUMBER_OF_DESKTOPS
@@ -442,7 +445,7 @@ handleEvent phi dispvar XExtras.PropertyEvent {XExtras.ev_atom = atom, XExtras.e
sendMessage phi Repaint
when (atom == atom_NET_CLIENT_LIST atoms) $ do
(windows, windowStates) <- get
- (windows', windowStates') <- liftIO $ getWindowStates disp screens atoms windowStates
+ (windows', windowStates') <- liftIO $ getWindowStates disp atoms windowStates
when (windows /= windows') $ do
sendMessage phi $ WindowListUpdate windows' windowStates'
@@ -476,14 +479,12 @@ handleEvent phi dispvar XExtras.PropertyEvent {XExtras.ev_atom = atom, XExtras.e
return ()
handleEvent phi dispvar XExtras.ConfigureEvent {XExtras.ev_window = window} = do
- let screens = getScreens dispvar
-
(windows, windowStates) <- get
when (elem window windows) $ withDisplay dispvar $ \disp -> do
- let screen = fmap windowScreen . M.lookup window $ windowStates
- screen' <- liftIO $ getWindowScreen disp screens window
- when (screen /= (Just screen')) $ do
- let windowStates' = M.update (\state -> Just state {windowScreen = screen'}) window windowStates
+ let geom = fmap windowGeometry . M.lookup window $ windowStates
+ geom' <- liftIO $ getWindowGeometry disp window
+ when (geom /= (Just geom')) $ do
+ let windowStates' = M.update (\state -> Just state {windowGeometry = geom'}) window windowStates
sendMessage phi $ WindowListUpdate windows windowStates'
sendMessage phi Repaint
put (windows, windowStates')
@@ -504,8 +505,8 @@ 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 -> [Xlib.Rectangle] -> Atoms -> M.Map Window WindowState -> IO ([Window], M.Map Window WindowState)
-getWindowStates disp screens atoms windowStates = do
+getWindowStates :: Xlib.Display -> Atoms -> M.Map Window WindowState -> IO ([Window], M.Map Window WindowState)
+getWindowStates disp atoms windowStates = do
windows <- getWindowList disp atoms
let windowStates' = map (\w -> (w, M.lookup w windowStates)) windows
@@ -517,20 +518,20 @@ getWindowStates disp screens atoms windowStates = do
getWindowState' (window, Just windowState) = return (window, windowState)
getWindowState' (window, Nothing) = do
Xlib.selectInput disp window $ Xlib.propertyChangeMask .|. Xlib.structureNotifyMask
- windowState <- getWindowState disp screens atoms window
+ windowState <- getWindowState disp atoms window
return (window, windowState)
-getWindowState :: Xlib.Display -> [Xlib.Rectangle] -> Atoms -> Window -> IO WindowState
-getWindowState disp screens atoms window = do
+getWindowState :: Xlib.Display -> Atoms -> Window -> IO WindowState
+getWindowState disp atoms window = do
(name, workspace, visible) <- getWindowInfo disp atoms window
icons <- getWindowIcons disp atoms window
- screen <- getWindowScreen disp screens window
+ geom <- getWindowGeometry disp window
return $ WindowState { windowTitle = name
, windowDesktop = workspace
, windowVisible = visible
, windowIcons = icons
- , windowScreen = screen
+ , windowGeometry = geom
}
getWindowInfo :: Xlib.Display -> Atoms -> Window -> IO (String, Int, Bool)
@@ -581,18 +582,12 @@ premultiply c = a .|. r .|. g .|. b
b = pm bmask
-getWindowScreen :: Xlib.Display -> [Xlib.Rectangle] -> Window -> IO Xlib.Rectangle
-getWindowScreen disp screens window = flip catch (\_ -> return $ head screens) $ do
+getWindowGeometry :: Xlib.Display -> Window -> IO Xlib.Rectangle
+getWindowGeometry disp window = flip catch (\_ -> return $ Xlib.Rectangle 0 0 0 0) $ do
(_, _, _, width, height, _, _) <- Xlib.getGeometry disp window
(ret, x, y, _) <- Xlib.translateCoordinates disp window (Xlib.defaultRootWindow disp) 0 0
- case ret of
- True -> do
- let windowRect = Xlib.Rectangle x y width height
- screen = maximumBy (compare `on` unionArea windowRect) screens
- return screen
- False ->
- return $ head screens
+ return $ if ret then Xlib.Rectangle x y width height else Xlib.Rectangle 0 0 0 0
showWindow :: Xlib.Display -> Atoms -> Window -> IO Bool
generated by cgit v1.2.3 (git 2.25.1) at 2024-05-02 22:37:02 +0200