Allow showing desktop numbers in taskbar

1 files changed, 104 insertions, 49 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 $ "<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