summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar
diff options
context:
space:
mode:
authorjao <jao@gnu.org>2022-02-06 00:29:46 +0000
committerjao <jao@gnu.org>2022-02-06 00:29:46 +0000
commit89d958a838e1b1c80d56ec0b84abf853edc517d7 (patch)
treee1770b6552cb53cf420f7d5ee3521d0c06736c70 /src/Xmobar
parentafc2d1ed565910b372f65eaf77ea90878ac3ab2b (diff)
downloadxmobar-89d958a838e1b1c80d56ec0b84abf853edc517d7.tar.gz
xmobar-89d958a838e1b1c80d56ec0b84abf853edc517d7.tar.bz2
swaybar-protocol: borders (but not quite working as expected)
Diffstat (limited to 'src/Xmobar')
-rw-r--r--src/Xmobar/Text/Swaybar.hs76
1 files changed, 63 insertions, 13 deletions
diff --git a/src/Xmobar/Text/Swaybar.hs b/src/Xmobar/Text/Swaybar.hs
index 69739ed..b97cc15 100644
--- a/src/Xmobar/Text/Swaybar.hs
+++ b/src/Xmobar/Text/Swaybar.hs
@@ -28,6 +28,9 @@ import Xmobar.Config.Types (Config)
import Xmobar.Run.Parsers ( Segment
, Widget(..)
+ , Box(..)
+ , BoxBorder(..)
+ , tBoxes
, tColorsString
, colorComponents)
@@ -43,36 +46,83 @@ preamble :: String
preamble = (asString $ Preamble { version = 1, click_events = True }) ++ "\x0A["
data Block =
- Block { full_text :: !String
- , color :: !String
- , background :: !String
- , separator :: !Bool
- , separator_block_width :: !Int
- , name :: !String
+ Block { full_text :: String
+ , name :: String
+ , color :: Maybe String
+ , background :: Maybe String
+ , separator :: Bool
+ , separator_block_width :: Int
+ , border :: Maybe String
+ , border_top :: Maybe Int
+ , border_bottom :: Maybe Int
+ , border_left :: Maybe Int
+ , border_right :: Maybe Int
} deriving (Eq,Show,Generic)
+
defaultBlock :: Block
defaultBlock = Block { full_text = ""
, name = ""
- , color = ""
- , background = ""
+ , color = Nothing
+ , background = Nothing
, separator = False
- , separator_block_width = 0}
+ , separator_block_width = 0
+ , border = Nothing
+ , border_top = Nothing
+ , border_bottom = Nothing
+ , border_left = Nothing
+ , border_right = Nothing
+ }
+
+instance ToJSON Block where
+ toJSON = genericToJSON defaultOptions
+ { omitNothingFields = True }
instance ToJSON Preamble
-instance ToJSON Block
+
+withBox :: Box -> Block -> Block
+withBox (Box b _ n c _) bl =
+ (case b of
+ BBFull -> bl { border_right = w, border_left = w
+ , border_bottom = w, border_top = w }
+ BBTop -> bl { border_top = w }
+ BBBottom -> bl { border_bottom = w }
+ BBVBoth -> bl { border_bottom = w, border_top = w }
+ BBLeft -> bl { border_left = w }
+ BBRight -> bl { border_right = w }
+ BBHBoth -> bl { border_right = w, border_left = w }
+ ) { border = bc }
+ where w = Just (fromIntegral n)
+ bc = if null c then Nothing else Just c
formatSwaybar' :: Config -> Segment -> Block
formatSwaybar' conf (Text txt, info, _, as) =
- defaultBlock {full_text = txt , color = fg , background = bg , name = show as}
+ foldr withBox block (tBoxes info)
where (fg, bg) = colorComponents conf (tColorsString info)
+ block = defaultBlock { full_text = txt
+ , color = Just fg
+ , background = Just bg
+ , name = show as
+ }
formatSwaybar' conf (Hspace n, info, i, a) =
formatSwaybar' conf (Text (replicate (fromIntegral n) ' '), info, i, a)
formatSwaybar' _ _ = defaultBlock
+collectBlock :: Block -> [Block] -> [Block]
+collectBlock b [] = [b]
+collectBlock b (h:bs) =
+ if b {full_text = ""} == h {full_text = ""} then
+ h {full_text = full_text b ++ full_text h} : bs
+ else b:h:bs
+
+collectSegment :: Config -> Segment -> [Block] -> [Block]
+collectSegment config segment blocks =
+ if null $ full_text b then blocks else collectBlock b blocks
+ where b = formatSwaybar' config segment
+
formatSwaybar :: Config -> [Segment] -> String
-formatSwaybar conf segs = asString elems ++ ","
- where elems = filter (not . null . full_text) (map (formatSwaybar' conf) segs)
+formatSwaybar conf segs = asString blocks ++ ","
+ where blocks = foldr (collectSegment conf) [] segs
prepare :: IO ()
prepare = startHandler >> putStrLn preamble