1 files changed, 84 insertions, 0 deletions
diff --git a/lib/ConfigurableBorders.hs b/lib/ConfigurableBorders.hs
new file mode 100644
index 0000000..ea64a04
--- /dev/null
+++ b/lib/ConfigurableBorders.hs
@@ -0,0 +1,84 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts, PatternGuards, DeriveDataTypeable #-}
+
+module ConfigurableBorders ( configureBorders
+                           , configBorderWidth
+                           , resetBorderWidth
+                           , doConfigBorderWidth
+                           , doConfigBorderOff
+                           ) where
+
+
+import qualified XMonad.Core as XM
+import XMonad.Operations (sendMessage)
+import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..))
+import Graphics.X11.Types (Window)
+import Graphics.X11.Xlib.Types (Dimension)
+import Graphics.X11.Xlib.Window (setWindowBorderWidth)
+
+import Control.Monad.Reader
+
+import Data.Monoid
+import Data.Typeable
+import qualified Data.Map as M
+import qualified Data.Set as S
+
+
+defaultBorderWidth :: XM.X Dimension
+defaultBorderWidth = asks (XM.borderWidth . XM.config)
+
+
+data BorderWidth = BorderWidth Window Dimension deriving Typeable
+
+instance XM.Message BorderWidth
+
+
+configBorderWidth :: Dimension -> Window -> XM.X ()
+configBorderWidth w win = sendMessage $ BorderWidth win w
+
+resetBorderWidth :: Window -> XM.X ()
+resetBorderWidth win = do
+  defBW <- defaultBorderWidth
+  configBorderWidth defBW win
+
+doConfigBorderWidth :: Dimension -> XM.ManageHook
+doConfigBorderWidth w = XM.Query $ do
+                        win <- ask
+                        lift $ configBorderWidth w win
+                        return $ Endo id
+
+doConfigBorderOff :: XM.ManageHook
+doConfigBorderOff = doConfigBorderWidth 0
+
+
+data ConfigureBorders a = ConfigureBorders (M.Map a Dimension) (M.Map a Dimension)
+                          deriving (Show, Read)
+
+configureBorders :: (XM.LayoutClass l a) =>
+                    l a
+                 -> ModifiedLayout ConfigureBorders l a
+configureBorders = ModifiedLayout $ ConfigureBorders M.empty M.empty
+
+
+instance LayoutModifier ConfigureBorders Window where
+    modifierDescription _ = "ConfigureBorders"
+                            
+    pureMess (ConfigureBorders wm wmlast) m
+        | Just (BorderWidth win width) <- XM.fromMessage m = do
+                                                  let wmnew = M.insert win width wm
+                                                  return $ ConfigureBorders wmnew wmlast
+
+    pureMess _ _ = Nothing
+    
+    redoLayout (ConfigureBorders wm wmlast) _ _ wrs = do
+      setBorders wmlast
+      return (wrs, Just $ ConfigureBorders M.empty wm)
+        where
+          ws = S.fromList $ map fst wrs
+
+
+setBorders :: (M.Map Window Dimension) -> XM.X ()
+setBorders wm = forM_ (M.toList wm) $ \(win,width) -> setBorder win width
+
+
+setBorder :: Window -> Dimension -> XM.X ()
+setBorder w width = XM.withDisplay $ \dpy -> XM.io $ setWindowBorderWidth dpy w width