diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Config.hs | 10 | ||||
| -rw-r--r-- | src/Main.hs | 6 | ||||
| -rw-r--r-- | src/Parsers.hs | 17 | ||||
| -rw-r--r-- | src/XUtil.hsc | 4 | ||||
| -rw-r--r-- | src/Xmobar.hs | 39 |
5 files changed, 49 insertions, 27 deletions
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 |