summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--src/Xmobar/Run/Parsers.hs1
-rw-r--r--src/Xmobar/Text/Pango.hs8
-rw-r--r--src/Xmobar/Text/Swaybar.hs31
3 files changed, 31 insertions, 9 deletions
diff --git a/src/Xmobar/Run/Parsers.hs b/src/Xmobar/Run/Parsers.hs
index 8a1ba0a..7c5e64c 100644
--- a/src/Xmobar/Run/Parsers.hs
+++ b/src/Xmobar/Run/Parsers.hs
@@ -17,6 +17,7 @@
module Xmobar.Run.Parsers ( parseString
, colorComponents
, Segment
+ , FontIndex
, Box(..)
, BoxBorder(..)
, BoxOffset(..)
diff --git a/src/Xmobar/Text/Pango.hs b/src/Xmobar/Text/Pango.hs
index b8205ef..38d1b5b 100644
--- a/src/Xmobar/Text/Pango.hs
+++ b/src/Xmobar/Text/Pango.hs
@@ -15,9 +15,10 @@
--
------------------------------------------------------------------------------
-module Xmobar.Text.Pango (withPangoColor) where
+module Xmobar.Text.Pango (withPangoColor, withPangoFont) where
import Text.Printf (printf)
+import Data.List (isPrefixOf)
replaceAll :: (Eq a) => a -> [a] -> [a] -> [a]
replaceAll c s = concatMap (\x -> if x == c then s else [x])
@@ -33,3 +34,8 @@ withPangoColor :: (String, String) -> String -> String
withPangoColor (fg, bg) s =
printf fmt (xmlEscape fg) (xmlEscape bg) (xmlEscape s)
where fmt = "<span foreground=\"%s\" background=\"%s\">%s</span>"
+
+withPangoFont :: String -> String -> String
+withPangoFont font txt = printf fmt pfn (xmlEscape txt)
+ where fmt = "<span font=\"%s\">%s</span>"
+ pfn = if "xft:" `isPrefixOf` font then drop 4 font else font
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 ()