diff options
Diffstat (limited to 'src/Xmobar.hs')
| -rw-r--r-- | src/Xmobar.hs | 55 |
1 files changed, 30 insertions, 25 deletions
diff --git a/src/Xmobar.hs b/src/Xmobar.hs index f531cb4..f8db6a5 100644 --- a/src/Xmobar.hs +++ b/src/Xmobar.hs @@ -49,6 +49,11 @@ import Runnable import Signal import Window import XUtil +import ColorCache + +#ifdef XFT +import Graphics.X11.Xft +#endif #ifdef DBUS import IPC.DBus @@ -77,6 +82,9 @@ 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 +#ifdef XFT + xftInitFtLibrary +#endif tv <- atomically $ newTVar [] _ <- forkIO (checker tv [] vs sig `catch` \(SomeException _) -> void (putStrLn "Thread checker failed")) @@ -132,7 +140,7 @@ 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 _ w fs cfg) signal = do +eventLoop tv xc@(XConf d r w fs cfg) signal = do typ <- atomically $ takeTMVar signal case typ of Wakeup -> do @@ -148,7 +156,7 @@ eventLoop tv xc@(XConf d _ w fs cfg) signal = do Hide t -> hide (t*100*1000) Reveal t -> reveal (t*100*1000) - Toggle t -> toggle (t*100*1000) + Toggle t -> toggle t TogglePersistent -> eventLoop tv xc { config = cfg { persistent = not $ persistent cfg } } signal @@ -156,27 +164,27 @@ eventLoop tv xc@(XConf d _ w fs cfg) signal = do where isPersistent = not $ persistent cfg - hide t | t == 0 = do - when isPersistent $ hideWindow d w - eventLoop tv xc signal - | otherwise = do - void $ forkIO - $ threadDelay t >> atomically (putTMVar signal $ Hide 0) - eventLoop tv xc signal + hide t + | t == 0 = + when isPersistent (hideWindow d w) >> eventLoop tv xc signal + | otherwise = do + void $ forkIO + $ threadDelay t >> atomically (putTMVar signal $ Hide 0) + eventLoop tv xc signal - reveal t | t == 0 = - if isPersistent - then do - r' <- repositionWin d w fs cfg - showWindow d w - eventLoop tv (XConf d r' w fs cfg) signal - else eventLoop tv xc signal - | otherwise = do - void $ forkIO - $ threadDelay t >> atomically (putTMVar signal $ Reveal 0) - eventLoop tv xc signal + reveal t + | t == 0 = do + when isPersistent (showWindow r cfg d w) + eventLoop tv xc signal + | otherwise = do + void $ forkIO + $ threadDelay t >> atomically (putTMVar signal $ Reveal 0) + eventLoop tv xc signal - toggle t = isMapped d w >>= \b -> if b then hide t else reveal t + toggle t = do + ismapped <- isMapped d w + atomically (putTMVar signal $ if ismapped then Hide t else Reveal t) + eventLoop tv xc signal reposWindow rcfg = do r' <- repositionWin d w fs rcfg @@ -262,7 +270,7 @@ printStrings dr gc fontst offs a sl@((s,c,l):xs) = do let (conf,d) = (config &&& display) r Rectangle _ _ wid ht = rect r totSLen = foldr (\(_,_,len) -> (+) len) 0 sl - valign = (fi ht `div` 2) + (fi (as + ds) `div` 3) + valign = -1 + (fi ht + fi (as + ds)) `div` 2 remWidth = fi wid - fi totSLen offset = case a of C -> (remWidth + offs) `div` 2 @@ -271,8 +279,5 @@ 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) - withColors d [bc] $ \[bc'] -> do - io $ setForeground d gc bc' - io $ fillRectangle d dr gc offset 0 (fi l) ht io $ printString d dr fontst gc fc bc offset valign s printStrings dr gc fontst (offs + l) a xs |