-----------------------------------------------------------------------------
-- |
-- Module       : XMonad.Hooks.FadeInactive
-- Description :  Set the _NET_WM_WINDOW_OPACITY atom for inactive windows.
-- Copyright    : (c) 2008 Justin Bogner <mail@justinbogner.com>
-- License      : BSD
--
-- Maintainer   : Justin Bogner <mail@justinbogner.com>
-- Stability    : unstable
-- Portability  : unportable
--
-- Makes XMonad set the _NET_WM_WINDOW_OPACITY atom for inactive windows,
-- which causes those windows to become slightly translucent if something
-- like xcompmgr is running
-----------------------------------------------------------------------------
module XMonad.Hooks.FadeInactive (
    -- * Usage
    -- $usage
    setOpacity,
    isUnfocused,
    isUnfocusedOnCurrentWS,
    fadeIn,
    fadeOut,
    fadeIf,
    fadeInactiveLogHook,
    fadeInactiveCurrentWSLogHook,
    fadeOutLogHook
    ) where

import XMonad
import XMonad.Prelude
import qualified XMonad.StackSet as W

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad
-- > import XMonad.Hooks.FadeInactive
-- >
-- > myLogHook :: X ()
-- > myLogHook = fadeInactiveLogHook fadeAmount
-- >     where fadeAmount = 0.8
-- >
-- > main = xmonad def { logHook = myLogHook }
--
-- 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
--
-- For more detailed instructions on editing the logHook see:
--
-- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars"
--
-- For more detailed instructions on editing the layoutHook see:
--
-- "XMonad.Doc.Extending#Editing_the_layout_hook"

-- | Converts a percentage to the format required for _NET_WM_WINDOW_OPACITY
rationalToOpacity :: Integral a => Rational -> a
rationalToOpacity :: forall a. Integral a => Rational -> a
rationalToOpacity Rational
perc
    | Rational
perc Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
0 Bool -> Bool -> Bool
|| Rational
perc Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
1 = Rational -> a
forall a b. (RealFrac a, Integral b) => a -> b
round Rational
perc -- to maintain backwards-compatability
    | Bool
otherwise = Rational -> a
forall a b. (RealFrac a, Integral b) => a -> b
round (Rational -> a) -> Rational -> a
forall a b. (a -> b) -> a -> b
$ Rational
perc Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
0xffffffff

-- | Sets the opacity of a window
setOpacity :: Window -> Rational -> X ()
setOpacity :: Window -> Rational -> X ()
setOpacity Window
w Rational
t = (Display -> X ()) -> X ()
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
    Window
a <- String -> X Window
getAtom String
"_NET_WM_WINDOW_OPACITY"
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Window -> Window -> Window -> CInt -> [CLong] -> IO ()
changeProperty32 Display
dpy Window
w Window
a Window
cARDINAL CInt
propModeReplace [Rational -> CLong
forall a. Integral a => Rational -> a
rationalToOpacity Rational
t]

-- | Fades a window out by setting the opacity
fadeOut :: Rational -> Window -> X ()
fadeOut :: Rational -> Window -> X ()
fadeOut = (Window -> Rational -> X ()) -> Rational -> Window -> X ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Window -> Rational -> X ()
setOpacity

-- | Makes a window completely opaque
fadeIn :: Window -> X ()
fadeIn :: Window -> X ()
fadeIn = Rational -> Window -> X ()
fadeOut Rational
1

-- | Fades a window by the specified amount if it satisfies the first query, otherwise
-- makes it opaque.
fadeIf :: Query Bool -> Rational -> Query Rational
fadeIf :: Query Bool -> Rational -> Query Rational
fadeIf Query Bool
qry Rational
amt = Query Bool
qry Query Bool -> (Bool -> Query Rational) -> Query Rational
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b -> Rational -> Query Rational
forall (m :: * -> *) a. Monad m => a -> m a
return (Rational -> Query Rational) -> Rational -> Query Rational
forall a b. (a -> b) -> a -> b
$ if Bool
b then Rational
amt else Rational
1

-- | Sets the opacity of inactive windows to the specified amount
fadeInactiveLogHook :: Rational -> X ()
fadeInactiveLogHook :: Rational -> X ()
fadeInactiveLogHook = Query Rational -> X ()
fadeOutLogHook (Query Rational -> X ())
-> (Rational -> Query Rational) -> Rational -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query Bool -> Rational -> Query Rational
fadeIf Query Bool
isUnfocused

-- | Set the opacity of inactive windows, on the current workspace, to the
-- specified amount. This is specifically usefull in a multi monitor setup. See
-- 'isUnfocusedOnCurrentWS'.
fadeInactiveCurrentWSLogHook :: Rational -> X ()
fadeInactiveCurrentWSLogHook :: Rational -> X ()
fadeInactiveCurrentWSLogHook = Query Rational -> X ()
fadeOutLogHook (Query Rational -> X ())
-> (Rational -> Query Rational) -> Rational -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query Bool -> Rational -> Query Rational
fadeIf Query Bool
isUnfocusedOnCurrentWS

-- | Returns True if the window doesn't have the focus.
isUnfocused :: Query Bool
isUnfocused :: Query Bool
isUnfocused = Query Window
forall r (m :: * -> *). MonadReader r m => m r
ask Query Window -> (Window -> Query Bool) -> Query Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Window
w -> X Bool -> Query Bool
forall a. X a -> Query a
liftX (X Bool -> Query Bool)
-> ((XState -> Bool) -> X Bool) -> (XState -> Bool) -> Query Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XState -> Bool) -> X Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((XState -> Bool) -> Query Bool) -> (XState -> Bool) -> Query Bool
forall a b. (a -> b) -> a -> b
$ (Window -> Maybe Window
forall a. a -> Maybe a
Just Window
w Maybe Window -> Maybe Window -> Bool
forall a. Eq a => a -> a -> Bool
/=) (Maybe Window -> Bool)
-> (XState -> Maybe Window) -> XState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek (StackSet String (Layout Window) Window ScreenId ScreenDetail
 -> Maybe Window)
-> (XState
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Maybe Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset

-- | Returns True if the window doesn't have the focus, and the window is on the
-- current workspace. This is specifically handy in a multi monitor setup
-- (xinerama) where multiple workspaces are visible. Using this, non-focused
-- workspaces are are not faded out making it easier to look and read the
-- content on them.
isUnfocusedOnCurrentWS :: Query Bool
isUnfocusedOnCurrentWS :: Query Bool
isUnfocusedOnCurrentWS = do
  Window
w <- Query Window
forall r (m :: * -> *). MonadReader r m => m r
ask
  StackSet String (Layout Window) Window ScreenId ScreenDetail
ws <- X (StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> Query
     (StackSet String (Layout Window) Window ScreenId ScreenDetail)
forall a. X a -> Query a
liftX (X (StackSet String (Layout Window) Window ScreenId ScreenDetail)
 -> Query
      (StackSet String (Layout Window) Window ScreenId ScreenDetail))
-> X (StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> Query
     (StackSet String (Layout Window) Window ScreenId ScreenDetail)
forall a b. (a -> b) -> a -> b
$ (XState
 -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X (StackSet String (Layout Window) Window ScreenId ScreenDetail)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset
  let thisWS :: Bool
thisWS = Window
w Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` StackSet String (Layout Window) Window ScreenId ScreenDetail
-> [Window]
forall i l a s sd. StackSet i l a s sd -> [a]
W.index StackSet String (Layout Window) Window ScreenId ScreenDetail
ws
      unfocused :: Bool
unfocused = Window -> Maybe Window
forall a. a -> Maybe a
Just Window
w Maybe Window -> Maybe Window -> Bool
forall a. Eq a => a -> a -> Bool
/= StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek StackSet String (Layout Window) Window ScreenId ScreenDetail
ws
  Bool -> Query Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Query Bool) -> Bool -> Query Bool
forall a b. (a -> b) -> a -> b
$ Bool
thisWS Bool -> Bool -> Bool
&& Bool
unfocused

-- | Fades out every window by the amount returned by the query.
fadeOutLogHook :: Query Rational -> X ()
fadeOutLogHook :: Query Rational -> X ()
fadeOutLogHook Query Rational
qry = (StackSet String (Layout Window) Window ScreenId ScreenDetail
 -> X ())
-> X ()
forall a.
(StackSet String (Layout Window) Window ScreenId ScreenDetail
 -> X a)
-> X a
withWindowSet ((StackSet String (Layout Window) Window ScreenId ScreenDetail
  -> X ())
 -> X ())
-> (StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> X ())
-> X ()
forall a b. (a -> b) -> a -> b
$ \StackSet String (Layout Window) Window ScreenId ScreenDetail
s -> do
    let visibleWins :: [Window]
visibleWins = (Maybe (Stack Window) -> [Window]
forall a. Maybe (Stack a) -> [a]
W.integrate' (Maybe (Stack Window) -> [Window])
-> (StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> Maybe (Stack Window))
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace String (Layout Window) Window -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace String (Layout Window) Window -> Maybe (Stack Window))
-> (StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> Workspace String (Layout Window) Window)
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Maybe (Stack Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> Workspace String (Layout Window) Window)
-> (StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current (StackSet String (Layout Window) Window ScreenId ScreenDetail
 -> [Window])
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> [Window]
forall a b. (a -> b) -> a -> b
$ StackSet String (Layout Window) Window ScreenId ScreenDetail
s) [Window] -> [Window] -> [Window]
forall a. [a] -> [a] -> [a]
++
                      (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> [Window])
-> [Screen String (Layout Window) Window ScreenId ScreenDetail]
-> [Window]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Maybe (Stack Window) -> [Window]
forall a. Maybe (Stack a) -> [a]
W.integrate' (Maybe (Stack Window) -> [Window])
-> (Screen String (Layout Window) Window ScreenId ScreenDetail
    -> Maybe (Stack Window))
-> Screen String (Layout Window) Window ScreenId ScreenDetail
-> [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace String (Layout Window) Window -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace String (Layout Window) Window -> Maybe (Stack Window))
-> (Screen String (Layout Window) Window ScreenId ScreenDetail
    -> Workspace String (Layout Window) Window)
-> Screen String (Layout Window) Window ScreenId ScreenDetail
-> Maybe (Stack Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace) (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> [Screen String (Layout Window) Window ScreenId ScreenDetail]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible StackSet String (Layout Window) Window ScreenId ScreenDetail
s)
    [Window] -> (Window -> X ()) -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Window]
visibleWins ((Window -> X ()) -> X ()) -> (Window -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ ((Rational -> X ()) -> X Rational -> X ())
-> (Window -> Rational -> X ())
-> (Window -> X Rational)
-> Window
-> X ()
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (Rational -> X ()) -> X Rational -> X ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) Window -> Rational -> X ()
setOpacity (Query Rational -> Window -> X Rational
forall a. Query a -> Window -> X a
runQuery Query Rational
qry)