Use `setWindowBorderWithFallback' to support windows with RGBA color maps

This brings xmonad-contrib inline with xmonad in this regard.  Should
also be fix for #138

XMonad/Hooks/UrgencyHook.hs

@@ -339,7 +339,7 @@ getNetWMState :: Window -> X [CLong]
 getNetWMState w = do
     a_wmstate <- getAtom "_NET_WM_STATE"
     fromMaybe [] `fmap` getProp32 a_wmstate w
-   
+
 
 -- The Non-ICCCM Manifesto:
 -- Note: Some non-standard choices have been made in this implementation to
@@ -497,14 +497,14 @@ data BorderUrgencyHook = BorderUrgencyHook { urgencyBorderColor :: !String }
 
 instance UrgencyHook BorderUrgencyHook where
   urgencyHook BorderUrgencyHook { urgencyBorderColor = cs } w =
-    withDisplay $ \dpy -> io $ do
+    withDisplay $ \dpy -> do
-      c' <- initColor dpy cs
+      c' <- io (initColor dpy cs)
       case c' of
-        Just c -> setWindowBorder dpy w c
+        Just c -> setWindowBorderWithFallback dpy w cs c
-        _      -> hPutStrLn stderr $ concat ["Warning: bad urgentBorderColor "
+        _      -> io $ hPutStrLn stderr $ concat ["Warning: bad urgentBorderColor "
-                                            ,show cs
+                                                 ,show cs
-                                            ," in BorderUrgencyHook"
+                                                 ," in BorderUrgencyHook"
-                                            ]
+                                                 ]
 
 -- | Flashes when a window requests your attention and you can't see it.
 -- Defaults to a duration of five seconds, and no extra args to dzen.
@@ -543,4 +543,3 @@ filterUrgencyHook skips w = do
         Just tag -> when (tag `elem` skips)
                         $ adjustUrgents (delete w)
         _ -> return ()
-

XMonad/Layout/WindowNavigation.hs

@@ -195,7 +195,9 @@ navigable :: Direction2D -> Point -> [(Window, Rectangle)] -> [(Window, Rectangl
 navigable d pt = sortby d . filter (inr d pt . snd)
 
 sc :: Pixel -> Window -> X ()
-sc c win = withDisplay $ \dpy -> io $ setWindowBorder dpy win c
+sc c win = withDisplay $ \dpy -> do
+    colorName <- io (pixelToString dpy c)
+    setWindowBorderWithFallback dpy win colorName c
 
 center :: Rectangle -> Point
 center (Rectangle x y w h) = P (fromIntegral x + fromIntegral w/2)  (fromIntegral y + fromIntegral h/2)

XMonad/Util/Font.hs

@@ -29,6 +29,7 @@ module XMonad.Util.Font
     , textExtentsXMF
     , printStringXMF
     , stringToPixel
+    , pixelToString
     , fi
     ) where
 
@@ -37,6 +38,8 @@ import Foreign
 import Control.Applicative
 import Control.Exception as E
 import Data.Maybe
+import Data.Bits (shiftR)
+import Text.Printf (printf)
 
 #ifdef XFT
 import Data.List
@@ -61,6 +64,19 @@ stringToPixel d s = fromMaybe fallBack <$> io getIt
     where getIt    = initColor d s
           fallBack = blackPixel d (defaultScreen d)
 
+-- | Convert a @Pixel@ into a @String@.
+pixelToString :: (MonadIO m) => Display -> Pixel -> m String
+pixelToString d p = do
+    let cm = defaultColormap d (defaultScreen d)
+    (Color _ r g b _) <- io (queryColor d cm $ Color p 0 0 0 0)
+    return ("#" ++ hex r ++ hex g ++ hex b)
+  where
+    -- NOTE: The @Color@ type has 16-bit values for red, green, and
+    -- blue, even though the actual type in X is only 8 bits wide.  It
+    -- seems that the upper and lower 8-bit sections of the @Word16@
+    -- values are the same.  So, we just discard the lower 8 bits.
+    hex = printf "%02x" . (`shiftR` 8)
+
 econst :: a -> IOException -> a
 econst = const
 

XMonad/Util/XUtils.hs

@@ -28,6 +28,7 @@ module XMonad.Util.XUtils
     , paintAndWrite
     , paintTextAndIcons
     , stringToPixel
+    , pixelToString
     , fi
     ) where
 
@@ -208,4 +209,3 @@ mkWindow d s rw x y w h p o = do
            set_background_pixel  attributes p
            createWindow d rw x y w h 0 (defaultDepthOfScreen s)
                         inputOutput visual attrmask attributes
-