Add ability to set border width

4 files changed, 37 insertions, 16 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/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