diff options
Diffstat (limited to 'src/Xmobar.hs')
| -rw-r--r-- | src/Xmobar.hs | 50 |
1 files changed, 33 insertions, 17 deletions
diff --git a/src/Xmobar.hs b/src/Xmobar.hs index 7730620..b7355c4 100644 --- a/src/Xmobar.hs +++ b/src/Xmobar.hs @@ -23,13 +23,13 @@ module Xmobar , startCommand -- * Window Management -- $window - , createWin, updateWin + , createWin -- * Printing -- $print , drawInWin, printStrings ) where -import Prelude +import Prelude hiding (lookup) import Graphics.X11.Xlib hiding (textExtents, textWidth) import Graphics.X11.Xlib.Extras import Graphics.X11.Xinerama @@ -41,12 +41,14 @@ import Control.Concurrent import Control.Concurrent.STM import Control.Exception (handle, SomeException(..)) import Data.Bits +import Data.Map hiding (foldr, map, filter) import Config import Parsers import Commands import Runnable import Signal +import Types import Window import XUtil import ColorCache @@ -72,6 +74,7 @@ data XConf = , rect :: Rectangle , window :: Window , fontS :: XFont + , iconS :: Map FilePath Bitmap , config :: Config } @@ -81,7 +84,7 @@ runX xc f = runReaderT f xc -- | Starts the main event loop and threads startLoop :: XConf -> TMVar SignalType -> [[(Maybe ThreadId, TVar String)]] -> IO () -startLoop xcfg@(XConf _ _ w _ _) sig vs = do +startLoop xcfg@(XConf _ _ w _ _ _) sig vs = do #ifdef XFT xftInitFtLibrary #endif @@ -98,7 +101,7 @@ startLoop xcfg@(XConf _ _ w _ _) sig vs = do eventLoop tv xcfg sig where handler thing (SomeException _) = - putStrLn ("Thread " ++ thing ++ " failed") >> return () + void $ putStrLn ("Thread " ++ thing ++ " failed") -- Reacts on events from X eventer signal = allocaXEvent $ \e -> do @@ -139,12 +142,14 @@ checker tvar ov vs signal = do -- | Continuously wait for a signal from a thread or a interrupt handler eventLoop :: TVar [String] -> XConf -> TMVar SignalType -> IO () -eventLoop tv xc@(XConf d r w fs cfg) signal = do +eventLoop tv xc@(XConf d r w fs is cfg) signal = do typ <- atomically $ takeTMVar signal case typ of Wakeup -> do - runX xc (updateWin tv) - eventLoop tv xc signal + str <- updateString cfg tv + xc' <- updateCache d w is str >>= \c -> return xc { iconS = c } + runX xc' $ drawInWin r str + eventLoop tv xc' signal Reposition -> reposWindow cfg @@ -187,7 +192,7 @@ eventLoop tv xc@(XConf d r w fs cfg) signal = do reposWindow rcfg = do r' <- repositionWin d w fs rcfg - eventLoop tv (XConf d r' w fs rcfg) signal + eventLoop tv (XConf d r' w fs is rcfg) signal updateConfigPosition ocfg = case position ocfg of @@ -219,14 +224,23 @@ startCommand sig (com,s,ss) return (Just h,var) where is = s ++ "Updating..." ++ ss -updateWin :: TVar [String] -> X () -updateWin v = do - xc <- ask - s <- io $ atomically $ readTVar v - let (conf,rec) = (config &&& rect) xc - l:c:r:_ = s ++ repeat "" - ps <- io $ mapM (parseString conf) [l, c, r] - drawInWin rec ps +updateString :: Config -> TVar [String] -> IO [[(Widget, String)]] +updateString conf v = do + s <- atomically $ readTVar v + let l:c:r:_ = s ++ repeat "" + io $ mapM (parseString conf) [l, c, r] + +updateCache :: Display -> Window -> Map FilePath Bitmap -> [[(Widget, String)]] -> IO (Map FilePath Bitmap) +updateCache dpy win cache ps = do + let paths = map (\(Icon p, _) -> p) . concatMap (filter icons) $ ps + icons (Icon _, _) = True + icons _ = False + foldM (\m path -> if member path m + then return m + else do bitmap <- io $ loadBitmap dpy win path + case bitmap of + Nothing -> return m + Just bmap -> return $ insert path bmap m) cache paths -- $print @@ -283,5 +297,7 @@ printStrings dr gc fontst offs a sl@((s,c,l):xs) = do (fc,bc) = case break (==',') c of (f,',':b) -> (f, b ) (f, _) -> (f, bgColor conf) - io $ printString d dr fontst gc fc bc offset valign s + case s of + (Text t) -> io $ printString d dr fontst gc fc bc offset valign t + (Icon p) -> io $ maybe (return ()) (drawBitmap d dr fontst gc fc bc offset valign) (lookup p (iconS r)) printStrings dr gc fontst (offs + l) a xs |