summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar/X11/Parsers.hs
diff options
context:
space:
mode:
authorUnoqwy <julien.qwy@gmail.com>2020-07-25 00:10:30 +0200
committerUnoqwy <julien.qwy@gmail.com>2020-08-07 19:49:33 +0200
commit45126039c7d1a7c990e83c644df984823aff6656 (patch)
treea0dcb26cda22a10c69715f6e385816dea256a47e /src/Xmobar/X11/Parsers.hs
parentafc7a9eff0c3b65b0df83e05dd90d2c2c8202a6c (diff)
downloadxmobar-45126039c7d1a7c990e83c644df984823aff6656.tar.gz
xmobar-45126039c7d1a7c990e83c644df984823aff6656.tar.bz2
Add the <box> tag to set borders around text
Diffstat (limited to 'src/Xmobar/X11/Parsers.hs')
-rw-r--r--src/Xmobar/X11/Parsers.hs58
1 files changed, 47 insertions, 11 deletions
diff --git a/src/Xmobar/X11/Parsers.hs b/src/Xmobar/X11/Parsers.hs
index fded3b3..c25715c 100644
--- a/src/Xmobar/X11/Parsers.hs
+++ b/src/Xmobar/X11/Parsers.hs
@@ -14,7 +14,7 @@
--
-----------------------------------------------------------------------------
-module Xmobar.X11.Parsers (parseString, TextRenderInfo(..), Widget(..)) where
+module Xmobar.X11.Parsers (parseString, Box(..), BoxBorder(..), TextRenderInfo(..), Widget(..)) where
import Xmobar.Config.Types
import Xmobar.X11.Actions
@@ -25,15 +25,37 @@ import Data.Int (Int32)
import Text.ParserCombinators.Parsec
import Text.Read (readMaybe)
import Graphics.X11.Types (Button)
+import Foreign.C.Types (CInt)
data Widget = Icon String | Text String
-type AbsBgOffset = Int32
+data BoxBorder = BBTop
+ | BBBottom
+ | BBVBoth
+ | BBLeft
+ | BBRight
+ | BBHBoth
+ | BBFull
+ deriving ( Read, Eq )
+data Box = Box BoxBorder Align Int32 CInt String deriving ( Eq )
+instance Read Box where
+ readsPrec _ input = do
+ let b = case (words input) of
+ [pos] -> Just $ Box (read pos) C 0 1 "white"
+ [pos,alg] -> Just $ Box (read pos) (read alg) 0 1 "white"
+ [pos,alg,off] -> Just $ Box (read pos) (read alg) (read off) 1 "white"
+ [pos,alg,off,wdh] -> Just $ Box (read pos) (read alg) (read off) (read wdh) "white"
+ [pos,alg,off,wdh,c] -> Just $ Box (read pos) (read alg) (read off) (read wdh) c
+ _ -> Nothing
+ case b of
+ Just b' -> [(b', "")]
+ _ -> []
data TextRenderInfo =
- TextRenderInfo { tColorsString :: String
- , tBgTopOffset :: AbsBgOffset
- , tBgBottomOffset :: AbsBgOffset
- } deriving Show
+ TextRenderInfo { tColorsString :: String
+ , tBgTopOffset :: Int32
+ , tBgBottomOffset :: Int32
+ , tBoxes :: [Box]
+ }
type FontIndex = Int
-- | Runs the string parser
@@ -46,7 +68,7 @@ parseString c s =
, 0
, Nothing)]
Right x -> return (concat x)
- where ci = TextRenderInfo (fgColor c) 0 0
+ where ci = TextRenderInfo (fgColor c) 0 0 []
allParsers :: TextRenderInfo
-> FontIndex
@@ -57,7 +79,8 @@ allParsers c f a = textParser c f a
<|> try (rawParser c f a)
<|> try (actionParser c f a)
<|> try (fontParser c a)
- <|> colorParser f a
+ <|> try (boxParser c f a)
+ <|> colorParser c f a
-- | Gets the string and combines the needed parsers
stringParser :: TextRenderInfo -> FontIndex -> Maybe [Action]
@@ -71,12 +94,14 @@ textParser c f a = do s <- many1 $
noneOf "<" <|>
try (notFollowedBy' (char '<')
(try (string "fc=") <|>
+ try (string "box=") <|>
try (string "fn=") <|>
try (string "action=") <|>
try (string "/action>") <|>
try (string "icon=") <|>
try (string "raw=") <|>
try (string "/fn>") <|>
+ try (string "/box>") <|>
string "/fc>"))
return [(Text s, c, f, a)]
@@ -135,19 +160,30 @@ toButtons :: String -> [Button]
toButtons = map (\x -> read [x])
-- | Parsers a string wrapped in a color specification.
-colorParser :: FontIndex -> Maybe [Action]
+colorParser :: TextRenderInfo -> FontIndex -> Maybe [Action]
-> Parser [(Widget, TextRenderInfo, FontIndex, Maybe [Action])]
-colorParser f a = do
+colorParser (TextRenderInfo _ _ _ bs) f a = do
c <- between (string "<fc=") (string ">") colors
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 (TextRenderInfo (fst colorParts) (fromMaybe (-1) $ readMaybe ot) (fromMaybe (-1) $ readMaybe ob)) f a)
+ (allParsers (TextRenderInfo (fst colorParts) (fromMaybe (-1) $ readMaybe ot) (fromMaybe (-1) $ readMaybe ob) bs) f a)
(try $ string "</fc>")
return (concat s)
+-- | Parses a string wrapped in a box specification.
+boxParser :: TextRenderInfo -> FontIndex -> Maybe [Action]
+ -> Parser [(Widget, TextRenderInfo, FontIndex, Maybe [Action])]
+boxParser (TextRenderInfo cs ot ob bs) f a = do
+ c <- between (string "<box=") (string ">") (many1 (alphaNum <|> char ' ' <|> char '#'))
+ let b = fromMaybe (Box BBFull C 0 1 "white") $ readMaybe c
+ s <- manyTill
+ (allParsers (TextRenderInfo cs ot ob (b : bs)) f a)
+ (try $ string "</box>")
+ return (concat s)
+
-- | Parsers a string wrapped in a font specification.
fontParser :: TextRenderInfo -> Maybe [Action]
-> Parser [(Widget, TextRenderInfo, FontIndex, Maybe [Action])]