diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,16 @@ +## Version 0.48 (April, 2024) + +- The `Kbd` monitor is now clickable (thanks, Enrico Maria) +- Fix zombie processes left by `` tag and low battery action (thanks, + Ulrik) +- Fix plugins such as `Alsa` and `Com` not working when configuration is + recompiled (#657, ditto) +- New `Lock'` monitor with configurable labels (thanks, Enrico Maria) + +## Version 0.47.4 (March, 2024) + +- Bug fixes (launching processes from self-compiled instances) + ## Version 0.47.3 (February, 2024) - New flag `with_shared` to use xmobar with dynamic linking (see PR #690) diff --git a/doc/plugins.org b/doc/plugins.org --- a/doc/plugins.org +++ b/doc/plugins.org @@ -658,8 +658,9 @@ ** Keyboard and screen monitors *** =Kbd Opts= - - Registers to XKB/X11-Events and output the currently active keyboard - layout. Supports replacement of layout names. + - Registers to XKB/X11-Events, output the currently active keyboard + layout, and maps left and right clicks to switching to next and + previous layouts respectively. Supports replacement of layout names. - Aliases to =kbd= @@ -697,16 +698,35 @@ #+begin_src haskell Run Brightness ["-t", ""] 60 #+end_src + *** =Locks= - Displays the status of Caps Lock, Num Lock and Scroll Lock. - Aliases to =locks= + - Contructors: + + - =Locks= is nullary and uses the strings =CAPS=, =NUM=, =SCROLL= to signal + that a lock is enabled (and empty strings to signal it's disabled) + + - =Locks'= allow customizing the strings for the enabled/disabled states + of the 3 locks by accepting an assoc list of type =[(String, (String, String))]=, + which is expected to contain exactly 3 elements with keys + ="CAPS"=, ="NUM"=, ="SCROLL"=. + - Example: #+begin_src haskell + -- using default labels Run Locks + #+end_src + + #+begin_src haskell + -- using custom labels + Run $ Locks' [("CAPS" , ("\xf023", "\xf09c") ) + ,("NUM" , ("\xf047", "\xf047" ) ) + ,("SCROLL", ("SlOCK", "" ))] #+end_src ** Load and Process monitors diff --git a/etc/xmobar.el b/etc/xmobar.el --- a/etc/xmobar.el +++ b/etc/xmobar.el @@ -1,6 +1,6 @@ ;; xmobar.el --- Display xmobar text output -*- lexical-binding: t -*- -;; Copyright 2022, 2024 jao +;; Copyright 2022 jao ;; Version: 0.0.1 ;; Package-Requires: ((emacs "28.1")) ;; Keywords: unix @@ -98,33 +98,28 @@ (defun xmobar--update (update) "Apply an UPDATE to the xmobar bar." - (when (and xmobar-mode update) - (let* ((str (or (funcall xmobar--colorize-fn update) "")) + (when xmobar-mode + (let* ((str (funcall xmobar--colorize-fn update)) (strs (and xmobar-tab-split (split-string str xmobar-tab-split)))) (setq xmobar-string (if strs (cadr strs) str) xmobar--left-string (or (car strs) "") - xmobar--len (+ (string-width (or xmobar--left-string "")) - (string-width (or xmobar-string ""))))) + xmobar--len (+ (string-width xmobar--left-string) + (string-width xmobar-string)))) (force-mode-line-update t))) (defun xmobar--process-filter (proc string) "Process output from the xmobar process." - (when string - (let ((buf (process-buffer proc))) - (condition-case err - (when (buffer-live-p buf) - (with-current-buffer buf - ;; Write the input to the buffer (might be partial). - (save-excursion - (goto-char (process-mark proc)) - (insert string) - (set-marker (process-mark proc) (point))) - (when (string-match-p "\n$" string) - (xmobar--update (buffer-substring (point-min) (- (point-max) 1))) - (delete-region (point-min) (point-max))))) - (error (message "Error running xmobar filter: %s" - (error-message-string err)) - (xmobar--stop)))))) + (let ((buf (process-buffer proc))) + (when (buffer-live-p buf) + (with-current-buffer buf + ;; Write the input to the buffer (might be partial). + (save-excursion + (goto-char (process-mark proc)) + (insert string) + (set-marker (process-mark proc) (point))) + (when (string-match-p "\n$" string) + (xmobar--update (buffer-substring (point-min) (- (point-max) 1))) + (delete-region (point-min) (point-max))))))) (defun xmobar--process-sentinel (proc status) "Handle events from the xmobar process (PROC). diff --git a/readme.org b/readme.org --- a/readme.org +++ b/readme.org @@ -26,7 +26,7 @@ [[file:doc/screenshots/xmobar-exwm.png]] -Check [[src/branch/master/changelog.md][the change log]] for our release history. We also have an IRC +Check [[https://codeberg.org/xmobar/xmobar/src/branch/master/changelog.md][the change log]] for our release history. We also have an IRC channel, ~#xmobar~, at [[ircs://irc.libera.chat][Libera]]. * Breaking news @@ -43,9 +43,9 @@ should be mostly transparent, except for the facts that it's allowed fixing quite a few bugs and that your /font names/ in your configuration, if you used ~xft~ ones, might need to be adapted to Pango's syntax: please see - [[src/branch/master/doc/quick-start.org#fonts][this section of the documentation]] for all the details. If you're + [[https://codeberg.org/xmobar/xmobar/src/branch/master/doc/quick-start.org#fonts][this section of the documentation]] for all the details. If you're compiling your own xmobar, there's a new dependency on libpango (see - [[src/branch/master/doc/compiling.org#c-libraries][C library dependencies]]). + [[https://codeberg.org/xmobar/xmobar/src/branch/master/doc/compiling.org#c-libraries][C library dependencies]]). * Installation :PROPERTIES: @@ -90,7 +90,7 @@ ** Using cabal or stack Xmobar is available from [[http://hackage.haskell.org/package/xmobar/][Hackage]], and you can compile and install it using - =cabal-install=, making sure the [[src/branch/master/doc/compiling.org#c-libraries][required C libraries]] are in place. For a + =cabal-install=, making sure the [[https://codeberg.org/xmobar/xmobar/src/branch/master/doc/compiling.org#c-libraries][required C libraries]] are in place. For a full build with all available extensions: #+begin_src shell @@ -105,10 +105,10 @@ Starting with version 0.35.1, xmobar requires at least GHC version 8.4.x. to build. See [[https://codeberg.org/xmobar/xmobar/issues/461][this issue]] for more information. - See [[src/branch/master/doc/compiling.org#optional-features][here]] for a list of optional compilation flags that will enable some + See [[https://codeberg.org/xmobar/xmobar/src/branch/master/doc/compiling.org#optional-features][here]] for a list of optional compilation flags that will enable some optional plugins. - See [[src/branch/master/doc/compiling.org][compiling]] for full compilation instructions starting from source. + See [[https://codeberg.org/xmobar/xmobar/src/branch/master/doc/compiling.org][compiling]] for full compilation instructions starting from source. * Running xmobar ** Running xmobar with a configuration file @@ -129,7 +129,7 @@ or =~/.xmobarrc=. All the available command line switches and configuration parameters are - described in [[src/branch/master/doc/quick-start.org][the quick start guide]] and [[src/branch/master/doc/plugins.org][the plugins index]]. + described in [[https://codeberg.org/xmobar/xmobar/src/branch/master/doc/quick-start.org][the quick start guide]] and [[https://codeberg.org/xmobar/xmobar/src/branch/master/doc/plugins.org][the plugins index]]. ** Writing your own xmobar in Haskell @@ -139,7 +139,7 @@ Haskell instead of using a configuration file. (This is very similar to how [[http://xmonad.org][xmonad]] works.) That gives you the ability of using Haskell and its libraries to extend xmobar to your heart's content. If you are a - programmer, take a look [[src/branch/master/doc/using-haskell.org][here]] to learn more. + programmer, take a look [[https://codeberg.org/xmobar/xmobar/src/branch/master/doc/using-haskell.org][here]] to learn more. ** Running xmobar in text mode @@ -147,24 +147,24 @@ it is possible to redirect xmobar's output to the standard output, optionally with color escape sequences. In this mode, xmobar can be run inside a terminal o console, or its output piped to other applications, and - there is no need for an X11 display. See [[src/branch/master/doc/quick-start.org#text-mode][Running xmobar in text mode]] for - details. Using this mode, you could [[src/branch/master/doc/quick-start.org#wayland][pipe xmobar's output to, say, swaybar]], - and use it in wayland, or, with the [[src/branch/master/etc/xmobar.el][xmobar.el]] package, show it in Emacs's + there is no need for an X11 display. See [[https://codeberg.org/xmobar/xmobar/src/branch/master/doc/quick-start.org#text-mode][Running xmobar in text mode]] for + details. Using this mode, you could [[https://codeberg.org/xmobar/xmobar/src/branch/master/doc/quick-start.org#wayland][pipe xmobar's output to, say, swaybar]], + and use it in wayland, or, with the [[https://codeberg.org/xmobar/xmobar/src/branch/master/etc/xmobar.el][xmobar.el]] package, show it in Emacs's tab bar. * Configuration and further documentation - If you want to jump straight into running xmobar, head over to the - [[src/branch/master/doc/quick-start.org][quick start guide]]. + [[https://codeberg.org/xmobar/xmobar/src/branch/master/doc/quick-start.org][quick start guide]]. - If you want to get a detailed overview of all available plugins and - monitors, visit the [[src/branch/master/doc/plugins.org][plugins index]]. + monitors, visit the [[https://codeberg.org/xmobar/xmobar/src/branch/master/doc/plugins.org][plugins index]]. - For more information on how to use xmobar as a Haskell library see the - [[src/branch/master/doc/using-haskell.org][using Haskell guide]]. + [[https://codeberg.org/xmobar/xmobar/src/branch/master/doc/using-haskell.org][using Haskell guide]]. - If you want to know how to contribute to the xmobar project, check out - [[src/branch/master/contributing.org][contributing]]. + [[https://codeberg.org/xmobar/xmobar/src/branch/master/contributing.org][contributing]]. * Authors and credits @@ -173,24 +173,24 @@ the greater xmobar and Haskell communities. In particular, xmobar incorporates patches by Kostas Agnantis, Mohammed - Alshiekh, Alex Ameen, Axel Angel, Dhananjay Balan, Claudio Bley, Dragos - Boca, Ben Boeckel, Ivan Brennan, Duncan Burke, Roman Cheplyaka, Patrick - Chilton, Antoine Eiche, Nathaniel Wesley Filardo, Guy Gastineau, John - Goerzen, Jonathan Grochowski, Patrick Günther, Reto Hablützel, Corey Halpin, - Juraj Hercek, Jaroslaw Jantura, Tomáš Janoušek, Ada Joule, Spencer Janssen, - Roman Joost, Pavel Kalugin, Jochen Keil, Sam Kirby, Lennart Kolmodin, - Krzysztof Kosciuszkiewicz, Dmitry Kurochkin, Todd Lunter, Vanessa McHale, - Robert J. Macomber, Dmitry Malikov, David McLean, Joan Milev, Marcin - Mikołajczyk, Dino Morelli, Tony Morris, Eric Mrak, Thiago Negri, Edward - O'Callaghan, Svein Ove, Martin Perner, Jens Petersen, Alexander Polakov, - Sibi Prabakaran, Pavan Rikhi, Petr Rockai, Andrew Emmanuel Rosa, - Sackville-West, Amir Saeid, Markus Scherer, Daniel Schüssler, Olivier - Schneider, Alexander Shabalin, Valentin Shirokov, Peter Simons, Alexander - Solovyov, Will Song, John Soo, John Soros, Felix Springer, Travis Staton, - Artem Tarasov, Samuli Thomasson, Edward Tjörnhammar, Sergei Trofimovich, - Thomas Tuegel, John Tyree, Jan Vornberger, Anton Vorontsov, Daniel Wagner, - Zev Weiss, Phil Xiaojun Hu, Nikolay Yakimov, Edward Z. Yang, Leo Zhang, - Norbert Zeh, and Michał Zielonka. + Alshiekh, Alex Ameen, Axel Angel, Enrico Maria De Angelis, Dhananjay Balan, + Claudio Bley, Dragos Boca, Ben Boeckel, Ivan Brennan, Duncan Burke, Roman + Cheplyaka, Patrick Chilton, Antoine Eiche, Nathaniel Wesley Filardo, Guy + Gastineau, John Goerzen, Jonathan Grochowski, Patrick Günther, Reto + Hablützel, Corey Halpin, Juraj Hercek, Jaroslaw Jantura, Tomáš Janoušek, Ada + Joule, Spencer Janssen, Roman Joost, Pavel Kalugin, Jochen Keil, Sam Kirby, + Lennart Kolmodin, Krzysztof Kosciuszkiewicz, Dmitry Kurochkin, Todd Lunter, + Vanessa McHale, Robert J. Macomber, Dmitry Malikov, David McLean, Ulrik de + Muelenaere, Joan Milev, Marcin Mikołajczyk, Dino Morelli, Tony Morris, Eric + Mrak, Thiago Negri, Edward O'Callaghan, Svein Ove, Martin Perner, Jens + Petersen, Alexander Polakov, Sibi Prabakaran, Pavan Rikhi, Petr Rockai, + Andrew Emmanuel Rosa, Sackville-West, Amir Saeid, Markus Scherer, Daniel + Schüssler, Olivier Schneider, Alexander Shabalin, Valentin Shirokov, Peter + Simons, Alexander Solovyov, Will Song, John Soo, John Soros, Felix Springer, + Travis Staton, Artem Tarasov, Samuli Thomasson, Edward Tjörnhammar, Sergei + Trofimovich, Thomas Tuegel, John Tyree, Jan Vornberger, Anton Vorontsov, + Daniel Wagner, Zev Weiss, Phil Xiaojun Hu, Nikolay Yakimov, Edward Z. Yang, + Leo Zhang, Norbert Zeh, and Michał Zielonka. Andrea wants to thank Robert Manea and Spencer Janssen for their help in understanding how X works. They gave him suggestions on how to solve many @@ -203,6 +203,6 @@ This software is released under a BSD-style license. See [[https://codeberg.org/xmobar/xmobar/src/branch/master/license][license]] for more details. - Copyright © 2010-2023 Jose Antonio Ortega Ruiz + Copyright © 2010-2024 Jose Antonio Ortega Ruiz Copyright © 2007-2010 Andrea Rossato diff --git a/src/Xmobar/App/Compile.hs b/src/Xmobar/App/Compile.hs --- a/src/Xmobar/App/Compile.hs +++ b/src/Xmobar/App/Compile.hs @@ -20,20 +20,17 @@ module Xmobar.App.Compile(recompile, trace, xmessage) where import Control.Monad.IO.Class -import Control.Monad.Fix (fix) -import Control.Exception.Extensible (try, bracket, SomeException(..)) +import Control.Exception.Extensible (bracket, SomeException(..)) import qualified Control.Exception.Extensible as E import Control.Monad (filterM, when) import Data.List ((\\)) -import Data.Maybe (isJust) import System.FilePath((), takeExtension) import System.IO import System.Directory import System.Process import System.Exit -import System.Posix.Process(executeFile, forkProcess, getAnyProcessStatus) +import System.Posix.Process(executeFile, forkProcess) import System.Posix.Types(ProcessID) -import System.Posix.Signals isExecutable :: FilePath -> IO Bool isExecutable f = @@ -144,14 +141,12 @@ else shouldRecompile verb src bin lib if sc then do - uninstallSignalHandlers status <- bracket (openFile err WriteMode) hClose $ \errHandle -> waitForProcess =<< if useScript then runScript script bin confDir errHandle else runGHC bin confDir errHandle - installSignalHandlers if status == ExitSuccess then trace verb "Xmobar recompilation process exited with success!" else do @@ -174,21 +169,3 @@ ++ ["-o", bin] runGHC bin = runProc "ghc" (opts bin) runScript script bin = runProc script [bin] - --- | Ignore SIGPIPE to avoid termination when a pipe is full, and SIGCHLD to --- avoid zombie processes, and clean up any extant zombie processes. -installSignalHandlers :: MonadIO m => m () -installSignalHandlers = liftIO $ do - installHandler openEndedPipe Ignore Nothing - installHandler sigCHLD Ignore Nothing - (try :: IO a -> IO (Either SomeException a)) - $ fix $ \more -> do - x <- getAnyProcessStatus False False - when (isJust x) more - return () - -uninstallSignalHandlers :: MonadIO m => m () -uninstallSignalHandlers = liftIO $ do - installHandler openEndedPipe Default Nothing - installHandler sigCHLD Default Nothing - return () diff --git a/src/Xmobar/App/Opts.hs b/src/Xmobar/App/Opts.hs --- a/src/Xmobar/App/Opts.hs +++ b/src/Xmobar/App/Opts.hs @@ -1,7 +1,7 @@ ------------------------------------------------------------------------------ -- | -- Module: Xmobar.App.Opts --- Copyright: (c) 2018, 2019, 2020, 2022, 2023 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2018, 2019, 2020, 2022, 2023, 2024 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org @@ -116,7 +116,7 @@ info :: String info = "xmobar " ++ showVersion version - ++ "\n (C) 2010 - 2023 Jose A Ortega Ruiz" + ++ "\n (C) 2010 - 2024 Jose A Ortega Ruiz" ++ "\n (C) 2007 - 2010 Andrea Rossato\n " ++ mail ++ "\n" ++ license ++ "\n" diff --git a/src/Xmobar/Draw/Boxes.hs b/src/Xmobar/Draw/Boxes.hs --- a/src/Xmobar/Draw/Boxes.hs +++ b/src/Xmobar/Draw/Boxes.hs @@ -1,7 +1,7 @@ ------------------------------------------------------------------------------ -- | -- Module: Xmobar.X11.Boxes --- Copyright: (c) 2022 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2022, 2024 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org @@ -43,11 +43,10 @@ T.C -> (ma, -ma) T.R -> (ma, 0) lc = fromIntegral lw / 2 - [mt, mr, mb, ml] = map fromIntegral [top, right, bot, left] - xmin = x0 - ml - lc - xmax = x1 + mr + lc - ymin = mt + lc - ymax = ht - mb - lc + xmin = x0 - fromIntegral left - lc + xmax = x1 + fromIntegral right + lc + ymin = fromIntegral top + lc + ymax = ht - fromIntegral bot - lc rtop = (xmin + p0, ymin, xmax + p1, ymin) rbot = (xmin + p0, ymax, xmax + p1, ymax) rleft = (xmin, ymin + p0, xmin, ymax + p1) diff --git a/src/Xmobar/Draw/Cairo.hs b/src/Xmobar/Draw/Cairo.hs --- a/src/Xmobar/Draw/Cairo.hs +++ b/src/Xmobar/Draw/Cairo.hs @@ -2,7 +2,7 @@ ------------------------------------------------------------------------------ -- | -- Module: Xmobar.X11.Cairo --- Copyright: (c) 2022, 2023 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2022, 2023, 2024 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org @@ -169,21 +169,22 @@ drawSegments :: T.DrawContext -> Surface -> IO T.Actions drawSegments dctx surf = do - let [left, center, right] = take 3 $ T.dcSegments dctx ++ repeat [] + let segs = take 3 $ T.dcSegments dctx ++ repeat [] dh = T.dcHeight dctx dw = T.dcWidth dctx conf = T.dcConfig dctx sWidth = foldl (\a (_,_,w) -> a + w) 0 ctx <- Pango.cairoCreateContext Nothing Pango.cairoContextSetResolution ctx $ C.dpi conf - llyts <- mapM (withRenderinfo ctx dctx) left - rlyts <- mapM (withRenderinfo ctx dctx) right - clyts <- mapM (withRenderinfo ctx dctx) center + llyts <- mapM (withRenderinfo ctx dctx) (head segs) + rlyts <- mapM (withRenderinfo ctx dctx) (segs !! 2) + clyts <- mapM (withRenderinfo ctx dctx) (segs !! 1) #ifndef XRENDER drawCairoBackground dctx surf #endif (lend, as, bx) <- foldM (drawSegment dctx surf dw) (0, [], []) llyts - let [rw, cw] = map sWidth [rlyts, clyts] + let rw = sWidth rlyts + cw = sWidth clyts rstart = max lend (dw - rw) cstart = if lend > 1 || rw == 0 then max lend ((dw - cw) / 2.0) else lend (_, as', bx') <- if cw > 0 diff --git a/src/Xmobar/Plugins/Kbd.hs b/src/Xmobar/Plugins/Kbd.hs --- a/src/Xmobar/Plugins/Kbd.hs +++ b/src/Xmobar/Plugins/Kbd.hs @@ -14,9 +14,11 @@ module Xmobar.Plugins.Kbd(Kbd(..)) where -import Data.List (isPrefixOf) +import Data.Bifunctor (bimap) +import Data.List (find, tails, isPrefixOf) import Data.Maybe (fromMaybe) -import Data.Char (toLower) +import Data.Char (toLower, isLetter) +import Data.Function ((&)) import Control.Monad (forever) import Control.Applicative ((<|>)) import Graphics.X11.Xlib @@ -26,6 +28,13 @@ import Xmobar.X11.Events (nextEvent') import Xmobar.System.Kbd +-- some strong typing +newtype Lay = Lay String deriving (Eq) +newtype Sym = Sym String +instance Show Sym where show (Sym s) = s +type KbdOpts' = [(Lay, Sym)] +typed :: [(String, String)] -> [(Lay, Sym)] +typed = map (bimap Lay Sym) -- 'Bad' prefixes of layouts noLaySymbols :: [String] @@ -49,15 +58,22 @@ (pref, "") -> [pref] -- replaces input string if on search list (exact match) with corresponding --- element on replacement list. +-- element on replacement list, and returns it paired with the following item -- --- if not found, return string unchanged -searchReplaceLayout :: KbdOpts -> String -> String -searchReplaceLayout opts s = fromMaybe s $ lookup s opts +-- if not found, return string unchanged, paired with empty string +searchReplaceLayout :: KbdOpts' -> String -> (Lay, Lay, Sym) +searchReplaceLayout opts curr + = maybe (Lay "", Lay "", Sym curr) + pickSymWithAdjLays + (find currLayout (tails $ cycle opts)) + where + pickSymWithAdjLays ((l1, _):(_, s):(l2, _):_) = (l1, l2, s) + pickSymWithAdjLays _ = error "This should never happen" + currLayout = (Lay curr ==) . (!! 1) . map fst --- returns the active layout -getKbdLay :: Display -> KbdOpts -> IO String -getKbdLay dpy opts = do +-- returns the active layout and the following one +getCurAndNextKbdLays :: Display -> KbdOpts' -> IO (Lay, Lay, Sym) +getCurAndNextKbdLays dpy opts = do lay <- splitLayout <$> getLayoutStr dpy grps <- map (map toLower . take 2) <$> getGrpNames dpy curLay <- getKbdLayout dpy @@ -73,6 +89,37 @@ newtype Kbd = Kbd [(String, String)] deriving (Read, Show) +attachClickAction :: (Lay, Lay, Sym) -> Sym +attachClickAction (Lay prv, Lay nxt, txt) = txt & linkTo nxt `onKey` "1" + & linkTo prv `onKey` "3" + where + splitLayParensPhon :: String -> (String, String, String) + splitLayParensPhon = (\(a, (b, c)) -> (a, b, c)) + . second (second (drop 1) . break (== ')') . drop 1) + . break (== '(') + parseLayPhon :: String -> (Maybe String, Maybe String) + parseLayPhon s = let (l, p, i) = splitLayParensPhon s + l' = if all isLetter l + then Just ("-layout " ++ l) + else Nothing + p' = if (p, i) == ("phonetic", "") + then Just "-variant phonetic" + else Nothing + in (l', p') + linkTo :: String -> String -> Sym -> Sym + linkTo linked button currLay = Sym $ case parseLayPhon linked of + (Nothing, _) -> "??" + (Just linkedLay, phon) -> wrapIn setxkbmap button currLay + where + setxkbmap = unwords ["setxkbmap", linkedLay, fromMaybe "" phon] + wrapIn :: String -> String -> Sym -> String + wrapIn action buttons (Sym sym) = openingTag ++ sym ++ closingTag + where + openingTag = "" + closingTag = "" + onKey = ($) + second = fmap + instance Exec Kbd where alias (Kbd _) = "kbd" start (Kbd opts) cb = do @@ -80,7 +127,7 @@ dpy <- openDisplay "" -- initial set of layout - cb =<< getKbdLay dpy opts + cb . show . attachClickAction =<< getCurAndNextKbdLays dpy (typed opts) -- enable listing for -- group changes @@ -91,7 +138,6 @@ allocaXEvent $ \e -> forever $ do nextEvent' dpy e _ <- getEvent e - cb =<< getKbdLay dpy opts + cb . show . attachClickAction =<< getCurAndNextKbdLays dpy (typed opts) closeDisplay dpy - return () diff --git a/src/Xmobar/Plugins/Locks.hs b/src/Xmobar/Plugins/Locks.hs --- a/src/Xmobar/Plugins/Locks.hs +++ b/src/Xmobar/Plugins/Locks.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE TupleSections #-} ----------------------------------------------------------------------------- -- | -- Module : Plugins.Locks @@ -16,45 +17,70 @@ import Graphics.X11 import Data.List +import Data.List.Extra (trim) import Data.Bits +import Data.Maybe (fromJust) import Control.Monad +import Control.Monad.Extra (ifM) import Graphics.X11.Xlib.Extras import Xmobar.Run.Exec import Xmobar.System.Kbd import Xmobar.X11.Events (nextEvent') -data Locks = Locks +data Locks = Locks | Locks' [(String, (String, String))] deriving (Read, Show) locks :: [ ( KeySym, String )] -locks = [ ( xK_Caps_Lock, "CAPS" ) - , ( xK_Num_Lock, "NUM" ) +locks = [ ( xK_Caps_Lock, "CAPS" ) + , ( xK_Num_Lock, "NUM" ) , ( xK_Scroll_Lock, "SCROLL" ) ] -run' :: Display -> Window -> IO String -run' d root = do +type Labels = [ ( String, (String, String) )] +defaultLabels :: Labels +defaultLabels = let nms = map snd locks + in zip nms (map (, mempty) nms) + +type LabelledLock = (KeySym, String, String, String) + +attach :: (KeySym, String) -> Labels -> LabelledLock +(key, lock) `attach` lbls = let (enb, dis) = fromJust $ lookup lock lbls + in (key, lock, enb, dis) + +enabled :: (a, b, c, d) -> c +enabled (_, _, c, _) = c +disabled :: (a, b, c, d) -> d +disabled (_, _, _, d) = d + +isEnabled :: (Bits a1, Foldable t, Foldable t1, Integral a) + => Display -> t (a, t1 KeyCode) -> a1 -> (KeySym, b, c, d) -> IO Bool +isEnabled d modMap m ( ks, _, _, _ ) = do + kc <- keysymToKeycode d ks + return $ case find (elem kc . snd) modMap of + Nothing -> False + Just ( i, _ ) -> testBit m (fromIntegral i) + +run' :: Display -> Window -> Labels -> IO String +run' d root labels = do modMap <- getModifierMapping d ( _, _, _, _, _, _, _, m ) <- queryPointer d root - ls <- filterM ( \( ks, _ ) -> do - kc <- keysymToKeycode d ks - return $ case find (elem kc . snd) modMap of - Nothing -> False - Just ( i, _ ) -> testBit m (fromIntegral i) - ) locks - - return $ unwords $ map snd ls + ls' <- forM (map (`attach` labels) locks) + (\l -> ifM (isEnabled d modMap m l) + (return (enabled l)) + (return (disabled l))) + return $ trim $ unwords ls' instance Exec Locks where - alias Locks = "locks" - start Locks cb = do + alias _ = "locks" + start Locks cb = start (Locks' defaultLabels) cb + start (Locks' labels) cb = do d <- openDisplay "" root <- rootWindow d (defaultScreen d) _ <- xkbSelectEventDetails d xkbUseCoreKbd xkbIndicatorStateNotify m m allocaXEvent $ \ep -> forever $ do - cb =<< run' d root + cb =<< run' d root labels nextEvent' d ep getEvent ep diff --git a/src/Xmobar/Plugins/Monitors/Alsa.hs b/src/Xmobar/Plugins/Monitors/Alsa.hs --- a/src/Xmobar/Plugins/Monitors/Alsa.hs +++ b/src/Xmobar/Plugins/Monitors/Alsa.hs @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Alsa --- Copyright : (c) 2018 Daniel Schüssler +-- Copyright : (c) 2018, 2024 Daniel Schüssler -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz @@ -25,6 +25,7 @@ import Control.Exception import Control.Monad import Data.IORef +import Data.Maybe (fromJust) import Data.Time.Clock import Xmobar.Plugins.Monitors.Common import qualified Xmobar.Plugins.Monitors.Volume as Volume; @@ -129,7 +130,8 @@ {std_out = CreatePipe} runAlsaOnce = - withCreateProcess createProc $ \_ (Just alsaOut) _ _ -> do + withCreateProcess createProc $ \_ out _ _ -> do + let alsaOut = fromJust out hSetBuffering alsaOut LineBuffering tryPutMVar mvar () -- Refresh immediately after restarting alsactl diff --git a/src/Xmobar/Plugins/Monitors/Batt/Common.hs b/src/Xmobar/Plugins/Monitors/Batt/Common.hs --- a/src/Xmobar/Plugins/Monitors/Batt/Common.hs +++ b/src/Xmobar/Plugins/Monitors/Batt/Common.hs @@ -18,7 +18,7 @@ , Status(..) , maybeAlert) where -import System.Process (spawnCommand) +import System.Process (spawnCommand, waitForProcess) import Control.Monad (unless, void) import Xmobar.Plugins.Monitors.Common @@ -54,4 +54,4 @@ case onLowAction opts of Nothing -> return () Just x -> unless (isNaN left || actionThreshold opts < 100 * left) - $ void $ spawnCommand x + $ void $ spawnCommand (x ++ " &") >>= waitForProcess diff --git a/src/Xmobar/Plugins/Monitors/Common/Output.hs b/src/Xmobar/Plugins/Monitors/Common/Output.hs --- a/src/Xmobar/Plugins/Monitors/Common/Output.hs +++ b/src/Xmobar/Plugins/Monitors/Common/Output.hs @@ -3,7 +3,7 @@ ------------------------------------------------------------------------------ -- | -- Module: Xmobar.Plugins.Monitors.Strings --- Copyright: (c) 2018, 2019, 2020, 2022 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2018, 2019, 2020, 2022, 2024 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org @@ -88,9 +88,9 @@ pColorizeString :: (Num a, Ord a, MonadIO m) => MonitorConfig -> a -> String -> m String pColorizeString p x s = do let col = pSetColor p s - [ll,hh] = map fromIntegral $ sort [pLow p, pHigh p] -- consider high < low - pure $ head $ [col pHighColor | x > hh ] ++ - [col pNormalColor | x > ll ] ++ + cols = map fromIntegral $ sort [pLow p, pHigh p] -- consider high < low + pure $ head $ [col pHighColor | x > (cols !! 1) ] ++ + [col pNormalColor | x > head cols ] ++ [col pLowColor | True] pSetColor :: MonitorConfig -> String -> PSelector (Maybe String) -> String @@ -197,9 +197,9 @@ h <- getConfigValue high l <- getConfigValue low let col = setColor s - [ll,hh] = map fromIntegral $ sort [l, h] -- consider high < low - head $ [col highColor | x > hh ] ++ - [col normalColor | x > ll ] ++ + cols = map fromIntegral $ sort [l, h] -- consider high < low + head $ [col highColor | x > cols !! 1 ] ++ + [col normalColor | x > head cols ] ++ [col lowColor | True] showWithColors :: (Num a, Ord a) => (a -> String) -> a -> Monitor String @@ -260,11 +260,11 @@ h <- fromIntegral `fmap` getConfigValue high l <- fromIntegral `fmap` getConfigValue low bw <- fromIntegral `fmap` getConfigValue barWidth - let [ll, hh] = sort [l, h] + let ws = sort [l, h] bw' = if bw > 0 then bw else 10 scaled x | x == 0.0 = 0 - | x <= ll = 1 / bw' - | otherwise = f + logBase 2 (x / hh) / bw' + | x <= head ws = 1 / bw' + | otherwise = f + logBase 2 (x / ws !! 1) / bw' return $ scaled v showLogBar :: Float -> Float -> Monitor String diff --git a/src/Xmobar/Plugins/Monitors/Disk.hs b/src/Xmobar/Plugins/Monitors/Disk.hs --- a/src/Xmobar/Plugins/Monitors/Disk.hs +++ b/src/Xmobar/Plugins/Monitors/Disk.hs @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Disk --- Copyright : (c) 2010, 2011, 2012, 2014, 2018, 2019 Jose A Ortega Ruiz +-- Copyright : (c) 2010-2012, 2014, 2018, 2019, 2024 Jose A Ortega Ruiz -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A Ortega Ruiz @@ -131,10 +131,9 @@ runM args diskIOConfig (runDiskIO dref disks) rate cb runDiskU' :: DiskUOpts -> String -> [Integer] -> Monitor String -runDiskU' opts tmp stat = do +runDiskU' opts tmp (total:free:diff:_) = do setConfigValue tmp template - let [total, free, diff] = stat - strs = map sizeToStr [free, diff] + let strs = map sizeToStr [free, diff] freep = if total > 0 then free * 100 `div` total else 0 fr = fromIntegral freep / 100 s <- zipWithM showWithColors' strs [freep, 100 - freep] @@ -146,6 +145,7 @@ uvb <- showVerticalBar (fromIntegral $ 100 - freep) (1 - fr) uipat <- showIconPattern (usedIconPattern opts) (1 - fr) parseTemplate $ [sizeToStr total] ++ s ++ sp ++ [fb,fvb,fipat,ub,uvb,uipat] +runDiskU' _ _ _ = return "" runDiskU :: [(String, String)] -> [String] -> Monitor String runDiskU disks argv = do diff --git a/src/Xmobar/Plugins/Monitors/Mem/Linux.hs b/src/Xmobar/Plugins/Monitors/Mem/Linux.hs --- a/src/Xmobar/Plugins/Monitors/Mem/Linux.hs +++ b/src/Xmobar/Plugins/Monitors/Mem/Linux.hs @@ -25,9 +25,13 @@ let content = map words $ take 8 $ lines file info = M.fromList $ map ( \line -> (head line, (read $ line !! 1 :: Float) / 1024)) content - [total, free, buffer, cache] = - map (info M.!) ["MemTotal:", "MemFree:", "Buffers:", "Cached:"] - available = M.findWithDefault (free + buffer + cache) "MemAvailable:" info + info' x = info M.! (x ++ ":") + total = info' "MemTotal" + free = info' "MemFree" + buffer = info' "Buffers" + cache = info' "Cached" + available = + M.findWithDefault (free + buffer + cache) "MemAvailable:" info used = total - available usedratio = used / total freeratio = free / total diff --git a/src/Xmobar/Plugins/Monitors/Net/Linux.hs b/src/Xmobar/Plugins/Monitors/Net/Linux.hs --- a/src/Xmobar/Plugins/Monitors/Net/Linux.hs +++ b/src/Xmobar/Plugins/Monitors/Net/Linux.hs @@ -47,7 +47,10 @@ return $! (head . B.lines) operstate `elem` ["up", "unknown"] readNetDev :: [String] -> IO NetDevRawTotal -readNetDev ~[d, x, y] = do +readNetDev ds = do + let (d, x, y) = case ds of + d':x':y':_ -> (d', x', y') + _ -> ("", "", "") up <- unsafeInterleaveIO $ isUp d return $ N d (if up then ND (r x) (r y) else NI) where r s | s == "" = 0 diff --git a/src/Xmobar/Run/Actions.hs b/src/Xmobar/Run/Actions.hs --- a/src/Xmobar/Run/Actions.hs +++ b/src/Xmobar/Run/Actions.hs @@ -16,7 +16,7 @@ , runAction' , stripActions) where -import System.Process (spawnCommand) +import System.Process (spawnCommand, waitForProcess) import Control.Monad (void) import Text.Regex (Regex, subRegex, mkRegex, matchRegex) import Data.Word (Word32) @@ -26,11 +26,11 @@ data Action = Spawn [Button] String deriving (Eq, Read, Show) runAction :: Action -> IO () -runAction (Spawn _ s) = void $ spawnCommand s +runAction (Spawn _ s) = void $ spawnCommand (s ++ " &") >>= waitForProcess -- | Run action with stdout redirected to stderr runAction' :: Action -> IO () -runAction' (Spawn _ s) = void $ spawnCommand (s ++ " 1>&2") +runAction' (Spawn _ s) = void $ spawnCommand (s ++ " 1>&2 &") >>= waitForProcess stripActions :: String -> String stripActions s = case matchRegex actionRegex s of diff --git a/src/Xmobar/Run/Template.hs b/src/Xmobar/Run/Template.hs --- a/src/Xmobar/Run/Template.hs +++ b/src/Xmobar/Run/Template.hs @@ -77,5 +77,6 @@ (ce,_:ri) -> [le, ce, ri] _ -> def _ -> def - where [l, r] = if length alignSep == 2 then alignSep else defaultAlign + where sep = if length alignSep == 2 then alignSep else defaultAlign + (l, r) = (head sep, sep !! 1) def = [template, "", ""] diff --git a/src/Xmobar/System/Environment.hs b/src/Xmobar/System/Environment.hs --- a/src/Xmobar/System/Environment.hs +++ b/src/Xmobar/System/Environment.hs @@ -36,12 +36,13 @@ False -> do remainder <- expandEnv $ drop 1 s return $ escString s ++ remainder - where escString s' = let (cc:_) = s' in + where escString (cc:_) = case cc of 't' -> "\t" 'n' -> "\n" '$' -> "$" _ -> [cc] + escString [] = "" _ -> do remainder <- expandEnv s diff --git a/src/Xmobar/X11/Bitmap.hs b/src/Xmobar/X11/Bitmap.hs --- a/src/Xmobar/X11/Bitmap.hs +++ b/src/Xmobar/X11/Bitmap.hs @@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : X11.Bitmap --- Copyright : (C) 2013, 2015, 2017, 2018, 2022 Alexander Polakov +-- Copyright : (C) 2013, 2015, 2017, 2018, 2022, 2024 Alexander Polakov -- License : BSD3 -- -- Maintainer : jao@gnu.org @@ -116,8 +116,9 @@ drawBitmap :: Display -> Drawable -> GC -> String -> String -> Position -> Position -> Bitmap -> IO () drawBitmap d p gc fc bc x y i = - withColors d [fc, bc] $ \[fc', bc'] -> do - let w = width i + withColors d [fc, bc] $ \cs -> do + let (fc', bc') = (head cs, cs !! 1) + w = width i h = height i y' = 1 + y - fromIntegral h `div` 2 setForeground d gc fc' diff --git a/src/Xmobar/X11/Loop.hs b/src/Xmobar/X11/Loop.hs --- a/src/Xmobar/X11/Loop.hs +++ b/src/Xmobar/X11/Loop.hs @@ -3,7 +3,7 @@ ------------------------------------------------------------------------------ -- | -- Module: Xmobar.App.X11EventLoop --- Copyright: (c) 2018, 2020, 2022, 2023 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2018, 2020, 2022, 2023, 2024 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org @@ -149,8 +149,7 @@ parseSegments :: C.Config -> STM.TVar [String] -> IO [[C.Segment]] parseSegments conf v = do s <- STM.readTVarIO v - let l:c:r:_ = s ++ repeat "" - return $ map (CT.parseString conf) [l, c, r] + return $ map (CT.parseString conf) (take 3 $ s ++ repeat "") updateIconCache :: T.XConf -> [[C.Segment]] -> IO T.XConf updateIconCache xc@(T.XConf d _ w _ c cfg) segs = do diff --git a/xmobar.cabal b/xmobar.cabal --- a/xmobar.cabal +++ b/xmobar.cabal @@ -1,5 +1,5 @@ name: xmobar -version: 0.47.4 +version: 0.48 homepage: https://codeberg.org/xmobar/xmobar synopsis: A Minimalistic Text Based Status Bar description: Xmobar is a minimalistic text based status bar. @@ -204,6 +204,7 @@ colour >= 2.3.6, containers, directory, + extra, extensible-exceptions == 0.1.*, filepath, mtl >= 2.1 && < 2.4,