summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Xmobar/Text/Ansi.hs44
-rw-r--r--src/Xmobar/Text/Loop.hs73
-rw-r--r--src/Xmobar/Text/Output.hs41
-rw-r--r--src/Xmobar/Text/Pango.hs35
-rw-r--r--xmobar.cabal3
5 files changed, 131 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 '<' "&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 :: 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 '"' "&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>"
diff --git a/xmobar.cabal b/xmobar.cabal
index 0f3bdaa..b411834 100644
--- a/xmobar.cabal
+++ b/xmobar.cabal
@@ -127,7 +127,10 @@ library
Xmobar.System.Localize,
Xmobar.System.Signal,
Xmobar.System.Kbd,
+ Xmobar.Text.Ansi,
+ Xmobar.Text.Pango,
Xmobar.Text.Loop,
+ Xmobar.Text.Output,
Xmobar.X11.Events,
Xmobar.X11.Loop,
Xmobar.X11.Types,
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-10 23:03:42 +0000