diff options
| -rw-r--r-- | news.md | 13 | ||||
| -rw-r--r-- | readme.md | 15 | ||||
| -rw-r--r-- | src/Actions.hs | 4 | ||||
| -rw-r--r-- | src/Config.hs | 2 | ||||
| -rw-r--r-- | src/MinXft.hsc | 84 | ||||
| -rw-r--r-- | src/Parsers.hs | 5 | ||||
| -rw-r--r-- | src/Plugins/Kbd.hsc | 3 | ||||
| -rw-r--r-- | src/Plugins/Locks.hs | 37 | ||||
| -rw-r--r-- | src/Window.hs | 41 | ||||
| -rw-r--r-- | src/XUtil.hsc | 36 | ||||
| -rw-r--r-- | src/Xmobar.hs | 5 |
11 files changed, 196 insertions, 49 deletions
@@ -14,12 +14,23 @@ _New features_ using Haskell-style multiline script, thanks to dunric - Icons can now be also xpm files (if xmobar is compiled with `with_xpm`), thanks to Alexander Shabalin. + - New `borderWidth` option to set xmobar's boder width, thanks to + Travis Staton. + - Support for multiple Xft fonts, thanks to Phil Xiaojun Hu and + Cedric staub (see [pull request #196]). _Bug fixes_ + - Much more efficient implementation of the `Locks` plugin, thanks + to Anton Vorontsov (see [pull request #195]). - Not colorizing total disk size in `DiskU` ([issue #189]). + - Avoiding zombies on click actions, thanks to Phil Xiaojun Hu + ([issue #181]). -[issue #189]: https://github.com/jaor/xmobar/issues/89 +[issue #181]: https://github.com/jaor/xmobar/issues/181 +[issue #189]: https://github.com/jaor/xmobar/issues/189 +[pull request #195]: https://github.com/jaor/xmobar/pull/195 +[pull request #196]: https://github.com/jaor/xmobar/pull/196 ## Version 0.21 (Jul 1, 2014) @@ -124,6 +124,10 @@ Otherwise, you'll need to install them yourself. font = "xft:Times New Roman-10:italic" + Or to have fallback fonts, just separate them by commas: + + font = "xft:Open Sans:size=9,WenQuanYi Zen Hei:size=9" + `with_mpd` : Enables support for the [MPD] daemon. Requires the [libmpd] package. @@ -312,6 +316,9 @@ Other configuration options: `borderColor` : Border color. +`borderWidth` +: Border width in pixels. + `commands` : For setting the options of the programs to run (optional). @@ -1475,10 +1482,10 @@ Janssen, Jochen Keil, Lennart Kolmodin, Krzysztof Kosciuszkiewicz, Dmitry Kurochkin, Todd Lunter, Robert J. Macomber, Dmitry Malikov, David McLean, Marcin Mikołajczyk, Tony Morris, Eric Mrak, Thiago Negri, Edward O'Callaghan, Svein Ove, Martin Perner, Jens Petersen, -Alexander Polakov, Petr Rockai, Alexander Shabalin, Peter Simons, -Andrew Sackville-West, Alexander Solovyov, John Soros, Artem Tarasov, -Sergei Trofimovich, Thomas Tuegel, Jan Vornberger, Daniel Wagner and -Norbert Zeh. +Alexander Polakov, Petr Rockai, Andrew Sackville-West, Alexander +Shabalin, Peter Simons, Alexander Solovyov, John Soros, Travis Staton, +Artem Tarasov, Sergei Trofimovich, Thomas Tuegel, Jan Vornberger, +Anton Vorontsov, Daniel Wagner, Phil Xiaojun Hu and Norbert Zeh. [jao]: http://jao.io [incorporates patches]: http://www.ohloh.net/p/xmobar/contributors diff --git a/src/Actions.hs b/src/Actions.hs index a739828..cd8ecb9 100644 --- a/src/Actions.hs +++ b/src/Actions.hs @@ -12,7 +12,7 @@ module Actions (Action(..), runAction, stripActions) where -import System.Process (runCommand) +import System.Process (system) import Control.Monad (void) import Text.Regex (Regex, subRegex, mkRegex, matchRegex) import Graphics.X11.Types (Button) @@ -21,7 +21,7 @@ data Action = Spawn [Button] String deriving (Eq) runAction :: Action -> IO () -runAction (Spawn _ s) = void $ runCommand s +runAction (Spawn _ s) = void $ system (s ++ "&") stripActions :: String -> String stripActions s = case matchRegex actionRegex s of diff --git a/src/Config.hs b/src/Config.hs index bda8838..e7c25ad 100644 --- a/src/Config.hs +++ b/src/Config.hs @@ -54,6 +54,7 @@ data Config = , position :: XPosition -- ^ Top Bottom or Static , border :: Border -- ^ NoBorder TopB BottomB or FullB , borderColor :: String -- ^ Border color + , borderWidth :: Int -- ^ Border width , hideOnStart :: Bool -- ^ Hide (Unmap) the window on -- initialization , allDesktops :: Bool -- ^ Tell the WM to map to all desktops @@ -110,6 +111,7 @@ defaultConfig = , position = Top , border = NoBorder , borderColor = "#BFBFBF" + , borderWidth = 1 , hideOnStart = False , lowerOnStart = True , persistent = False diff --git a/src/MinXft.hsc b/src/MinXft.hsc index 327e95e..b2299af 100644 --- a/src/MinXft.hsc +++ b/src/MinXft.hsc @@ -2,7 +2,7 @@ ------------------------------------------------------------------------------ -- | -- Module: MinXft --- Copyright: (c) 2012 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2012, 2014 Jose Antonio Ortega Ruiz -- (c) Clemens Fruhwirth <clemens@endorphin.org> 2007 -- License: BSD3-style (see LICENSE) -- @@ -26,13 +26,18 @@ module MinXft ( AXftColor , freeAXftColor , withAXftDraw , drawXftString + , drawXftString' , drawXftRect , openAXftFont , closeAXftFont , xftTxtExtents + , xftTxtExtents' , xft_ascent + , xft_ascent' , xft_descent + , xft_descent' , xft_height + , xft_height' ) where @@ -45,6 +50,7 @@ import Foreign import Foreign.C.Types import Foreign.C.String import Codec.Binary.UTF8.String as UTF8 +import Data.Char (ord) #include <X11/Xft/Xft.h> @@ -73,12 +79,21 @@ newtype AXftFont = AXftFont (Ptr AXftFont) xft_ascent :: AXftFont -> IO Int xft_ascent (AXftFont p) = peekCUShort p #{offset XftFont, ascent} +xft_ascent' :: [AXftFont] -> IO Int +xft_ascent' = (fmap maximum) . (mapM xft_ascent) + xft_descent :: AXftFont -> IO Int xft_descent (AXftFont p) = peekCUShort p #{offset XftFont, descent} +xft_descent' :: [AXftFont] -> IO Int +xft_descent' = (fmap maximum) . (mapM xft_descent) + xft_height :: AXftFont -> IO Int xft_height (AXftFont p) = peekCUShort p #{offset XftFont, height} +xft_height' :: [AXftFont] -> IO Int +xft_height' = (fmap maximum) . (mapM xft_height) + foreign import ccall "XftTextExtentsUtf8" cXftTextExtentsUtf8 :: Display -> AXftFont -> CString -> CInt -> Ptr XGlyphInfo -> IO () @@ -90,6 +105,12 @@ xftTxtExtents d f string = cXftTextExtentsUtf8 d f str_ptr (fi len) cglyph peek cglyph +xftTxtExtents' :: Display -> [AXftFont] -> String -> IO XGlyphInfo +xftTxtExtents' d fs string = do + chunks <- getChunks d fs string + let (_, _, gi, _, _) = last chunks + return gi + foreign import ccall "XftFontOpenName" c_xftFontOpen :: Display -> CInt -> CString -> IO AXftFont @@ -101,6 +122,14 @@ openAXftFont dpy screen name = foreign import ccall "XftFontClose" closeAXftFont :: Display -> AXftFont -> IO () +foreign import ccall "XftCharExists" + cXftCharExists :: Display -> AXftFont -> (#type FcChar32) -> IO (#type FcBool) + +xftCharExists :: Display -> AXftFont -> Char -> IO Bool +xftCharExists d f c = bool `fmap` cXftCharExists d f (fi $ ord c) + where + bool 0 = False + bool _ = True -- Drawing fi :: (Integral a, Num b) => a -> b @@ -111,6 +140,9 @@ newtype AXftDraw = AXftDraw (Ptr AXftDraw) foreign import ccall "XftDrawCreate" c_xftDrawCreate :: Display -> Drawable -> Visual -> Colormap -> IO AXftDraw +foreign import ccall "XftDrawDisplay" + c_xftDrawDisplay :: AXftDraw -> IO Display + foreign import ccall "XftDrawDestroy" c_xftDrawDestroy :: AXftDraw -> IO () @@ -130,6 +162,56 @@ drawXftString d c f x y string = withArrayLen (map fi (UTF8.encode string)) (\len ptr -> cXftDrawStringUtf8 d c f (fi x) (fi y) ptr (fi len)) +drawXftString' :: AXftDraw -> + AXftColor -> + [AXftFont] -> + Integer -> + Integer -> + String -> IO () +drawXftString' d c fs x y string = do + display <- c_xftDrawDisplay d + chunks <- getChunks display fs string + mapM_ (\(f, s, _, xo, yo) -> drawXftString d c f (x+xo) (y+yo) s) chunks + +-- Split string and determine fonts/offsets for individual parts +getChunks :: Display -> [AXftFont] -> [Char] -> + IO [(AXftFont, String, XGlyphInfo, Integer, Integer)] +getChunks disp fts str = do + chunks <- getFonts disp fts str + getOffsets (XGlyphInfo 0 0 0 0 0 0) chunks + where + -- Split string and determine fonts for individual parts + getFonts _ [] _ = return [] + getFonts _ _ [] = return [] + getFonts _ [ft] s = return [(ft, s)] + getFonts d fonts@(ft:_) s = do + -- Determine which glyph can be rendered by current font + glyphs <- mapM (xftCharExists d ft) s + -- Split string into parts that can/cannot be rendered + let splits = split (runs glyphs) s + -- Determine which font to render each chunk with + concat `fmap` mapM (getFont d fonts) splits + + -- Determine fonts for substrings + getFont _ [] _ = return [] + getFont _ [ft] (_, s) = return [(ft, s)] -- Last font, use it + getFont _ (ft:_) (True, s) = return [(ft, s)] -- Current font can render this substring + getFont d (_:fs) (False, s) = getFonts d fs s -- Fallback to next font + + -- Helpers + runs [] = [] + runs (x:xs) = let (h, t) = span (==x) xs in (x, length h + 1) : runs t + split [] _ = [] + split ((x, c):xs) s = let (h, t) = splitAt c s in (x, h) : split xs t + + -- Determine coordinates for chunks using extents + getOffsets _ [] = return [] + getOffsets (XGlyphInfo _ _ x y xo yo) ((f, s):chunks) = do + (XGlyphInfo w' h' _ _ xo' yo') <- xftTxtExtents disp f s + let gi = XGlyphInfo (xo+w') (yo+h') x y (xo+xo') (yo+yo') + rest <- getOffsets gi chunks + return $ (f, s, gi, fromIntegral xo, fromIntegral yo) : rest + foreign import ccall "XftDrawRect" cXftDrawRect :: AXftDraw -> AXftColor -> CInt -> CInt -> CUInt -> CUInt -> IO () diff --git a/src/Parsers.hs b/src/Parsers.hs index f7be1e3..5e6f4d6 100644 --- a/src/Parsers.hs +++ b/src/Parsers.hs @@ -199,8 +199,8 @@ parseConfig = runParser parseConf fields "Config" . stripComments perms = permute $ Config <$?> pFont <|?> pBgColor <|?> pFgColor <|?> pPosition - <|?> pBorder <|?> pBdColor <|?> pHideOnStart <|?> pAllDesktops - <|?> pOverrideRedirect <|?> pPickBroadest + <|?> pBorder <|?> pBdColor <|?> pBdWidth <|?> pHideOnStart + <|?> pAllDesktops <|?> pOverrideRedirect <|?> pPickBroadest <|?> pLowerOnStart <|?> pPersistent <|?> pCommands <|?> pSepChar <|?> pAlignSep <|?> pTemplate @@ -224,6 +224,7 @@ parseConfig = runParser parseConf fields "Config" . stripComments pLowerOnStart = readField lowerOnStart "lowerOnStart" pPersistent = readField persistent "persistent" pBorder = readField border "border" + pBdWidth = readField borderWidth "borderWidth" pAllDesktops = readField allDesktops "allDesktops" pOverrideRedirect = readField overrideRedirect "overrideRedirect" pPickBroadest = readField pickBroadest "pickBroadest" diff --git a/src/Plugins/Kbd.hsc b/src/Plugins/Kbd.hsc index 241dde4..318effc 100644 --- a/src/Plugins/Kbd.hsc +++ b/src/Plugins/Kbd.hsc @@ -276,6 +276,9 @@ xkbUseCoreKbd = #const XkbUseCoreKbd xkbStateNotify :: CUInt xkbStateNotify = #const XkbStateNotify +xkbIndicatorStateNotify :: CUInt +xkbIndicatorStateNotify = #const XkbIndicatorStateNotify + xkbMapNotify :: CUInt xkbMapNotify = #const XkbMapNotify diff --git a/src/Plugins/Locks.hs b/src/Plugins/Locks.hs index 3c1e0a9..79b1583 100644 --- a/src/Plugins/Locks.hs +++ b/src/Plugins/Locks.hs @@ -20,6 +20,8 @@ import Data.Bits import Control.Monad import Graphics.X11.Xlib.Extras import Plugins +import Plugins.Kbd +import XUtil (nextEvent') data Locks = Locks deriving (Read, Show) @@ -30,22 +32,33 @@ locks = [ ( xK_Caps_Lock, "CAPS" ) , ( xK_Scroll_Lock, "SCROLL" ) ] +run' :: Display -> Window -> IO String +run' d root = 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 + instance Exec Locks where alias Locks = "locks" - rate Locks = 2 - run Locks = do + start Locks cb = do d <- openDisplay "" root <- rootWindow d (defaultScreen d) + _ <- xkbSelectEventDetails d xkbUseCoreKbd xkbIndicatorStateNotify m m - modMap <- getModifierMapping d - ( _, _, _, _, _, _, _, m ) <- queryPointer d root + allocaXEvent $ \ep -> forever $ do + cb =<< run' d root + nextEvent' d ep + getEvent ep - 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 closeDisplay d - - return $ unwords $ map snd ls + return () + where + m = xkbAllStateComponentsMask diff --git a/src/Window.hs b/src/Window.hs index f7e1801..95ad3a3 100644 --- a/src/Window.hs +++ b/src/Window.hs @@ -164,20 +164,22 @@ getStaticStrutValues (Static cx cy cw ch) rwh xe = xs + cw getStaticStrutValues _ _ = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] -drawBorder :: Border -> Display -> Drawable -> GC -> Pixel +drawBorder :: Border -> Int -> Display -> Drawable -> GC -> Pixel -> Dimension -> Dimension -> IO () -drawBorder b d p gc c wi ht = case b of +drawBorder b lw d p gc c wi ht = case b of NoBorder -> return () - TopB -> drawBorder (TopBM 0) d p gc c w h - BottomB -> drawBorder (BottomBM 0) d p gc c w h - FullB -> drawBorder (FullBM 0) d p gc c w h - TopBM m -> sf >> drawLine d p gc 0 (fi m) (fi w) 0 - BottomBM m -> let rw = fi h - fi m in - sf >> drawLine d p gc 0 rw (fi w) rw - FullBM m -> let pad = 2 * fi m; mp = fi m in - sf >> drawRectangle d p gc mp mp (w - pad) (h - pad) - where sf = setForeground d gc c - (w, h) = (wi - 1, ht - 1) + TopB -> drawBorder (TopBM 0) lw d p gc c wi ht + BottomB -> drawBorder (BottomBM 0) lw d p gc c wi ht + FullB -> drawBorder (FullBM 0) lw d p gc c wi ht + TopBM m -> sf >> sla >> drawLine d p gc 0 (fi m + boff) (fi wi) (fi m + boff) + BottomBM m -> let rw = fi ht - fi m + boff in + sf >> sla >> drawLine d p gc 0 rw (fi wi) rw + FullBM m -> let pad = 2 * fi m + 2 * fi boff'; mp = fi m + fi boff' in + sf >> sla >> drawRectangle d p gc mp mp (wi - pad) (ht - pad) + where sf = setForeground d gc c + sla = setLineAttributes d gc (fi lw) lineSolid capNotLast joinMiter + boff = borderOffset b lw + boff' = calcBorderOffset lw :: Int hideWindow :: Display -> Window -> IO () hideWindow d w = do @@ -193,3 +195,18 @@ showWindow r c d w = do isMapped :: Display -> Window -> IO Bool isMapped d w = ism <$> getWindowAttributes d w where ism (WindowAttributes { wa_map_state = wms }) = wms /= waIsUnmapped + +borderOffset :: (Integral a) => Border -> Int -> a +borderOffset b lw = + case b of + BottomB -> negate boffs + BottomBM _ -> negate boffs + TopB -> boffs + TopBM _ -> boffs + _ -> 0 + where boffs = calcBorderOffset lw + +calcBorderOffset :: (Integral a) => Int -> a +calcBorderOffset = ceiling . (/2) . toDouble + where toDouble = fi :: (Integral a) => a -> Double + diff --git a/src/XUtil.hsc b/src/XUtil.hsc index b1e885c..1217452 100644 --- a/src/XUtil.hsc +++ b/src/XUtil.hsc @@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : XUtil --- Copyright : (C) 2011, 2012, 2013 Jose Antonio Ortega Ruiz +-- Copyright : (C) 2011, 2012, 2013, 2014 Jose Antonio Ortega Ruiz -- (C) 2007 Andrea Rossato -- License : BSD3 -- @@ -72,7 +72,7 @@ hGetLineSafe = hGetLine data XFont = Core FontStruct | Utf8 FontSet #ifdef XFT - | Xft AXftFont + | Xft [AXftFont] #endif -- | When initFont gets a font name that starts with 'xft:' it switchs @@ -118,12 +118,22 @@ initUtf8Font d s = do fallBack = const $ createFontSet d miscFixedFont #ifdef XFT -initXftFont :: Display -> String -> IO AXftFont +initXftFont :: Display -> String -> IO [AXftFont] initXftFont d s = do setupLocale - f <- openAXftFont d (defaultScreenOfDisplay d) (drop 4 s) - addFinalizer f (closeAXftFont d f) - return f + let fontNames = wordsBy (== ',') (drop 4 s) + fonts <- mapM openFont fontNames + return fonts + where + openFont fontName = do + f <- openAXftFont d (defaultScreenOfDisplay d) fontName + addFinalizer f (closeAXftFont d f) + return f + wordsBy p str = case dropWhile p str of + "" -> [] + str' -> w : wordsBy p str'' + where + (w, str'') = break p str' #endif textWidth :: Display -> XFont -> String -> IO Int @@ -131,7 +141,7 @@ textWidth _ (Utf8 fs) s = return $ fi $ wcTextEscapement fs s textWidth _ (Core fs) s = return $ fi $ Xlib.textWidth fs s #ifdef XFT textWidth dpy (Xft xftdraw) s = do - gi <- xftTxtExtents dpy xftdraw s + gi <- xftTxtExtents' dpy xftdraw s return $ xglyphinfo_xOff gi #endif @@ -145,9 +155,9 @@ textExtents (Utf8 fs) s = do descent = fi $ rect_height rl + (fi $ rect_y rl) return (ascent, descent) #ifdef XFT -textExtents (Xft xftfont) _ = do - ascent <- fi `fmap` xft_ascent xftfont - descent <- fi `fmap` xft_descent xftfont +textExtents (Xft xftfonts) _ = do + ascent <- fi `fmap` xft_ascent' xftfonts + descent <- fi `fmap` xft_descent' xftfonts return (ascent, descent) #endif @@ -167,15 +177,15 @@ printString d p (Utf8 fs) gc fc bc x y s = io $ wcDrawImageString d p fs gc x y s #ifdef XFT -printString dpy drw fs@(Xft font) _ fc bc x y s = do +printString dpy drw fs@(Xft fonts) _ fc bc x y s = do (a,d) <- textExtents fs s - gi <- xftTxtExtents dpy font s + gi <- xftTxtExtents' dpy fonts s withDrawingColors dpy drw fc bc $ \draw -> \fc' -> \bc' -> (drawXftRect draw bc' (x + 1 - fi (xglyphinfo_x gi)) (y - (a + d) + 1) (xglyphinfo_xOff gi) (a + d)) >> - (drawXftString draw fc' font x (y - 2) s) + (drawXftString' draw fc' fonts (toInteger x) (toInteger (y - 2)) s) #endif diff --git a/src/Xmobar.hs b/src/Xmobar.hs index 6ea8fab..91245e2 100644 --- a/src/Xmobar.hs +++ b/src/Xmobar.hs @@ -296,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!) @@ -315,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 - valign = -1 + (fi ht + fi (as + ds)) `div` 2 + valign = boffs-1 + (fi ht + fi (as + ds)) `div` 2 remWidth = fi wid - fi totSLen offset = case a of C -> (remWidth + offs) `div` 2 |