diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,20 @@ +## Version 0.27 (July, 2018) + +_New features_ + + - Dropped support for GHC 7.x. See [issue #352]. + - New configuration option, `textOffsets` to specify separate + vertical offsets for each of the fonts in `additionalFonts`. See + [issue #311]. + +_Bug fixes_ + + - Use the maximum width options `-T` and `-E` correctly when a + monitor subtemplate contains font and color tags. + +[issue #311]: https://github.com/jaor/xmobar/issues/311 +[issue #352]: https://github.com/jaor/xmobar/issues/352 + ## Version 0.26 (April, 2018) _New features_ diff --git a/readme.md b/readme.md --- a/readme.md +++ b/readme.md @@ -15,7 +15,6 @@ antialiased fonts. And [this one] is my desktop with [xmonad] and two instances of xmobar. -[release notes]: http://projects.haskell.org/xmobar/releases.html [xmonad]: http://xmonad.org [Ion3]: http://tuomov.iki.fi/software/ [This screenshot]: http://projects.haskell.org/xmobar/xmobar-sawfish.png @@ -215,7 +214,8 @@ fonts. - `additionalFonts` Haskell-style list of fonts to be used with the - `fn`-template. Use the `xft:` prefix for XFT fonts. + `fn`-template. Use the `xft:` prefix for XFT fonts. See also + `textOffsets` below. - `bgColor` Background color. @@ -258,6 +258,11 @@ If negative or not given, xmobar will try to center text vertically. +- `textOffsets` A list of vertical offsets, in pixels, for the text + baseline, to be used with the each of the fonts in + `additionalFonts` (if any). If negative or not given, xmobar will + try to center text vertically for that font. + - `iconOffset` The vertical offset, in pixels, for icons bottom line. If negative or not given, xmobar will try to center icons vertically. @@ -1566,11 +1571,7 @@ Thanks to Andrea for creating xmobar in the first place, and for giving me the chance to contribute. -# Useful links - -- [Github page]. -- [Mailing list]. -- [xmobar's Ohloh page]. +# Related - To understand the internal mysteries of xmobar you may try reading [this tutorial] on X Window Programming in Haskell. @@ -1578,7 +1579,6 @@ - My [sawflibs] project includes a module to automate running xmobar in [sawfish]. -[xmobar's Ohloh page]: https://www.ohloh.net/p/xmobar [this tutorial]: http://www.haskell.org/haskellwiki/X_window_programming_in_Haskell [sawflibs]: http://github.com/jaor/sawflibs diff --git a/src/Config.hs b/src/Config.hs --- a/src/Config.hs +++ b/src/Config.hs @@ -56,6 +56,7 @@ , fgColor :: String -- ^ Default font color , position :: XPosition -- ^ Top Bottom or Static , textOffset :: Int -- ^ Offset from top of window for text + , textOffsets :: [Int] -- ^ List of offsets for additionalFonts , iconOffset :: Int -- ^ Offset from top of window for icons , border :: Border -- ^ NoBorder TopB BottomB or FullB , borderColor :: String -- ^ Border color @@ -125,6 +126,7 @@ , borderWidth = 1 , textOffset = -1 , iconOffset = -1 + , textOffsets = [] , hideOnStart = False , lowerOnStart = True , persistent = False @@ -151,8 +153,8 @@ -- the 'Runnable.Runnable' Read instance. To install a plugin just add -- the plugin's type to the list of types (separated by ':*:') appearing in -- this function's type signature. -runnableTypes :: Command :*: Monitors :*: Date :*: PipeReader :*: BufferedPipeReader :*: CommandReader :*: StdinReader :*: XMonadLog :*: EWMH :*: Kbd :*: Locks :*: - Mail :*: MBox :*: - DateZone :*: MarqueePipeReader :*: - () +runnableTypes :: Command :*: Monitors :*: Date :*: PipeReader :*: + BufferedPipeReader :*: CommandReader :*: StdinReader :*: + XMonadLog :*: EWMH :*: Kbd :*: Locks :*: Mail :*: MBox :*: + DateZone :*: MarqueePipeReader :*: () runnableTypes = undefined diff --git a/src/IPC/DBus.hs b/src/IPC/DBus.hs --- a/src/IPC/DBus.hs +++ b/src/IPC/DBus.hs @@ -15,11 +15,13 @@ module IPC.DBus (runIPC) where import DBus -import DBus.Client +import DBus.Client hiding (interfaceName) +import qualified DBus.Client as DC import Control.Monad (when) import Control.Concurrent.STM import Control.Exception (handle) import System.IO (stderr, hPutStrLn) +import Control.Monad.IO.Class (liftIO) import Signal @@ -40,10 +42,13 @@ exportConnection = do client <- connectSession requestName client busName [ nameDoNotQueue ] - export client objectPath [ sendSignalMethod mvst ] + export client objectPath defaultInterface + { DC.interfaceName = interfaceName + , DC.interfaceMethods = [ sendSignalMethod mvst ] + } sendSignalMethod :: TMVar SignalType -> Method -sendSignalMethod mvst = method interfaceName sendSignalName +sendSignalMethod mvst = makeMethod sendSignalName (signature_ [variantType $ toVariant (undefined :: SignalType)]) (signature_ []) sendSignalMethodCall @@ -51,11 +56,11 @@ sendSignalName :: MemberName sendSignalName = memberName_ "SendSignal" - sendSignalMethodCall :: MethodCall -> IO Reply - sendSignalMethodCall mc = do + sendSignalMethodCall :: MethodCall -> DBusR Reply + sendSignalMethodCall mc = liftIO $ do when ( methodCallMember mc == sendSignalName ) $ mapM_ (sendSignal . fromVariant) (methodCallBody mc) - return ( replyReturn [] ) + return ( ReplyReturn [] ) sendSignal :: Maybe SignalType -> IO () sendSignal = maybe (return ()) (atomically . putTMVar mvst) diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -66,7 +66,9 @@ vars <- mapM (mapM $ startCommand sig) cls (r,w) <- createWin d fs conf let ic = Map.empty - startLoop (XConf d r w (fs:fl) ic conf) sig vars + to = textOffset conf + ts = textOffsets conf ++ replicate (length fl) (-1) + startLoop (XConf d r w (fs:fl) (to:ts) ic conf) sig vars -- | Splits the template in its parts splitTemplate :: Config -> [String] @@ -190,7 +192,7 @@ info :: String info = "xmobar " ++ showVersion version ++ "\n (C) 2007 - 2010 Andrea Rossato " - ++ "\n (C) 2010 - 2017 Jose A Ortega Ruiz\n " + ++ "\n (C) 2010 - 2018 Jose A Ortega Ruiz\n " ++ mail ++ "\n" ++ license mail :: String diff --git a/src/Parsers.hs b/src/Parsers.hs --- a/src/Parsers.hs +++ b/src/Parsers.hs @@ -28,6 +28,7 @@ import Control.Monad (guard, mzero) import qualified Data.Map as Map import Text.ParserCombinators.Parsec +import Text.ParserCombinators.Parsec.Number (int) import Text.ParserCombinators.Parsec.Perm import Graphics.X11.Types (Button) @@ -214,7 +215,8 @@ perms = permute $ Config <$?> pFont <|?> pFontList <|?> pWmClass <|?> pWmName <|?> pBgColor <|?> pFgColor - <|?> pPosition <|?> pTextOffset <|?> pIconOffset <|?> pBorder + <|?> pPosition <|?> pTextOffset <|?> pTextOffsets + <|?> pIconOffset <|?> pBorder <|?> pBdColor <|?> pBdWidth <|?> pAlpha <|?> pHideOnStart <|?> pAllDesktops <|?> pOverrideRedirect <|?> pPickBroadest <|?> pLowerOnStart <|?> pPersistent <|?> pIconRoot @@ -224,7 +226,7 @@ fields = [ "font", "additionalFonts","bgColor", "fgColor" , "wmClass", "wmName", "sepChar" , "alignSep" , "border", "borderColor" ,"template" - , "position" , "textOffset", "iconOffset" + , "position" , "textOffset", "textOffsets", "iconOffset" , "allDesktops", "overrideRedirect", "pickBroadest" , "hideOnStart", "lowerOnStart", "persistent", "iconRoot" , "alpha", "commands" @@ -242,6 +244,7 @@ pTemplate = strField template "template" pTextOffset = readField textOffset "textOffset" + pTextOffsets = readIntList textOffsets "textOffsets" pIconOffset = readField iconOffset "iconOffset" pPosition = readField position "position" pHideOnStart = readField hideOnStart "hideOnStart" @@ -300,6 +303,16 @@ updateState (filter (/= n)) >> sepEndSpc [n,"="] >> wrapSkip c >>= \r -> fieldEnd >> return r readField a n = field a n $ tillFieldEnd >>= read' n + + readIntList d n = field d n intList + intList = do + spaces + char '[' + list <- sepBy (spaces >> int >>= \x-> spaces >> return x) (char ',') + spaces + char ']' + return list + read' d s = case reads s of [(x, _)] -> return x _ -> fail $ "error reading the " ++ d ++ " field: " ++ s diff --git a/src/Plugins/BufferedPipeReader.hs b/src/Plugins/BufferedPipeReader.hs --- a/src/Plugins/BufferedPipeReader.hs +++ b/src/Plugins/BufferedPipeReader.hs @@ -84,4 +84,4 @@ threadDelay ( to * 100 * 1000 ) readTVarIO tb >>= \b -> when b $ do when tg $ putMVar signal $ Hide 0 - atomically (readTVar ts) >>= maybe (return ()) cb + readTVarIO ts >>= maybe (return ()) cb diff --git a/src/Plugins/EWMH.hs b/src/Plugins/EWMH.hs --- a/src/Plugins/EWMH.hs +++ b/src/Plugins/EWMH.hs @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -w #-} -{-# LANGUAGE CPP, NamedFieldPuns, GeneralizedNewtypeDeriving, FlexibleContexts #-} - +{-# LANGUAGE CPP, NamedFieldPuns, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TupleSections, FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module : Plugins.EWMH @@ -224,7 +224,7 @@ case mwp of Just xs -> do cl <- gets clients - let cl' = Map.fromList $ map (flip (,) initialClient . fromIntegral) xs + let cl' = Map.fromList $ map ((, initialClient) . fromIntegral) xs dels = Map.difference cl cl' new = Map.difference cl' cl modify (\s -> s { clients = Map.union (Map.intersection cl cl') cl'}) diff --git a/src/Plugins/MBox.hs b/src/Plugins/MBox.hs --- a/src/Plugins/MBox.hs +++ b/src/Plugins/MBox.hs @@ -31,6 +31,15 @@ import qualified Data.ByteString.Lazy.Char8 as B +#if MIN_VERSION_hinotify(0,3,10) +import qualified Data.ByteString.Char8 as BS (ByteString, pack) +pack :: String -> BS.ByteString +pack = BS.pack +#else +pack :: String -> String +pack = id +#endif + data Options = Options { oAll :: Bool , oUniq :: Bool @@ -93,7 +102,7 @@ n <- if exists then countMails f else return (-1) v <- newTVarIO (f, n) when exists $ - addWatch i events f (handleNotification v) >> return () + addWatch i events (pack f) (handleNotification v) >> return () return v) boxes diff --git a/src/Plugins/Mail.hs b/src/Plugins/Mail.hs --- a/src/Plugins/Mail.hs +++ b/src/Plugins/Mail.hs @@ -29,7 +29,20 @@ import Data.List (isPrefixOf) import Data.Set (Set) import qualified Data.Set as S + +#if MIN_VERSION_hinotify(0,3,10) +import qualified Data.ByteString.Char8 as BS (ByteString, pack, unpack) +unpack :: BS.ByteString -> String +unpack = BS.unpack +pack :: String -> BS.ByteString +pack = BS.pack #else +unpack :: String -> String +unpack = id +pack :: String -> String +pack = id +#endif +#else import System.IO #endif @@ -54,7 +67,7 @@ ds <- mapM expandHome rs i <- initINotify - zipWithM_ (\d v -> addWatch i ev d (handle v)) ds vs + zipWithM_ (\d v -> addWatch i ev d (handle v)) (map pack ds) vs forM_ (zip ds vs) $ \(d, v) -> do s <- fmap (S.fromList . filter (not . isPrefixOf ".")) @@ -74,6 +87,6 @@ MovedOut {} -> delete _ -> id where - delete = S.delete (filePath e) - create = S.insert (filePath e) + delete = S.delete ((unpack . filePath) e) + create = S.insert ((unpack . filePath) e) #endif diff --git a/src/Plugins/Monitors/Common.hs b/src/Plugins/Monitors/Common.hs --- a/src/Plugins/Monitors/Common.hs +++ b/src/Plugins/Monitors/Common.hs @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Common --- Copyright : (c) 2010, 2011, 2013, 2016, 2017 Jose Antonio Ortega Ruiz +-- Copyright : (c) 2010, 2011, 2013, 2016, 2017, 2018 Jose Antonio Ortega Ruiz -- (c) 2007-2010 Andrea Rossato -- License : BSD-style (see LICENSE) -- @@ -336,6 +336,19 @@ templateParser :: Parser [(String,String,String)] templateParser = many templateStringParser --"%") +trimTo :: Int -> String -> String -> (Int, String) +trimTo n p "" = (n, p) +trimTo n p ('<':cs) = trimTo n p' s + where p' = p ++ "<" ++ takeWhile (/= '>') cs ++ ">" + s = drop 1 (dropWhile (/= '>') cs) +trimTo 0 p s = trimTo 0 p (dropWhile (/= '<') s) +trimTo n p s = let p' = takeWhile (/= '<') s + s' = dropWhile (/= '<') s + in + if length p' <= n + then trimTo (n - length p') (p ++ p') s' + else trimTo 0 (p ++ take n p') s' + -- | Takes a list of strings that represent the values of the exported -- keys. The strings are joined with the exported keys to form a map -- to be combined with 'combine' to the parsed template. Returns the @@ -346,10 +359,13 @@ do t <- getConfigValue template e <- getConfigValue export w <- getConfigValue maxTotalWidth - ellipsis <- getConfigValue maxTotalWidthEllipsis + ell <- getConfigValue maxTotalWidthEllipsis let m = Map.fromList . zip e $ l s <- parseTemplate' t m - return $ if w > 0 && length s > w then take w s ++ ellipsis else s + let (n, s') = if w > 0 && length s > w + then trimTo (w - length ell) "" s + else (1, s) + return $ if n > 0 then s' else s' ++ ell -- | Parses the template given to it with a map of export values and combines -- them diff --git a/src/XUtil.hsc b/src/XUtil.hsc --- a/src/XUtil.hsc +++ b/src/XUtil.hsc @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : XUtil --- Copyright : (C) 2011, 2012, 2013, 2014, 2015, 2017 Jose Antonio Ortega Ruiz +-- Copyright : (C) 2011, 2012, 2013, 2014, 2015, 2017, 2018 Jose Antonio Ortega Ruiz -- (C) 2007 Andrea Rossato -- License : BSD3 -- @@ -77,7 +77,7 @@ -- | When initFont gets a font name that starts with 'xft:' it switchs -- to the Xft backend Example: 'xft:Sans-10' -initFont :: Display ->String -> IO XFont +initFont :: Display -> String -> IO XFont initFont d s = let xftPrefix = "xft:" in if xftPrefix `isPrefixOf` s then diff --git a/src/Xmobar.hs b/src/Xmobar.hs --- a/src/Xmobar.hs +++ b/src/Xmobar.hs @@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Xmobar --- Copyright : (c) 2011, 2012, 2013, 2014, 2015, 2017 Jose Antonio Ortega Ruiz +-- Copyright : (c) 2011, 2012, 2013, 2014, 2015, 2017, 2018 Jose Antonio Ortega Ruiz -- (c) 2007 Andrea Rossato -- License : BSD-style (see LICENSE) -- @@ -79,6 +79,7 @@ , rect :: Rectangle , window :: Window , fontListS :: [XFont] + , verticalOffsets :: [Int] , iconS :: Map FilePath Bitmap , config :: Config } @@ -90,7 +91,7 @@ -- | Starts the main event loop and threads startLoop :: XConf -> TMVar SignalType -> [[(Maybe ThreadId, TVar String)]] -> IO () -startLoop xcfg@(XConf _ _ w _ _ _) sig vs = do +startLoop xcfg@(XConf _ _ w _ _ _ _) sig vs = do #ifdef XFT xftInitFtLibrary #endif @@ -148,8 +149,12 @@ -- | Continuously wait for a signal from a thread or a interrupt handler -eventLoop :: TVar [String] -> XConf -> [([Action], Position, Position)] -> TMVar SignalType -> IO () -eventLoop tv xc@(XConf d r w fs is cfg) as signal = do +eventLoop :: TVar [String] + -> XConf + -> [([Action], Position, Position)] + -> TMVar SignalType + -> IO () +eventLoop tv xc@(XConf d r w fs vos is cfg) as signal = do typ <- atomically $ takeTMVar signal case typ of Wakeup -> do @@ -203,7 +208,7 @@ reposWindow rcfg = do r' <- repositionWin d w (head fs) rcfg - eventLoop tv (XConf d r' w fs is rcfg) as signal + eventLoop tv (XConf d r' w fs vos is rcfg) as signal updateConfigPosition ocfg = case position ocfg of @@ -245,7 +250,7 @@ updateString :: Config -> TVar [String] -> IO [[(Widget, String, Int, Maybe [Action])]] updateString conf v = do - s <- atomically $ readTVar v + s <- readTVarIO v let l:c:r:_ = s ++ repeat "" io $ mapM (parseString conf) [l, c, r] @@ -281,7 +286,7 @@ drawInWin wr@(Rectangle _ _ wid ht) ~[left,center,right] = do r <- ask let (c,d) = (config &&& display) r - (w,fs) = (window &&& fontListS ) r + (w,(fs,vs)) = (window &&& fontListS &&& verticalOffsets) r strLn = io . mapM getWidth iconW i = maybe 0 Bitmap.width (lookup i $ iconS r) getWidth (Text s,cl,i,_) = @@ -303,9 +308,9 @@ io $ setForeground d gc bgcolor io $ fillRectangle d p gc 0 0 wid ht -- write to the pixmap the new string - printStrings p gc fs 1 L =<< strLn left - printStrings p gc fs 1 R =<< strLn right - printStrings p gc fs 1 C =<< strLn center + printStrings p gc fs vs 1 L =<< strLn left + printStrings p gc fs vs 1 R =<< strLn right + printStrings p gc fs vs 1 C =<< strLn center -- draw border if requested io $ drawBorder (border c) (borderWidth c) d p gc bdcolor wid ht -- copy the pixmap with the new string to the window @@ -317,22 +322,22 @@ io $ sync d True verticalOffset :: (Integral b, Integral a, MonadIO m) => - a -> Widget -> XFont -> Config -> m b -verticalOffset ht (Text t) fontst conf - | textOffset conf > -1 = return $ fi (textOffset conf) + a -> Widget -> XFont -> Int -> Config -> m b +verticalOffset ht (Text t) fontst voffs _ + | voffs > -1 = return $ fi voffs | otherwise = do (as,ds) <- io $ textExtents fontst t let margin = (fi ht - fi ds - fi as) `div` 2 return $ fi as + margin - 1 -verticalOffset ht (Icon _) _ conf +verticalOffset ht (Icon _) _ _ conf | iconOffset conf > -1 = return $ fi (iconOffset conf) | otherwise = return $ fi (ht `div` 2) - 1 -- | An easy way to print the stuff we need to print -printStrings :: Drawable -> GC -> [XFont] -> Position +printStrings :: Drawable -> GC -> [XFont] -> [Int] -> Position -> Align -> [(Widget, String, Int, Position)] -> X () -printStrings _ _ _ _ _ [] = return () -printStrings dr gc fontlist offs a sl@((s,c,i,l):xs) = do +printStrings _ _ _ _ _ _ [] = return () +printStrings dr gc fontlist voffs offs a sl@((s,c,i,l):xs) = do r <- ask let (conf,d) = (config &&& display) r alph = alpha conf @@ -347,10 +352,10 @@ (fc,bc) = case break (==',') c of (f,',':b) -> (f, b ) (f, _) -> (f, bgColor conf) - valign <- verticalOffset ht s (head fontlist) conf + valign <- verticalOffset ht s (head fontlist) (voffs !! i) conf case s of (Text t) -> io $ printString d dr fontst gc fc bc offset valign t alph (Icon p) -> io $ maybe (return ()) (drawBitmap d dr gc fc bc offset valign) (lookup p (iconS r)) - printStrings dr gc fontlist (offs + l) a xs + printStrings dr gc fontlist voffs (offs + l) a xs diff --git a/xmobar.cabal b/xmobar.cabal --- a/xmobar.cabal +++ b/xmobar.cabal @@ -1,5 +1,5 @@ name: xmobar -version: 0.26 +version: 0.27 homepage: http://xmobar.org synopsis: A Minimalistic Text Based Status Bar description: Xmobar is a minimalistic text based status bar. @@ -46,7 +46,7 @@ Plugins.Monitors.Uptime, Plugins.Monitors.Bright, Plugins.Monitors.CatInt build-depends: - base == 4.*, + base >= 4.9.1.0 && < 4.12, hspec == 2.*, containers, regex-compat, @@ -61,6 +61,7 @@ X11 >= 1.6.1, mtl >= 2.1 && < 2.3, parsec == 3.1.*, + parsec-numbers == 0.1.0, stm >= 2.3 && < 2.5 source-repository head @@ -158,7 +159,7 @@ extra-libraries: Xrandr Xrender build-depends: - base == 4.*, + base >= 4.9.1.0 && < 4.12, containers, regex-compat, process, @@ -172,8 +173,16 @@ X11 >= 1.6.1, mtl >= 2.1 && < 2.3, parsec == 3.1.*, + parsec-numbers >= 0.1.0, stm >= 2.3 && < 2.5 + if impl(ghc < 8.0.2) + -- Disable building with GHC before 8.0.2. + -- Due to a cabal bug, do not use buildable: False, + -- but instead give it an impossible constraint. + -- See: https://github.com/haskell-infra/hackage-trustees/issues/165 + build-depends: unsupported-ghc-version > 1 && < 1 + if flag(with_threaded) -- -threaded is a workaround for 100% CPU busy loop -- (http://hackage.haskell.org/trac/ghc/ticket/4934). @@ -221,12 +230,12 @@ cpp-options: -DDATEZONE if flag(with_mpris) || flag(all_extensions) - build-depends: dbus >= 0.10 && < 1.0 + build-depends: dbus >= 1 other-modules: Plugins.Monitors.Mpris cpp-options: -DMPRIS if flag(with_dbus) || flag(all_extensions) - build-depends: dbus >= 0.10 + build-depends: dbus >= 1 other-modules: IPC.DBus cpp-options: -DDBUS