-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Util.Hacks
-- Description :  A collection of small fixes and utilities with possibly hacky implementations.
-- Copyright   :  (c) 2020 Leon Kowarschick
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Leon Kowarschick. <thereal.elkowar@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- This module is a collection of random fixes, workarounds and other functions
-- that rely on somewhat hacky implementations which may have unwanted side effects
-- and/or are small enough to not warrant a separate module.
--
-- Import this module as qualified like so:
--
-- > import qualified XMonad.Util.Hacks as Hacks
--
-- and then use the functions you want as described in their respective documentation.
--
-----------------------------------------------------------------------------

module XMonad.Util.Hacks (
  -- * Windowed fullscreen
  -- $windowedFullscreenFix
  windowedFullscreenFixEventHook,

  -- * Java Hack
  -- $java
  javaHack,

  -- * Stacking trays (trayer) above panels (xmobar)
  -- $raiseTrayer
  trayerAboveXmobarEventHook,
  trayAbovePanelEventHook,
  ) where


import XMonad
import XMonad.Prelude (All (All), filterM, when)
import System.Posix.Env (putEnv)


-- $windowedFullscreenFix
-- Windowed fullscreen describes the behaviour in which XMonad,
-- by default, does not automatically put windows that request being fullscreened
-- into actual fullscreen, but keeps them constrained
-- to their normal window dimensions, still rendering them in fullscreen.
--
-- With chromium based applications like Chrome, Discord and others this
-- can cause issues, where the window does not correctly see the size of the window
-- when displaying the fullscreen content, thus cutting off the window content.
--
-- This function works around that issue by forcing the window to recalculate their
-- dimensions after initiating fullscreen, thus making chrome-based applications
-- behave properly when in windowed fullscreen.
--
-- The following gif shows the behaviour of chrome (left) without this fix
-- compared to firefox, which already behaves as expected by default:
-- <<https://user-images.githubusercontent.com/79924233/115355075-e61dd280-a1ec-11eb-81d3-927ca462945f.gif>>
--
-- Using this function, chrome will now behave as expected as well:
-- <<https://user-images.githubusercontent.com/5300871/99186115-4dbb8780-274e-11eb-9ed2-b7815ba9e597.gif>>
--
-- Usage:
-- add to handleEventHook as follows:
--
-- > handleEventHook = handleEventHook def <+> Hacks.windowedFullscreenFixEventHook
--

-- | Fixes fullscreen behaviour of chromium based apps by quickly applying and undoing a resize.
-- This causes chromium to recalculate the fullscreen window
-- dimensions to match the actual "windowed fullscreen" dimensions.
windowedFullscreenFixEventHook :: Event -> X All
windowedFullscreenFixEventHook :: Event -> X All
windowedFullscreenFixEventHook (ClientMessageEvent EventType
_ CULong
_ Bool
_ Display
dpy Window
win Window
typ (CInt
_:[CInt]
dats)) = do
  Window
wmstate <- String -> X Window
getAtom String
"_NET_WM_STATE"
  Window
fullscreen <- String -> X Window
getAtom String
"_NET_WM_STATE_FULLSCREEN"
  Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Window
typ Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
== Window
wmstate Bool -> Bool -> Bool
&& Window -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Window
fullscreen CInt -> [CInt] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CInt]
dats) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$
    Display -> Window -> (WindowAttributes -> X ()) -> X ()
withWindowAttributes Display
dpy Window
win ((WindowAttributes -> X ()) -> X ())
-> (WindowAttributes -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \WindowAttributes
attrs ->
      IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ do
        Display -> Window -> EventType -> EventType -> IO ()
resizeWindow Display
dpy Window
win (CInt -> EventType
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> EventType) -> CInt -> EventType
forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_width WindowAttributes
attrs CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1) (CInt -> EventType
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> EventType) -> CInt -> EventType
forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_height WindowAttributes
attrs)
        Display -> Window -> EventType -> EventType -> IO ()
resizeWindow Display
dpy Window
win (CInt -> EventType
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> EventType) -> CInt -> EventType
forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_width WindowAttributes
attrs) (CInt -> EventType
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> EventType) -> CInt -> EventType
forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_height WindowAttributes
attrs)
  All -> X All
forall (m :: * -> *) a. Monad m => a -> m a
return (All -> X All) -> All -> X All
forall a b. (a -> b) -> a -> b
$ Bool -> All
All Bool
True
windowedFullscreenFixEventHook Event
_ = All -> X All
forall (m :: * -> *) a. Monad m => a -> m a
return (All -> X All) -> All -> X All
forall a b. (a -> b) -> a -> b
$ Bool -> All
All Bool
True


-- $java
-- Some java Applications might not work with xmonad. A common workaround would be to set the environment
-- variable @_JAVA_AWT_WM_NONREPARENTING@ to 1. The function 'javaHack' does exactly that.
-- Example usage:
--
-- > main = xmonad $ Hacks.javaHack (def {...})
--

-- | Fixes Java applications that don't work well with xmonad, by setting @_JAVA_AWT_WM_NONREPARENTING=1@
javaHack :: XConfig l -> XConfig l
javaHack :: XConfig l -> XConfig l
javaHack XConfig l
conf = XConfig l
conf
  { startupHook :: X ()
startupHook = XConfig l -> X ()
forall (l :: * -> *). XConfig l -> X ()
startupHook XConfig l
conf
                    X () -> X () -> X ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (String -> IO ()
putEnv String
"_JAVA_AWT_WM_NONREPARENTING=1")
  }


-- $raiseTrayer
-- Placing @trayer@ on top of @xmobar@ is somewhat tricky:
--
-- - they both should be lowered to the bottom of the stacking order to avoid
--   overlapping fullscreen windows
--
-- - the tray needs to be stacked on top of the panel regardless of which
--   happens to start first
--
-- 'trayerAboveXmobarEventHook' (and the more generic
-- 'trayAbovePanelEventHook') is an event hook that ensures the latter:
-- whenever the tray lowers itself to the bottom of the stack, it checks
-- whether there are any panels above it and lowers these again.
--
-- To ensure the former, that is having both @trayer@ and @xmobar@ lower
-- themselves, which is a necessary prerequisite for this event hook to
-- trigger:
--
-- - set @lowerOnStart = True@ and @overrideRedirect = True@ in @~/.xmobarrc@
-- - pass @-l@ to @trayer@
--
-- Usage:
--
-- > handleEventHook = … <> Hacks.trayerAboveXmobarEventHook

-- | 'trayAbovePanelEventHook' for trayer/xmobar
trayerAboveXmobarEventHook :: Event -> X All
trayerAboveXmobarEventHook :: Event -> X All
trayerAboveXmobarEventHook = Query Bool -> Query Bool -> Event -> X All
trayAbovePanelEventHook (Query String
className Query String -> String -> Query Bool
forall a. Eq a => Query a -> a -> Query Bool
=? String
"trayer") (Query String
appName Query String -> String -> Query Bool
forall a. Eq a => Query a -> a -> Query Bool
=? String
"xmobar")

-- | Whenever a tray window lowers itself to the bottom of the stack, look for
-- any panels above it and lower these.
trayAbovePanelEventHook
  :: Query Bool -- ^ tray
  -> Query Bool -- ^ panel
  -> (Event -> X All) -- ^ event hook
trayAbovePanelEventHook :: Query Bool -> Query Bool -> Event -> X All
trayAbovePanelEventHook Query Bool
trayQ Query Bool
panelQ ConfigureEvent{ev_window :: Event -> Window
ev_window = Window
w, ev_above :: Event -> Window
ev_above = Window
a} | Window
a Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
== Window
none = do
  X Bool -> X () -> X ()
whenX (Query Bool -> Window -> X Bool
forall a. Query a -> Window -> X a
runQuery Query Bool
trayQ Window
w) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ (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
rootw <- (XConf -> Window) -> X Window
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Window
theRoot
    (Window
_, Window
_, [Window]
ws) <- IO (Window, Window, [Window]) -> X (Window, Window, [Window])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Window, Window, [Window]) -> X (Window, Window, [Window]))
-> IO (Window, Window, [Window]) -> X (Window, Window, [Window])
forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO (Window, Window, [Window])
queryTree Display
dpy Window
rootw
    let aboveTrayWs :: [Window]
aboveTrayWs = (Window -> Bool) -> [Window] -> [Window]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Window
w Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
/=) [Window]
ws
    [Window]
panelWs <- (Window -> X Bool) -> [Window] -> X [Window]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (Query Bool -> Window -> X Bool
forall a. Query a -> Window -> X a
runQuery Query Bool
panelQ) [Window]
aboveTrayWs
    (Window -> X ()) -> [Window] -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> (Window -> IO ()) -> Window -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Display -> Window -> IO ()
lowerWindow Display
dpy) [Window]
panelWs
  X All
forall a. Monoid a => a
mempty
trayAbovePanelEventHook Query Bool
_ Query Bool
_ Event
_ = X All
forall a. Monoid a => a
mempty