New plugin: MailX

3 files changed, 70 insertions, 9 deletions

diff --git a/changelog.md b/changelog.md
index ae5b4e0..967b973 100644
--- a/changelog.md
+++ b/changelog.md
@@ -2,6 +2,7 @@
 
 _New features_
 
+  - New plugin `MailX` extending `Mail` with colors and prefix/suffix.
   - New options `--lows`, `--mediums`, and `--highs` for `Battery`
     to display an additional string depending on battery level.
   - New options `-L` and `-H` for `Volume` to set low and high volume
diff --git a/readme.md b/readme.md
index a20a85f..6cff2ab 100644
--- a/readme.md
+++ b/readme.md
@@ -1275,6 +1275,30 @@ following differences:
                    ("lists", "~/var/mail/lists")]
                   "mail"
 
+### `MailX Args Opts Alias`
+
+- Args: list of maildirs in form
+  `[("name1","path1","color1"),...]`. Paths may start with a '~'
+  to expand to the user's home directory.  When mails are present,
+  counts are displayed with the given name and color.
+- Opts is a possibly empty list of options, as flags. Possible values:
+   -d dir  --dir dir a string giving the base directory where maildir files with
+                     a relative path live.
+   -p prefix --prefix prefix  a string giving a prefix for the list
+                      of displayed mail counts
+   -s suffix --suffix suffix  a string giving a suffix for the list
+                      of displayed mail counts
+- This plugin requires inotify support in your Linux kernel and the
+  [hinotify] package. To activate, pass `--flags="with_inotify"`
+  during compilation.
+- Example:
+
+         Run MailX [("I", "inbox", "green"),
+                    ("L", "lists", "orange")]
+                   ["-d", "~/var/mail", "-p", " ", "-s", " "]
+                   "mail"
+
+
 ### `MBox Mboxes Opts Alias`
 
 - Mboxes a list of mbox files of the form `[("name", "path", "color")]`,
diff --git a/src/Xmobar/Plugins/Mail.hs b/src/Xmobar/Plugins/Mail.hs
index 7325087..ee4a119 100644
--- a/src/Xmobar/Plugins/Mail.hs
+++ b/src/Xmobar/Plugins/Mail.hs
@@ -13,7 +13,7 @@
 --
 -----------------------------------------------------------------------------
 
-module Xmobar.Plugins.Mail(Mail(..)) where
+module Xmobar.Plugins.Mail(Mail(..),MailX(..)) where
 
 import Xmobar.Run.Exec
 #ifdef INOTIFY
@@ -26,6 +26,7 @@ import Control.Concurrent.STM
 import System.Directory
 import System.FilePath
 import System.INotify
+import System.Console.GetOpt
 
 import Data.List (isPrefixOf)
 import Data.Set (Set)
@@ -47,23 +48,56 @@ pack = id
 import System.IO
 #endif
 
+data MOptions = MOptions
+               { oDir :: FilePath
+               , oPrefix :: String
+               , oSuffix :: String
+               }
+
+defaults :: MOptions
+defaults = MOptions {oDir = "", oPrefix = "", oSuffix = ""}
+
+options :: [OptDescr (MOptions -> MOptions)]
+options =
+  [ Option "d" ["dir"] (ReqArg (\x o -> o { oDir = x }) "") ""
+  , Option "p" ["prefix"] (ReqArg (\x o -> o { oPrefix = x }) "") ""
+  , Option "s" ["suffix"] (ReqArg (\x o -> o { oSuffix = x }) "") ""
+  ]
+
+parseOptions :: [String] -> IO MOptions
+parseOptions args =
+  case getOpt Permute options args of
+    (o, _, []) -> return $ foldr id defaults o
+    (_, _, errs) -> ioError . userError $ concat errs
+
 
 -- | A list of mail box names and paths to maildirs.
 data Mail = Mail [(String, FilePath)] String
     deriving (Read, Show)
 
+-- | A list of mail box names, paths to maildirs and display colors.
+data MailX = MailX [(String, FilePath, String)] [String] String
+    deriving (Read, Show)
+
 instance Exec Mail where
-    alias (Mail _ a) = a
+  alias (Mail _ a) = a
+  start (Mail ms a) = start (MailX (map (\(n,p) -> (n,p,"")) ms) [] a)
+
+instance Exec MailX where
+    alias (MailX _ _ a) = a
 #ifndef INOTIFY
     start _ _ =
         hPutStrLn stderr $ "Warning: xmobar is not compiled with -fwith_inotify,"
                         ++ " but the Mail plugin requires it."
 #else
-    start (Mail ms _) cb = do
+    start (MailX ms args _) cb = do
         vs <- mapM (const $ newTVarIO S.empty) ms
-
-        let ts = map fst ms
-            rs = map ((</> "new") . snd) ms
+        opts <- parseOptions args
+        let prefix = oPrefix opts
+            suffix = oSuffix opts
+            dir = oDir opts
+            ps = map (\(_,p,_) -> if null dir then p else dir </> p) ms
+            rs = map (</> "new") ps
             ev = [Move, MoveIn, MoveOut, Create, Delete]
 
         ds <- mapM expandHome rs
@@ -76,9 +110,11 @@ instance Exec Mail where
             atomically $ modifyTVar v (S.union s)
 
         changeLoop (mapM (fmap S.size . readTVar) vs) $ \ns ->
-            cb . unwords $ [m ++ show n
-                            | (m, n) <- zip ts ns
-                            , n /= 0 ]
+            let showmbx m n c = if c == ""
+                                then m ++ show n
+                                else "<fc=" ++ c ++ ">" ++ m ++ show n ++ "</fc>"
+                cnts = [showmbx m n c | ((m,_,c), n) <- zip ms ns , n /= 0 ]
+            in cb $ if null cnts then "" else prefix ++ unwords cnts ++ suffix
 
 handle :: TVar (Set String) -> Event -> IO ()
 handle v e = atomically $ modifyTVar v $ case e of