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.
This commit is contained in:
Don Stewart
2008-02-06 19:48:58 +00:00
parent 261f742404
commit 695860f1fd
2 changed files with 14 additions and 5 deletions

View File

@@ -28,6 +28,7 @@ import Graphics.X11.Xlib hiding (refreshKeyboardMapping)
import Graphics.X11.Xlib.Extras import Graphics.X11.Xlib.Extras
import XMonad.Core import XMonad.Core
import qualified XMonad.Config as Default
import XMonad.StackSet (new, floating, member) import XMonad.StackSet (new, floating, member)
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
import XMonad.Operations import XMonad.Operations
@@ -46,8 +47,14 @@ xmonad initxmc = do
rootw <- rootWindow dpy dflt rootw <- rootWindow dpy dflt
xinesc <- getCleanedScreenInfo dpy xinesc <- getCleanedScreenInfo dpy
nbc <- initColor dpy $ normalBorderColor xmc nbc <- do v <- initColor dpy $ normalBorderColor xmc
fbc <- initColor dpy $ focusedBorderColor 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 hSetBuffering stdout NoBuffering
args <- getArgs args <- getArgs

View File

@@ -31,8 +31,9 @@ import qualified Data.Map as M
import qualified Data.Set as S import qualified Data.Set as S
import Control.Applicative import Control.Applicative
import Control.Monad.State
import Control.Monad.Reader import Control.Monad.Reader
import Control.Monad.State
import qualified Control.Exception as C
import System.IO import System.IO
import Graphics.X11.Xlib import Graphics.X11.Xlib
@@ -381,8 +382,9 @@ cleanMask km = do
return (complement (nlm .|. lockMask) .&. km) return (complement (nlm .|. lockMask) .&. km)
-- | Get the Pixel value for a named color -- | Get the Pixel value for a named color
initColor :: Display -> String -> IO Pixel initColor :: Display -> String -> IO (Maybe Pixel)
initColor dpy c = (color_pixel . fst) <$> allocNamedColor dpy colormap c initColor dpy c = C.handle (\_ -> return Nothing) $
(Just . color_pixel . fst) <$> allocNamedColor dpy colormap c
where colormap = defaultColormap dpy (defaultScreen dpy) where colormap = defaultColormap dpy (defaultScreen dpy)
------------------------------------------------------------------------ ------------------------------------------------------------------------