From b2b35e632a354fc0ffb944553adffbb58ad1e006 Mon Sep 17 00:00:00 2001 From: Matthias Schiffer Date: Sat, 16 Jul 2011 10:46:26 +0200 Subject: Allow showing desktop numbers in taskbar --- lib/Phi/Widgets/Taskbar.hs | 153 ++++++++++++++++++++++++++++++--------------- lib/Phi/X11/AtomList.hs | 1 + src/Phi.hs | 21 ++++++- 3 files changed, 125 insertions(+), 50 deletions(-) diff --git a/lib/Phi/Widgets/Taskbar.hs b/lib/Phi/Widgets/Taskbar.hs index 4f85e71..4377224 100644 --- a/lib/Phi/Widgets/Taskbar.hs +++ b/lib/Phi/Widgets/Taskbar.hs @@ -4,6 +4,7 @@ module Phi.Widgets.Taskbar ( IconStyle , idIconStyle , desaturateIconStyle , TaskStyle(..) + , DesktopStyle(..) , TaskbarConfig(..) , defaultTaskbarConfig , taskbar @@ -47,7 +48,7 @@ import Phi.X11.Atoms type IconStyle = Surface -> Render () instance Show IconStyle where - show _ = "IconStyle" + show _ = "IconStyle " idIconStyle :: IconStyle idIconStyle = flip withPatternForSurface setSource @@ -83,24 +84,31 @@ data TaskStyle = TaskStyle { taskFont :: !String , taskIconStyle :: !IconStyle } deriving Show +data DesktopStyle = DesktopStyle { desktopFont :: !String + , desktopLabelWidth :: !Int + , desktopLabelGap :: !Int + , desktopColor :: !Color + , desktopBorder :: !BorderConfig + } deriving Show + data TaskbarConfig = TaskbarConfig { taskMaxSize :: !Int - , showDesktops :: !Bool , normalTaskStyle :: !TaskStyle , activeTaskStyle :: !TaskStyle + , desktopStyle :: !(Maybe (DesktopStyle, DesktopStyle)) } deriving Show defaultStyle :: TaskStyle defaultStyle = TaskStyle { taskFont = "Sans 8" , taskColor = (0, 0, 0, 1) - , taskBorder = defaultBorderConfig + , taskBorder = defaultBorderConfig { backgroundColor = (0.75, 0.75, 0.75, 1) } , taskIconStyle = idIconStyle } defaultTaskbarConfig :: TaskbarConfig defaultTaskbarConfig = TaskbarConfig { taskMaxSize = 150 - , showDesktops = False , normalTaskStyle = defaultStyle , activeTaskStyle = defaultStyle {taskBorder = defaultBorderConfig { borderColor = (1, 1, 1, 1) }} + , desktopStyle = Nothing } data Taskbar = Taskbar TaskbarConfig deriving Show @@ -108,11 +116,12 @@ data Taskbar = Taskbar TaskbarConfig deriving Show instance Show Surface where show _ = "Surface " -data TaskbarState = TaskbarState { taskbarActiveWindow :: !Window - , taskbarDesktopCount :: !Int - , taskbarWindows :: ![Window] - , taskbarWindowStates :: !(M.Map Window WindowState) - , taskbarWindowIcons :: !(M.Map Window [(Int, Surface)]) +data TaskbarState = TaskbarState { taskbarActiveWindow :: !Window + , taskbarDesktopCount :: !Int + , taskbarCurrentDesktop :: !Int + , taskbarWindows :: ![Window] + , taskbarWindowStates :: !(M.Map Window WindowState) + , taskbarWindowIcons :: !(M.Map Window [(Int, Surface)]) } deriving Show data WindowState = WindowState { windowTitle :: !String @@ -122,6 +131,7 @@ data WindowState = WindowState { windowTitle :: !String data TaskbarMessage = WindowListUpdate [Xlib.Window] (M.Map Window WindowState) (M.Map Window [(Int, Surface)]) | DesktopCountUpdate Int + | CurrentDesktopUpdate Int | ActiveWindowUpdate Window deriving (Show, Typeable) @@ -131,7 +141,7 @@ instance WidgetClass Taskbar where initWidget (Taskbar _) phi dispvar = do forkIO $ taskbarRunner phi dispvar - return $ TaskbarState 0 0 [] M.empty M.empty + return $ TaskbarState 0 0 (-1) [] M.empty M.empty minSize _ = 0 @@ -139,69 +149,103 @@ instance WidgetClass Taskbar where render (Taskbar config) TaskbarState { taskbarActiveWindow = activeWindow , taskbarDesktopCount = desktopCount + , taskbarCurrentDesktop = currentDesktop , taskbarWindows = windows , taskbarWindowStates = windowStates , taskbarWindowIcons = windowIcons } 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 + let desktopNumbers = take desktopCount [0..] + desktops = map (\desktop -> (desktop, filter (fromMaybe False . fmap (windowOnDesktop desktop) . flip M.lookup windowStates) windows)) desktopNumbers + windowCount = sum $ map (length . snd) $ desktops + dstyle d = fmap (if d == currentDesktop then snd else fst) $ desktopStyle config + dlabelwidth d = fromMaybe 0 $ fmap desktopLabelWidth $ dstyle d + gap d ds = if null (snd $ desktops !! d) then 0 else desktopLabelGap ds + dleftwidth d = fromMaybe 0 $ fmap (\ds@DesktopStyle {desktopBorder = border} + -> (borderLeft $ margin border) + (borderWidth border) + (borderLeft $ padding border) + + dlabelwidth d + gap d ds) $ dstyle d + dwidth d = fromMaybe 0 $ fmap (\ds@DesktopStyle {desktopBorder = border} + -> (borderH $ margin border) + 2*(borderWidth border) + (borderH $ padding border) + + dlabelwidth d + gap d ds) $ dstyle d + when (windowCount /= 0) $ do - let windowWidth = min (taskMaxSize config) (w `div` windowCount) + let desktopsWidth = sum $ map dwidth desktopNumbers + windowWidth = min (taskMaxSize config) ((w - desktopsWidth) `div` windowCount) - forM_ (zip [0..] $ join $ map snd desktopWindows) $ \(i, window) -> do - let style = (if window == activeWindow then activeTaskStyle else normalTaskStyle) config - (r, g, b, a) = taskColor style - leftBorder = (borderLeft $ margin $ taskBorder style) + (borderWidth $ taskBorder style) + (borderLeft $ padding $ taskBorder style) - rightBorder = (borderRight $ margin $ taskBorder style) + (borderWidth $ taskBorder style) + (borderRight $ padding $ taskBorder style) - h' = h - (borderV $ margin $ taskBorder style) - mstate = M.lookup window windowStates - micons = M.lookup window windowIcons - - case (mstate, micons) of - (Just state, Just icons) -> do + flip (flip foldM_ 0) desktops $ \nwindows (desktop, desktopWindows) -> do + let dstyle' = dstyle desktop + dx = dleftwidth desktop + (sum $ map dwidth $ take desktop [0..]) + nwindows*windowWidth + + case dstyle' of + Just ds -> do + let (r, g, b, a) = desktopColor ds save - drawBorder (taskBorder style) (i*windowWidth) 0 windowWidth h + drawBorder (desktopBorder ds) (dx - dleftwidth desktop) 0 (dwidth desktop + windowWidth * length desktopWindows) h clip setSourceRGBA r g b a - renderText style (fromIntegral (i*windowWidth + leftBorder + h' + 3)) 0 (windowWidth - leftBorder - h' - 3 - rightBorder) h $ windowTitle state + renderText (desktopFont ds) (fromIntegral (dx - dlabelwidth desktop - gap desktop ds)) 0 (dlabelwidth desktop) h $ show (desktop+1) restore - - case bestIcon h' icons of - Just icon -> do - save - translate (fromIntegral $ i*windowWidth + leftBorder) (fromIntegral $ borderTop $ margin $ taskBorder style) - imageW <- imageSurfaceGetWidth icon - imageH <- imageSurfaceGetHeight icon - - let scalef = (fromIntegral h')/(fromIntegral $ max imageW imageH) - scale scalef scalef - - when (imageH < imageW) $ - translate 0 $ (fromIntegral (imageW-imageH))/2 - - taskIconStyle style icon - paint - restore - - Nothing -> return () - _ -> return () + forM_ (zip [0..] desktopWindows) $ \(i, window) -> do + let style = (if window == activeWindow then activeTaskStyle else normalTaskStyle) config + (r, g, b, a) = taskColor style + leftBorder = (borderLeft $ margin $ taskBorder style) + (borderWidth $ taskBorder style) + (borderLeft $ padding $ taskBorder style) + rightBorder = (borderRight $ margin $ taskBorder style) + (borderWidth $ taskBorder style) + (borderRight $ padding $ taskBorder style) + h' = h - (borderV $ margin $ taskBorder style) + mstate = M.lookup window windowStates + micons = M.lookup window windowIcons + x = dx + i*windowWidth + + case (mstate, micons) of + (Just state, Just icons) -> do + save + drawBorder (taskBorder style) x 0 windowWidth h + clip + + setSourceRGBA r g b a + renderText (taskFont style) (fromIntegral (x + leftBorder + h' + 3)) 0 (windowWidth - leftBorder - h' - 3 - rightBorder) h $ windowTitle state + + restore + + case bestIcon h' icons of + Just icon -> do + save + translate (fromIntegral $ x + leftBorder) (fromIntegral $ borderTop $ margin $ taskBorder style) + imageW <- imageSurfaceGetWidth icon + imageH <- imageSurfaceGetHeight icon + + let scalef = (fromIntegral h')/(fromIntegral $ max imageW imageH) + scale scalef scalef + + when (imageH < imageW) $ + translate 0 $ (fromIntegral (imageW-imageH))/2 + + taskIconStyle style icon + paint + restore + + Nothing -> return () + + _ -> return () + + return $ nwindows + length desktopWindows + handleMessage _ priv m = case (fromMessage m) of Just (WindowListUpdate windows windowStates icons) -> priv {taskbarWindows = windows, taskbarWindowStates = windowStates, taskbarWindowIcons = icons} Just (DesktopCountUpdate count) -> priv {taskbarDesktopCount = count} + Just (CurrentDesktopUpdate current) -> priv {taskbarCurrentDesktop = current} Just (ActiveWindowUpdate window) -> priv {taskbarActiveWindow = window} _ -> priv -renderText :: TaskStyle -> Int -> Int -> Int -> Int -> String -> Render () -renderText style x y w h text = do +renderText :: String -> Int -> Int -> Int -> Int -> String -> Render () +renderText font x y w h text = do layout <- createLayout "" (_, PangoRectangle _ _ textWidth textHeight) <- liftIO $ do - layoutSetMarkup layout $ "" ++ (escapeMarkup text) ++ "" + layoutSetMarkup layout $ "" ++ (escapeMarkup text) ++ "" layoutSetWidth layout $ Just $ fromIntegral w layoutSetEllipsize layout EllipsizeEnd @@ -226,9 +270,11 @@ taskbarRunner phi dispvar = do (windows, states, icons) <- liftIO $ withDisplay dispvar $ \disp -> do (windows, states, icons) <- getWindowStates disp (getAtoms dispvar) [] M.empty M.empty desktopCount <- getDesktopCount disp (getAtoms dispvar) + current <- getCurrentDesktop disp (getAtoms dispvar) activeWindow <- getActiveWindow disp (getAtoms dispvar) sendMessage phi $ WindowListUpdate windows states icons sendMessage phi $ DesktopCountUpdate desktopCount + sendMessage phi $ CurrentDesktopUpdate current sendMessage phi $ ActiveWindowUpdate activeWindow return (windows, states, icons) sendMessage phi Repaint @@ -247,6 +293,7 @@ handlePropertyUpdate phi dispvar XExtras.PropertyEvent {XExtras.ev_atom = atom, 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 @@ -265,6 +312,10 @@ handlePropertyUpdate phi dispvar XExtras.PropertyEvent {XExtras.ev_atom = atom, desktopCount <- liftIO $ getDesktopCount disp atoms sendMessage phi $ DesktopCountUpdate desktopCount sendMessage phi Repaint + when (atom == atom_NET_CURRENT_DESKTOP atoms) $ do + current <- liftIO $ getCurrentDesktop disp atoms + sendMessage phi $ CurrentDesktopUpdate current + sendMessage phi Repaint when (atom == atom_NET_CLIENT_LIST atoms) $ do (windows, windowStates, icons) <- get (windows', windowStates', icons') <- liftIO $ getWindowStates disp atoms windows windowStates icons @@ -298,6 +349,10 @@ 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 +getCurrentDesktop :: Xlib.Display -> Atoms -> IO Int +getCurrentDesktop disp atoms = + liftM (fromIntegral . fromMaybe (-1) . join . fmap listToMaybe) $ XExtras.getWindowProperty32 disp (atom_NET_CURRENT_DESKTOP 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 diff --git a/lib/Phi/X11/AtomList.hs b/lib/Phi/X11/AtomList.hs index dc5eac1..d18be71 100644 --- a/lib/Phi/X11/AtomList.hs +++ b/lib/Phi/X11/AtomList.hs @@ -22,6 +22,7 @@ atoms = [ "UTF8_STRING" , "_NET_WM_STRUT_PARTIAL" , "_NET_ACTIVE_WINDOW" , "_NET_NUMBER_OF_DESKTOPS" + , "_NET_CURRENT_DESKTOP" , "_NET_CLIENT_LIST" , "_MOTIF_WM_HINTS" , "_XROOTPMAP_ID" diff --git a/src/Phi.hs b/src/Phi.hs index 30a63f8..417d8f8 100644 --- a/src/Phi.hs +++ b/src/Phi.hs @@ -12,16 +12,35 @@ main = do runPhi defaultXConfig defaultPanelConfig { panelPosition = Bottom } [theTaskbar, brightBorder [theClock]] where - normalTaskBorder = BorderConfig (BorderWidth 2 4 2 4) 1 (BorderWidth 0 5 0 5) (0.9, 0.9, 0.9, 0.65) (0.45, 0.45, 0.45, 0.8) 5 0 + normalTaskBorder = BorderConfig (BorderWidth 2 (-4) 2 7) 1 (BorderWidth 0 5 0 5) (0.9, 0.9, 0.9, 0.65) (0.45, 0.45, 0.45, 0.8) 5 0 activeTaskBorder = normalTaskBorder {borderColor = (1, 1, 1, 0.65), backgroundColor = (0, 0, 0, 0.8)} + normalDesktopBorder = normalTaskBorder { margin = BorderWidth 2 3 2 3 + , padding = BorderWidth 0 2 0 2 + , borderColor = (0.75, 0.75, 0.75, 0.5) + , backgroundColor = (1, 1, 1, 0.8) + } + currentDesktopBorder = normalDesktopBorder { borderColor = (0.75, 0.75, 0.75, 0.8) + , backgroundColor = (0.2, 0.2, 0.2, 0.9) + } taskStyle = TaskStyle { taskFont = "Sans 7" , taskColor = (1, 1, 1, 1) , taskBorder = normalTaskBorder , taskIconStyle = idIconStyle } + normalDesktopStyle = DesktopStyle { desktopFont = "Sans 8" + , desktopLabelWidth = 15 + , desktopLabelGap = (-5) + , desktopColor = (0, 0, 0, 1) + , desktopBorder = normalDesktopBorder + } + currentDesktopStyle = normalDesktopStyle { desktopBorder = currentDesktopBorder + , desktopColor = (1, 1, 1, 1) + } + theTaskbar = taskbar defaultTaskbarConfig { normalTaskStyle = taskStyle {taskIconStyle = desaturateIconStyle 0.7} , activeTaskStyle = taskStyle {taskBorder = activeTaskBorder} + , desktopStyle = Just (normalDesktopStyle, currentDesktopStyle) } theClock = clock defaultClockConfig { clockFormat = "%R\n%A %d %B" -- cgit v1.2.3