summaryrefslogtreecommitdiffhomepage
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-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
6 files changed, 65 insertions, 28 deletions
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