summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar/Text/Swaybar.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Xmobar/Text/Swaybar.hs')
-rw-r--r--src/Xmobar/Text/Swaybar.hs31
1 files changed, 23 insertions, 8 deletions
diff --git a/src/Xmobar/Text/Swaybar.hs b/src/Xmobar/Text/Swaybar.hs
index 73ca75c..a2fc585 100644
--- a/src/Xmobar/Text/Swaybar.hs
+++ b/src/Xmobar/Text/Swaybar.hs
@@ -24,17 +24,19 @@ import Data.ByteString.Lazy.UTF8 (toString)
import GHC.Generics
-import Xmobar.Config.Types (Config)
+import Xmobar.Config.Types (Config (additionalFonts))
import Xmobar.Run.Parsers ( Segment
, Widget(..)
, Box(..)
, BoxBorder(..)
+ , FontIndex
, tBoxes
, tColorsString
, colorComponents)
import Xmobar.Text.SwaybarClicks (startHandler)
+import Xmobar.Text.Pango (withPangoFont)
data Preamble =
Preamble {version :: !Int, click_events :: Bool} deriving (Eq,Show,Generic)
@@ -46,17 +48,18 @@ preamble :: String
preamble = (asString $ Preamble { version = 1, click_events = True }) ++ "\x0A["
data Block =
- Block { full_text :: String
- , name :: String
+ Block { full_text :: !String
+ , name :: !String
, color :: Maybe String
, background :: Maybe String
- , separator :: Bool
- , separator_block_width :: Int
+ , 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
+ , markup :: Maybe String
} deriving (Eq,Show,Generic)
@@ -72,6 +75,7 @@ defaultBlock = Block { full_text = ""
, border_bottom = Nothing
, border_left = Nothing
, border_right = Nothing
+ , markup = Nothing
}
instance ToJSON Block where
@@ -98,10 +102,21 @@ withBox (Box b _ n c _) block =
bl = block { border_right = j0, border_left = j0
, border_bottom = j0, border_top = j0 }
+withFont :: Config -> FontIndex -> Block -> Block
+withFont conf idx block =
+ if idx < 1 || idx > length fonts then block
+ else block { markup = Just $ fonts !! (idx - 1) }
+ where fonts = additionalFonts conf
+
+withPango :: Block -> Block
+withPango block = case markup block of
+ Nothing -> block
+ Just fnt -> block { full_text = txt fnt, markup = Just "pango"}
+ where txt fn = withPangoFont fn (full_text block)
formatSwaybar' :: Config -> Segment -> Block
-formatSwaybar' conf (Text txt, info, _, as) =
- foldr withBox block (tBoxes info)
+formatSwaybar' conf (Text txt, info, idx, as) =
+ foldr withBox (withFont conf idx block) (tBoxes info)
where (fg, bg) = colorComponents conf (tColorsString info)
block = defaultBlock { full_text = txt
, color = Just fg
@@ -125,7 +140,7 @@ collectSegment config segment blocks =
where b = formatSwaybar' config segment
formatSwaybar :: Config -> [Segment] -> String
-formatSwaybar conf segs = asString blocks ++ ","
+formatSwaybar conf segs = asString (map withPango blocks) ++ ","
where blocks = foldr (collectSegment conf) [] segs
prepare :: IO ()