Merge pull request #768 from liskin/fullscreen-hooks

Add (un)fullscreen hooks and float-restoring toggleFullFloat action

CHANGES.md

@@ -106,7 +106,14 @@
     - A new module replicating the functionality of
       `XMonad.Hooks.DynamicProperty`, but with more discoverable names.
 
+  * `XMonad.Actions.ToggleFullFloat`:
+
+    - Fullscreen (float) a window while remembering its original state.
+      There's both an action to be bound to a key, and hooks that plug into
+      `XMonad.Hooks.EwmhDesktops`.
+
 ### Bug Fixes and Minor Changes
+
   * `XMonad.Util.Loggers`
 
     - Added `logClassname`, `logClassnames`, `logClassnames'`,
@@ -201,6 +208,11 @@
       some status bars (see this
       [polybar issue](https://github.com/polybar/polybar/issues/2603)).
 
+    - Added `setEwmhFullscreenHooks` to override the default fullfloat/sink
+      behaviour of `_NET_WM_STATE_FULLSCREEN` requests. See also
+      `XMonad.Actions.ToggleFullFloat` for a float-restoring implementation of
+      fullscreening.
+
   * `XMonad.Hooks.StatusBar`
 
     - Added `startAllStatusBars` to start the configured status bars.

XMonad/Actions/ToggleFullFloat.hs

@@ -0,0 +1,122 @@
+-- |
+-- Module      :  XMonad.Actions.ToggleFullFloat
+-- Description :  Fullscreen (float) a window while remembering its original state.
+-- Copyright   :  (c) 2022 Tomáš Janoušek <tomi@nomi.cz>
+-- License     :  BSD3
+-- Maintainer  :  Tomáš Janoušek <tomi@nomi.cz>
+--
+module XMonad.Actions.ToggleFullFloat (
+    -- * Usage
+    -- $usage
+    toggleFullFloatEwmhFullscreen,
+    toggleFullFloat,
+    fullFloat,
+    unFullFloat,
+    gcToggleFullFloat,
+    ) where
+
+import qualified Data.Map.Strict as M
+
+import XMonad
+import XMonad.Prelude
+import XMonad.Hooks.EwmhDesktops (setEwmhFullscreenHooks)
+import XMonad.Hooks.ManageHelpers
+import qualified XMonad.StackSet as W
+import qualified XMonad.Util.ExtensibleState as XS
+
+-- ---------------------------------------------------------------------
+-- $usage
+--
+-- The main use-case is to make 'ewmhFullscreen' (re)store the size and
+-- position of floating windows instead of just unconditionally sinking them
+-- into the floating layer. To enable this, you'll need this in your
+-- @xmonad.hs@:
+--
+-- > import XMonad
+-- > import XMonad.Actions.ToggleFullFloat
+-- > import XMonad.Hooks.EwmhDesktops
+-- >
+-- > main = xmonad $ … . toggleFullFloatEwmhFullscreen . ewmhFullscreen . ewmh . … $ def{…}
+--
+-- Additionally, this "smart" fullscreening can be bound to a key and invoked
+-- manually whenever one needs a larger window temporarily:
+--
+-- >   , ((modMask .|. shiftMask, xK_t), withFocused toggleFullFloat)
+
+newtype ToggleFullFloat = ToggleFullFloat{ fromToggleFullFloat :: M.Map Window (Maybe W.RationalRect) }
+    deriving (Show, Read)
+
+instance ExtensionClass ToggleFullFloat where
+    extensionType = PersistentExtension
+    initialValue = ToggleFullFloat mempty
+
+-- | Full-float a window, remembering its state (tiled/floating and
+-- position/size).
+fullFloat :: Window -> X ()
+fullFloat = windows . appEndo <=< runQuery doFullFloatSave
+
+-- | Restore window to its remembered state.
+unFullFloat :: Window -> X ()
+unFullFloat = windows . appEndo <=< runQuery doFullFloatRestore
+
+-- | Full-float a window, if it's not already full-floating. Otherwise,
+-- restore its original state.
+toggleFullFloat :: Window -> X ()
+toggleFullFloat w = ifM (isFullFloat w) (unFullFloat w) (fullFloat w)
+
+isFullFloat :: Window -> X Bool
+isFullFloat w = gets $ (Just fullRect ==) . M.lookup w . W.floating . windowset
+  where
+    fullRect = W.RationalRect 0 0 1 1
+
+doFullFloatSave :: ManageHook
+doFullFloatSave = do
+    w <- ask
+    liftX $ do
+        f <- gets $ M.lookup w . W.floating . windowset
+        -- @M.insertWith const@ = don't overwrite stored original state
+        XS.modify' $ ToggleFullFloat . M.insertWith const w f . fromToggleFullFloat
+    doFullFloat
+
+doFullFloatRestore :: ManageHook
+doFullFloatRestore = do
+    w <- ask
+    mf <- liftX $ do
+        mf <- XS.gets $ M.lookup w . fromToggleFullFloat
+        XS.modify' $ ToggleFullFloat . M.delete w . fromToggleFullFloat
+        pure mf
+    doF $ case mf of
+        Just (Just f) -> W.float w f  -- was floating before
+        Just Nothing -> W.sink w      -- was tiled before
+        Nothing -> W.sink w           -- fallback when not found in ToggleFullFloat
+
+-- | Install ToggleFullFloat garbage collection hooks.
+--
+-- Note: This is included in 'toggleFullFloatEwmhFullscreen', only needed if
+-- using the 'toggleFullFloat' separately from the EWMH hook.
+gcToggleFullFloat :: XConfig a -> XConfig a
+gcToggleFullFloat c = c { startupHook     = startupHook c <> gcToggleFullFloatStartupHook
+                        , handleEventHook = handleEventHook c <> gcToggleFullFloatEventHook }
+
+-- | ToggleFullFloat garbage collection: drop windows when they're destroyed.
+gcToggleFullFloatEventHook :: Event -> X All
+gcToggleFullFloatEventHook DestroyWindowEvent{ev_window = w} = do
+    XS.modify' $ ToggleFullFloat . M.delete w . fromToggleFullFloat
+    mempty
+gcToggleFullFloatEventHook _ = mempty
+
+-- | ToggleFullFloat garbage collection: restrict to existing windows at
+-- startup.
+gcToggleFullFloatStartupHook :: X ()
+gcToggleFullFloatStartupHook = withWindowSet $ \ws ->
+    XS.modify' $ ToggleFullFloat . M.filterWithKey (\w _ -> w `W.member` ws) . fromToggleFullFloat
+
+-- | Hook this module into 'XMonad.Hooks.EwmhDesktops.ewmhFullscreen'. This
+-- makes windows restore their original state (size and position if floating)
+-- instead of unconditionally sinking into the tiling layer.
+--
+-- ('gcToggleFullFloat' is included here.)
+toggleFullFloatEwmhFullscreen :: XConfig a -> XConfig a
+toggleFullFloatEwmhFullscreen =
+    setEwmhFullscreenHooks doFullFloatSave doFullFloatRestore .
+    gcToggleFullFloat

XMonad/Hooks/EwmhDesktops.hs

@@ -40,6 +40,10 @@ module XMonad.Hooks.EwmhDesktops (
     -- $customActivate
     setEwmhActivateHook,
 
+    -- ** Fullscreen
+    -- $customFullscreen
+    setEwmhFullscreenHooks,
+
     -- ** @_NET_DESKTOP_VIEWPORT@
     -- $customManageDesktopViewport
     disableEwmhManageDesktopViewport,
@@ -106,6 +110,8 @@ data EwmhDesktopsConfig =
             -- ^ configurable workspace rename (see 'XMonad.Hooks.StatusBar.PP.ppRename')
         , activateHook :: ManageHook
             -- ^ configurable handling of window activation requests
+        , fullscreenHooks :: (ManageHook, ManageHook)
+            -- ^ configurable handling of fullscreen state requests
         , manageDesktopViewport :: Bool
             -- ^ manage @_NET_DESKTOP_VIEWPORT@?
         }
@@ -115,6 +121,7 @@ instance Default EwmhDesktopsConfig where
         { workspaceSort = getSortByIndex
         , workspaceRename = pure pure
         , activateHook = doFocus
+        , fullscreenHooks = (doFullFloat, doSink)
         , manageDesktopViewport = True
         }
 
@@ -235,6 +242,25 @@ setEwmhWorkspaceRename f = XC.modifyDef $ \c -> c{ workspaceRename = f }
 setEwmhActivateHook :: ManageHook -> XConfig l -> XConfig l
 setEwmhActivateHook h = XC.modifyDef $ \c -> c{ activateHook = h }
 
+
+-- $customFullscreen
+-- When a client sends a @_NET_WM_STATE@ request to add/remove/toggle the
+-- @_NET_WM_STATE_FULLSCREEN@ state, 'ewmhFullscreen' uses a pair of hooks to
+-- make the window fullscreen and revert its state. The default hooks are
+-- stateless: windows are fullscreened by turning them into fullscreen floats,
+-- and reverted by sinking them into the tiling layer. This behaviour can be
+-- configured by supplying a pair of 'ManageHook's to 'setEwmhFullscreenHooks'.
+--
+-- See "XMonad.Actions.ToggleFullFloat" for a pair of hooks that store the
+-- original state of floating windows.
+
+-- | Set (replace) the hooks invoked when clients ask to add/remove the
+-- $_NET_WM_STATE_FULLSCREEN@ state. The defaults are 'doFullFloat' and
+-- 'doSink'.
+setEwmhFullscreenHooks :: ManageHook -> ManageHook -> XConfig l -> XConfig l
+setEwmhFullscreenHooks f uf = XC.modifyDef $ \c -> c{ fullscreenHooks = (f, uf) }
+
+
 -- $customManageDesktopViewport
 -- Setting @_NET_DESKTOP_VIEWPORT@ is typically desired but can lead to a
 -- confusing workspace list in polybar, where this information is used to
@@ -472,7 +498,12 @@ fullscreenStartup = setFullscreenSupported
 -- Note this is not included in 'ewmh'.
 {-# DEPRECATED fullscreenEventHook "Use ewmhFullscreen instead." #-}
 fullscreenEventHook :: Event -> X All
-fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do
+fullscreenEventHook = XC.withDef . fullscreenEventHook'
+
+fullscreenEventHook' :: Event -> EwmhDesktopsConfig -> X All
+fullscreenEventHook'
+    ClientMessageEvent{ev_event_display = dpy, ev_window = win, ev_message_type = typ, ev_data = action:dats}
+    EwmhDesktopsConfig{fullscreenHooks = (fullscreenHook, unFullscreenHook)} = do
   managed <- isClient win
   wmstate <- getAtom "_NET_WM_STATE"
   fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN"
@@ -489,14 +520,14 @@ fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do
   when (managed && typ == wmstate && fi fullsc `elem` dats) $ do
     when (action == add || (action == toggle && not isFull)) $ do
       chWstate (fi fullsc:)
-      windows $ W.float win $ W.RationalRect 0 0 1 1
+      windows . appEndo =<< runQuery fullscreenHook win
     when (action == remove || (action == toggle && isFull)) $ do
       chWstate $ delete (fi fullsc)
-      windows $ W.sink win
+      windows . appEndo =<< runQuery unFullscreenHook win
 
   return $ All True
 
-fullscreenEventHook _ = return $ All True
+fullscreenEventHook' _ _ = return $ All True
 
 setNumberOfDesktops :: (Integral a) => a -> X ()
 setNumberOfDesktops n = withDisplay $ \dpy -> do

xmonad-contrib.cabal

@@ -147,6 +147,7 @@ library
                         XMonad.Actions.SwapWorkspaces
                         XMonad.Actions.TagWindows
                         XMonad.Actions.TiledWindowDragging
+                        XMonad.Actions.ToggleFullFloat
                         XMonad.Actions.TopicSpace
                         XMonad.Actions.TreeSelect
                         XMonad.Actions.UpdateFocus