summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar
diff options
context:
space:
mode:
Diffstat (limited to 'src/Xmobar')
-rw-r--r--src/Xmobar/Run/Parsers.hs5
-rw-r--r--src/Xmobar/X11/Bitmap.hs23
-rw-r--r--src/Xmobar/X11/CairoDraw.hs2
-rw-r--r--src/Xmobar/X11/Loop.hs125
-rw-r--r--src/Xmobar/X11/Types.hs7
-rw-r--r--src/Xmobar/X11/XlibDraw.hs6
6 files changed, 75 insertions, 93 deletions
diff --git a/src/Xmobar/Run/Parsers.hs b/src/Xmobar/Run/Parsers.hs
index 8da7204..de983fd 100644
--- a/src/Xmobar/Run/Parsers.hs
+++ b/src/Xmobar/Run/Parsers.hs
@@ -82,10 +82,7 @@ colorComponents conf c =
(f,',':b) -> (f, b)
(f, _) -> (f, bgColor conf)
-allParsers :: TextRenderInfo
- -> FontIndex
- -> Maybe [Action]
- -> Parser [Segment]
+allParsers :: TextRenderInfo -> FontIndex -> Maybe [Action] -> Parser [Segment]
allParsers c f a = textParser c f a
<|> try (iconParser c f a)
<|> try (hspaceParser c f a)
diff --git a/src/Xmobar/X11/Bitmap.hs b/src/Xmobar/X11/Bitmap.hs
index 026cd5c..027462d 100644
--- a/src/Xmobar/X11/Bitmap.hs
+++ b/src/Xmobar/X11/Bitmap.hs
@@ -14,17 +14,16 @@
module Xmobar.X11.Bitmap
( updateCache
, drawBitmap
- , Bitmap(..)) where
+ , Bitmap(..)
+ , BitmapCache) where
import Control.Monad
import Control.Monad.Trans(MonadIO(..))
-import Data.Map hiding (map, filter)
-import Graphics.X11.Xlib
+import Data.Map hiding (map)
+import Graphics.X11.Xlib hiding (Segment)
import System.Directory (doesFileExist)
import System.FilePath ((</>))
import System.Mem.Weak ( addFinalizer )
-import Xmobar.Run.Actions (Action)
-import Xmobar.Run.Parsers (TextRenderInfo(..), Widget(..))
import Xmobar.X11.ColorCache
#ifdef XPM
@@ -53,14 +52,12 @@ data Bitmap = Bitmap { width :: Dimension
, bitmapType :: BitmapType
}
-updateCache :: Display -> Window -> Map FilePath Bitmap -> FilePath
- -> [[(Widget, TextRenderInfo, Int, Maybe [Action])]]
- -> IO (Map FilePath Bitmap)
-updateCache dpy win cache iconRoot ps = do
- let paths = map (\(Icon p, _, _, _) -> p) . concatMap (filter icons) $ ps
- icons (Icon _, _, _, _) = True
- icons _ = False
- expandPath path@('/':_) = path
+type BitmapCache = Map FilePath Bitmap
+
+updateCache :: Display -> Window -> Map FilePath Bitmap -> FilePath -> [FilePath]
+ -> IO BitmapCache
+updateCache dpy win cache iconRoot paths = do
+ let expandPath path@('/':_) = path
expandPath path@('.':'/':_) = path
expandPath path@('.':'.':'/':_) = path
expandPath path = iconRoot </> path
diff --git a/src/Xmobar/X11/CairoDraw.hs b/src/Xmobar/X11/CairoDraw.hs
index 9dac493..714041d 100644
--- a/src/Xmobar/X11/CairoDraw.hs
+++ b/src/Xmobar/X11/CairoDraw.hs
@@ -65,7 +65,7 @@ drawInPixmap gc p s = do
liftIO $ withXlibSurface disp p vis (fromIntegral w) (fromIntegral h) render
lookupXBitmap :: XConf -> String -> Maybe B.Bitmap
-lookupXBitmap xconf path = lookup path (iconS xconf)
+lookupXBitmap xconf path = lookup path (iconCache xconf)
drawXBitmap :: XConf -> GC -> Pixmap -> BitmapDrawer
drawXBitmap xconf gc p h v path = do
diff --git a/src/Xmobar/X11/Loop.hs b/src/Xmobar/X11/Loop.hs
index 8f74b79..4cf4b8f 100644
--- a/src/Xmobar/X11/Loop.hs
+++ b/src/Xmobar/X11/Loop.hs
@@ -19,7 +19,7 @@
module Xmobar.X11.Loop (x11Loop) where
import Prelude hiding (lookup)
-import Graphics.X11.Xlib hiding (textExtents, textWidth, Segment)
+import Graphics.X11.Xlib hiding (textExtents, textWidth, Segment, Button)
import Graphics.X11.Xlib.Extras
import Graphics.X11.Xinerama
import Graphics.X11.Xrandr
@@ -111,59 +111,44 @@ x11EventLoop w signal =
putTMVar signal (Action (ev_button ev) (fi $ ev_x ev))
_ -> return ()
--- | Continuously wait for a signal from a thread or an interrupt handler
--- The list of actions provide also the positions of clickable rectangles
+-- | Continuously wait for a signal from a thread or an interrupt handler.
+-- The list of actions provides the positions of clickable rectangles,
+-- and there is a mutable variable for received signals and the list
+-- of strings updated by running monitors.
signalLoop :: XConf
-> [([Action], Position, Position)]
-> TMVar SignalType
-> TVar [String]
-> IO ()
-signalLoop xc@(XConf d r w fs vos is cfg) as signal tv = do
- typ <- atomically $ takeTMVar signal
- case typ of
- Wakeup -> do
- segs <- updateSegments cfg tv
- xc' <- updateCache d w is (iconRoot cfg) segs >>=
- \c -> return xc { iconS = c }
- as' <- runX xc' $ drawInWin segs
- signalLoop xc' as' signal tv
-
- Reposition ->
- reposWindow cfg
-
- ChangeScreen -> do
- ncfg <- updateConfigPosition cfg
- reposWindow ncfg
-
- Hide t -> hide (t*100*1000)
- Reveal t -> reveal (t*100*1000)
- Toggle t -> toggle t
-
- TogglePersistent -> signalLoop
- xc { config = cfg { persistent = not $ persistent cfg } } as signal tv
-
- SetAlpha a -> signalLoop xc { config = cfg { alpha = a}} as signal tv
-
- Action but x -> action but x
-
+signalLoop xc@(XConf d r w fs vos is cfg) actions signal strs = do
+ typ <- atomically $ takeTMVar signal
+ case typ of
+ Wakeup -> wakeup
+ Action button x -> runActions actions button x >> loopOn
+ Reposition -> reposWindow cfg
+ ChangeScreen -> updateConfigPosition d cfg >>= reposWindow
+ Hide t -> hiderev t Hide hideWindow
+ Reveal t -> hiderev t Reveal (showWindow r cfg)
+ Toggle t -> toggle t
+ TogglePersistent -> updateCfg $ cfg {persistent = not $ persistent cfg}
+ SetAlpha a -> updateCfg $ cfg {alpha = a}
where
- isPersistent = not $ persistent cfg
- loopOn = signalLoop xc as signal tv
- hide t
- | t == 0 =
- when isPersistent (hideWindow d w) >> loopOn
+ loopOn' xc' = signalLoop xc' actions signal strs
+ loopOn = loopOn' xc
+ updateCfg cfg' = loopOn' (xc {config = cfg'})
+
+ wakeup = do
+ segs <- parseSegments cfg strs
+ xc' <- updateIconCache xc segs
+ actions' <- runX xc' $ drawInWin segs
+ signalLoop xc' actions' signal strs
+
+ hiderev t sign op
+ | t == 0 = unless (persistent cfg) (op d w) >> loopOn
| otherwise = do
void $ forkIO
- $ threadDelay t >> atomically (putTMVar signal $ Hide 0)
- loopOn
-
- reveal t
- | t == 0 = do
- when isPersistent (showWindow r cfg d w)
- loopOn
- | otherwise = do
- void $ forkIO
- $ threadDelay t >> atomically (putTMVar signal $ Reveal 0)
+ $ threadDelay (t*100*1000) >>
+ atomically (putTMVar signal $ sign 0)
loopOn
toggle t = do
@@ -173,28 +158,32 @@ signalLoop xc@(XConf d r w fs vos is cfg) as signal tv = do
reposWindow rcfg = do
r' <- repositionWin d w (NE.head fs) rcfg
- signalLoop (XConf d r' w fs vos is rcfg) as signal tv
-
- updateConfigPosition ocfg =
- case position ocfg of
- OnScreen n o -> do
- srs <- getScreenInfo d
- return (if n == length srs
- then
- (ocfg {position = OnScreen 1 o})
- else
- (ocfg {position = OnScreen (n+1) o}))
- o -> return (ocfg {position = OnScreen 1 o})
-
- action button x = do
- mapM_ runAction $
- filter (\(Spawn b _) -> button `elem` b) $
- concatMap (\(a,_,_) -> a) $
- filter (\(_, from, to) -> x >= from && x <= to) as
- loopOn
-
-updateSegments :: Config -> TVar [String] -> IO [[Segment]]
-updateSegments conf v = do
+ signalLoop (XConf d r' w fs vos is rcfg) actions signal strs
+
+parseSegments :: Config -> TVar [String] -> IO [[Segment]]
+parseSegments conf v = do
s <- readTVarIO v
let l:c:r:_ = s ++ repeat ""
liftIO $ mapM (parseString conf) [l, c, r]
+
+updateIconCache :: XConf -> [[Segment]] -> IO XConf
+updateIconCache xc@(XConf d _ w _ _ c cfg) segs = do
+ c' <- updateCache d w c (iconRoot cfg) [p | (Icon p, _, _, _) <- concat segs]
+ return $ xc {iconCache = c'}
+
+updateConfigPosition :: Display -> Config -> IO Config
+updateConfigPosition disp cfg =
+ case position cfg of
+ OnScreen n o -> do
+ srs <- getScreenInfo disp
+ return (if n == length srs
+ then (cfg {position = OnScreen 1 o})
+ else (cfg {position = OnScreen (n+1) o}))
+ o -> return (cfg {position = OnScreen 1 o})
+
+runActions :: [([Action], Position, Position)] -> Button -> Position -> IO ()
+runActions actions button pos =
+ mapM_ runAction $
+ filter (\(Spawn b _) -> button `elem` b) $
+ concatMap (\(a,_,_) -> a) $
+ filter (\(_, from, to) -> pos >= from && pos <= to) actions
diff --git a/src/Xmobar/X11/Types.hs b/src/Xmobar/X11/Types.hs
index a403e11..e94967b 100644
--- a/src/Xmobar/X11/Types.hs
+++ b/src/Xmobar/X11/Types.hs
@@ -1,7 +1,7 @@
------------------------------------------------------------------------------
-- |
-- Module: Xmobar.Types
--- Copyright: (c) 2018 Jose Antonio Ortega Ruiz
+-- Copyright: (c) 2018, 2022 Jose Antonio Ortega Ruiz
-- License: BSD3-style (see LICENSE)
--
-- Maintainer: jao@gnu.org
@@ -15,11 +15,10 @@
------------------------------------------------------------------------------
-module Xmobar.X11.Types (X, XConf (..)) where
+module Xmobar.X11.Types (X, XConf (..), Bitmap (..), XFont (..)) where
import Graphics.X11.Xlib
import Control.Monad.Reader
-import Data.Map
import qualified Data.List.NonEmpty as NE
import Xmobar.X11.Bitmap
@@ -36,6 +35,6 @@ data XConf =
, window :: Window
, fontListS :: NE.NonEmpty XFont
, verticalOffsets :: NE.NonEmpty Int
- , iconS :: Map FilePath Bitmap
+ , iconCache :: BitmapCache
, config :: Config
}
diff --git a/src/Xmobar/X11/XlibDraw.hs b/src/Xmobar/X11/XlibDraw.hs
index 77de23b..15a0ec7 100644
--- a/src/Xmobar/X11/XlibDraw.hs
+++ b/src/Xmobar/X11/XlibDraw.hs
@@ -56,7 +56,7 @@ drawInPixmap gc p wid ht ~[left,center,right] = do
fs = fontListS r
vs = verticalOffsets r
strLn = liftIO . mapM getWidth
- iconW i = maybe 0 B.width (lookup i $ iconS r)
+ iconW i = maybe 0 B.width (lookup i $ iconCache r)
getWidth (Text s,cl,i,_) =
textWidth d (safeIndex fs i) s >>= \tw -> return (Text s,cl,i,fi tw)
getWidth (Icon s,cl,i,_) = return (Icon s,cl,i,fi $ iconW s)
@@ -161,7 +161,7 @@ printStrings dr gc fontlist voffs offs a boxes sl@((s,c,i,l):xs) = do
(Text t) -> liftIO $ printString d dr fontst gc fc bc offset valign ay ht' t alph
(Icon p) -> liftIO $ maybe (return ())
(B.drawBitmap d dr gc fc bc offset valign)
- (lookup p (iconS r))
+ (lookup p (iconCache r))
(Hspace _) -> liftIO $ return ()
let triBoxes = tBoxes c
dropBoxes = filter (\(_,b) -> b `notElem` triBoxes) boxes
@@ -269,7 +269,7 @@ updateActions (Rectangle _ _ wid _) ~[left,center,right] = do
fs = fontListS conf
strLn :: [Segment] -> IO [(Maybe [Action], Position, Position)]
strLn = liftIO . mapM getCoords
- iconW i = maybe 0 B.width (lookup i $ iconS conf)
+ iconW i = maybe 0 B.width (lookup i $ iconCache conf)
getCoords (Text s,_,i,a) =
textWidth d (safeIndex fs i) s >>= \tw -> return (a, 0, fi tw)
getCoords (Icon s,_,_,a) = return (a, 0, fi $ iconW s)
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-27 05:24:14 +0000