Re: XMonad.Hooks.FadeInactive with floating windows

This seems generally useful, so I'm sending your idea and patch to the
xmonad mailing list. It's best to send ideas about xmonad/xmonad-contrib
improvements there, so they get a wider audience.
On Thu, Nov 19, 2009 at 1:16 AM, Jasper van der Jeugt
Hello,
I recently installed the XMonad.Hooks.FadeInactive into my xmonad.hs. I think it is very usable, altough there is one drawback: floating windows.
I (and most people, I think) use floating windows mostly for many-window applications like, for example, the GIMP. In the GIMP, you wouldn't want a window to become transparent, since you want a clear view of your image, even when you're clicking around in the toolbox window.
I therefore propose to add a Query that returns true if the window is unfocused, and in the tiling layer. I attached the code as a diff. I'd like to know what you think.
Kind regards, Jasper Van der Jeugt

I use a customized test condition to fade windows, maybe this will help you.
It adds the ability to determine both statically and dynamically which
windows do you want to fade.
Daniel Schoepe and Adam Vogt helped me setting this config at #xmonad.
Now with extstate this can be integrated into FadeInactive.
import Data.IORef
import Control.Monad (liftM, join)
import XMonad
import XMonad.Hooks.FadeInactive
import XMonad.Util.EZConfig
import qualified Data.Set as S
testCondition :: IORef (S.Set Window) -> Query Bool
testCondition floats =
liftM not doNotFadeOutWindows <&&> isUnfocused
<&&> (join . asks $ \w -> liftX . io $ S.notMember w `fmap` readIORef
floats)
toggleFadeOut :: Window -> S.Set Window -> S.Set Window
toggleFadeOut w s | w `S.member` s = S.delete w s
| otherwise = S.insert w s
myLogHook toggleFadeSet = fadeOutLogHook $ fadeIf (testCondition
toggleFadeSet) 0.7
doNotFadeOutWindows = className =? "xine" <||> className =? "MPlayer"
main = do
toggleFadeSet <- newIORef S.empty
xmonad $ defaultConfig
{ logHook = myLogHook toggleFadeSet
} `additionalKeysP`
[ ("M-S-f", withFocused $ io . modifyIORef toggleFadeSet .
toggleFadeOut)
]
Regards,
Henrique G. Abreu
On Fri, Nov 20, 2009 at 12:32, Justin Bogner
This seems generally useful, so I'm sending your idea and patch to the xmonad mailing list. It's best to send ideas about xmonad/xmonad-contrib improvements there, so they get a wider audience.
Hello,
I recently installed the XMonad.Hooks.FadeInactive into my xmonad.hs. I think it is very usable, altough there is one drawback: floating windows.
I (and most people, I think) use floating windows mostly for many-window applications like, for example, the GIMP. In the GIMP, you wouldn't want a window to become transparent, since you want a clear view of your image, even when you're clicking around in the toolbox window.
I therefore propose to add a Query that returns true if the window is unfocused, and in the tiling layer. I attached the code as a diff. I'd
On Thu, Nov 19, 2009 at 1:16 AM, Jasper van der Jeugt
wrote: like to know what you think.
Kind regards, Jasper Van der Jeugt
_______________________________________________ xmonad mailing list xmonad@haskell.org http://www.haskell.org/mailman/listinfo/xmonad
participants (2)
-
Henrique G. Abreu
-
Justin Bogner