diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,10 @@ +# 0.4.6 + + * Fix a longstanding bug in loading .rc files (Peder Stray) + * Add support for scrolling in the workspace switcher (Saksham Sharma) + * Improve default formatting of empty workspaces in the pager (Saksham Sharma) + * Relax gtk version bounds + # 0.4.5 * GHC 7.10 compat diff --git a/src/System/Information/EWMHDesktopInfo.hs b/src/System/Information/EWMHDesktopInfo.hs --- a/src/System/Information/EWMHDesktopInfo.hs +++ b/src/System/Information/EWMHDesktopInfo.hs @@ -22,12 +22,14 @@ module System.Information.EWMHDesktopInfo ( X11Window -- re-exported from X11DesktopInfo , X11WindowHandle + , WorkspaceIdx(..) , withDefaultCtx -- re-exported from X11DesktopInfo , isWindowUrgent -- re-exported from X11DesktopInfo , getCurrentWorkspace , getVisibleWorkspaces , getWorkspaceNames , switchToWorkspace + , switchOneWorkspace , getWindowTitle , getWindowClass , getActiveWindowTitle @@ -37,44 +39,67 @@ , focusWindow ) where -import Data.List (elemIndex) +import Control.Applicative ((<$>)) +import Data.Tuple (swap) import Data.Maybe (listToMaybe, mapMaybe) import System.Information.X11DesktopInfo -- | Convenience alias for a pair of the form (props, window), where props is a -- tuple of the form (workspace index, window title, window class), and window -- is the internal ID of an open window. -type X11WindowHandle = ((Int, String, String), X11Window) +type X11WindowHandle = ((WorkspaceIdx, String, String), X11Window) +newtype WorkspaceIdx = WSIdx Int + deriving (Show, Read, Ord, Eq) + noFocus :: String noFocus = "..." -- | Retrieve the index of the current workspace in the desktop, -- starting from 0. -getCurrentWorkspace :: X11Property Int -getCurrentWorkspace = readAsInt Nothing "_NET_CURRENT_DESKTOP" +getCurrentWorkspace :: X11Property WorkspaceIdx +getCurrentWorkspace = WSIdx <$> readAsInt Nothing "_NET_CURRENT_DESKTOP" -- | Retrieve the indexes of all currently visible workspaces -- with the active workspace at the head of the list. -getVisibleWorkspaces :: X11Property [Int] +getVisibleWorkspaces :: X11Property [WorkspaceIdx] getVisibleWorkspaces = do vis <- getVisibleTags - allNames <- getWorkspaceNames + allNames <- map swap <$> getWorkspaceNames cur <- getCurrentWorkspace - return $ cur : mapMaybe (`elemIndex` allNames) vis + return $ cur : mapMaybe (flip lookup allNames) vis -- | Return a list with the names of all the workspaces currently -- available. -getWorkspaceNames :: X11Property [String] -getWorkspaceNames = readAsListOfString Nothing "_NET_DESKTOP_NAMES" +getWorkspaceNames :: X11Property [(WorkspaceIdx, String)] +getWorkspaceNames = go <$> readAsListOfString Nothing "_NET_DESKTOP_NAMES" + where go = zip [WSIdx i | i <- [0..]] -- | Ask the window manager to switch to the workspace with the given -- index, starting from 0. -switchToWorkspace :: Int -> X11Property () -switchToWorkspace idx = do +switchToWorkspace :: WorkspaceIdx -> X11Property () +switchToWorkspace (WSIdx idx) = do cmd <- getAtom "_NET_CURRENT_DESKTOP" sendCommandEvent cmd (fromIntegral idx) +-- | Move one workspace up or down from the current workspace +switchOneWorkspace :: Bool -> Int -> X11Property () +switchOneWorkspace dir end = do + cur <- getCurrentWorkspace + switchToWorkspace $ if dir then getPrev cur end else getNext cur end + +-- | Check for corner case and switch one workspace up +getPrev :: WorkspaceIdx -> Int -> WorkspaceIdx +getPrev (WSIdx idx) end + | idx > 0 = WSIdx $ idx-1 + | otherwise = WSIdx end + +-- | Check for corner case and switch one workspace down +getNext :: WorkspaceIdx -> Int -> WorkspaceIdx +getNext (WSIdx idx) end + | idx < end = WSIdx $ idx+1 + | otherwise = WSIdx 0 + -- | Get the title of the given X11 window. getWindowTitle :: X11Window -> X11Property String getWindowTitle window = do @@ -114,8 +139,8 @@ -- | Return the index (starting from 0) of the workspace on which the -- given window is being displayed. -getWorkspace :: X11Window -> X11Property Int -getWorkspace window = readAsInt (Just window) "_NET_WM_DESKTOP" +getWorkspace :: X11Window -> X11Property WorkspaceIdx +getWorkspace window = WSIdx <$> readAsInt (Just window) "_NET_WM_DESKTOP" -- | Ask the window manager to give focus to the given window. focusWindow :: X11Window -> X11Property () diff --git a/src/System/Taffybar.hs b/src/System/Taffybar.hs --- a/src/System/Taffybar.hs +++ b/src/System/Taffybar.hs @@ -225,7 +225,7 @@ nmonitors <- screenGetNMonitors screen allMonitorSizes <- mapM (screenGetMonitorGeometry screen) [0 .. (nmonitors - 1)] - when (monitorNumber cfg < nmonitors) $ do + when (monitorNumber cfg >= nmonitors) $ do IO.hPutStrLn IO.stderr $ printf "Monitor %d is not available in the selected screen" (monitorNumber cfg) let monitorSize = fromMaybe (allMonitorSizes !! 0) $ do @@ -261,15 +261,14 @@ taffybarMain :: TaffybarConfig -> IO () taffybarMain cfg = do - -- Override the default GTK theme path settings. This causes the - -- bar (by design) to ignore the real GTK theme and just use the - -- provided minimal theme to set the background and text colors. - -- Users can override this default. - defaultGtkConfig <- getDefaultConfigFile "taffybar.rc" - userGtkConfig <- getUserConfigFile "taffybar" "taffybar.rc" - rcSetDefaultFiles [ defaultGtkConfig, userGtkConfig ] _ <- initGUI + + -- Load default and user gtk resources + defaultGtkConfig <- getDefaultConfigFile "taffybar.rc" + userGtkConfig <- getUserConfigFile "taffybar" "taffybar.rc" + rcParse defaultGtkConfig + rcParse userGtkConfig Just disp <- displayGetDefault nscreens <- displayGetNScreens disp diff --git a/src/System/Taffybar/FreedesktopNotifications.hs b/src/System/Taffybar/FreedesktopNotifications.hs --- a/src/System/Taffybar/FreedesktopNotifications.hs +++ b/src/System/Taffybar/FreedesktopNotifications.hs @@ -113,9 +113,8 @@ -- | Apply the user's formatter and truncate the result with the -- specified maxlen. formatMessage :: NotifyState -> Notification -> String -formatMessage s = take maxlen . fmt +formatMessage s = fmt where - maxlen = notificationMaxLength $ noteConfig s fmt = notificationFormatter $ noteConfig s -- | The notificationDaemon thread looks at the notification queue. diff --git a/src/System/Taffybar/Pager.hs b/src/System/Taffybar/Pager.hs --- a/src/System/Taffybar/Pager.hs +++ b/src/System/Taffybar/Pager.hs @@ -82,7 +82,7 @@ , activeLayout = escape , activeWorkspace = colorize "yellow" "" . wrap "[" "]" . escape , hiddenWorkspace = escape - , emptyWorkspace = escape + , emptyWorkspace = const "" , visibleWorkspace = wrap "(" ")" . escape , urgentWorkspace = colorize "red" "yellow" . escape , widgetSep = " : " diff --git a/src/System/Taffybar/WindowSwitcher.hs b/src/System/Taffybar/WindowSwitcher.hs --- a/src/System/Taffybar/WindowSwitcher.hs +++ b/src/System/Taffybar/WindowSwitcher.hs @@ -26,6 +26,7 @@ ) where import Control.Monad (forM_) +import qualified Data.Map as M import Control.Monad.IO.Class ( liftIO ) import qualified Graphics.UI.Gtk as Gtk import Graphics.X11.Xlib.Extras (Event) @@ -118,7 +119,7 @@ if null handles then return () else do wsNames <- getWorkspaceNames forM_ handles $ \handle -> liftIO $ do - item <- Gtk.menuItemNewWithLabel (formatEntry wsNames handle) + item <- Gtk.menuItemNewWithLabel (formatEntry (M.fromList wsNames) handle) _ <- Gtk.on item Gtk.buttonPressEvent $ liftIO $ do withDefaultCtx (focusWindow $ snd handle) return True @@ -132,13 +133,13 @@ -- | Build the name to display in the list of windows by prepending the name -- of the workspace it is currently in to the name of the window itself -formatEntry :: [String] -- ^ List of names of all available workspaces +formatEntry :: M.Map WorkspaceIdx String -- ^ List of names of all available workspaces -> X11WindowHandle -- ^ Handle of the window to name -> String formatEntry wsNames ((ws, wtitle, _), _) = wsName ++ ": " ++ (nonEmpty wtitle) - where wsName = if 0 <= ws && ws < length wsNames - then wsNames !! ws - else "WS#" ++ show ws + where + wsName = M.findWithDefault ("WS#"++show wsN) ws wsNames + WSIdx wsN = ws -- | Return the given String if it's not empty, otherwise return "(nameless window)" nonEmpty :: String -> String diff --git a/src/System/Taffybar/WorkspaceSwitcher.hs b/src/System/Taffybar/WorkspaceSwitcher.hs --- a/src/System/Taffybar/WorkspaceSwitcher.hs +++ b/src/System/Taffybar/WorkspaceSwitcher.hs @@ -26,6 +26,7 @@ wspaceSwitcherNew ) where +import Control.Applicative import qualified Control.Concurrent.MVar as MV import Control.Monad import Control.Monad.IO.Class (MonadIO, liftIO) @@ -33,6 +34,8 @@ import qualified Graphics.UI.Gtk as Gtk import Graphics.X11.Xlib.Extras +import Prelude + import System.Taffybar.Pager import System.Information.EWMHDesktopInfo @@ -91,17 +94,18 @@ redrawcb = redrawCallback pager deskRef switcher urgentcb = urgentCallback cfg deskRef subscribe pager activecb "_NET_CURRENT_DESKTOP" + subscribe pager redrawcb "_NET_DESKTOP_NAMES" subscribe pager redrawcb "_NET_NUMBER_OF_DESKTOPS" subscribe pager urgentcb "WM_HINTS" return $ Gtk.toWidget switcher -- | List of indices of all available workspaces. -allWorkspaces :: Desktop -> [Int] -allWorkspaces desktop = [0 .. length desktop - 1] +allWorkspaces :: Desktop -> [WorkspaceIdx] +allWorkspaces desktop = map WSIdx [0 .. length desktop - 1] -- | List of indices of all the workspaces that contain at least one window. -nonEmptyWorkspaces :: IO [Int] +nonEmptyWorkspaces :: IO [WorkspaceIdx] nonEmptyWorkspaces = withDefaultCtx $ mapM getWorkspace =<< getWindows -- | Return a list of two-element tuples, one for every workspace, @@ -109,7 +113,7 @@ -- workspace and a String with its default (unmarked) representation. getDesktop :: Pager -> IO Desktop getDesktop pager = do - names <- withDefaultCtx getWorkspaceNames + names <- map snd <$> withDefaultCtx getWorkspaceNames labels <- toLabels $ map (hiddenWorkspace $ config pager) names return $ zipWith (\n l -> Workspace l n False) names labels @@ -143,9 +147,8 @@ curr <- withDefaultCtx getVisibleWorkspaces desktop <- MV.readMVar deskRef case curr of - visible : _ | length desktop > visible -> do - when (urgent (desktop !! visible)) $ do - toggleUrgent deskRef visible False + visible : _ | Just ws <- getWS desktop visible -> do + when (urgent ws) $ toggleUrgent deskRef visible False transition cfg desktop curr _ -> return () @@ -188,33 +191,45 @@ Gtk.labelSetMarkup lbl markup return lbl +-- | Get the workspace corresponding to the given 'WorkspaceIdx' on the given desktop +getWS :: Desktop -> WorkspaceIdx -> Maybe Workspace +getWS desktop (WSIdx idx) + | length desktop > idx = Just (desktop !! idx) + | otherwise = Nothing + -- | Build a new clickable event box containing the Label widget that -- corresponds to the given index, and add it to the given container. addButton :: Gtk.BoxClass self - => self -- ^ Graphical container. - -> Desktop -- ^ List of all workspace Labels available. - -> Int -- ^ Index of the workspace to use. + => self -- ^ Graphical container. + -> Desktop -- ^ List of all workspace Labels available. + -> WorkspaceIdx -- ^ Index of the workspace to use. -> IO () addButton hbox desktop idx - | length desktop > idx = do - let index = desktop !! idx - lbl = label index + | Just ws <- getWS desktop idx = do + let lbl = label ws ebox <- Gtk.eventBoxNew - Gtk.widgetSetName ebox $ name index + Gtk.widgetSetName ebox $ name ws Gtk.eventBoxSetVisibleWindow ebox False _ <- Gtk.on ebox Gtk.buttonPressEvent $ switch idx + _ <- Gtk.on ebox Gtk.scrollEvent $ do + dir <- Gtk.eventScrollDirection + case dir of + Gtk.ScrollUp -> switchOne True (length desktop - 1) + Gtk.ScrollLeft -> switchOne True (length desktop - 1) + Gtk.ScrollDown -> switchOne False (length desktop - 1) + Gtk.ScrollRight -> switchOne False (length desktop - 1) Gtk.containerAdd ebox lbl Gtk.boxPackStart hbox ebox Gtk.PackNatural 0 | otherwise = return () -- | Re-mark all workspace labels. -transition :: PagerConfig -- ^ Configuration settings. - -> Desktop -- ^ All available Labels with their default values. - -> [Int] -- ^ Currently visible workspaces (first is active). +transition :: PagerConfig -- ^ Configuration settings. + -> Desktop -- ^ All available Labels with their default values. + -> [WorkspaceIdx] -- ^ Currently visible workspaces (first is active). -> IO () transition cfg desktop wss = do - nonEmpty <- fmap (filter (>=0)) nonEmptyWorkspaces - let urgentWs = findIndices urgent desktop + nonEmpty <- fmap (filter (>=WSIdx 0)) nonEmptyWorkspaces + let urgentWs = map WSIdx $ findIndices urgent desktop allWs = (allWorkspaces desktop) \\ urgentWs nonEmptyWs = nonEmpty \\ urgentWs mapM_ (mark desktop $ hiddenWorkspace cfg) nonEmptyWs @@ -230,11 +245,10 @@ -- the given index. mark :: Desktop -- ^ List of all available labels. -> (String -> String) -- ^ Marking function. - -> Int -- ^ Index of the Label to modify. + -> WorkspaceIdx -- ^ Index of the Label to modify. -> IO () -mark desktop decorate idx - | length desktop > idx = do - let ws = desktop !! idx +mark desktop decorate wsIdx + | Just ws <- getWS desktop wsIdx = Gtk.postGUIAsync $ Gtk.labelSetMarkup (label ws) $ decorate' (name ws) | otherwise = return () where decorate' = pad . decorate @@ -242,18 +256,24 @@ | otherwise = ' ' : m -- | Switch to the workspace with the given index. -switch :: (MonadIO m) => Int -> m Bool +switch :: (MonadIO m) => WorkspaceIdx -> m Bool switch idx = do liftIO $ withDefaultCtx (switchToWorkspace idx) return True +-- | Switch to one workspace up or down given a boolean direction and the last workspace +switchOne :: (MonadIO m) => Bool -> Int -> m Bool +switchOne dir end = do + liftIO $ withDefaultCtx (if dir then switchOneWorkspace dir end else switchOneWorkspace dir end) + return True + -- | Modify the Desktop inside the given IORef, so that the Workspace at the -- given index has its "urgent" flag set to the given value. -toggleUrgent :: MV.MVar Desktop -- ^ IORef to modify. - -> Int -- ^ Index of the Workspace to replace. +toggleUrgent :: MV.MVar Desktop -- ^ MVar to modify. + -> WorkspaceIdx -- ^ Index of the Workspace to replace. -> Bool -- ^ New value of the "urgent" flag. -> IO () -toggleUrgent deskRef idx isUrgent = +toggleUrgent deskRef (WSIdx idx) isUrgent = MV.modifyMVar_ deskRef $ \desktop -> do let ws = desktop !! idx case length desktop > idx of diff --git a/taffybar.cabal b/taffybar.cabal --- a/taffybar.cabal +++ b/taffybar.cabal @@ -1,5 +1,5 @@ name: taffybar -version: 0.4.5 +version: 0.4.6 synopsis: A desktop bar similar to xmobar, but with more GUI license: BSD3 license-file: LICENSE @@ -8,6 +8,7 @@ category: System build-type: Simple cabal-version: >=1.10 +tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2 homepage: http://github.com/travitch/taffybar data-files: taffybar.rc extra-source-files: README.md, @@ -26,7 +27,7 @@ library default-language: Haskell2010 build-depends: base > 3 && < 5, - time >= 1.4 && < 1.6, + time >= 1.4 && < 1.7, time-locale-compat >= 0.1 && < 0.2, old-locale, containers, @@ -36,13 +37,13 @@ mtl >= 2, cairo, dbus >= 0.10.1 && < 1.0, - gtk >= 0.12.1 && < 0.14, - dyre >= 0.8.6, - HStringTemplate, + gtk >= 0.12.1 && < 0.15, + dyre >= 0.8.6 && < 0.9, + HStringTemplate >= 0.8 && < 0.9, gtk-traymanager >= 0.1.2 && < 0.2, xmonad-contrib, xmonad, - xdg-basedir, + xdg-basedir >= 0.2 && < 0.3, filepath, utf8-string, process, @@ -102,14 +103,12 @@ c-sources: src/gdk_property_change_wrapper.c ghc-options: -Wall -funbox-strict-fields - ghc-prof-options: -auto-all - executable taffybar default-language: Haskell2010 build-depends: base > 3 && < 5, dyre >= 0.8.6, - gtk >= 0.12 && < 0.14, + gtk >= 0.12 && < 0.15, safe >= 0.3 && < 1, xdg-basedir, filepath @@ -118,7 +117,6 @@ pkgconfig-depends: gtk+-2.0 c-sources: src/gdk_property_change_wrapper.c ghc-options: -Wall -rtsopts -threaded - ghc-prof-options: -auto-all source-repository head type: git diff --git a/taffybar.hs.example b/taffybar.hs.example --- a/taffybar.hs.example +++ b/taffybar.hs.example @@ -34,7 +34,7 @@ pager = taffyPagerNew defaultPagerConfig note = notifyAreaNew defaultNotificationConfig wea = weatherNew (defaultWeatherConfig "KMSN") 10 - mpris = mprisNew + mpris = mprisNew defaultMPRISConfig mem = pollingGraphNew memCfg 1 memCallback cpu = pollingGraphNew cpuCfg 0.5 cpuCallback tray = systrayNew diff --git a/taffybar.rc b/taffybar.rc --- a/taffybar.rc +++ b/taffybar.rc @@ -1,6 +1,10 @@ -gtk_color_scheme = "black:#000000\nwhite:#FFFFFF\ngreen:#00FF00\nred:#FF0000" -style "default" { +style "taffybar-default" { + color["black"] = "#000000" + color["white"] = "#ffffff" + color["green"] = "#00ff00" + color["red"] = "#ff0000" + bg[NORMAL] = @black fg[NORMAL] = @white text[NORMAL] = @white @@ -8,15 +12,15 @@ bg[PRELIGHT] = @black } -style "active-window" = "default" { +style "taffybar-active-window" = "taffybar-default" { fg[NORMAL] = @green } -style "notification-button" = "default" { +style "taffybar-notification-button" = "taffybar-default" { text[NORMAL] = @red fg[NORMAL] = @red } -widget "Taffybar*" style "default" -widget "Taffybar*WindowSwitcher*label" style "active-window" -widget "*NotificationCloseButton" style "notification-button" +widget "Taffybar*" style "taffybar-default" +widget "Taffybar*WindowSwitcher*label" style "taffybar-active-window" +widget "*NotificationCloseButton" style "taffybar-notification-button"