xmobar 0.19 → 0.20
raw patch · 24 files changed
+312/−168 lines, 24 filesdep +HTTPdep ~alsa-mixer
Dependencies added: HTTP
Dependency ranges changed: alsa-mixer
Files
- news.md +27/−0
- readme.md +37/−33
- src/Actions.hs +12/−5
- src/Bitmap.hs +1/−1
- src/Config.hs +1/−9
- src/Main.hs +9/−7
- src/Parsers.hs +26/−16
- src/Plugins/DateZone.hs +21/−7
- src/Plugins/MBox.hs +12/−1
- src/Plugins/Mail.hs +12/−0
- src/Plugins/Monitors.hs +5/−5
- src/Plugins/Monitors/Batt.hs +14/−11
- src/Plugins/Monitors/Common.hs +24/−11
- src/Plugins/Monitors/CoreCommon.hs +4/−3
- src/Plugins/Monitors/Disk.hs +8/−3
- src/Plugins/Monitors/MPD.hs +21/−7
- src/Plugins/Monitors/Mem.hs +5/−3
- src/Plugins/Monitors/Top.hs +6/−1
- src/Plugins/Monitors/Volume.hs +14/−12
- src/Plugins/Monitors/Weather.hs +28/−17
- src/Signal.hs +2/−1
- src/Window.hs +6/−3
- src/Xmobar.hs +14/−10
- xmobar.cabal +3/−2
news.md view
@@ -1,5 +1,32 @@ % xmobar - Release notes +## Version 0.20 (March 10, 2014)++_New features_++ - Mouse actions now support multiple buttons, by Marcin Mikołajczyk.+ - Non supported monitors are ignored in configuration files (see+ [issue #139]), by Adam Vogt.++_Bug fixes_++ - `Disk` monitor now ignores non-existent devices (Reto Hablützel).+ - `Weather` is now non-blocking and doesn't use curl (Ben Boeckel).+ - Fix for `Memory` monitor in 3.14 kernels (Ben Boeckel).+ - Fix for infinite loops in `AutoMPD` ([issue #76], [issue #111]).+ - More robust AC readings in `BatteryP`.+ - Fix for `Top` monitor's readings for processes whose name contains+ blanks.+ - Fixes for geometry computation on multihead (Dmitry Malikov).+ - Fixes for missing XDG configuration (Thiago Negri and James McCoy,+ see [issue #133]).+ - Compatibility with latest `directory` (1.2.0.2).++[issue #76]: https://github.com/jaor/xmobar/issues/76+[issue #111]: https://github.com/jaor/xmobar/issues/111+[issue #133]: https://github.com/jaor/xmobar/issues/133+[issue #139]: https://github.com/jaor/xmobar/issues/133+ ## Version 0.19 (October 27, 2013) As of this release, the old bug tracker at Google code is deprecated.
readme.md view
@@ -11,7 +11,7 @@ features, like dynamic color management, icons, output templates, and extensibility through plugins. -This page documents xmobar 0.19 (see [release notes]).+This page documents xmobar 0.20 (see [release notes]). [This screenshot] shows xmobar running under [sawfish], with antialiased fonts. And [this one] is my desktop with [xmonad] and two@@ -132,7 +132,7 @@ Requires the [dbus] and [text] packages. `with_inotify`-: Support for inotify in modern linux kernels. This option is needed+: Support for inotify in modern Linux kernels. This option is needed for the MBox and Mail plugins to work. Requires the [hinotify] package. @@ -197,7 +197,10 @@ - `<icon=/path/to/icon.xbm/>` will insert the given bitmap. -- `<action=command>` will execute given command.+- ```<action=`command` button=12345>``` will execute given command when+ clicked with specified buttons. If not specified, button is equal to 1+ (left mouse button). Using old syntax (without backticks surrounding `command`)+ will result in `button` attribute being ignored. Other configuration options: @@ -256,7 +259,7 @@ `allDesktops` : When set to True (the default), xmobar will tell the window manager- explicitily to be shown in all desktops, by setting+ explicitly to be shown in all desktops, by setting `_NET_WM_DESKTOP` to 0xffffffff. `overrideRedirect`@@ -347,7 +350,7 @@ controlled over dbus. All signals defined in [src/Signal.hs] as `data SignalType` can now be sent over dbus to xmobar. Due to current limitations of the implementation only one process of xmobar can-aquire the dbus. This is handled on a first-come-first-seved basis,+acquire the dbus. This is handled on a first-come-first-served basis, meaning that the first process will get the dbus interface. Other processes will run without further problems, yet have no dbus interface.@@ -461,9 +464,10 @@ It's also possible to use action directives of the form: - <action=command>+ <action=`command` button=12345> -which will be executed when clicked on.+which will be executed when clicked on with specified mouse buttons. This tag+can be nested, allowing different commands to be run depending on button clicked. ## The `commands` Configuration Option @@ -488,7 +492,7 @@ This example will run "xclock" command when date is clicked: - template="<action=xclock>%date%</action>+ template="<action=`xclock`>%date%</action> The only internal available command is `Com` (see below Executing External Commands). All other commands are provided by plugins. xmobar@@ -514,7 +518,7 @@ ### Default Monitor Arguments Monitors accept a common set of arguments, described in the first-subsection below. In additon, some monitors accept additional options+subsection below. In addition, some monitors accept additional options that are specific to them. When specifying the list of arguments in your configuration, the common options come first, followed by "--", followed by any monitor-specific options.@@ -646,15 +650,15 @@ ### `Weather StationID Args RefreshRate` -- Aliases to the Station ID: so `Weather "LIPB" []` can be used in template as `%LIPB%`+- Aliases to the Station ID: so `Weather "LIPB" []` can be used in+ template as `%LIPB%` - Args: default monitor arguments - Variables that can be used with the `-t`/`--template` argument: `station`, `stationState`, `year`, `month`, `day`, `hour`, `wind`, `visibility`, `skyCondition`, `tempC`, `tempF`, `dewPoint`, `rh`, `pressure` - Default template: `<station>: <tempC>C, rh <rh>% (<hour>)`-- Requires `curl` in the `$PATH` to retrieve weather information from- `http://weather.noaa.gov`+- Retrieves weather information from http://weather.noaa.gov. ### `Network Interface Args RefreshRate` @@ -751,7 +755,7 @@ - `-H`: high power threshold (default: -10) - `-l`: color to display power lower than the `-L` threshold - `-m`: color to display power lower than the `-H` threshold- - `-h`: color to display power highter than the `-H` threshold+ - `-h`: color to display power higher than the `-H` threshold - `-p`: color to display positive power (battery charging) - `-f`: file in `/sys/class/power_supply` with AC info (default: "AC/online")@@ -860,7 +864,7 @@ - Variables that can be used with the `-t`/`--template` argument: `temp` - Default template: `<temp>C`-- This plugin works only on sytems with devices having thermal zone.+- This plugin works only on systems with devices having thermal zone. Check directories in `/sys/class/thermal` for possible values of the zone number (e.g., 0 corresponds to `thermal_zone0` in that directory).@@ -878,7 +882,7 @@ - Variables that can be used with the `-t`/`--template` argument: `temp` - Default template: `Thm: <temp>C`-- This plugin works only on sytems with devices having thermal zone.+- This plugin works only on systems with devices having thermal zone. Check directories in /proc/acpi/thermal_zone for possible values. - Example: @@ -954,10 +958,10 @@ The environment variables `MPD_HOST` and `MPD_PORT` are used to configure the mpd server to communicate with. - Variables that can be used with the `-t`/`--template` argument:- `bar`, `state`, `statei`, `volume`, `length`+ `bar`, `state`, `statei`, `volume`, `length`, `lapsed`, `remaining`,- `plength` (playlist length), `ppos` (playlist position)- `name`, `artist`, `composer`, `performer`+ `plength` (playlist length), `ppos` (playlist position),+ `name`, `artist`, `composer`, `performer`, `album`, `title`, `track`, `file`, `genre` - Default template: `MPD: <state>` - Example (note that you need "--" to separate regular monitor options from@@ -1001,7 +1005,7 @@ - Args: list of maildirs in form `[("name1","path1"),...]`. Paths may start with a '~' to expand to the user's home directory.-- This plugin requires inotify support in your linux kernel and the+- This plugin requires inotify support in your Linux kernel and the [hinotify] package. To activate, pass `--flags="with_inotify"` during compilation. - Example:@@ -1021,11 +1025,11 @@ -d dir --dir dir a string giving the base directory where mbox files with a relative path live. -p prefix --prefix prefix a string giving a prefix for the list- of displayed mail coints+ of displayed mail counts -s suffix --suffix suffix a string giving a suffix for the list- of displayed mail coints+ of displayed mail counts - Paths may start with a '~' to expand to the user's home directory.-- This plugin requires inotify support in your linux kernel and the+- This plugin requires inotify support in your Linux kernel and the [hinotify] package. To activate, pass `--flags="with_inotify"` during compilation. - Example. The following command look for mails in `/var/mail/inbox`@@ -1059,7 +1063,7 @@ - `-C`: file with the current brightness (default: actual_brightness) - `-M`: file with the maximum brightness (default:- max_brigtness)+ max_brightness) - Variables that can be used with the `-t`/`--template` argument: `hbar`, `percent`, `bar` - Default template: `<percent>`@@ -1070,9 +1074,9 @@ ### `Kbd Opts` - Registers to XKB/X11-Events and output the currently active keyboard layout.- Supports replacement of layoutnames.+ Supports replacement of layout names. - Aliases to `kbd`-- Opts is a list of tuple:+- Opts is a list of tuples: - first element of the tuple is the search string - second element of the tuple is the corresponding replacement - Example:@@ -1137,7 +1141,7 @@ - Sample usage: send to xmobar's stdin the list of your workspaces enclosed by actions tags that switches the workspaces to be able to switch workspaces by clicking on xmobar:- `<action=xdotool key alt+1>ws1</action> <action=xdotool key alt+1>ws2</action>`+ ```<action=`xdotool key alt+1`>ws1</action> <action=`xdotool key alt+1`>ws2</action>``` <font size="+1">**`Date Format Alias RefreshRate`**</font> @@ -1176,13 +1180,13 @@ content is restored i.e. if there was already something from a previous pipe it will be put on display again, overwriting the current status.-- A pipe with Timout of 0 will be displayed permanently, just like+- A pipe with Timeout of 0 will be displayed permanently, just like `PipeReader` - The boolean option indicates whether new data for this pipe should make xmobar appear (unhide, reveal). In this case, the Timeout additionally specifies when the window should be hidden again. The output is restored in any case.-- Use it for OSD like status bars e.g. for setting the volume or+- Use it for OSD-like status bars e.g. for setting the volume or brightness: Run BufferedPipeReader "bpr"@@ -1346,11 +1350,11 @@ Cheplyaka, Patrick Chilton, John Goerzen, Reto Hablützel, Juraj Hercek, Tomas Janousek, Spencer Janssen, Jochen Keil, Lennart Kolmodin, Krzysztof Kosciuszkiewicz, Dmitry Kurochkin, Todd Lunter,-Dmitry Malikov, David McLean, Thiago Negri, Edward O'Callaghan, Svein-Ove, Martin Perner, Jens Petersen, Alexander Polakov, Petr Rockai,-Peter Simons, Andrew Sackville-West, Alexander Solovyov, John Soros,-Artem Tarasov, Sergei Trofimovich, Thomas Tuegel, Jan Vornberger,-Daniel Wagner and Norbert Zeh.+Dmitry Malikov, David McLean, Marcin Mikołajczyk, Thiago Negri, Edward+O'Callaghan, Svein Ove, Martin Perner, Jens Petersen, Alexander+Polakov, Petr Rockai, Peter Simons, Andrew Sackville-West, Alexander+Solovyov, John Soros, Artem Tarasov, Sergei Trofimovich, Thomas+Tuegel, Jan Vornberger, Daniel Wagner and Norbert Zeh. [jao]: http://jao.io [incorporates patches]: http://www.ohloh.net/p/xmobar/contributors
src/Actions.hs view
@@ -14,14 +14,21 @@ import System.Process (system) import Control.Monad (void)-import Text.Regex (subRegex, mkRegex)+import Text.Regex (Regex, subRegex, mkRegex, matchRegex)+import Graphics.X11.Types (Button) -data Action = Spawn String+data Action = Spawn [Button] String deriving (Eq) runAction :: Action -> IO ()-runAction (Spawn s) = void $ system (s ++ "&")+runAction (Spawn _ s) = void $ system (s ++ "&") stripActions :: String -> String-stripActions s = subRegex actionRegex s "[action=\1]\2[action]"- where actionRegex = mkRegex "<action=([^>])*>(.+)</action>"+stripActions s = case matchRegex actionRegex s of+ Nothing -> s+ Just _ -> stripActions strippedOneLevel+ where+ strippedOneLevel = subRegex actionRegex s $ "[action=\\1\\2]\\3[/action]"++actionRegex :: Regex+actionRegex = mkRegex "<action=`?([^>`]*)`?( +button=[12345]+)?>(.+)</action>"
src/Bitmap.hs view
@@ -30,7 +30,7 @@ } updateCache :: Display -> Window -> Map FilePath Bitmap ->- [[(Widget, String, Maybe Action)]] -> IO (Map FilePath Bitmap)+ [[(Widget, String, Maybe [Action])]] -> IO (Map FilePath Bitmap) updateCache dpy win cache ps = do let paths = map (\(Icon p, _, _) -> p) . concatMap (filter icons) $ ps icons (Icon _, _, _) = True
src/Config.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, TypeOperators #-}+{-# LANGUAGE TypeOperators #-} ----------------------------------------------------------------------------- -- |@@ -37,14 +37,10 @@ import Plugins.Kbd import Plugins.Locks -#ifdef INOTIFY import Plugins.Mail import Plugins.MBox-#endif -#ifdef DATEZONE import Plugins.DateZone-#endif -- $config -- Configuration data type and default configuration@@ -135,11 +131,7 @@ -- the plugin's type to the list of types (separated by ':*:') appearing in -- this function's type signature. runnableTypes :: Command :*: Monitors :*: Date :*: PipeReader :*: BufferedPipeReader :*: CommandReader :*: StdinReader :*: XMonadLog :*: EWMH :*: Kbd :*: Locks :*:-#ifdef INOTIFY Mail :*: MBox :*:-#endif-#ifdef DATEZONE DateZone :*:-#endif () runnableTypes = undefined
src/Main.hs view
@@ -105,14 +105,16 @@ -- | Read default configuration file or load the default config readDefaultConfig :: IO (Config,[String]) readDefaultConfig = do- xdgconf <- getXdgConfigFile- x <- io $ fileExist xdgconf+ xdgConfigFile <- getXdgConfigFile+ xdgConfigFileExists <- io $ fileExist xdgConfigFile home <- io $ getEnv "HOME"- let path = home ++ "/.xmobarrc"- f <- io $ fileExist path- if x then readConfig path- else if f then readConfig path- else return (defaultConfig,[])+ let defaultConfigFile = home ++ "/.xmobarrc"+ defaultConfigFileExists <- io $ fileExist defaultConfigFile+ if xdgConfigFileExists+ then readConfig xdgConfigFile+ else if defaultConfigFileExists+ then readConfig defaultConfigFile+ else return (defaultConfig,[]) data Opts = Help | Version
src/Parsers.hs view
@@ -28,13 +28,14 @@ import qualified Data.Map as Map import Text.ParserCombinators.Parsec import Text.ParserCombinators.Parsec.Perm+import Graphics.X11.Types (Button) data Widget = Icon String | Text String type ColorString = String -- | Runs the string parser-parseString :: Config -> String -> IO [(Widget, ColorString, Maybe Action)]+parseString :: Config -> String -> IO [(Widget, ColorString, Maybe [Action])] parseString c s = case parse (stringParser (fgColor c) Nothing) "" s of Left _ -> return [(Text $ "Could not parse string: " ++ s@@ -43,14 +44,14 @@ Right x -> return (concat x) -- | Gets the string and combines the needed parsers-stringParser :: String -> Maybe Action- -> Parser [[(Widget, ColorString, Maybe Action)]]+stringParser :: String -> Maybe [Action]+ -> Parser [[(Widget, ColorString, Maybe [Action])]] stringParser c a = manyTill (textParser c a <|> try (iconParser c a) <|>- try (actionParser c) <|> colorParser a) eof+ try (actionParser c a) <|> colorParser a) eof -- | Parses a maximal string without color markup.-textParser :: String -> Maybe Action- -> Parser [(Widget, ColorString, Maybe Action)]+textParser :: String -> Maybe [Action]+ -> Parser [(Widget, ColorString, Maybe [Action])] textParser c a = do s <- many1 $ noneOf "<" <|> try (notFollowedBy' (char '<')@@ -61,7 +62,6 @@ string "/fc>")) return [(Text s, c, a)] - -- | 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.@@ -70,28 +70,38 @@ notFollowedBy $ try (e >> return '*') return x -iconParser :: String -> Maybe Action- -> Parser [(Widget, ColorString, Maybe Action)]+iconParser :: String -> Maybe [Action]+ -> Parser [(Widget, ColorString, Maybe [Action])] iconParser c a = do string "<icon=" i <- manyTill (noneOf ">") (try (string "/>")) return [(Icon i, c, a)] -actionParser :: String -> Parser [(Widget, ColorString, Maybe Action)]-actionParser c = do- a <- between (string "<action=") (string ">") (many1 (noneOf ">"))- let a' = Just (Spawn a)+actionParser :: String -> Maybe [Action] -> Parser [(Widget, ColorString, Maybe [Action])]+actionParser c 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 (try (textParser c a') <|> try (iconParser c a') <|>- try (colorParser a') <|> actionParser c)+ try (colorParser a') <|> actionParser c a') (try $ string "</action>") return (concat 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)]+colorParser :: Maybe [Action] -> Parser [(Widget, ColorString, Maybe [Action])] colorParser a = do c <- between (string "<fc=") (string ">") colors s <- manyTill (try (textParser c a) <|> try (iconParser c a) <|>- try (colorParser a) <|> actionParser c) (try $ string "</fc>")+ try (colorParser a) <|> actionParser c a) (try $ string "</fc>") return (concat s) -- | Parses a color specification (hex or named)
src/Plugins/DateZone.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DoAndIfThenElse #-} ----------------------------------------------------------------------------- -- |@@ -23,30 +24,37 @@ import Plugins -import Localize +#ifdef DATEZONE import Control.Concurrent.STM +import System.IO.Unsafe++import Localize import Data.Time.LocalTime import Data.Time.Format import Data.Time.LocalTime.TimeZone.Olson import Data.Time.LocalTime.TimeZone.Series -import System.IO.Unsafe import System.Locale (TimeLocale)+#else+import System.IO+import Plugins.Date+#endif -{-# NOINLINE localeLock #-}--- ensures that only one plugin instance sets the locale-localeLock :: TMVar Bool-localeLock = unsafePerformIO (newTMVarIO False)- data DateZone = DateZone String String String String Int deriving (Read, Show) instance Exec DateZone where alias (DateZone _ _ _ a _) = a+#ifndef DATEZONE+ start (DateZone f _ _ a r) cb = do+ hPutStrLn stderr $ "Warning: DateZone plugin needs -fwith_datezone."+++ " Using Date plugin instead."+ start (Date f a r) cb+#else start (DateZone f l z _ r) cb = do lock <- atomically $ takeTMVar localeLock setupTimeLocale l@@ -60,6 +68,11 @@ where go func = func >>= cb >> tenthSeconds r >> go func +{-# NOINLINE localeLock #-}+-- ensures that only one plugin instance sets the locale+localeLock :: TMVar Bool+localeLock = unsafePerformIO (newTMVarIO False)+ date :: String -> TimeLocale -> IO String date format loc = getZonedTime >>= return . formatTime loc format @@ -67,3 +80,4 @@ dateZone format loc timeZone = getZonedTime >>= return . formatTime loc format . utcToLocalTime' timeZone . zonedTimeToUTC -- zonedTime <- getZonedTime -- return $ formatTime loc format $ utcToLocalTime' timeZone $ zonedTimeToUTC zonedTime+#endif
src/Plugins/MBox.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Plugins.MBox@@ -16,6 +17,7 @@ import Prelude import Plugins+#ifdef INOTIFY import Plugins.Utils (changeLoop, expandHome) import Control.Monad (when)@@ -57,6 +59,10 @@ (o, _, []) -> return $ foldr id defaults o (_, _, errs) -> ioError . userError $ concat errs +#else+import System.IO+#endif+ -- | A list of display names, paths to mbox files and display colours, -- followed by a list of options. data MBox = MBox [(String, FilePath, String)] [String] String@@ -64,8 +70,12 @@ instance Exec MBox where alias (MBox _ _ a) = a+#ifndef INOTIFY+ start _ _ = do+ hPutStrLn stderr $ "Warning: xmobar is not compiled with -fwith_inotify" +++ " but the MBox plugin requires it"+#else start (MBox boxes args _) cb = do- opts <- parseOptions args let showAll = oAll opts prefix = oPrefix opts@@ -109,3 +119,4 @@ (p, _) <- atomically $ readTVar v n <- countMails p atomically $ writeTVar v (p, n)+#endif
src/Plugins/Mail.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Plugins.Mail@@ -15,6 +16,7 @@ module Plugins.Mail where import Plugins+#ifdef INOTIFY import Plugins.Utils (expandHome, changeLoop) import Control.Monad@@ -27,13 +29,22 @@ import Data.List (isPrefixOf) import Data.Set (Set) import qualified Data.Set as S+#else+import System.IO+#endif + -- | A list of mail box names and paths to maildirs. data Mail = Mail [(String, FilePath)] String deriving (Read, Show) instance Exec Mail where alias (Mail _ a) = a+#ifndef INOTIFY+ start _ _ = do+ hPutStrLn stderr $ "Warning: xmobar is not compiled with -fwith_inotify,"+ ++ " but the Mail plugin requires it."+#else start (Mail ms _) cb = do vs <- mapM (const $ newTVarIO S.empty) ms @@ -65,3 +76,4 @@ where delete = S.delete (filePath e) create = S.insert (filePath e)+#endif
src/Plugins/Monitors.hs view
@@ -19,7 +19,7 @@ import Plugins -import Plugins.Monitors.Common (runM)+import Plugins.Monitors.Common (runM, runMD) import Plugins.Monitors.Weather import Plugins.Monitors.Net import Plugins.Monitors.Mem@@ -40,7 +40,7 @@ #endif #ifdef LIBMPD import Plugins.Monitors.MPD-import Plugins.Monitors.Common (runMB)+import Plugins.Monitors.Common (runMBD) #endif #ifdef ALSA import Plugins.Monitors.Volume@@ -136,7 +136,7 @@ start (MultiCpu a r) = startMultiCpu a r start (TopProc a r) = startTop a r start (TopMem a r) = runM a topMemConfig runTopMem r- start (Weather s a r) = runM (a ++ [s]) weatherConfig runWeather r+ start (Weather s a r) = runMD (a ++ [s]) weatherConfig runWeather r weatherReady start (Thermal z a r) = runM (a ++ [z]) thermalConfig runThermal r start (ThermalZone z a r) = runM (a ++ [show z]) thermalZoneConfig runThermalZone r@@ -155,8 +155,8 @@ start (Wireless i a r) = runM (a ++ [i]) wirelessConfig runWireless r #endif #ifdef LIBMPD- start (MPD a r) = runM a mpdConfig runMPD r- start (AutoMPD a) = runMB a mpdConfig runMPD mpdWait+ start (MPD a r) = runMD a mpdConfig runMPD r mpdReady+ start (AutoMPD a) = runMBD a mpdConfig runMPD mpdWait mpdReady #endif #ifdef ALSA start (Volume m c a r) = runM a volumeConfig (runVolume m c) r
src/Plugins/Monitors/Batt.hs view
@@ -87,6 +87,7 @@ , fNow :: String , fVoltage :: String , fCurrent :: String+ , isCurrent :: Bool } | NoFiles data Battery = Battery@@ -103,20 +104,21 @@ batteryFiles bat = do is_charge <- exists "charge_now" is_energy <- if is_charge then return False else exists "energy_now"- is_current <- exists "current_now"+ is_power <- exists "power_now" plain <- if is_charge then exists "charge_full" else exists "energy_full"- let cf = if is_current then "current_now" else "power_now"+ let cf = if is_power then "power_now" else "current_now" sf = if plain then "" else "_design" return $ case (is_charge, is_energy) of- (True, _) -> files "charge" cf sf- (_, True) -> files "energy" cf sf+ (True, _) -> files "charge" cf sf is_power+ (_, True) -> files "energy" cf sf is_power _ -> NoFiles where prefix = sysDir </> bat exists = safeFileExist prefix- files ch cf sf = Files { fFull = prefix </> ch ++ "_full" ++ sf- , fNow = prefix </> ch ++ "_now"- , fCurrent = prefix </> cf- , fVoltage = prefix </> "voltage_now" }+ files ch cf sf ip = Files { fFull = prefix </> ch ++ "_full" ++ sf+ , fNow = prefix </> ch ++ "_now"+ , fCurrent = prefix </> cf+ , fVoltage = prefix </> "voltage_now"+ , isCurrent = not ip} haveAc :: FilePath -> IO Bool haveAc f =@@ -129,9 +131,10 @@ do a <- grab $ fFull files b <- grab $ fNow files d <- grab $ fCurrent files- return $ Battery (3600 * a / sc) -- wattseconds- (3600 * b / sc) -- wattseconds- (d / sc) -- watts+ let sc' = if isCurrent files then sc / 10 else sc+ return $ Battery (3600 * a / sc') -- wattseconds+ (3600 * b / sc') -- wattseconds+ (d / sc') -- watts where grab f = handle onError $ withFile f ReadMode (fmap read . hGetLine) onError = const (return (-1)) :: SomeException -> IO Float
src/Plugins/Monitors/Common.hs view
@@ -23,7 +23,9 @@ , getConfigValue , mkMConfig , runM+ , runMD , runMB+ , runMBD , io -- * Parsers -- $parsers@@ -178,11 +180,14 @@ , Option "x" ["nastring"] (ReqArg NAString "N/A string") "String used when the monitor is not available" ] -doArgs :: [String] -> ([String] -> Monitor String) -> Monitor String-doArgs args action =+doArgs :: [String] -> ([String] -> Monitor String) -> ([String] -> Monitor Bool) -> Monitor String+doArgs args action detect = case getOpt Permute options args of (o, n, []) -> do doConfigOptions o- action n+ ready <- detect n+ if ready+ then action n+ else return "<Waiting...>" (_, _, errs) -> return (concat errs) doConfigOptions :: [Opts] -> Monitor ()@@ -216,10 +221,18 @@ -> (String -> IO ()) -> IO () runM args conf action r = runMB args conf action (tenthSeconds r) -runMB :: [String] -> IO MConfig -> ([String] -> Monitor String)- -> IO () -> (String -> IO ()) -> IO ()-runMB args conf action wait cb = handle (cb . showException) loop- where ac = doArgs args action+runMD :: [String] -> IO MConfig -> ([String] -> Monitor String) -> Int+ -> ([String] -> Monitor Bool) -> (String -> IO ()) -> IO ()+runMD args conf action r = runMBD args conf action (tenthSeconds r)++runMB :: [String] -> IO MConfig -> ([String] -> Monitor String) -> IO ()+ -> (String -> IO ()) -> IO ()+runMB args conf action wait = runMBD args conf action wait (\_ -> return True)++runMBD :: [String] -> IO MConfig -> ([String] -> Monitor String) -> IO ()+ -> ([String] -> Monitor Bool) -> (String -> IO ()) -> IO ()+runMBD args conf action wait detect cb = handle (cb . showException) loop+ where ac = doArgs args action detect loop = conf >>= runReaderT ac >>= cb >> wait >> loop showException :: SomeException -> String@@ -324,10 +337,10 @@ combine _ [] = return [] combine m ((s,ts,ss):xs) = do next <- combine m xs- let str = Map.findWithDefault err ts m- err = "<" ++ ts ++ " not found!>"- nstr <- parseTemplate' str m- return $ s ++ (if null nstr then str else nstr) ++ ss ++ next+ str <- case Map.lookup ts m of+ Nothing -> return $ "<" ++ ts ++ ">"+ Just r -> let f "" = r; f n = n; in fmap f $ parseTemplate' r m+ return $ s ++ str ++ ss ++ next -- $strings
src/Plugins/Monitors/CoreCommon.hs view
@@ -35,7 +35,8 @@ => [String] -> Maybe (String, String -> Int) -> (Double -> a) -> (a -> String) -> Monitor (Maybe String) retrieveData path lbl trans fmt = do- pairs <- map snd . sortBy (compare `on` fst) <$> (mapM readFiles =<< findFiles path lbl)+ pairs <- map snd . sortBy (compare `on` fst) <$>+ (mapM readFiles =<< findFilesAndLabel path lbl) if null pairs then return Nothing else Just <$> ( parseTemplate@@ -84,9 +85,9 @@ -- | Function to find all files matching the given path and possible label file. -- The path must be absolute (start with a leading slash).-findFiles :: [String] -> Maybe (String, String -> Int)+findFilesAndLabel :: [String] -> Maybe (String, String -> Int) -> Monitor [(String, Either Int (String, String -> Int))]-findFiles path lbl = catMaybes+findFilesAndLabel path lbl = catMaybes <$> ( mapM addLabel . zip [0..] . sort =<< recFindFiles (pathComponents path) "/" )
src/Plugins/Monitors/Disk.hs view
@@ -23,7 +23,8 @@ import Control.Monad (zipWithM) import qualified Data.ByteString.Lazy.Char8 as B import Data.List (isPrefixOf, find)-import System.Directory (canonicalizePath)+import Data.Maybe (catMaybes)+import System.Directory (canonicalizePath, doesFileExist) diskIOConfig :: IO MConfig diskIOConfig = mkMConfig "" ["total", "read", "write",@@ -40,11 +41,15 @@ mountedDevices :: [String] -> IO [(DevName, Path)] mountedDevices req = do s <- B.readFile "/etc/mtab"- parse `fmap` mapM canon (devs s)+ parse `fmap` mapM mbcanon (devs s) where+ mbcanon (d, p) = doesFileExist d >>= \e ->+ if e+ then Just `fmap` canon (d,p)+ else return Nothing canon (d, p) = do {d' <- canonicalizePath d; return (d', p)} devs = filter isDev . map (firstTwo . B.words) . B.lines- parse = map undev . filter isReq+ parse = map undev . filter isReq . catMaybes firstTwo (a:b:_) = (B.unpack a, B.unpack b) firstTwo _ = ("", "") isDev (d, _) = "/dev/" `isPrefixOf` d
src/Plugins/Monitors/MPD.hs view
@@ -12,12 +12,13 @@ -- ----------------------------------------------------------------------------- -module Plugins.Monitors.MPD ( mpdConfig, runMPD, mpdWait ) where+module Plugins.Monitors.MPD ( mpdConfig, runMPD, mpdWait, mpdReady ) where import Data.List import Plugins.Monitors.Common import System.Console.GetOpt import qualified Network.MPD as M+import Control.Concurrent (threadDelay) mpdConfig :: IO MConfig mpdConfig = mkMConfig "MPD: <state>"@@ -50,16 +51,29 @@ runMPD :: [String] -> Monitor String runMPD args = do opts <- io $ mopts args- let mpd = M.withMPD- status <- io $ mpd M.status- song <- io $ mpd M.currentSong+ status <- io $ M.withMPD M.status+ song <- io $ M.withMPD M.currentSong s <- parseMPD status song opts parseTemplate s mpdWait :: IO ()-mpdWait = M.withMPD idle >> return ()- where idle = M.idle [M.PlayerS, M.MixerS]+mpdWait = do+ status <- M.withMPD $ M.idle [M.PlayerS, M.MixerS]+ case status of+ Left _ -> threadDelay 10000000+ _ -> return () +mpdReady :: [String] -> Monitor Bool+mpdReady _ = do+ response <- io $ M.withMPD M.ping+ case response of+ Right _ -> return True+ -- Only cases where MPD isn't responding is an issue; bogus information at+ -- least won't hold xmobar up.+ Left M.NoMPD -> return False+ Left M.TimedOut -> return False+ Left _ -> return True+ mopts :: [String] -> IO MOpts mopts argv = case getOpt Permute options argv of@@ -68,7 +82,7 @@ parseMPD :: M.Response M.Status -> M.Response (Maybe M.Song) -> MOpts -> Monitor [String]-parseMPD (Left e) _ _ = return $ show e:repeat ""+parseMPD (Left e) _ _ = return $ show e:replicate 18 "" parseMPD (Right st) song opts = do songData <- parseSong song bar <- showPercentBar (100 * b) b
src/Plugins/Monitors/Mem.hs view
@@ -15,6 +15,7 @@ module Plugins.Monitors.Mem (memConfig, runMem, totalMem, usedMem) where import Plugins.Monitors.Common+import qualified Data.Map as M memConfig :: IO MConfig memConfig = mkMConfig@@ -28,10 +29,11 @@ parseMEM :: IO [Float] parseMEM = do file <- fileMEM- let content = map words $ take 4 $ lines file- [total, free, buffer, cache] = map (\line -> (read $ line !! 1 :: Float) / 1024) content+ let content = map words $ take 8 $ lines file+ info = M.fromList $ map (\line -> (line !! 0, (read $ line !! 1 :: Float) / 1024)) content+ [total, free, buffer, cache] = map (info M.!) ["MemTotal:", "MemFree:", "Buffers:", "Cached:"] rest = free + buffer + cache- used = total - rest+ used = total - (M.findWithDefault rest "MemAvailable:" info) usedratio = used / total freeratio = free / total return [usedratio, freeratio, total, free, buffer, cache, rest, used, freeratio]
src/Plugins/Monitors/Top.hs view
@@ -57,10 +57,15 @@ processes = fmap (filter isPid) (getDirectoryContents "/proc") where isPid = (`elem` ['0'..'9']) . head +statWords :: [String] -> [String]+statWords line@(x:pn:ppn:xs) =+ if last pn == ')' then line else statWords (x:(pn ++ " " ++ ppn):xs)+statWords _ = replicate 52 "0"+ getProcessData :: FilePath -> IO [String] getProcessData pidf = handle ign $ withFile ("/proc" </> pidf </> "stat") ReadMode readWords- where readWords = fmap words . hGetLine+ where readWords = fmap (statWords . words) . hGetLine ign = const (return []) :: SomeException -> IO [String] handleProcesses :: ([String] -> a) -> IO [a]
src/Plugins/Monitors/Volume.hs view
@@ -110,11 +110,13 @@ runVolume :: String -> String -> [String] -> Monitor String runVolume mixerName controlName argv = do opts <- io $ parseOpts argv- control <- io $ getControlByName mixerName controlName- (lo, hi) <- io . liftMaybe $ getRange <$> volumeControl control- val <- getVal $ volumeControl control- db <- getDB $ volumeControl control- sw <- getSw $ switchControl control+ (lo, hi, val, db, sw) <- io $ withMixer mixerName $ \mixer -> do+ control <- getControlByName mixer controlName+ (lo, hi) <- liftMaybe $ getRange <$> volumeControl control+ val <- getVal $ volumeControl control+ db <- getDB $ volumeControl control+ sw <- getSw $ switchControl control+ return (lo, hi, val, db, sw) p <- liftMonitor $ liftM3 formatVol lo hi val b <- liftMonitor $ liftM3 formatVolBar lo hi val d <- getFormatDB opts db@@ -138,18 +140,18 @@ liftMonitor Nothing = unavailable liftMonitor (Just m) = m - getDB :: Maybe Volume -> Monitor (Maybe Integer)+ getDB :: Maybe Volume -> IO (Maybe Integer) getDB Nothing = return Nothing- getDB (Just v) = io $ AE.catch (getChannel FrontLeft $ dB v)- (const $ return $ Just 0)+ getDB (Just v) = AE.catch (getChannel FrontLeft $ dB v)+ (const $ return $ Just 0) - getVal :: Maybe Volume -> Monitor (Maybe Integer)+ getVal :: Maybe Volume -> IO (Maybe Integer) getVal Nothing = return Nothing- getVal (Just v) = io $ getChannel FrontLeft $ value v+ getVal (Just v) = getChannel FrontLeft $ value v - getSw :: Maybe Switch -> Monitor (Maybe Bool)+ getSw :: Maybe Switch -> IO (Maybe Bool) getSw Nothing = return Nothing- getSw (Just s) = io $ getChannel FrontLeft s+ getSw (Just s) = getChannel FrontLeft s getFormatDB :: VolumeOpts -> Maybe Integer -> Monitor String getFormatDB _ Nothing = unavailable
src/Plugins/Monitors/Weather.hs view
@@ -16,10 +16,8 @@ import Plugins.Monitors.Common -import Control.Monad (when)-import System.Process-import System.Exit-import System.IO+import Control.Exception (catch, IOException)+import Network.HTTP import Text.ParserCombinators.Parsec @@ -129,20 +127,15 @@ defUrl :: String defUrl = "http://weather.noaa.gov/pub/data/observations/metar/decoded/" +stationUrl :: String -> String+stationUrl station = defUrl ++ station ++ ".TXT"+ getData :: String -> IO String-getData url=- do (i,o,e,p) <- runInteractiveCommand ("curl " ++ defUrl ++ url ++ ".TXT")- exit <- waitForProcess p- let closeHandles = do hClose o- hClose i- hClose e- case exit of- ExitSuccess -> do str <- hGetContents o- when (str == str) $ return ()- closeHandles- return str- _ -> do closeHandles- return "Could not retrieve data"+getData station = do+ let request = getRequest (stationUrl station)+ catch (simpleHTTP request >>= getResponseBody) errHandler+ where errHandler :: IOException -> IO String+ errHandler _ = return "<Could not retrieve data>" formatWeather :: [WeatherInfo] -> Monitor String formatWeather [(WI st ss y m d h w v sk tC tF dp r p)] =@@ -156,3 +149,21 @@ do d <- io $ getData $ head str i <- io $ runP parseData d formatWeather i++weatherReady :: [String] -> Monitor Bool+weatherReady str = do+ let station = head str+ request = headRequest (stationUrl station)+ io $ catch (simpleHTTP request >>= checkResult) errHandler+ where errHandler :: IOException -> IO Bool+ errHandler _ = return False+ checkResult result = do+ case result of+ Left _ -> return False+ Right response -> do+ case rspCode response of+ -- Permission or network errors are failures; anything+ -- else is recoverable.+ (4, _, _) -> return False+ (5, _, _) -> return False+ (_, _, _) -> return True
src/Signal.hs view
@@ -22,6 +22,7 @@ import Control.Concurrent.STM import Control.Exception hiding (handle) import System.Posix.Signals+import Graphics.X11.Types (Button) import Graphics.X11.Xlib.Types (Position) #ifdef DBUS@@ -41,7 +42,7 @@ | Reveal Int | Toggle Int | TogglePersistent- | Action Position+ | Action Button Position deriving (Read, Show) #ifdef DBUS
src/Window.hs view
@@ -22,7 +22,9 @@ import Graphics.X11.Xinerama import Foreign.C.Types (CLong) -import Data.Maybe(fromMaybe)+import Data.Function (on)+import Data.List (maximumBy)+import Data.Maybe (fromMaybe) import System.Posix.Process (getProcessID) import Config@@ -72,8 +74,8 @@ OnScreen _ p'' -> setPosition p'' [scr] ht where (scr@(Rectangle rx ry rw rh), p') =- case p of OnScreen i x -> (fromMaybe (head rs) $ safeIndex i rs, x)- _ -> (head rs, p)+ case p of OnScreen i x -> (fromMaybe (broadest rs) $ safeIndex i rs, x)+ _ -> (broadest rs, p) ny = ry + fi (rh - ht) center i = rx + fi (div (remwid i) 2) right i = rx + fi (remwid i)@@ -87,6 +89,7 @@ mh h' = max (fi h') h ny' h' = ry + fi (rh - mh h') safeIndex i = lookup i . zip [0..]+ broadest = maximumBy (compare `on` rect_width) setProperties :: Config -> Display -> Window -> IO () setProperties c d w = do
src/Xmobar.hs view
@@ -122,7 +122,7 @@ ConfigureEvent {} -> atomically $ putTMVar signal Reposition ExposeEvent {} -> atomically $ putTMVar signal Wakeup RRScreenChangeNotifyEvent {} -> atomically $ putTMVar signal Reposition- ButtonEvent {} -> atomically $ putTMVar signal (Action (fi $ ev_x ev))+ ButtonEvent {} -> atomically $ putTMVar signal (Action (ev_button ev) (fi $ ev_x ev)) _ -> return () -- | Send signal to eventLoop every time a var is updated@@ -144,7 +144,7 @@ -- | Continuously wait for a signal from a thread or a interrupt handler-eventLoop :: TVar [String] -> XConf -> [(Action, Position, Position)] -> TMVar SignalType -> IO ()+eventLoop :: TVar [String] -> XConf -> [([Action], Position, Position)] -> TMVar SignalType -> IO () eventLoop tv xc@(XConf d r w fs is cfg) as signal = do typ <- atomically $ takeTMVar signal case typ of@@ -169,7 +169,7 @@ TogglePersistent -> eventLoop tv xc { config = cfg { persistent = not $ persistent cfg } } as signal - Action x -> action x+ Action but x -> action but x where isPersistent = not $ persistent cfg@@ -211,8 +211,12 @@ o -> return (ocfg {position = OnScreen 1 o}) - action x = do mapM_ (\(a,_,_) -> runAction a) $ filter (\(_, from, to) -> x >= from && x <= to) as- eventLoop tv xc as signal+ action button x = do+ mapM_ runAction $+ filter (\(Spawn b _) -> button `elem` b) $+ concatMap (\(a,_,_) -> a) $+ filter (\(_, from, to) -> x >= from && x <= to) as+ eventLoop tv xc as signal -- $command @@ -233,17 +237,17 @@ return (Just h,var) where is = s ++ "Updating..." ++ ss -updateString :: Config -> TVar [String] -> IO [[(Widget, String, Maybe Action)]]+updateString :: Config -> TVar [String] -> IO [[(Widget, String, Maybe [Action])]] updateString conf v = do s <- atomically $ readTVar v let l:c:r:_ = s ++ repeat "" io $ mapM (parseString conf) [l, c, r] -updateActions :: XConf -> Rectangle -> [[(Widget, String, Maybe Action)]] ->- IO [(Action, Position, Position)]+updateActions :: XConf -> Rectangle -> [[(Widget, String, Maybe [Action])]] ->+ IO [([Action], Position, Position)] updateActions conf (Rectangle _ _ wid _) ~[left,center,right] = do let (d,fs) = (display &&& fontS) conf- strLn :: [(Widget, String, Maybe Action)] -> IO [(Maybe Action, Position, Position)]+ strLn :: [(Widget, String, Maybe [Action])] -> IO [(Maybe [Action], Position, Position)] strLn = io . mapM getCoords iconW i = maybe 0 Bitmap.width (lookup i $ iconS conf) getCoords (Text s,_,a) = textWidth d fs s >>= \tw -> return (a, 0, fi tw)@@ -266,7 +270,7 @@ -- $print -- | Draws in and updates the window-drawInWin :: Rectangle -> [[(Widget, String, Maybe Action)]] -> X ()+drawInWin :: Rectangle -> [[(Widget, String, Maybe [Action])]] -> X () drawInWin (Rectangle _ _ wid ht) ~[left,center,right] = do r <- ask let (c,d ) = (config &&& display) r
xmobar.cabal view
@@ -1,5 +1,5 @@ name: xmobar-version: 0.19+version: 0.20 homepage: http://projects.haskell.org/xmobar/ bug-reports: http://code.google.com/p/xmobar/issues synopsis: A Minimalistic Text Based Status Bar@@ -108,6 +108,7 @@ X11 >= 1.6.1, mtl >= 2.0 && < 2.2, parsec == 3.1.*,+ HTTP >= 4000, stm >= 2.3 && < 2.5 if flag(with_threaded)@@ -145,7 +146,7 @@ cpp-options: -DLIBMPD if flag(with_alsa) || flag(all_extensions)- build-depends: alsa-mixer == 0.1.*+ build-depends: alsa-mixer == 0.2.* build-depends: alsa-core == 0.5.* other-modules: Plugins.Monitors.Volume cpp-options: -DALSA