{-# LANGUAGE FlexibleInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.FadeWindows -- Description : A more flexible and general compositing interface than FadeInactive. -- 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.Prelude import XMonad.ManageHook (liftX) import qualified XMonad.StackSet as W import XMonad.Hooks.FadeInactive (setOpacity ,isUnfocused ) import Control.Monad.Reader (ask ,asks) import Control.Monad.State (gets) import qualified Data.Map as M 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 [ opaque -- > , isUnfocused --> transparency 0.2 -- > ] -- -- The above is like FadeInactive with a fade value of 0.2. -- -- 'FadeHook's do not accumulate; instead, they compose from right to -- left like 'ManageHook's, so in the above example @myFadeHook@ will -- render unfocused windows at 4/5 opacity and the focused window as -- opaque. This means that, in particular, the order in the above -- example is important. -- -- The 'opaque' hook above is optional, by the way, as any unmatched -- window will be opaque by default. If you want to make all windows a -- bit transparent by default, you can replace 'opaque' with something -- like -- -- > transparency 0.93 -- -- at the top of @myFadeHook@. -- -- 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 Semigroup Opacity where Opacity r <> :: Opacity -> Opacity -> Opacity <> Opacity OEmpty = Opacity r Opacity _ <> Opacity r = Opacity r instance Monoid Opacity where mempty :: Opacity mempty = Opacity OEmpty -- | A FadeHook is similar to a ManageHook, but records window opacity. type FadeHook = Query Opacity -- | Render a window fully opaque. opaque :: FadeHook opaque :: FadeHook opaque = Opacity -> FadeHook forall m. Monoid m => m -> Query m doS (Rational -> Opacity Opacity Rational 1) -- | Render a window fully transparent. transparent :: FadeHook transparent :: FadeHook transparent = Opacity -> FadeHook forall m. Monoid m => m -> Query m doS (Rational -> Opacity Opacity Rational 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 :: Rational -> FadeHook transparency = Opacity -> FadeHook forall m. Monoid m => m -> Query m doS (Opacity -> FadeHook) -> (Rational -> Opacity) -> Rational -> FadeHook forall b c a. (b -> c) -> (a -> b) -> a -> c . Rational -> Opacity Opacity (Rational -> Opacity) -> (Rational -> Rational) -> Rational -> Opacity forall b c a. (b -> c) -> (a -> b) -> a -> c . (Rational 1Rational -> Rational -> Rational forall a. Num a => a -> a -> a -) (Rational -> Rational) -> (Rational -> Rational) -> Rational -> Rational forall b c a. (b -> c) -> (a -> b) -> a -> c . Rational -> Rational 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 :: Rational -> FadeHook opacity = Opacity -> FadeHook forall m. Monoid m => m -> Query m doS (Opacity -> FadeHook) -> (Rational -> Opacity) -> Rational -> FadeHook forall b c a. (b -> c) -> (a -> b) -> a -> c . Rational -> Opacity Opacity (Rational -> Opacity) -> (Rational -> Rational) -> Rational -> Opacity forall b c a. (b -> c) -> (a -> b) -> a -> c . Rational -> Rational clampRatio fadeTo, translucence, fadeBy :: Rational -> FadeHook -- | An alias for 'transparency'. fadeTo :: Rational -> FadeHook fadeTo = Rational -> FadeHook transparency -- | An alias for 'transparency'. translucence :: Rational -> FadeHook translucence = Rational -> FadeHook transparency -- | An alias for 'opacity'. fadeBy :: Rational -> FadeHook fadeBy = Rational -> FadeHook opacity invisible, solid :: FadeHook -- | An alias for 'transparent'. invisible :: FadeHook invisible = FadeHook transparent -- | An alias for 'opaque'. solid :: FadeHook solid = FadeHook 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 :: m -> Query m doS = m -> Query m forall (m :: * -> *) a. Monad m => a -> m a return -- | The identity 'FadeHook', which renders windows 'opaque'. idFadeHook :: FadeHook idFadeHook :: FadeHook idFadeHook = FadeHook opaque -- | A Query to determine if a window is floating. isFloating :: Query Bool isFloating :: Query Bool isFloating = 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 -> Map Window RationalRect -> Bool forall k a. Ord k => k -> Map k a -> Bool M.member Window w (Map Window RationalRect -> Bool) -> (XState -> Map Window RationalRect) -> XState -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail -> Map Window RationalRect forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect W.floating (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail -> Map Window RationalRect) -> (XState -> StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail) -> XState -> Map Window RationalRect forall b c a. (b -> c) -> (a -> b) -> a -> c . XState -> StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail 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 :: FadeHook -> X () fadeWindowsLogHook FadeHook h = (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail -> X ()) -> X () forall a. (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail -> X a) -> X a withWindowSet ((StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail -> X ()) -> X ()) -> (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail -> X ()) -> X () forall a b. (a -> b) -> a -> b $ \StackSet WorkspaceId (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 WorkspaceId (Layout Window) Window ScreenId ScreenDetail -> Maybe (Stack Window)) -> StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail -> [Window] forall b c a. (b -> c) -> (a -> b) -> a -> c . Workspace WorkspaceId (Layout Window) Window -> Maybe (Stack Window) forall i l a. Workspace i l a -> Maybe (Stack a) W.stack (Workspace WorkspaceId (Layout Window) Window -> Maybe (Stack Window)) -> (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail -> Workspace WorkspaceId (Layout Window) Window) -> StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail -> Maybe (Stack Window) forall b c a. (b -> c) -> (a -> b) -> a -> c . Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail -> Workspace WorkspaceId (Layout Window) Window forall i l a sid sd. Screen i l a sid sd -> Workspace i l a W.workspace (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail -> Workspace WorkspaceId (Layout Window) Window) -> (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail) -> StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail -> Workspace WorkspaceId (Layout Window) Window forall b c a. (b -> c) -> (a -> b) -> a -> c . StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail -> Screen WorkspaceId (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 WorkspaceId (Layout Window) Window ScreenId ScreenDetail -> [Window]) -> StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail -> [Window] forall a b. (a -> b) -> a -> b $ StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail s) [Window] -> [Window] -> [Window] forall a. [a] -> [a] -> [a] ++ (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail -> [Window]) -> [Screen WorkspaceId (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 WorkspaceId (Layout Window) Window ScreenId ScreenDetail -> Maybe (Stack Window)) -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail -> [Window] forall b c a. (b -> c) -> (a -> b) -> a -> c . Workspace WorkspaceId (Layout Window) Window -> Maybe (Stack Window) forall i l a. Workspace i l a -> Maybe (Stack a) W.stack (Workspace WorkspaceId (Layout Window) Window -> Maybe (Stack Window)) -> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail -> Workspace WorkspaceId (Layout Window) Window) -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail -> Maybe (Stack Window) forall b c a. (b -> c) -> (a -> b) -> a -> c . Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail -> Workspace WorkspaceId (Layout Window) Window forall i l a sid sd. Screen i l a sid sd -> Workspace i l a W.workspace) (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail -> [Screen WorkspaceId (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 WorkspaceId (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 $ \Window w -> do Opacity o <- Opacity -> X Opacity -> X Opacity forall a. a -> X a -> X a userCodeDef (Rational -> Opacity Opacity Rational 1) (FadeHook -> Window -> X Opacity forall a. Query a -> Window -> X a runQuery FadeHook h Window w) Window -> Rational -> X () setOpacity Window w (Rational -> X ()) -> Rational -> X () forall a b. (a -> b) -> a -> b $ case Opacity o of Opacity OEmpty -> Rational 1 Opacity Rational r -> Rational 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 :: Event -> X All fadeWindowsEventHook MapNotifyEvent{} = -- we need to run the fadeWindowsLogHook. only one way... (XConf -> XConfig Layout) -> X (XConfig Layout) forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks XConf -> XConfig Layout config X (XConfig Layout) -> (XConfig Layout -> X ()) -> X () forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= XConfig Layout -> X () forall (l :: * -> *). XConfig l -> X () logHook X () -> X All -> X All forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> All -> X All forall (m :: * -> *) a. Monad m => a -> m a return (Bool -> All All Bool True) fadeWindowsEventHook Event _ = All -> X All forall (m :: * -> *) a. Monad m => a -> m a return (Bool -> All All Bool True) -- A utility to clamp opacity fractions to the range (0,1) clampRatio :: Rational -> Rational clampRatio :: Rational -> Rational clampRatio Rational r | Rational r Rational -> Rational -> Bool forall a. Ord a => a -> a -> Bool >= Rational 0 Bool -> Bool -> Bool && Rational r Rational -> Rational -> Bool forall a. Ord a => a -> a -> Bool <= Rational 1 = Rational r | Rational r Rational -> Rational -> Bool forall a. Ord a => a -> a -> Bool < Rational 0 = Rational 0 | Bool otherwise = Rational 1