diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Xmobar/Run/Parsers.hs | 1 | ||||
| -rw-r--r-- | src/Xmobar/Text/Pango.hs | 8 | ||||
| -rw-r--r-- | src/Xmobar/Text/Swaybar.hs | 31 |
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 () |