summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Xmobar.hs')
-rw-r--r--src/Xmobar.hs25
1 files changed, 14 insertions, 11 deletions
diff --git a/src/Xmobar.hs b/src/Xmobar.hs
index 7befc18..766b2fe 100644
--- a/src/Xmobar.hs
+++ b/src/Xmobar.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable, CPP #-}
+{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module : Xmobar
@@ -36,13 +36,14 @@ import Graphics.X11.Xinerama
import Graphics.X11.Xrandr
import Control.Arrow ((&&&))
+import Control.Applicative ((<$>))
import Control.Monad.Reader
import Control.Concurrent
import Control.Concurrent.STM
import Control.Exception (handle, SomeException(..))
import Data.Bits
import Data.Map hiding (foldr, map, filter)
-import Data.Maybe (fromJust)
+import Data.Maybe (fromJust, isJust)
import Bitmap
import Config
@@ -150,7 +151,7 @@ eventLoop tv xc@(XConf d r w fs is cfg) as signal = do
case typ of
Wakeup -> do
str <- updateString cfg tv
- xc' <- updateCache d w is str >>= \c -> return xc { iconS = c }
+ xc' <- updateCache d w is (iconRoot cfg) str >>= \c -> return xc { iconS = c }
as' <- updateActions xc r str
runX xc' $ drawInWin r str
eventLoop tv xc' as' signal
@@ -204,10 +205,11 @@ eventLoop tv xc@(XConf d r w fs is cfg) as signal = do
case position ocfg of
OnScreen n o -> do
srs <- getScreenInfo d
- if n == length srs then
- return (ocfg {position = OnScreen 1 o})
- else
- return (ocfg {position = OnScreen (n+1) o})
+ 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})
@@ -254,7 +256,7 @@ updateActions conf (Rectangle _ _ wid _) ~[left,center,right] = do
getCoords (Text s,_,a) = textWidth d fs s >>= \tw -> return (a, 0, fi tw)
getCoords (Icon s,_,a) = return (a, 0, fi $ iconW s)
partCoord off xs = map (\(a, x, x') -> (fromJust a, x, x')) $
- filter (\(a, _,_) -> a /= Nothing) $
+ filter (\(a, _,_) -> isJust a) $
scanl (\(_,_,x') (a,_,w') -> (a, x', x' + w')) (Nothing, 0, off) xs
totSLen = foldr (\(_,_,len) -> (+) len) 0
@@ -265,7 +267,7 @@ updateActions conf (Rectangle _ _ wid _) ~[left,center,right] = do
R -> remWidth xs
L -> offs
- fmap concat $ mapM (\(a,xs) -> fmap (\xs' -> partCoord (offset a xs') xs') $ strLn xs) $
+ fmap concat $ mapM (\(a,xs) -> (\xs' -> partCoord (offset a xs') xs') <$> strLn xs) $
zip [L,C,R] [left,center,right]
-- $print
@@ -294,7 +296,7 @@ drawInWin (Rectangle _ _ wid ht) ~[left,center,right] = do
printStrings p gc fs 1 R =<< strLn right
printStrings p gc fs 1 C =<< strLn center
-- draw 1 pixel border if requested
- io $ drawBorder (border c) d p gc bdcolor wid ht
+ io $ drawBorder (border c) (borderWidth c) d p gc bdcolor wid ht
-- copy the pixmap with the new string to the window
io $ copyArea d p w gc 0 0 wid ht 0 0
-- free up everything (we do not want to leak memory!)
@@ -313,9 +315,10 @@ printStrings dr gc fontst offs a sl@((s,c,l):xs) = do
Text t -> io $ textExtents fontst t
Icon _ -> return (0, 0)
let (conf,d) = (config &&& display) r
+ boffs = borderOffset (border conf) (borderWidth conf)
Rectangle _ _ wid ht = rect r
totSLen = foldr (\(_,_,len) -> (+) len) 0 sl
- verticalMargin = (fi ht) - fi (as + ds)
+ verticalMargin = (fi ht) - fi (as + ds) + boffs
valign = (fi ht) - (fi ds) - (verticalMargin `div` 2)
remWidth = fi wid - fi totSLen
offset = case a of