diff options
| -rw-r--r-- | news.md | 5 | ||||
| -rw-r--r-- | readme.md | 11 | ||||
| -rw-r--r-- | src/Config.hs | 2 | ||||
| -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/Xmobar.hs | 5 |
8 files changed, 77 insertions, 32 deletions
@@ -14,12 +14,17 @@ _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. _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]). [issue #189]: https://github.com/jaor/xmobar/issues/89 +[pull request #195]: https://github.com/jaor/xmobar/pull/195 ## Version 0.21 (Jul 1, 2014) @@ -312,6 +312,9 @@ Other configuration options: `borderColor` : Border color. +`borderWidth` +: Border width in pixels. + `commands` : For setting the options of the programs to run (optional). @@ -1430,10 +1433,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 and Norbert Zeh. [jao]: http://jao.io [incorporates patches]: http://www.ohloh.net/p/xmobar/contributors 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/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/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 |