aboutsummaryrefslogtreecommitdiffstats
path: root/XMonad/Hooks/FadeWindows.hs
blob: 4b8e62b658f3ba28f4682fc88e2a6a77cf6f1a48 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Hooks.FadeWindows
-- Copyright   :  Brandon S Allbery KF8NH <allbery.b@gmail.com>
-- License     :  BSD
--
-- Maintainer  :  Brandon S Allbery KF8NH
-- Stability   :  unstable
-- Portability :  unportable
--
-- A more flexible and general compositing interface than FadeInactive.
-- Windows can be selected and opacity specified by means of FadeHooks,
-- which are very similar to ManageHooks and use the same machinery.
--
-----------------------------------------------------------------------------

module XMonad.Hooks.FadeWindows (-- * Usage
                                 -- $usage

                                 -- * The 'logHook' for window fading
                                 fadeWindowsLogHook

                                 -- * The 'FadeHook'
                                ,FadeHook
                                ,Opacity
                                ,idFadeHook

                                 -- * Predefined 'FadeHook's
                                ,opaque
                                ,solid
                                ,transparent
                                ,invisible
                                ,transparency
                                ,translucence
                                ,fadeBy
                                ,opacity
                                ,fadeTo

                                -- * 'handleEventHook' for mapped/unmapped windows
                                ,fadeWindowsEventHook

                                -- * 'doF' for simple hooks
                                ,doS

                                -- * Useful 'Query's for 'FadeHook's
                                ,isFloating
                                ,isUnfocused
                                ) where

import           XMonad.Core
import           XMonad.ManageHook                       (liftX)
import qualified XMonad.StackSet             as W

import           XMonad.Hooks.FadeInactive               (setOpacity
                                                         ,isUnfocused
                                                         )

import           Control.Monad                           (forM_)
import           Control.Monad.Reader                    (ask
                                                         ,asks)
import           Control.Monad.State                     (gets)
import qualified Data.Map                    as M
import           Data.Monoid

import           Graphics.X11.Xlib.Extras                (Event(..))

-- $usage
-- To use this module, make sure your @xmonad@ core supports generalized
-- 'ManageHook's (check the type of 'idHook'; if it's @ManageHook@ then
-- your @xmonad@ is too old) and then add @fadeWindowsLogHook@ to your
-- 'logHook' and @fadeWindowsEventHook@ to your 'handleEventHook':
--
-- >     , logHook = fadeWindowsLogHook myFadeHook
-- >     , handleEventHook = fadeWindowsEventHook
-- >     {- ... -}
-- >
-- > myFadeHook = composeAll [isUnfocused --> transparency 0.2
-- >                         ,                opaque
-- >                         ]
--
-- The above is like FadeInactive with a fade value of 0.2.
--
-- FadeHooks do not accumulate; instead, they compose from right to
-- left like 'ManageHook's, so the above example @myFadeHook@ will
-- render unfocused windows at 4/5 opacity and the focused window
-- as opaque.  The 'opaque' hook above is optional, by the way, as any
-- unmatched window will be opaque by default.
--
-- This module is best used with "XMonad.Hooks.MoreManageHelpers", which
-- exports a number of Queries that can be used in either @ManageHook@
-- or @FadeHook@.
--
-- Note that you need a compositing manager such as @xcompmgr@,
-- @dcompmgr@, or @cairo-compmgr@ for window fading to work.  If you
-- aren't running a compositing manager, the opacity will be recorded
-- but won't take effect until a compositing manager is started.
--
-- 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 'handleEventHook',
-- see:
--
-- "XMonad.Doc.Extending#Editing_the_event_hook"
-- (which sadly doesnt exist at the time of writing...)
--
-- /WARNING:/  This module is very good at triggering bugs in
-- compositing managers.  Symptoms range from windows not being
-- repainted until the compositing manager is restarted or the
-- window is unmapped and remapped, to the machine becoming sluggish
-- until the compositing manager is restarted (at which point a
-- popup/dialog will suddenly appear; apparently it's getting into
-- a tight loop trying to fade the popup in).  I find it useful to
-- have a key binding to restart the compositing manager; for example,
--
-- main = xmonad $ def {
--                   {- ... -}
--                 }
--                 `additionalKeysP`
--                 [("M-S-4",spawn "killall xcompmgr; sleep 1; xcompmgr -cCfF &")]
--                 {- ... -}
--                 ]
--
-- (See "XMonad.Util.EZConfig" for 'additionalKeysP'.)

-- a window opacity to be carried in a Query.  OEmpty is sort of a hack
-- to make it obay the monoid laws
data Opacity = Opacity Rational | OEmpty

instance Monoid Opacity where
  mempty                  = OEmpty
  r      `mappend` OEmpty = r
  _      `mappend` r      = r

-- | A FadeHook is similar to a ManageHook, but records window opacity.
type FadeHook = Query Opacity

-- | Render a window fully opaque.
opaque :: FadeHook
opaque =  doS (Opacity 1)

-- | Render a window fully transparent.
transparent :: FadeHook
transparent =  doS (Opacity 0)

-- | Specify a window's transparency.
transparency :: Rational -- ^ The window's transparency as a fraction.
                         --   @transparency 1@ is the same as 'transparent',
                         --   whereas @transparency 0@ is the same as 'opaque'.
             -> FadeHook
transparency =  doS . Opacity . (1-) . clampRatio

-- | Specify a window's opacity; this is the inverse of 'transparency'.
opacity :: Rational -- ^ The opacity of a window as a fraction.
                    --   @opacity 1@ is the same as 'opaque',
                    --   whereas @opacity 0@ is the same as 'transparent'.
        -> FadeHook
opacity =  doS . Opacity . clampRatio

fadeTo, translucence, fadeBy :: Rational -> FadeHook
-- ^ An alias for 'transparency'.
fadeTo       = transparency
-- ^ An alias for 'transparency'.
translucence = transparency
-- ^ An alias for 'transparency'.
fadeBy       = opacity

invisible, solid :: FadeHook
-- ^ An alias for 'transparent'.
invisible    = transparent
-- ^ An alias for 'opaque'.
solid        = opaque

-- | Like 'doF', but usable with 'ManageHook'-like hooks that
-- aren't 'Query' wrapped around transforming functions ('Endo').
doS :: Monoid m => m -> Query m
doS =  return

-- | The identity 'FadeHook', which renders windows 'opaque'.
idFadeHook :: FadeHook
idFadeHook =  opaque

-- | A Query to determine if a window is floating.
isFloating :: Query Bool
isFloating =  ask >>= \w -> liftX . gets $ M.member w . W.floating . windowset

-- boring windows can't be seen outside of a layout, so we watch messages with
-- a dummy LayoutModifier and stow them in a persistent bucket.  this is not
-- entirely reliable given that boringAuto still isn't observable; we just hope
-- those aren't visible and won;t be affected anyway
-- @@@ punted for now, will be a separate module.  it's still slimy, though

-- | A 'logHook' to fade windows under control of a 'FadeHook', which is
--   similar to but not identical to 'ManageHook'.
fadeWindowsLogHook   :: FadeHook -> X ()
fadeWindowsLogHook h =  withWindowSet $ \s -> do
  let visibleWins = (W.integrate' . W.stack . W.workspace . W.current $ s) ++
                    concatMap (W.integrate' . W.stack . W.workspace) (W.visible s)
  forM_ visibleWins $ \w -> do
    o <- userCodeDef (Opacity 1) (runQuery h w)
    setOpacity w $ case o of
                     OEmpty    -> 0.93
                     Opacity r -> r

-- | A 'handleEventHook' to handle fading and unfading of newly mapped
--   or unmapped windows; this avoids problems with layouts such as
--   "XMonad.Layout.Full" or "XMonad.Layout.Tabbed".  This hook may
--   also be useful with "XMonad.Hooks.FadeInactive".
fadeWindowsEventHook                     :: Event -> X All
fadeWindowsEventHook (MapNotifyEvent {}) =
  -- we need to run the fadeWindowsLogHook.  only one way...
  asks config >>= logHook >> return (All True)
fadeWindowsEventHook _                   =  return (All True)

-- A utility to clamp opacity fractions to the range (0,1)
clampRatio   :: Rational         -> Rational
clampRatio r |  r >= 0 && r <= 1 =  r
             |  r < 0            =  0
             |  otherwise        =  1