diff options
-rw-r--r-- | src/Actions.hs | 6 | ||||
-rw-r--r-- | src/Parsers.hs | 32 | ||||
-rw-r--r-- | src/Xmobar.hs | 2 |
3 files changed, 15 insertions, 25 deletions
diff --git a/src/Actions.hs b/src/Actions.hs index 2befe77..8772b07 100644 --- a/src/Actions.hs +++ b/src/Actions.hs @@ -17,7 +17,7 @@ import Control.Monad (void) import Text.Regex (Regex, subRegex, mkRegex, matchRegex) import Graphics.X11.Types (Button) -data Action = Spawn Button String +data Action = Spawn [Button] String deriving (Eq) runAction :: Action -> IO () @@ -28,7 +28,7 @@ stripActions s = case matchRegex actionRegex s of Nothing -> s Just _ -> stripActions strippedOneLevel where - strippedOneLevel = subRegex actionRegex s $ "[\\1=\\2]\\3[\\4]" + strippedOneLevel = subRegex actionRegex s $ "[action=\\1\\2]\\3[/action]" actionRegex :: Regex -actionRegex = mkRegex "<(action|button.)=([^>]*)>(.+)</(action|button.)>" +actionRegex = mkRegex "<action=`?([^>`]*)`?( +button=[12345]+)?>(.+)</action>" diff --git a/src/Parsers.hs b/src/Parsers.hs index 2b00f37..a1d60d8 100644 --- a/src/Parsers.hs +++ b/src/Parsers.hs @@ -56,17 +56,11 @@ textParser c a = do s <- many1 $ noneOf "<" <|> try (notFollowedBy' (char '<') (try (string "fc=") <|> - try (tryChoice openings) <|> - try (tryChoice closings) <|> + try (string "action=") <|> + try (string "/action>") <|> try (string "icon=") <|> string "/fc>")) return [(Text s, c, a)] - where - openings = map (++ "=") buttons - closings = map (\s -> '/' : s ++ ">") buttons - - tryChoice strs = choice $ map (try . string) strs - -- | 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 @@ -85,26 +79,22 @@ iconParser c a = do actionParser :: String -> Maybe [Action] -> Parser [(Widget, ColorString, Maybe [Action])] actionParser c act = do - string "<" - button <- choice $ map (try . string) buttons - command <- between (string "=") (string ">") (many1 (noneOf ">")) - let a = Spawn (toButton button) command + 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 (try (textParser c a') <|> try (iconParser c a') <|> try (colorParser a') <|> actionParser c a') - (try $ string $ "</" ++ button ++ ">") + (try $ string "</action>") return (concat s) --- List of accepted buttons plus action for backward compatibility -buttons :: [String] -buttons = "action" : zipWith (++) (repeat "button") (map show ([1..5] :: [Int])) - -toButton :: String -> Button -toButton s = case s of - "action" -> 1 - _ -> read $ [last s] +toButtons :: String -> [Button] +toButtons s = map (\x -> read [x]) s -- | Parsers a string wrapped in a color specification. colorParser :: Maybe [Action] -> Parser [(Widget, ColorString, Maybe [Action])] diff --git a/src/Xmobar.hs b/src/Xmobar.hs index 653ca69..ce32a0a 100644 --- a/src/Xmobar.hs +++ b/src/Xmobar.hs @@ -213,7 +213,7 @@ eventLoop tv xc@(XConf d r w fs is cfg) as signal = do action button x = do mapM_ runAction $ - filter (\(Spawn b _) -> button == b) $ + filter (\(Spawn b _) -> button `elem` b) $ concatMap (\(a,_,_) -> a) $ filter (\(_, from, to) -> x >= from && x <= to) as eventLoop tv xc as signal |