summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar/Plugins
diff options
context:
space:
mode:
Diffstat (limited to 'src/Xmobar/Plugins')
-rw-r--r--src/Xmobar/Plugins/EWMH.hs1
-rw-r--r--src/Xmobar/Plugins/Kbd.hs72
-rw-r--r--src/Xmobar/Plugins/Kraken.hs2
-rw-r--r--src/Xmobar/Plugins/Locks.hs58
-rw-r--r--src/Xmobar/Plugins/Monitors/Alsa.hs6
-rw-r--r--src/Xmobar/Plugins/Monitors/Batt/Common.hs6
-rw-r--r--src/Xmobar/Plugins/Monitors/Common/Output.hs22
-rw-r--r--src/Xmobar/Plugins/Monitors/Disk.hs8
-rw-r--r--src/Xmobar/Plugins/Monitors/Mem/Linux.hs10
-rw-r--r--src/Xmobar/Plugins/Monitors/Net/Linux.hs5
10 files changed, 136 insertions, 54 deletions
diff --git a/src/Xmobar/Plugins/EWMH.hs b/src/Xmobar/Plugins/EWMH.hs
index 94fd7d7..78f1cc0 100644
--- a/src/Xmobar/Plugins/EWMH.hs
+++ b/src/Xmobar/Plugins/EWMH.hs
@@ -19,6 +19,7 @@ module Xmobar.Plugins.EWMH (EWMH(..)) where
import Control.Applicative (Applicative(..))
import Control.Monad.State
+import Control.Monad
import Control.Monad.Reader
import Graphics.X11 hiding (Modifier, Color)
import Graphics.X11.Xlib.Extras
diff --git a/src/Xmobar/Plugins/Kbd.hs b/src/Xmobar/Plugins/Kbd.hs
index 2214628..3871ca8 100644
--- 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.Run.Exec
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 @@ split p s = case break p s of
(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
-
--- returns the active layout
-getKbdLay :: Display -> KbdOpts -> IO String
-getKbdLay dpy opts = do
+-- 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 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 @@ getKbdLay dpy opts = do
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 = "<action=`" ++ action ++ "` button=" ++ buttons ++ ">"
+ closingTag = "</action>"
+ onKey = ($)
+ second = fmap
+
instance Exec Kbd where
alias (Kbd _) = "kbd"
start (Kbd opts) cb = do
@@ -80,7 +127,7 @@ instance Exec Kbd where
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 @@ instance Exec Kbd where
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/Kraken.hs b/src/Xmobar/Plugins/Kraken.hs
index 2345b3d..5d565e0 100644
--- a/src/Xmobar/Plugins/Kraken.hs
+++ b/src/Xmobar/Plugins/Kraken.hs
@@ -36,7 +36,7 @@ instance Exec Kraken where
cb (display g)
loop mv g
- loop mvar (Map.fromList $ zip ps (repeat 0.0))
+ loop mvar (Map.fromList $ map (, 0.0) ps)
where
display :: Map.Map String Double -> String
diff --git a/src/Xmobar/Plugins/Locks.hs b/src/Xmobar/Plugins/Locks.hs
index 9176312..35a3f97 100644
--- 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 @@ module Xmobar.Plugins.Locks(Locks(..)) where
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
index dfc7329..8d02931 100644
--- 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 <jao@gnu.org>
@@ -25,6 +25,7 @@ import Control.Concurrent.Async
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 @@ alsaReaderThread mixerName alsaCtlPath outputCallback mvar =
{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
index 3262b78..ddb2b8c 100644
--- a/src/Xmobar/Plugins/Monitors/Batt/Common.hs
+++ b/src/Xmobar/Plugins/Monitors/Batt/Common.hs
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------------
-- |
-- Module : Plugins.Monitors.Batt.Common
--- Copyright : (c) 2010, 2011, 2012, 2013, 2015, 2016, 2018, 2019 Jose A Ortega
+-- Copyright : (c) 2010-2016, 2018, 2019, 2024 Jose A Ortega
-- (c) 2010 Andrea Rossato, Petr Rockai
-- License : BSD-style (see LICENSE)
--
@@ -18,7 +18,7 @@ module Xmobar.Plugins.Monitors.Batt.Common (BattOpts(..)
, Status(..)
, maybeAlert) where
-import System.Process (system)
+import System.Process (spawnCommand, waitForProcess)
import Control.Monad (unless, void)
import Xmobar.Plugins.Monitors.Common
@@ -54,4 +54,4 @@ maybeAlert opts left =
case onLowAction opts of
Nothing -> return ()
Just x -> unless (isNaN left || actionThreshold opts < 100 * left)
- $ void $ system x
+ $ void $ spawnCommand (x ++ " &") >>= waitForProcess
diff --git a/src/Xmobar/Plugins/Monitors/Common/Output.hs b/src/Xmobar/Plugins/Monitors/Common/Output.hs
index bd60710..c0a00ab 100644
--- 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 @@ pShowWithColors p f x = do
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
@@ -140,7 +140,7 @@ showWithUnits d n x
padString :: Int -> Int -> String -> Bool -> String -> String -> String
padString mnw mxw pad pr ellipsis s =
let len = length s
- rmin = if mnw < 0 then 0 else mnw
+ rmin = max mnw 0
rmax = if mxw <= 0 then max len rmin else mxw
(rmn, rmx) = if rmin <= rmax then (rmin, rmax) else (rmax, rmin)
rlen = min (max rmn len) rmx
@@ -197,9 +197,9 @@ colorizeString x s = do
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 @@ logScaling f v = do
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
index 47d1eac..95bcff6 100644
--- 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 <jao@gnu.org>
@@ -131,10 +131,9 @@ startDiskIO disks args rate cb = do
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 @@ runDiskU' opts tmp stat = do
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
index 79dcc9d..7a81c6d 100644
--- a/src/Xmobar/Plugins/Monitors/Mem/Linux.hs
+++ b/src/Xmobar/Plugins/Monitors/Mem/Linux.hs
@@ -25,9 +25,13 @@ parseMEM =
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
index 9306497..f9cbc28 100644
--- a/src/Xmobar/Plugins/Monitors/Net/Linux.hs
+++ b/src/Xmobar/Plugins/Monitors/Net/Linux.hs
@@ -47,7 +47,10 @@ isUp d = flip catchIOError (const $ return False) $ do
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-04-28 19:03:32 +0000