summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--news.md9
-rw-r--r--readme.md11
-rw-r--r--src/Actions.hs4
-rw-r--r--src/Config.hs2
-rw-r--r--src/Parsers.hs5
-rw-r--r--src/Plugins/Kbd.hsc3
-rw-r--r--src/Plugins/Locks.hs37
-rw-r--r--src/Window.hs41
-rw-r--r--src/Xmobar.hs5
9 files changed, 82 insertions, 35 deletions
diff --git a/news.md b/news.md
index 27e2e45..583ef9a 100644
--- a/news.md
+++ b/news.md
@@ -14,12 +14,19 @@ _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]).
+ - Avoiding zombies on click actions ([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
## Version 0.21 (Jul 1, 2014)
diff --git a/readme.md b/readme.md
index 91be262..dd3f1ff 100644
--- a/readme.md
+++ b/readme.md
@@ -316,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).
@@ -1434,10 +1437,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/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/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