summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Xmobar/App/EventLoop.hs6
-rw-r--r--src/Xmobar/X11/Bitmap.hs4
-rw-r--r--src/Xmobar/X11/Draw.hs26
-rw-r--r--src/Xmobar/X11/Parsers.hs57
4 files changed, 56 insertions, 37 deletions
diff --git a/src/Xmobar/App/EventLoop.hs b/src/Xmobar/App/EventLoop.hs
index e6232cd..2b33768 100644
--- a/src/Xmobar/App/EventLoop.hs
+++ b/src/Xmobar/App/EventLoop.hs
@@ -250,17 +250,17 @@ startCommand sig (com,s,ss)
where is = s ++ "Updating..." ++ ss
updateString :: Config -> TVar [String]
- -> IO [[(Widget, String, Int, Maybe [Action])]]
+ -> IO [[(Widget, ColorInfo, Int, Maybe [Action])]]
updateString conf v = do
s <- readTVarIO v
let l:c:r:_ = s ++ repeat ""
liftIO $ mapM (parseString conf) [l, c, r]
-updateActions :: XConf -> Rectangle -> [[(Widget, String, Int, Maybe [Action])]]
+updateActions :: XConf -> Rectangle -> [[(Widget, ColorInfo, Int, Maybe [Action])]]
-> IO [([Action], Position, Position)]
updateActions conf (Rectangle _ _ wid _) ~[left,center,right] = do
let (d,fs) = (display &&& fontListS) conf
- strLn :: [(Widget, String, Int, Maybe [Action])] -> IO [(Maybe [Action], Position, Position)]
+ strLn :: [(Widget, ColorInfo, Int, Maybe [Action])] -> IO [(Maybe [Action], Position, Position)]
strLn = liftIO . mapM getCoords
iconW i = maybe 0 Bitmap.width (lookup i $ iconS conf)
getCoords (Text s,_,i,a) = textWidth d (safeIndex fs i) s >>= \tw -> return (a, 0, fi tw)
diff --git a/src/Xmobar/X11/Bitmap.hs b/src/Xmobar/X11/Bitmap.hs
index e323606..e764384 100644
--- a/src/Xmobar/X11/Bitmap.hs
+++ b/src/Xmobar/X11/Bitmap.hs
@@ -24,7 +24,7 @@ import System.Directory (doesFileExist)
import System.FilePath ((</>))
import System.Mem.Weak ( addFinalizer )
import Xmobar.X11.ColorCache
-import Xmobar.X11.Parsers (Widget(..))
+import Xmobar.X11.Parsers (ColorInfo(..), Widget(..))
import Xmobar.X11.Actions (Action)
#ifdef XPM
@@ -54,7 +54,7 @@ data Bitmap = Bitmap { width :: Dimension
}
updateCache :: Display -> Window -> Map FilePath Bitmap -> FilePath ->
- [[(Widget, String, Int, Maybe [Action])]] -> IO (Map FilePath Bitmap)
+ [[(Widget, ColorInfo, Int, Maybe [Action])]] -> IO (Map FilePath Bitmap)
updateCache dpy win cache iconRoot ps = do
let paths = map (\(Icon p, _, _, _) -> p) . concatMap (filter icons) $ ps
icons (Icon _, _, _, _) = True
diff --git a/src/Xmobar/X11/Draw.hs b/src/Xmobar/X11/Draw.hs
index ab7c6df..003f579 100644
--- a/src/Xmobar/X11/Draw.hs
+++ b/src/Xmobar/X11/Draw.hs
@@ -36,7 +36,7 @@ import Xmobar.X11.Types
import Xmobar.X11.Text
import Xmobar.X11.ColorCache
import Xmobar.X11.Window (drawBorder)
-import Xmobar.X11.Parsers (Widget(..))
+import Xmobar.X11.Parsers (ColorInfo(..), Widget(..))
import Xmobar.System.Utils (safeIndex)
#ifdef XFT
@@ -48,7 +48,7 @@ fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
-- | Draws in and updates the window
-drawInWin :: Rectangle -> [[(Widget, String, Int, Maybe [Action])]] -> X ()
+drawInWin :: Rectangle -> [[(Widget, ColorInfo, Int, Maybe [Action])]] -> X ()
drawInWin wr@(Rectangle _ _ wid ht) ~[left,center,right] = do
r <- ask
let (c,d) = (config &&& display) r
@@ -102,33 +102,35 @@ verticalOffset ht (Icon _) _ _ conf
| otherwise = return $ fi (ht `div` 2) - 1
printString :: Display -> Drawable -> XFont -> GC -> String -> String
- -> Position -> Position -> String -> Int -> IO ()
-printString d p (Core fs) gc fc bc x y s a = do
+ -> Position -> Position -> Position -> Position -> String -> Int -> IO ()
+printString d p (Core fs) gc fc bc x y ay ht s a = do
setFont d gc $ fontFromFontStruct fs
withColors d [fc, bc] $ \[fc', bc'] -> do
setForeground d gc fc'
when (a == 255) (setBackground d gc bc')
drawImageString d p gc x y s
-printString d p (Utf8 fs) gc fc bc x y s a =
+printString d p (Utf8 fs) gc fc bc x y ay ht s a =
withColors d [fc, bc] $ \[fc', bc'] -> do
setForeground d gc fc'
when (a == 255) (setBackground d gc bc')
liftIO $ wcDrawImageString d p fs gc x y s
#ifdef XFT
-printString dpy drw fs@(Xft fonts) _ fc bc x y s al =
+printString dpy drw fs@(Xft fonts) _ fc bc x y ay ht s al =
withDrawingColors dpy drw fc bc $ \draw fc' bc' -> do
when (al == 255) $ do
(a,d) <- textExtents fs s
gi <- xftTxtExtents' dpy fonts s
- drawXftRect draw bc' x (y - a) (1 + xglyphinfo_xOff gi) (a + d + 2)
+ if ay < 0
+ then drawXftRect draw bc' x (y - a) (1 + xglyphinfo_xOff gi) (a + d + 2)
+ else drawXftRect draw bc' x ay (1 + xglyphinfo_xOff gi) ht
drawXftString' draw fc' fonts (toInteger x) (toInteger y) s
#endif
-- | An easy way to print the stuff we need to print
printStrings :: Drawable -> GC -> NE.NonEmpty XFont -> [Int] -> Position
- -> Align -> [(Widget, String, Int, Position)] -> X ()
+ -> Align -> [(Widget, ColorInfo, Int, Position)] -> X ()
printStrings _ _ _ _ _ _ [] = return ()
printStrings dr gc fontlist voffs offs a sl@((s,c,i,l):xs) = do
r <- ask
@@ -142,12 +144,16 @@ printStrings dr gc fontlist voffs offs a sl@((s,c,i,l):xs) = do
C -> (remWidth + offs) `div` 2
R -> remWidth
L -> offs
- (fc,bc) = case break (==',') c of
+ (fc,bc) = case break (==',') (colorsString c) of
(f,',':b) -> (f, b )
(f, _) -> (f, bgColor conf)
valign <- verticalOffset ht s (NE.head fontlist) (voffs !! i) conf
+ let (ht',ay) = case (bgTopOffset c, bgBottomOffset c) of
+ (-1,_) -> (0, -1)
+ (_,-1) -> (0, -1)
+ (ot,ob) -> ((fromIntegral ht) - ot - ob, ob)
case s of
- (Text t) -> liftIO $ printString d dr fontst gc fc bc offset valign t alph
+ (Text t) -> liftIO $ printString d dr fontst gc fc bc offset valign ay ht' t alph
(Icon p) -> liftIO $ maybe (return ())
(B.drawBitmap d dr gc fc bc offset valign)
(lookup p (iconS r))
diff --git a/src/Xmobar/X11/Parsers.hs b/src/Xmobar/X11/Parsers.hs
index 1d486d9..175de8c 100644
--- a/src/Xmobar/X11/Parsers.hs
+++ b/src/Xmobar/X11/Parsers.hs
@@ -14,37 +14,44 @@
--
-----------------------------------------------------------------------------
-module Xmobar.X11.Parsers (parseString, Widget(..)) where
+module Xmobar.X11.Parsers (parseString, ColorInfo(..), Widget(..)) where
import Xmobar.Config.Types
import Xmobar.X11.Actions
import Control.Monad (guard, mzero)
import Data.Maybe (fromMaybe)
+import Data.Int (Int32)
import Text.ParserCombinators.Parsec
import Text.Read (readMaybe)
import Graphics.X11.Types (Button)
data Widget = Icon String | Text String
-type ColorString = String
+type AbsBgOffset = Int32
+data ColorInfo =
+ ColorInfo { colorsString :: String
+ , bgTopOffset :: AbsBgOffset
+ , bgBottomOffset :: AbsBgOffset
+ } deriving Show
type FontIndex = Int
-- | Runs the string parser
parseString :: Config -> String
- -> IO [(Widget, ColorString, FontIndex, Maybe [Action])]
+ -> IO [(Widget, ColorInfo, FontIndex, Maybe [Action])]
parseString c s =
- case parse (stringParser (fgColor c) 0 Nothing) "" s of
+ case parse (stringParser ci 0 Nothing) "" s of
Left _ -> return [(Text $ "Could not parse string: " ++ s
- , fgColor c
+ , ci
, 0
, Nothing)]
Right x -> return (concat x)
+ where ci = ColorInfo (fgColor c) 0 0
-allParsers :: ColorString
+allParsers :: ColorInfo
-> FontIndex
-> Maybe [Action]
- -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])]
+ -> Parser [(Widget, ColorInfo, FontIndex, Maybe [Action])]
allParsers c f a = textParser c f a
<|> try (iconParser c f a)
<|> try (rawParser c f a)
@@ -53,13 +60,13 @@ allParsers c f a = textParser c f a
<|> colorParser f a
-- | Gets the string and combines the needed parsers
-stringParser :: String -> FontIndex -> Maybe [Action]
- -> Parser [[(Widget, ColorString, FontIndex, Maybe [Action])]]
+stringParser :: ColorInfo -> FontIndex -> Maybe [Action]
+ -> Parser [[(Widget, ColorInfo, FontIndex, Maybe [Action])]]
stringParser c f a = manyTill (allParsers c f a) eof
-- | Parses a maximal string without markup.
-textParser :: String -> FontIndex -> Maybe [Action]
- -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])]
+textParser :: ColorInfo -> FontIndex -> Maybe [Action]
+ -> Parser [(Widget, ColorInfo, FontIndex, Maybe [Action])]
textParser c f a = do s <- many1 $
noneOf "<" <|>
try (notFollowedBy' (char '<')
@@ -78,10 +85,10 @@ textParser c f a = do s <- many1 $
-- string of digits (base 10) denoting the length of the raw string,
-- a literal ":" as digit-string-terminator, the raw string itself, and
-- then a literal "/>".
-rawParser :: ColorString
+rawParser :: ColorInfo
-> FontIndex
-> Maybe [Action]
- -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])]
+ -> Parser [(Widget, ColorInfo, FontIndex, Maybe [Action])]
rawParser c f a = do
string "<raw="
lenstr <- many1 digit
@@ -102,15 +109,15 @@ notFollowedBy' p e = do x <- p
notFollowedBy $ try (e >> return '*')
return x
-iconParser :: String -> FontIndex -> Maybe [Action]
- -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])]
+iconParser :: ColorInfo -> FontIndex -> Maybe [Action]
+ -> Parser [(Widget, ColorInfo, FontIndex, Maybe [Action])]
iconParser c f a = do
string "<icon="
i <- manyTill (noneOf ">") (try (string "/>"))
return [(Icon i, c, f, a)]
-actionParser :: String -> FontIndex -> Maybe [Action]
- -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])]
+actionParser :: ColorInfo -> FontIndex -> Maybe [Action]
+ -> Parser [(Widget, ColorInfo, FontIndex, Maybe [Action])]
actionParser c f act = do
string "<action="
command <- choice [between (char '`') (char '`') (many1 (noneOf "`")),
@@ -129,15 +136,21 @@ toButtons = map (\x -> read [x])
-- | Parsers a string wrapped in a color specification.
colorParser :: FontIndex -> Maybe [Action]
- -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])]
+ -> Parser [(Widget, ColorInfo, FontIndex, Maybe [Action])]
colorParser f a = do
c <- between (string "<fc=") (string ">") colors
- s <- manyTill (allParsers c f a) (try $ string "</fc>")
+ let colorParts = break (==':') c
+ let (ot,ob) = case break (==',') (Prelude.drop 1 $ snd colorParts) of
+ (top,',':btm) -> (top, btm)
+ (top, _) -> (top, top)
+ s <- manyTill
+ (allParsers (ColorInfo (fst colorParts) (fromMaybe (-1) $ readMaybe ot) (fromMaybe (-1) $ readMaybe ob)) f a)
+ (try $ string "</fc>")
return (concat s)
-- | Parsers a string wrapped in a font specification.
-fontParser :: ColorString -> Maybe [Action]
- -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])]
+fontParser :: ColorInfo -> Maybe [Action]
+ -> Parser [(Widget, ColorInfo, FontIndex, Maybe [Action])]
fontParser c a = do
f <- between (string "<fn=") (string ">") colors
s <- manyTill (allParsers c (fromMaybe 0 $ readMaybe f) a) (try $ string "</fn>")
@@ -145,4 +158,4 @@ fontParser c a = do
-- | Parses a color specification (hex or named)
colors :: Parser String
-colors = many1 (alphaNum <|> char ',' <|> char '#')
+colors = many1 (alphaNum <|> char ',' <|> char ':' <|> char '#')
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 05:01:52 +0000