diff options
Diffstat (limited to 'src/Xmobar')
| -rw-r--r-- | src/Xmobar/App/Config.hs | 2 | ||||
| -rw-r--r-- | src/Xmobar/App/TextEventLoop.hs | 30 | ||||
| -rw-r--r-- | src/Xmobar/Config/Parse.hs | 7 | ||||
| -rw-r--r-- | src/Xmobar/Config/Types.hs | 6 | 
4 files changed, 36 insertions, 9 deletions
| 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 '"' """ $ +              replaceAll '\'' "'" $ +              replaceAll '<' "<" $ +              replaceAll '>' ">" $ +              replaceAll '&' "&" 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 | 
