New configuration parameter `textOffsets` (fixes #311)

8 files changed, 69 insertions, 28 deletions

diff --git a/changelog.md b/changelog.md
index 2f4d54f..1d7602d 100644
--- a/changelog.md
+++ b/changelog.md
@@ -1,3 +1,14 @@
+## Version 0.27
+
+_New features_
+
+  - New configuration option, `textOffsets` to specify separate
+    vertical offsets for each of the fonts in `additionalFonts`.  See
+    [issue #311].
+
+
+[issue #311]: https://github.com/jaor/xmobar/issues/311
+
 ## Version 0.26 (April, 2018)
 
 _New features_
diff --git a/readme.md b/readme.md
index 40ceee8..71ffe1b 100644
--- a/readme.md
+++ b/readme.md
@@ -215,7 +215,8 @@ Other configuration options:
   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 +259,11 @@ Other configuration options:
    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.
diff --git a/src/Config.hs b/src/Config.hs
index b131648..c9ce1a8 100644
--- a/src/Config.hs
+++ b/src/Config.hs
@@ -56,6 +56,7 @@ data Config =
            , 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 @@ defaultConfig =
            , borderWidth = 1
            , textOffset = -1
            , iconOffset = -1
+           , textOffsets = []
            , hideOnStart = False
            , lowerOnStart = True
            , persistent = False
@@ -151,8 +153,8 @@ infixr :*:
 -- 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/Main.hs b/src/Main.hs
index 0c96688..4f35b38 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -66,7 +66,9 @@ main = do
   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 @@ usage = usageInfo header options ++ footer
 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
index bab13cb..bb5c2ea 100644
--- a/src/Parsers.hs
+++ b/src/Parsers.hs
@@ -28,6 +28,7 @@ import Actions
 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 @@ parseConfig = runParser parseConf fields "Config" . stripComments
       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 @@ parseConfig = runParser parseConf fields "Config" . stripComments
       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 @@ parseConfig = runParser parseConf fields "Config" . stripComments
       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 @@ parseConfig = runParser parseConf fields "Config" . stripComments
                      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/XUtil.hsc b/src/XUtil.hsc
index 9063147..dcca342 100644
--- 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 @@ data XFont = Core FontStruct
 
 -- | 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
index 9c6c2c6..d4aa083 100644
--- a/src/Xmobar.hs
+++ b/src/Xmobar.hs
@@ -79,6 +79,7 @@ data XConf =
           , rect      :: Rectangle
           , window    :: Window
           , fontListS :: [XFont]
+          , verticalOffsets :: [Int]
           , iconS     :: Map FilePath Bitmap
           , config    :: Config
           }
@@ -90,7 +91,7 @@ runX xc f = runReaderT f xc
 -- | 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 @@ checker tvar ov vs signal = do
 
 
 -- | 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 @@ eventLoop tv xc@(XConf d r w fs is cfg) as signal = do
 
         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
@@ -281,7 +286,7 @@ drawInWin :: Rectangle -> [[(Widget, String, Int, Maybe [Action])]] -> X ()
 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 @@ drawInWin wr@(Rectangle _ _ wid ht) ~[left,center,right] = do
       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 @@ drawInWin wr@(Rectangle _ _ wid ht) ~[left,center,right] = do
     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 @@ printStrings dr gc fontlist offs a sl@((s,c,i,l):xs) = do
       (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
index a9523b8..92dd44f 100644
--- a/xmobar.cabal
+++ b/xmobar.cabal
@@ -61,6 +61,7 @@ test-suite XmobarTest
     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
@@ -172,6 +173,7 @@ executable xmobar
       X11 >= 1.6.1,
       mtl >= 2.1 && < 2.3,
       parsec == 3.1.*,
+      parsec-numbers >= 0.1.0,
       stm >= 2.3 && < 2.5
 
     if flag(with_threaded)