xmonad: releaseSuperLogHook

1 files changed, 38 insertions, 6 deletions

diff --git a/pkgs/haskell/xmonad-tv/src/main.hs b/pkgs/haskell/xmonad-tv/src/main.hs
index 05817af..649085b 100644
--- a/pkgs/haskell/xmonad-tv/src/main.hs
+++ b/pkgs/haskell/xmonad-tv/src/main.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE ImportQualifiedPost #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE PatternSynonyms #-}
@@ -9,12 +10,17 @@ import XMonad.Hooks.EwmhDesktops (ewmh)
 import XMonad.Hooks.EwmhDesktops.Extra (ewmhExtra)
 import XMonad.Hooks.RefocusLast (refocusLastLayoutHook, toggleFocus)
 
-import Control.Monad (void)
+import Control.Exception (bracket)
+import Control.Monad (void, when)
 import Control.Monad.Extra (whenJustM)
-import qualified Data.Aeson
-import qualified Data.ByteString.Char8
-import qualified Data.List
-import qualified Data.Maybe
+import Data.Aeson qualified
+import Data.Bits ((.&.))
+import Data.ByteString.Char8 qualified
+import Data.Char (isDigit)
+import Data.Foldable (traverse_)
+import Data.List qualified
+import Data.Maybe qualified
+import Data.Monoid (All(All))
 import Graphics.X11.ExtraTypes.XF86
 import XMonad
 import XMonad.Extra (isFloatingX)
@@ -26,8 +32,9 @@ import XMonad.Actions.CycleWS (toggleWS)
 import XMonad.Layout.Gaps (Direction2D(U,R,D,L), gaps)
 import XMonad.Layout.FocusTracking (focusTracking)
 import XMonad.Layout.NoBorders (noBorders)
-import XMonad.Layout.ResizableTile (ResizableTall(ResizableTall))
 import XMonad.Layout.ResizableTile (MirrorResize(MirrorExpand,MirrorShrink))
+import XMonad.Layout.ResizableTile (ResizableTall(ResizableTall))
+import XMonad.Util.ExtensibleState qualified as XS
 import qualified XMonad.StackSet as W
 import Data.Map (Map)
 import qualified Data.Map as Map
@@ -109,6 +116,7 @@ mainNoArgs = do
                   []
                 |||
                 noBorders (focusTracking Full)
+            , logHook = releaseSuperLogHook
             , manageHook =
                 composeAll
                   [ appName =? "fzmenu-urxvt" --> doCenterFloat
@@ -244,3 +252,27 @@ myKeys conf = Map.fromList $
             , "-e", "sleep", "0.05"
             ]
             Nothing
+
+-- Windows that get the Super keys instead of xmonad.
+wantsSuper :: Query Bool
+wantsSuper = title =?? Data.List.isPrefixOf "river - X11-"
+
+newtype SuperReleased = SuperReleased Bool
+
+instance ExtensionClass SuperReleased where
+    initialValue = SuperReleased False
+
+-- While such a window is focused, grab only the bindings that involve
+-- neither mod4 nor a Super key.
+releaseSuperLogHook :: X ()
+releaseSuperLogHook = do
+    wanted <- withWindowSet $ maybe (return False) (runQuery wantsSuper) . W.peek
+    SuperReleased released <- XS.get
+    when (wanted /= released) $ do
+      XConf { display = dpy, theRoot = rootw } <- ask
+      let usesSuper (m, k) = m .&. mod4Mask /= 0 || k `elem` [xK_Super_L, xK_Super_R]
+          grab (km, kc) = io $ grabKey dpy kc km rootw True grabModeAsync grabModeAsync
+      io $ ungrabKey dpy anyKey anyModifier rootw
+      traverse_ grab =<< mkGrabs . filter (\b -> not (wanted && usesSuper b))
+                     =<< asks (Map.keys . keyActions)
+      XS.put (SuperReleased wanted)