From 6ef984e25433608183004086f21a75e51209012c Mon Sep 17 00:00:00 2001
From: Marcin Mikołajczyk <marcinmikolajcz@gmail.com>
Date: Thu, 20 Feb 2014 15:27:43 +0100
Subject: Change actions syntax

---
 src/Actions.hs |  6 +++---
 src/Parsers.hs | 32 +++++++++++---------------------
 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
-- 
cgit v1.2.3