More flexible interface for X.H.FadeInactive

This patch allows setting the opacity on a per-window basis and lets the
user specify it as a percentage instead of an Integer between 0 and 2^32-1.

XMonad/Hooks/FadeInactive.hs

@@ -19,6 +19,7 @@ module XMonad.Hooks.FadeInactive (
     isUnfocused,
     fadeIn,
     fadeOut,
+    fadeIf,
     fadeInactiveLogHook,
     fadeOutLogHook
     ) where
@@ -35,11 +36,11 @@ import Control.Monad
 -- >
 -- > myLogHook :: X ()
 -- > myLogHook = fadeInactiveLogHook fadeAmount
--- >     where fadeAmount = 0xdddddddd
+-- >     where fadeAmount = 0.8
 -- >
 -- > main = xmonad defaultConfig { logHook = myLogHook }
 --
--- fadeAmount can be any integer
+-- fadeAmount can be any rational between 0 and 1.
 -- you will need to have xcompmgr <http://freedesktop.org/wiki/Software/xapps>
 -- or something similar for this to do anything
 --
@@ -51,40 +52,43 @@ import Control.Monad
 --
 -- "XMonad.Doc.Extending#Editing_the_layout_hook"
 
--- |
--- sets the opacity of a window
-setOpacity :: Window -> Integer -> X ()
+-- | Converts a percentage to the format required for _NET_WM_WINDOW_OPACITY
+rationalToOpacity :: Integral a => Rational -> a
+rationalToOpacity perc
+    | perc < 0 || perc > 1 = 0xffffffff -- invalid input, default to opaque
+    | otherwise = round $ perc * 0xffffffff
+
+-- | sets the opacity of a window
+setOpacity :: Window -> Rational -> X ()
 setOpacity w t = withDisplay $ \dpy -> do
     a <- getAtom "_NET_WM_WINDOW_OPACITY"
     c <- getAtom "CARDINAL"
-    io $ changeProperty32 dpy w a c propModeReplace [fromIntegral t]
+    io $ changeProperty32 dpy w a c propModeReplace [rationalToOpacity t]
 
--- |
--- fades a window out by setting the opacity
-fadeOut :: Integer -> Window -> X ()
-fadeOut amt = flip setOpacity amt
+-- | fades a window out by setting the opacity
+fadeOut :: Rational -> Window -> X ()
+fadeOut = flip setOpacity
 
--- |
--- makes a window completely opaque
+-- | makes a window completely opaque
 fadeIn :: Window -> X ()
-fadeIn = flip setOpacity 0xffffffff
+fadeIn = fadeOut 1
 
--- |
--- lowers the opacity of inactive windows to the specified amount
-fadeInactiveLogHook :: Integer -> X ()
-fadeInactiveLogHook amt = fadeOutLogHook isUnfocused amt
+-- | Fades a window by the specified amount if it satisfies the first query, otherwise
+-- makes it opaque.
+fadeIf :: Query Bool -> Rational -> Query Rational
+fadeIf qry amt = qry >>= \b -> return $ if b then amt else 1
+
+-- | sets the opacity of inactive windows to the specified amount
+fadeInactiveLogHook :: Rational -> X ()
+fadeInactiveLogHook = fadeOutLogHook . fadeIf isUnfocused
 
 -- | returns True if the window doesn't have the focus.
-isUnfocused :: Window -> X Bool
-isUnfocused w = withWindowSet $ \s -> return $
-                case W.stack . W.workspace . W.current $ s of
-                  Nothing -> False
-                  Just stack -> W.focus stack /= w
+isUnfocused :: Query Bool
+isUnfocused = ask >>= \w -> liftX . gets $ maybe False (w /=) . W.peek . windowset
 
--- | fades out every window that satisfies a given property.
-fadeOutLogHook :: (Window -> X Bool) -> Integer -> X ()
-fadeOutLogHook p amt = withWindowSet $ \s -> do
+-- | fades out every window by the amount returned by the query.
+fadeOutLogHook :: Query Rational -> X ()
+fadeOutLogHook qry = withWindowSet $ \s -> do
     let visibleWins = (W.integrate' . W.stack . W.workspace . W.current $ s) ++
                       concatMap (W.integrate' . W.stack . W.workspace) (W.visible s)
-    mapM_ fadeIn =<< filterM (fmap not . p) visibleWins
-    mapM_ (fadeOut amt) =<< filterM p visibleWins
+    forM_ visibleWins $ liftM2 (=<<) setOpacity (runQuery qry)

XMonad/Layout/Monitor.hs

@@ -63,7 +63,7 @@ import Control.Monad
 -- >      -- avoid flickering
 -- >    , persistent = True
 -- >      -- make the window transparent
--- >    , opacity = 0xAAAAAAAA
+-- >    , opacity = 0.6
 -- >      -- hide on start
 -- >    , visible = False
 -- >      -- assign it a name to be able to toggle it independently of others
@@ -94,7 +94,7 @@ data Monitor a = Monitor
     , visible :: Bool     -- ^ is it visible by default?
     , name :: String      -- ^ name of monitor (useful when we have many of them)
     , persistent :: Bool  -- ^ is it shown on all layouts?
-    , opacity :: Integer -- ^ opacity level
+    , opacity :: Rational -- ^ opacity level
     } deriving (Read, Show)
 
 -- | Template for 'Monitor' record. At least 'prop' and 'rect' should be
@@ -106,7 +106,7 @@ monitor = Monitor
     , visible = True
     , name = ""
     , persistent = False
-    , opacity = 0xFFFFFFFF
+    , opacity = 1
     }
 
 -- | Messages without names affect all monitors. Messages with names affect only