xmobar 0.26 → 0.27
raw patch · 14 files changed
+150/−59 lines, 14 filesdep +parsec-numbersdep +unsupported-ghc-versiondep ~basedep ~dbus
Dependencies added: parsec-numbers, unsupported-ghc-version
Dependency ranges changed: base, dbus
Files
- changelog.md +17/−0
- readme.md +8/−8
- src/Config.hs +6/−4
- src/IPC/DBus.hs +11/−6
- src/Main.hs +4/−2
- src/Parsers.hs +15/−2
- src/Plugins/BufferedPipeReader.hs +1/−1
- src/Plugins/EWMH.hs +3/−3
- src/Plugins/MBox.hs +10/−1
- src/Plugins/Mail.hs +16/−3
- src/Plugins/Monitors/Common.hs +19/−3
- src/XUtil.hsc +2/−2
- src/Xmobar.hs +24/−19
- xmobar.cabal +14/−5
changelog.md view
@@ -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_
readme.md view
@@ -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
src/Config.hs view
@@ -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
src/IPC/DBus.hs view
@@ -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)
src/Main.hs view
@@ -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
src/Parsers.hs view
@@ -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
src/Plugins/BufferedPipeReader.hs view
@@ -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
src/Plugins/EWMH.hs view
@@ -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'})
src/Plugins/MBox.hs view
@@ -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
src/Plugins/Mail.hs view
@@ -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
src/Plugins/Monitors/Common.hs view
@@ -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
src/XUtil.hsc view
@@ -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
src/Xmobar.hs view
@@ -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
xmobar.cabal view
@@ -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