diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Xmobar/Text/Ansi.hs | 44 | ||||
-rw-r--r-- | src/Xmobar/Text/Loop.hs | 73 | ||||
-rw-r--r-- | src/Xmobar/Text/Output.hs | 41 | ||||
-rw-r--r-- | src/Xmobar/Text/Pango.hs | 35 |
4 files changed, 128 insertions, 65 deletions
diff --git a/src/Xmobar/Text/Ansi.hs b/src/Xmobar/Text/Ansi.hs new file mode 100644 index 0000000..2f1c2c4 --- /dev/null +++ b/src/Xmobar/Text/Ansi.hs @@ -0,0 +1,44 @@ +------------------------------------------------------------------------------ +-- | +-- Module: Xmobar.Text.Ansi +-- Copyright: (c) 2022 Jose Antonio Ortega Ruiz +-- License: BSD3-style (see LICENSE) +-- +-- Maintainer: jao@gnu.org +-- Stability: unstable +-- Portability: portable +-- Created: Fri Feb 4, 2022 01:10 +-- +-- +-- Codification with ANSI (color) escape codes +-- +------------------------------------------------------------------------------ + +module Xmobar.Text.Ansi (withAnsiColor) where + +import Data.List (intercalate) + +asInt :: String -> String +asInt x = case (reads $ "0x" ++ x) :: [(Integer, String)] of + [(v, "") ] -> show v + _ -> "" + +namedColor :: String -> String +namedColor c = + case c of + "black" -> "0"; "red" -> "1"; "green" -> "2"; "yellow" -> "3"; "blue" -> "4"; + "magenta" -> "5"; "cyan" -> "6"; "white" -> "7"; _ -> "" + +ansiCode :: String -> String +ansiCode ('#':r:g:[b]) = ansiCode ['#', '0', r, '0', g, '0', b] +ansiCode ('#':r0:r1:g0:g1:b0:[b1]) = + "2;" ++ intercalate ";" (map asInt [[r0,r1], [g0,g1], [b0,b1]]) +ansiCode ('#':n) = ansiCode n +ansiCode c = "5;" ++ if null i then namedColor c else i where i = asInt c + +withAnsiColor :: (String, String) -> String -> String +withAnsiColor (fg, bg) s = wrap "38;" fg (wrap "48;" bg s) + where wrap cd cl w = + if null cl + then w + else "\x1b[" ++ cd ++ ansiCode cl ++ "m" ++ w ++ "\x1b[0m" diff --git a/src/Xmobar/Text/Loop.hs b/src/Xmobar/Text/Loop.hs index 244c165..42c8700 100644 --- a/src/Xmobar/Text/Loop.hs +++ b/src/Xmobar/Text/Loop.hs @@ -17,9 +17,7 @@ module Xmobar.Text.Loop (loop) where import Prelude hiding (lookup) -import Text.Printf import System.IO -import Data.List (intercalate) import Control.Monad.Reader @@ -27,13 +25,14 @@ import Control.Concurrent.Async (Async) import Control.Concurrent.STM import Xmobar.System.Signal -import Xmobar.Config.Types (Config(textOutputFormat), TextOutputFormat(..)) + +import Xmobar.Config.Types (Config) + import qualified Xmobar.Run.Loop as Loop -import Xmobar.Run.Parsers ( Segment - , Widget(..) - , parseString - , tColorsString - , colorComponents) + +import Xmobar.Run.Parsers (parseString) + +import Xmobar.Text.Output (formatSegment) -- | Starts the main event loop and threads loop :: Config -> IO () @@ -64,64 +63,8 @@ updateString conf v = do let l:c:r:_ = s ++ repeat "" liftIO $ concat `fmap` mapM (parseStringAsText conf) [l, c, r] -asInt :: String -> String -asInt x = case (reads $ "0x" ++ x) :: [(Integer, String)] of - [(v, "") ] -> show v - _ -> "" - -namedColor :: String -> String -namedColor c = - case c of - "black" -> "0"; "red" -> "1"; "green" -> "2"; "yellow" -> "3"; "blue" -> "4"; - "magenta" -> "5"; "cyan" -> "6"; "white" -> "7"; _ -> "" - -ansiCode :: String -> String -ansiCode ('#':r:g:[b]) = ansiCode ['#', '0', r, '0', g, '0', b] -ansiCode ('#':r0:r1:g0:g1:b0:[b1]) = - "2;" ++ intercalate ";" (map asInt [[r0,r1], [g0,g1], [b0,b1]]) -ansiCode ('#':n) = ansiCode n -ansiCode c = "5;" ++ if null i then namedColor c else i where i = asInt c - -withAnsiColor :: (String, String) -> String -> String -withAnsiColor (fg, bg) s = wrap "38;" fg (wrap "48;" bg s) - where wrap cd cl w = - if null cl - 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 :: TextOutputFormat -> (String, String) -> String -> String -withColor format color = case format of - Plain -> id - Ansi -> withAnsiColor color - Pango -> withPangoColor color - - -asText :: Config -> Segment -> String -asText conf (Text s, info, _, _) = - withColor (textOutputFormat 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 _ _ = "" - parseStringAsText :: Config -> String -> IO String parseStringAsText c s = do segments <- parseString c s - let txts = map (asText c) segments + let txts = map (formatSegment c) segments return (concat txts) diff --git a/src/Xmobar/Text/Output.hs b/src/Xmobar/Text/Output.hs new file mode 100644 index 0000000..3754bd3 --- /dev/null +++ b/src/Xmobar/Text/Output.hs @@ -0,0 +1,41 @@ +-- | +-- Module: Xmobar.Text.Output +-- Copyright: (c) 2022 Jose Antonio Ortega Ruiz +-- License: BSD3-style (see LICENSE) +-- +-- Maintainer: jao@gnu.org +-- Stability: unstable +-- Portability: portable +-- Created: Fri Feb 4, 2022 01:10 +-- +-- +-- Format segments emitted by Commands into output strings +-- +------------------------------------------------------------------------------ + +module Xmobar.Text.Output (formatSegment) where + +import Xmobar.Config.Types (Config(textOutputFormat), TextOutputFormat(..)) +import Xmobar.Run.Parsers ( Segment + , Widget(..) + , tColorsString + , colorComponents) + +import Xmobar.Text.Ansi (withAnsiColor) +import Xmobar.Text.Pango (withPangoColor) + +withColor :: TextOutputFormat -> (String, String) -> String -> String +withColor format color = case format of + Plain -> id + Ansi -> withAnsiColor color + Pango -> withPangoColor color + + +formatSegment :: Config -> Segment -> String +formatSegment conf (Text s, info, _, _) = + withColor (textOutputFormat conf) components s + where components = colorComponents conf color + color = tColorsString info +formatSegment conf (Hspace n, i, x, y) = + formatSegment conf (Text $ replicate (fromIntegral n) ' ', i, x, y) +formatSegment _ _ = "" diff --git a/src/Xmobar/Text/Pango.hs b/src/Xmobar/Text/Pango.hs new file mode 100644 index 0000000..b8205ef --- /dev/null +++ b/src/Xmobar/Text/Pango.hs @@ -0,0 +1,35 @@ +------------------------------------------------------------------------------ +-- | +-- Module: Xmobar.Text.Pango +-- Copyright: (c) 2022 Jose Antonio Ortega Ruiz +-- License: BSD3-style (see LICENSE) +-- +-- Author: Pavel Kalugin +-- Maintainer: jao@gnu.org +-- Stability: unstable +-- Portability: portable +-- Created: Fri Feb 4, 2022 01:15 +-- +-- +-- Codification with Pango markup +-- +------------------------------------------------------------------------------ + +module Xmobar.Text.Pango (withPangoColor) where + +import Text.Printf (printf) + +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>" |