From cf6ed48334aa06718b29abf45b2be8ee2683a977 Mon Sep 17 00:00:00 2001
From: Matthias Schiffer <mschiffer@universe-factory.net>
Date: Wed, 11 Sep 2013 00:40:11 +0200
Subject: Add support for window borders

---
 XMonad/Core.hs | 37 ++++++++++++++++++++++++++++---------
 1 file changed, 28 insertions(+), 9 deletions(-)

(limited to 'XMonad/Core.hs')

diff --git a/XMonad/Core.hs b/XMonad/Core.hs
index 4171060..483bc28 100644
--- a/XMonad/Core.hs
+++ b/XMonad/Core.hs
@@ -17,7 +17,7 @@
 -----------------------------------------------------------------------------
 
 module XMonad.Core (
-    X, WindowSet, WindowSpace, WorkspaceId, WindowState(..),
+    X, WindowSet, WindowSpace, WorkspaceId, BorderWidth(..), WindowState(..),
     ScreenId(..), ScreenDetail(..), XState(..),
     XConf(..), XConfig(..), LayoutClass(..),
     Layout(..), readsLayout, Typeable, Message,
@@ -35,9 +35,11 @@ import Prelude hiding ( catch )
 import Codec.Binary.UTF8.String (encodeString)
 import Control.Exception.Extensible (catch, fromException, try, bracket, throw, finally, SomeException(..))
 import Control.Applicative
+import Control.Arrow ((&&&))
 import Control.Monad.State
 import Control.Monad.Reader
 import Data.Default
+import Data.Function (on)
 import System.FilePath
 import System.IO
 import System.Info
@@ -58,11 +60,22 @@ import Data.Monoid
 import qualified Data.Map as M
 
 
+data BorderWidth = BorderWidth
+    { bwTop    :: !Dimension
+    , bwRight  :: !Dimension
+    , bwBottom :: !Dimension
+    , bwLeft   :: !Dimension
+    } deriving Show
+
 data WindowState = WindowState
     { wsMapped       :: !Bool
     , wsWaitingUnmap :: !Int         -- ^ the number of expected UnmapEvents
     , wsFrame        :: !Window
-    } deriving (Show, Eq)
+    , wsBorderWidth  :: !BorderWidth
+    } deriving Show
+
+instance Eq WindowState where
+  (==) = (==) `on` (wsMapped &&& wsWaitingUnmap &&& wsFrame)
 
 
 -- | XState, the (mutable) window manager state.
@@ -101,6 +114,7 @@ data XConf = XConf
 data XConfig l = XConfig
     { normalBorderColor  :: !String              -- ^ Non focused windows border color. Default: \"#dddddd\"
     , focusedBorderColor :: !String              -- ^ Focused windows border color. Default: \"#ff0000\"
+    , defaultBorderWidth :: !BorderWidth
     , terminal           :: !String              -- ^ The preferred terminal application. Default: \"xterm\"
     , layoutHook         :: !(l Window)          -- ^ The available layouts
     , manageHook         :: !ManageHook          -- ^ The action to run when a new window is opened
@@ -218,20 +232,25 @@ isRoot w = (w==) <$> asks theRoot
 getAtom :: String -> X Atom
 getAtom str = withDisplay $ \dpy -> io $ internAtom dpy str False
 
-emptyWindowState :: WindowState
-emptyWindowState = WindowState False 0 0
+emptyWindowState :: X WindowState
+emptyWindowState = asks (defaultBorderWidth . config) >>= return . WindowState False 0 0
 
 getWindowState :: Window -> X WindowState
-getWindowState w = gets $ M.findWithDefault emptyWindowState w . windowState
+getWindowState w = do
+  ws <- gets $ (M.lookup w) . windowState
+  case ws of
+    Just s  -> return s
+    Nothing -> emptyWindowState
 
 getsWindowState :: (WindowState -> a) -> Window -> X a
 getsWindowState f w = f <$> getWindowState w
 
 setWindowState :: Window -> WindowState -> X ()
-setWindowState w ws = modify $ \s -> s { windowState = f (windowState s) }
-  where
-    f | ws == emptyWindowState = M.delete w
-      | otherwise              = M.insert w ws
+setWindowState w ws = do
+  emptyState <- emptyWindowState
+  let  f | ws == emptyState = M.delete w
+         | otherwise        = M.insert w ws
+  modify $ \s -> s { windowState = f (windowState s) }
 
 modifyWindowState :: (WindowState -> WindowState) -> Window -> X ()
 modifyWindowState f w = getWindowState w >>= return . f >>= setWindowState w
-- 
cgit v1.2.3