Text output: support choosing between Pango and ANSI markup

Signed-off-by: Pavel Kalugin <pavel@pavelthebest.me>

6 files changed, 38 insertions, 9 deletions

diff --git a/examples/xmobar.config b/examples/xmobar.config
index c0d4cdc..150f4fd 100644
--- a/examples/xmobar.config
+++ b/examples/xmobar.config
@@ -15,6 +15,7 @@ Config { font = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
        , iconRoot = "."
        , allDesktops = True
        , overrideRedirect = True
+       , textOutputColors = Ansi
        , commands = [ Run Weather "EGPF" ["-t","<station>: <tempC>C",
                                           "-L","18","-H","25",
                                           "--normal","green",
diff --git a/examples/xmobar.hs b/examples/xmobar.hs
index 4df8722..ea519eb 100644
--- a/examples/xmobar.hs
+++ b/examples/xmobar.hs
@@ -49,6 +49,7 @@ config = defaultConfig {
   , iconRoot = "."
   , allDesktops = True
   , overrideRedirect = True
+  , textOutputColors = Ansi
   , commands = [ Run $ Weather "EGPH" ["-t","<station>: <tempC>C",
                                         "-L","18","-H","25",
                                         "--normal","green",
diff --git a/src/Xmobar/App/Config.hs b/src/Xmobar/App/Config.hs
index bada3aa..34127aa 100644
--- a/src/Xmobar/App/Config.hs
+++ b/src/Xmobar/App/Config.hs
@@ -66,7 +66,7 @@ defaultConfig =
            , verbose = False
            , signal = SignalChan Nothing
            , textOutput = False
-           , ansiColors = True
+           , textOutputColors = Ansi
            }
 
 -- | Return the path to the xmobar data directory.  This directory is
diff --git a/src/Xmobar/App/TextEventLoop.hs b/src/Xmobar/App/TextEventLoop.hs
index 57f5c1a..3b754ac 100644
--- a/src/Xmobar/App/TextEventLoop.hs
+++ b/src/Xmobar/App/TextEventLoop.hs
@@ -17,6 +17,7 @@
 module Xmobar.App.TextEventLoop (textLoop) where
 
 import Prelude hiding (lookup)
+import Text.Printf
 import System.IO
 import Data.List (intercalate)
 
@@ -26,7 +27,7 @@ import Control.Concurrent.Async (Async)
 import Control.Concurrent.STM
 
 import Xmobar.System.Signal
-import Xmobar.Config.Types (Config, ansiColors)
+import Xmobar.Config.Types (Config(textOutputColors), TextColorFormat(..))
 import Xmobar.X11.Parsers (Segment, Widget(..), parseString, tColorsString, colorComponents)
 import Xmobar.App.CommandThreads (initLoop, loop)
 
@@ -84,10 +85,33 @@ withAnsiColor (fg, bg) s = wrap "38;" fg (wrap "48;" bg s)
           then w
           else "\x1b[" ++ cd ++ ansiCode cl ++ "m" ++ w ++ "\x1b[0m"
 
+replaceAll :: (Eq a) => a -> [a] -> [a] -> [a]
+replaceAll c s = concatMap (\x -> if x == c then s else [x])
+
+xmlEscape :: String -> String
+xmlEscape s = replaceAll '"' "&quot;" $
+              replaceAll '\'' "&apos;" $
+              replaceAll '<' "&lt;" $
+              replaceAll '>' "&gt;" $
+              replaceAll '&' "&amp;" s
+
+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>"
+
+withColor :: TextColorFormat -> (String, String) -> String -> String
+withColor format color = case format of
+                           NoColors -> id
+                           Ansi -> withAnsiColor color
+                           Pango -> withPangoColor color
+                                
+
 asText :: Config -> Segment -> String
 asText conf (Text s, info, _, _) =
-  if null color then s else withAnsiColor (colorComponents conf color) s
-  where color = if ansiColors conf then tColorsString info else ""
+  withColor (textOutputColors conf) components s
+  where components = colorComponents conf color
+        color = tColorsString info
 asText colors (Hspace n, i, x, y) =
   asText colors (Text $ replicate (fromIntegral n) ' ', i, x, y)
 asText _ _ = ""
diff --git a/src/Xmobar/Config/Parse.hs b/src/Xmobar/Config/Parse.hs
index 4c43e4d..fa99c59 100644
--- a/src/Xmobar/Config/Parse.hs
+++ b/src/Xmobar/Config/Parse.hs
@@ -62,7 +62,7 @@ parseConfig defaultConfig =
       perms = permute $ Config
               <$?> pFont <|?> pFontList <|?> pWmClass <|?> pWmName
               <|?> pBgColor <|?> pFgColor <|?> pPosition
-              <|?> pTextOutput <|?> pAnsiColors
+              <|?> pTextOutput <|?> pTextOutputColors
               <|?> pTextOffset <|?> pTextOffsets
               <|?> pIconOffset <|?> pBorder
               <|?> pBdColor <|?> pBdWidth <|?> pAlpha <|?> pHideOnStart
@@ -71,17 +71,18 @@ parseConfig defaultConfig =
               <|?> pCommands <|?> pSepChar <|?> pAlignSep <|?> pTemplate
               <|?> pVerbose <|?> pSignal
 
-      fields    = [ "font", "additionalFonts","bgColor", "fgColor"
+      fields    = [ "font", "additionalFonts", "bgColor", "fgColor"
                   , "wmClass", "wmName", "sepChar"
                   , "alignSep" , "border", "borderColor" ,"template"
                   , "position" , "textOffset", "textOffsets", "iconOffset"
                   , "allDesktops", "overrideRedirect", "pickBroadest"
                   , "hideOnStart", "lowerOnStart", "persistent", "iconRoot"
                   , "alpha", "commands", "verbose", "signal", "textOutput"
+                  , "textOutputColors"
                   ]
 
       pTextOutput = readField textOutput "textOutput"
-      pAnsiColors = readField textOutput "textAnsiColors"
+      pTextOutputColors = readField textOutputColors "textOutputColors"
       pFont = strField font "font"
       pFontList = strListField additionalFonts "additionalFonts"
       pWmClass = strField wmClass "wmClass"
diff --git a/src/Xmobar/Config/Types.hs b/src/Xmobar/Config/Types.hs
index 6ea012f..5f19528 100644
--- a/src/Xmobar/Config/Types.hs
+++ b/src/Xmobar/Config/Types.hs
@@ -16,7 +16,7 @@ module Xmobar.Config.Types
     ( -- * Configuration
       -- $config
       Config (..)
-    , XPosition (..), Align (..), Border(..)
+    , XPosition (..), Align (..), Border (..), TextColorFormat (..)
     , SignalChan (..)
     ) where
 
@@ -37,7 +37,7 @@ data Config =
            , fgColor :: String      -- ^ Default font color
            , position :: XPosition  -- ^ Top Bottom or Static
            , textOutput :: Bool     -- ^ Write data to stdout instead of X
-           , ansiColors :: Bool     -- ^ Use ANSI color escapes for stdout
+           , textOutputColors :: TextColorFormat -- ^ Which color format to use for stdout: Ansi or Pango
            , textOffset :: Int      -- ^ Offset from top of window for text
            , textOffsets :: [Int]   -- ^ List of offsets for additionalFonts
            , iconOffset :: Int      -- ^ Offset from top of window for icons
@@ -98,6 +98,8 @@ data Border = NoBorder
             | FullBM Int
               deriving ( Read, Show, Eq )
 
+data TextColorFormat = NoColors | Ansi | Pango deriving ( Read, Show, Eq )
+
 newtype SignalChan = SignalChan { unSignalChan :: Maybe (STM.TMVar SignalType) }
 
 instance Read SignalChan where