summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
authorjao <jao@gnu.org>2022-09-14 05:07:24 +0100
committerjao <jao@gnu.org>2022-09-14 05:07:24 +0100
commitce453fdcc78679d1073e0ab22b603e43fe88347f (patch)
tree193a1a91bb96ab626fde93780d0267c541fe5519
parentdd69f889c6326e46b3ffb14b545134e1d6e2ee8f (diff)
downloadxmobar-ce453fdcc78679d1073e0ab22b603e43fe88347f.tar.gz
xmobar-ce453fdcc78679d1073e0ab22b603e43fe88347f.tar.bz2
whitespace
-rw-r--r--src/Xmobar/Run/Parsers.hs30
-rw-r--r--src/Xmobar/X11/XlibDraw.hs69
2 files changed, 52 insertions, 47 deletions
diff --git a/src/Xmobar/Run/Parsers.hs b/src/Xmobar/Run/Parsers.hs
index de983fd..982ef71 100644
--- a/src/Xmobar/Run/Parsers.hs
+++ b/src/Xmobar/Run/Parsers.hs
@@ -119,10 +119,7 @@ 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 :: TextRenderInfo
- -> FontIndex
- -> Maybe [Action]
- -> Parser [Segment]
+rawParser :: TextRenderInfo -> FontIndex -> Maybe [Action] -> Parser [Segment]
rawParser c f a = do
string "<raw="
lenstr <- many1 digit
@@ -174,21 +171,28 @@ toButtons = map (\x -> read [x])
-- | Parsers a string wrapped in a color specification.
colorParser :: TextRenderInfo -> FontIndex -> Maybe [Action] -> Parser [Segment]
-colorParser (TextRenderInfo _ _ _ bs) f a = do
+colorParser (TextRenderInfo _ _ _ bs) fidx 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) bs) f a)
- (try $ string "</fc>")
+ (top,',':btm) -> (top, btm)
+ (top, _) -> (top, top)
+ tri = TextRenderInfo (fst colorParts)
+ (fromMaybe (-1) $ readMaybe ot)
+ (fromMaybe (-1) $ readMaybe ob)
+ bs
+ s <- manyTill (allParsers tri fidx a) (try $ string "</fc>")
return (concat s)
-- | Parses a string wrapped in a box specification.
boxParser :: TextRenderInfo -> FontIndex -> Maybe [Action] -> Parser [Segment]
boxParser (TextRenderInfo cs ot ob bs) f a = do
- c <- between (string "<box") (string ">") (option "" (many1 (alphaNum <|> char '=' <|> char ' ' <|> char '#' <|> char ',')))
+ c <- between (string "<box") (string ">")
+ (option "" (many1 (alphaNum
+ <|> char '='
+ <|> char ' '
+ <|> char '#'
+ <|> char ',')))
let b = Box BBFull (BoxOffset C 0) 1 cs (BoxMargins 0 0 0 0)
let g = boxReader b (words c)
s <- manyTill
@@ -209,7 +213,9 @@ boxParamReader b _ "" = b
boxParamReader (Box bb off lw fc mgs) "type" val =
Box (fromMaybe bb $ readMaybe ("BB" ++ val)) off lw fc mgs
boxParamReader (Box bb (BoxOffset alg off) lw fc mgs) "offset" (a:o) =
- Box bb (BoxOffset (fromMaybe alg $ readMaybe [a]) (fromMaybe off $ readMaybe o)) lw fc mgs
+ Box bb (BoxOffset align offset) lw fc mgs
+ where offset = fromMaybe off $ readMaybe o
+ align = fromMaybe alg $ readMaybe [a]
boxParamReader (Box bb off lw fc mgs) "width" val =
Box bb off (fromMaybe lw $ readMaybe val) fc mgs
boxParamReader (Box bb off lw _ mgs) "color" val =
diff --git a/src/Xmobar/X11/XlibDraw.hs b/src/Xmobar/X11/XlibDraw.hs
index f6637c5..2f3f1a2 100644
--- a/src/Xmobar/X11/XlibDraw.hs
+++ b/src/Xmobar/X11/XlibDraw.hs
@@ -107,13 +107,12 @@ printStrings dr gc fontlist offs a boxes sl@((s,c,i,l):xs) = do
totSLen = foldr (\(_,_,_,len) -> (+) len) 0 sl
remWidth = fi wid - fi totSLen
fontst = safeIndex fontlist i
- voff = indexedOffset conf i
offset = case a of
C -> (remWidth + offs) `div` 2
R -> remWidth
L -> offs
(fc,bc) = colorComponents conf (tColorsString c)
- valign <- verticalOffset ht s fontst voff conf
+ valign <- verticalOffset ht s fontst (indexedOffset conf i) conf
let (ht',ay) = case (tBgTopOffset c, tBgBottomOffset c) of
(-1,_) -> (0, -1)
(_,-1) -> (0, -1)
@@ -134,39 +133,6 @@ printStrings dr gc fontlist offs a boxes sl@((s,c,i,l):xs) = do
else liftIO $ drawBoxes d dr gc (fromIntegral ht) dropBoxes
printStrings dr gc fontlist (offs + l) a boxes' xs
-drawBorder :: Border -> Int -> Display -> Drawable -> GC -> Pixel
- -> Dimension -> Dimension -> IO ()
-drawBorder b lw d p gc c wi ht = case b of
- NoBorder -> return ()
- TopB -> drawBorder (TopBM 0) lw d p gc c wi ht
- BottomB -> drawBorder (BottomBM 0) lw d p gc c wi ht
- FullB -> drawBorder (FullBM 0) lw d p gc c wi ht
- TopBM m -> sf >> sla >>
- drawLine d p gc 0 (fi m + boff) (fi wi) (fi m + boff)
- BottomBM m -> let rw = fi ht - fi m + boff in
- sf >> sla >> drawLine d p gc 0 rw (fi wi) rw
- FullBM m -> let mp = fi m
- pad = 2 * fi mp + fi lw
- in sf >> sla >>
- drawRectangle d p gc mp mp (wi - pad) (ht - pad)
- where sf = setForeground d gc c
- sla = setLineAttributes d gc (fi lw) lineSolid capNotLast joinMiter
- boff = borderOffset b lw
-
-borderOffset :: (Integral a) => Border -> Int -> a
-borderOffset b lw =
- case b of
- BottomB -> negate boffs
- BottomBM _ -> negate boffs
- TopB -> boffs
- TopBM _ -> boffs
- _ -> 0
- where boffs = calcBorderOffset lw
-
-calcBorderOffset :: (Integral a) => Int -> a
-calcBorderOffset = ceiling . (/2) . toDouble
- where toDouble = fi :: (Integral a) => a -> Double
-
drawBoxes :: Display -> Drawable -> GC
-> Position -> [((Position, Position), Box)]
-> IO ()
@@ -214,6 +180,39 @@ drawBoxBorder
_ -> error "unreachable code"
+drawBorder :: Border -> Int -> Display -> Drawable -> GC -> Pixel
+ -> Dimension -> Dimension -> IO ()
+drawBorder b lw d p gc c wi ht = case b of
+ NoBorder -> return ()
+ TopB -> drawBorder (TopBM 0) lw d p gc c wi ht
+ BottomB -> drawBorder (BottomBM 0) lw d p gc c wi ht
+ FullB -> drawBorder (FullBM 0) lw d p gc c wi ht
+ TopBM m -> sf >> sla >>
+ drawLine d p gc 0 (fi m + boff) (fi wi) (fi m + boff)
+ BottomBM m -> let rw = fi ht - fi m + boff in
+ sf >> sla >> drawLine d p gc 0 rw (fi wi) rw
+ FullBM m -> let mp = fi m
+ pad = 2 * fi mp + fi lw
+ in sf >> sla >>
+ drawRectangle d p gc mp mp (wi - pad) (ht - pad)
+ where sf = setForeground d gc c
+ sla = setLineAttributes d gc (fi lw) lineSolid capNotLast joinMiter
+ boff = borderOffset b lw
+
+borderOffset :: (Integral a) => Border -> Int -> a
+borderOffset b lw =
+ case b of
+ BottomB -> negate boffs
+ BottomBM _ -> negate boffs
+ TopB -> boffs
+ TopBM _ -> boffs
+ _ -> 0
+ where boffs = calcBorderOffset lw
+
+calcBorderOffset :: (Integral a) => Int -> a
+calcBorderOffset = ceiling . (/2) . toDouble
+ where toDouble = fi :: (Integral a) => a -> Double
+
updateActions :: Rectangle -> [[Segment]] -> X [([Action], Position, Position)]
updateActions (Rectangle _ _ wid _) ~[left,center,right] = do
conf <- ask