From 4d371c7b8fc53f8e9ad04a011a57f2db9d289d04 Mon Sep 17 00:00:00 2001
From: Don Stewart <dons@galois.com>
Date: Wed, 6 Feb 2008 20:48:58 +0100
Subject: Lift initColor exceptions into Maybe

We should audit all X11 Haskell lib calls we make for whether
they throw undocumented exceptions, and then banish that.

darcs-hash:20080206194858-cba2c-143b6edd906a9ddfcc8ff85b4a42ebea0f3462bf.gz
---
 XMonad/Main.hs       | 11 +++++++++--
 XMonad/Operations.hs |  8 +++++---
 2 files changed, 14 insertions(+), 5 deletions(-)

(limited to 'XMonad')

diff --git a/XMonad/Main.hs b/XMonad/Main.hs
index 2c22792..0450a7c 100644
--- a/XMonad/Main.hs
+++ b/XMonad/Main.hs
@@ -28,6 +28,7 @@ import Graphics.X11.Xlib hiding (refreshKeyboardMapping)
 import Graphics.X11.Xlib.Extras
 
 import XMonad.Core
+import qualified XMonad.Config as Default
 import XMonad.StackSet (new, floating, member)
 import qualified XMonad.StackSet as W
 import XMonad.Operations
@@ -46,8 +47,14 @@ xmonad initxmc = do
 
     rootw  <- rootWindow dpy dflt
     xinesc <- getCleanedScreenInfo dpy
-    nbc    <- initColor dpy $ normalBorderColor xmc
-    fbc    <- initColor dpy $ focusedBorderColor xmc
+    nbc    <- do v            <- initColor dpy $ normalBorderColor  xmc
+                 ~(Just nbc_) <- initColor dpy $ normalBorderColor Default.defaultConfig
+                 return (fromMaybe nbc_ v)
+
+    fbc    <- do v <- initColor dpy $ focusedBorderColor xmc
+                 ~(Just fbc_)  <- initColor dpy $ focusedBorderColor Default.defaultConfig
+                 return (fromMaybe fbc_ v)
+
     hSetBuffering stdout NoBuffering
     args <- getArgs
 
diff --git a/XMonad/Operations.hs b/XMonad/Operations.hs
index 0e96893..46eebf8 100644
--- a/XMonad/Operations.hs
+++ b/XMonad/Operations.hs
@@ -31,8 +31,9 @@ import qualified Data.Map as M
 import qualified Data.Set as S
 
 import Control.Applicative
-import Control.Monad.State
 import Control.Monad.Reader
+import Control.Monad.State
+import qualified Control.Exception as C
 
 import System.IO
 import Graphics.X11.Xlib
@@ -381,8 +382,9 @@ cleanMask km = do
     return (complement (nlm .|. lockMask) .&. km)
 
 -- | Get the Pixel value for a named color
-initColor :: Display -> String -> IO Pixel
-initColor dpy c = (color_pixel . fst) <$> allocNamedColor dpy colormap c
+initColor :: Display -> String -> IO (Maybe Pixel)
+initColor dpy c = C.handle (\_ -> return Nothing) $
+    (Just . color_pixel . fst) <$> allocNamedColor dpy colormap c
     where colormap = defaultColormap dpy (defaultScreen dpy)
 
 ------------------------------------------------------------------------
-- 
cgit v1.2.3