diff options
Diffstat (limited to 'src')
| -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 |
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 |