taffybar 0.4.5 → 0.4.6

raw patch · 10 files changed

+127/−74 lines, 10 filesdep ~HStringTemplatedep ~dyredep ~gtkPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: HStringTemplate, dyre, gtk, time, xdg-basedir

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• src/System/Information/EWMHDesktopInfo.hs +38/−13
• src/System/Taffybar.hs +7/−8
• src/System/Taffybar/FreedesktopNotifications.hs +1/−2
• src/System/Taffybar/Pager.hs +1/−1
• src/System/Taffybar/WindowSwitcher.hs +6/−5
• src/System/Taffybar/WorkspaceSwitcher.hs +47/−27
• taffybar.cabal +8/−10
• taffybar.hs.example +1/−1
• taffybar.rc +11/−7

@@ -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

@@ -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 ()

@@ -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

@@ -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.

@@ -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        = " : "

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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"