summaryrefslogtreecommitdiffhomepage
path: root/src/lib/Xmobar/X11
diff options
context:
space:
mode:
Diffstat (limited to 'src/lib/Xmobar/X11')
-rw-r--r--src/lib/Xmobar/X11/Bitmap.hs2
-rw-r--r--src/lib/Xmobar/X11/Draw.hs2
-rw-r--r--src/lib/Xmobar/X11/EventLoop.hs4
-rw-r--r--src/lib/Xmobar/X11/Parsers.hs146
-rw-r--r--src/lib/Xmobar/X11/Types.hs2
5 files changed, 151 insertions, 5 deletions
diff --git a/src/lib/Xmobar/X11/Bitmap.hs b/src/lib/Xmobar/X11/Bitmap.hs
index dee3966..c0dba14 100644
--- a/src/lib/Xmobar/X11/Bitmap.hs
+++ b/src/lib/Xmobar/X11/Bitmap.hs
@@ -24,7 +24,7 @@ import System.Directory (doesFileExist)
import System.FilePath ((</>))
import System.Mem.Weak ( addFinalizer )
import Xmobar.X11.ColorCache
-import Xmobar.Parsers (Widget(..))
+import Xmobar.X11.Parsers (Widget(..))
import Xmobar.Actions (Action)
#ifdef XPM
diff --git a/src/lib/Xmobar/X11/Draw.hs b/src/lib/Xmobar/X11/Draw.hs
index 3fe6f5c..d0c78a8 100644
--- a/src/lib/Xmobar/X11/Draw.hs
+++ b/src/lib/Xmobar/X11/Draw.hs
@@ -29,7 +29,6 @@ import Data.Map hiding (foldr, map, filter)
import Graphics.X11.Xlib hiding (textExtents, textWidth)
import Graphics.X11.Xlib.Extras
-import Xmobar.Parsers (Widget(..))
import Xmobar.Actions (Action(..))
import qualified Xmobar.X11.Bitmap as B
import Xmobar.X11.Types
@@ -37,6 +36,7 @@ import Xmobar.X11.XUtil
import Xmobar.Config
import Xmobar.X11.ColorCache
import Xmobar.X11.Window (drawBorder)
+import Xmobar.X11.Parsers (Widget(..))
#ifdef XFT
import Xmobar.X11.MinXft
diff --git a/src/lib/Xmobar/X11/EventLoop.hs b/src/lib/Xmobar/X11/EventLoop.hs
index 231d953..cc08acd 100644
--- a/src/lib/Xmobar/X11/EventLoop.hs
+++ b/src/lib/Xmobar/X11/EventLoop.hs
@@ -37,14 +37,14 @@ import Data.Map hiding (foldr, map, filter)
import Data.Maybe (fromJust, isJust)
import Xmobar.Config
-import Xmobar.Parsers
import Xmobar.Commands
import Xmobar.Actions
import Xmobar.Runnable
+import Xmobar.Utils
import Xmobar.System.Signal
+import Xmobar.X11.Parsers
import Xmobar.X11.Window
import Xmobar.X11.XUtil
-import Xmobar.Utils
import Xmobar.X11.Draw
import Xmobar.X11.Bitmap as Bitmap
import Xmobar.X11.Types
diff --git a/src/lib/Xmobar/X11/Parsers.hs b/src/lib/Xmobar/X11/Parsers.hs
new file mode 100644
index 0000000..8c1abac
--- /dev/null
+++ b/src/lib/Xmobar/X11/Parsers.hs
@@ -0,0 +1,146 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module : Xmobar.Parsers
+-- Copyright : (c) Andrea Rossato
+-- License : BSD-style (see LICENSE)
+--
+-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>
+-- Stability : unstable
+-- Portability : unportable
+--
+-- Parsing for template substrings
+--
+-----------------------------------------------------------------------------
+
+module Xmobar.X11.Parsers (parseString, Widget(..)) where
+
+import Xmobar.Config
+import Xmobar.Actions
+
+import Control.Monad (guard, mzero)
+import Text.ParserCombinators.Parsec
+import Graphics.X11.Types (Button)
+
+data Widget = Icon String | Text String
+
+type ColorString = String
+type FontIndex = Int
+
+-- | Runs the string parser
+parseString :: Config -> String
+ -> IO [(Widget, ColorString, FontIndex, Maybe [Action])]
+parseString c s =
+ case parse (stringParser (fgColor c) 0 Nothing) "" s of
+ Left _ -> return [(Text $ "Could not parse string: " ++ s
+ , fgColor c
+ , 0
+ , Nothing)]
+ Right x -> return (concat x)
+
+allParsers :: ColorString
+ -> FontIndex
+ -> Maybe [Action]
+ -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])]
+allParsers c f a = textParser c f a
+ <|> try (iconParser c f a)
+ <|> try (rawParser c f a)
+ <|> try (actionParser c f a)
+ <|> try (fontParser c a)
+ <|> colorParser f a
+
+-- | Gets the string and combines the needed parsers
+stringParser :: String -> FontIndex -> Maybe [Action]
+ -> Parser [[(Widget, ColorString, FontIndex, Maybe [Action])]]
+stringParser c f a = manyTill (allParsers c f a) eof
+
+-- | Parses a maximal string without color markup.
+textParser :: String -> FontIndex -> Maybe [Action]
+ -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])]
+textParser c f a = do s <- many1 $
+ noneOf "<" <|>
+ try (notFollowedBy' (char '<')
+ (try (string "fc=") <|>
+ try (string "fn=") <|>
+ try (string "action=") <|>
+ try (string "/action>") <|>
+ try (string "icon=") <|>
+ try (string "raw=") <|>
+ try (string "/fn>") <|>
+ string "/fc>"))
+ return [(Text s, c, f, a)]
+
+-- | Parse a "raw" tag, which we use to prevent other tags from creeping in.
+-- The format here is net-string-esque: a literal "<raw=" followed by a
+-- string of digits (base 10) denoting the length of the raw string,
+-- a literal ":" as digit-string-terminator, the raw string itself, and
+-- then a literal "/>".
+rawParser :: ColorString
+ -> FontIndex
+ -> Maybe [Action]
+ -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])]
+rawParser c f a = do
+ string "<raw="
+ lenstr <- many1 digit
+ char ':'
+ case reads lenstr of
+ [(len,[])] -> do
+ guard ((len :: Integer) <= fromIntegral (maxBound :: Int))
+ s <- count (fromIntegral len) anyChar
+ string "/>"
+ return [(Text s, c, f, a)]
+ _ -> mzero
+
+-- | Wrapper for notFollowedBy that returns the result of the first parser.
+-- Also works around the issue that, at least in Parsec 3.0.0, notFollowedBy
+-- accepts only parsers with return type Char.
+notFollowedBy' :: Parser a -> Parser b -> Parser a
+notFollowedBy' p e = do x <- p
+ notFollowedBy $ try (e >> return '*')
+ return x
+
+iconParser :: String -> FontIndex -> Maybe [Action]
+ -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])]
+iconParser c f a = do
+ string "<icon="
+ i <- manyTill (noneOf ">") (try (string "/>"))
+ return [(Icon i, c, f, a)]
+
+actionParser :: String -> FontIndex -> Maybe [Action]
+ -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])]
+actionParser c f act = do
+ string "<action="
+ command <- choice [between (char '`') (char '`') (many1 (noneOf "`")),
+ many1 (noneOf ">")]
+ buttons <- (char '>' >> return "1") <|> (space >> spaces >>
+ between (string "button=") (string ">") (many1 (oneOf "12345")))
+ let a = Spawn (toButtons buttons) command
+ a' = case act of
+ Nothing -> Just [a]
+ Just act' -> Just $ a : act'
+ s <- manyTill (allParsers c f a') (try $ string "</action>")
+ return (concat s)
+
+toButtons :: String -> [Button]
+toButtons = map (\x -> read [x])
+
+-- | Parsers a string wrapped in a color specification.
+colorParser :: FontIndex -> Maybe [Action]
+ -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])]
+colorParser f a = do
+ c <- between (string "<fc=") (string ">") colors
+ s <- manyTill (allParsers c f a) (try $ string "</fc>")
+ return (concat s)
+
+-- | Parsers a string wrapped in a font specification.
+fontParser :: ColorString -> Maybe [Action]
+ -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])]
+fontParser c a = do
+ f <- between (string "<fn=") (string ">") colors
+ s <- manyTill (allParsers c (read f) a) (try $ string "</fn>")
+ return (concat s)
+
+-- | Parses a color specification (hex or named)
+colors :: Parser String
+colors = many1 (alphaNum <|> char ',' <|> char '#')
diff --git a/src/lib/Xmobar/X11/Types.hs b/src/lib/Xmobar/X11/Types.hs
index 77249b3..c5c7ade 100644
--- a/src/lib/Xmobar/X11/Types.hs
+++ b/src/lib/Xmobar/X11/Types.hs
@@ -15,7 +15,7 @@
------------------------------------------------------------------------------
-module Xmobar.X11.Types (X , XConf (..)) where
+module Xmobar.X11.Types (X, XConf (..)) where
import Graphics.X11.Xlib
import Control.Monad.Reader
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 15:24:29 +0000