Allow showing desktop numbers in taskbar
This commit is contained in:
parent
a4936c35b6
commit
b2b35e632a
3 changed files with 126 additions and 51 deletions
|
|
@ -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
|
||||
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 (mstate, micons) of
|
||||
(Just state, Just icons) -> do
|
||||
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 $ "<span font='" ++ (taskFont style) ++ "'>" ++ (escapeMarkup text) ++ "</span>"
|
||||
layoutSetMarkup layout $ "<span font='" ++ font ++ "'>" ++ (escapeMarkup text) ++ "</span>"
|
||||
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
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
21
src/Phi.hs
21
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 = "<span font='Sans 8'>%R</span>\n<span font='Sans 6'>%A %d %B</span>"
|
||||
|
|
|
|||
Reference in a new issue