From a52e646cc1406515ce9b67bc738b32307c3017c3 Mon Sep 17 00:00:00 2001 From: "L. S. Leary" Date: Sun, 4 Dec 2022 13:46:27 +1300 Subject: [PATCH] Extract redundant layouts into new module: X.L.FocusTracking X.L.StateFull's `FocusTracking` and the eponymous `TrackFloating` were redundant, hence the former was slated for deprecation. However, the latter and its host module are somewhat poorly named; the layout modifier has little relation to floats. As such, it's renamed and rehosted, becoming the eponymous `FocusTracking`. The redundant offerings in the original modules are redefined in terms of the new module where possible, and deprecated. See: #418; comments on #253, #783. --- CHANGES.md | 8 ++++ XMonad/Layout/FocusTracking.hs | 85 ++++++++++++++++++++++++++++++++++ XMonad/Layout/StateFull.hs | 50 ++++---------------- XMonad/Layout/TrackFloating.hs | 36 ++++---------- xmonad-contrib.cabal | 1 + 5 files changed, 112 insertions(+), 68 deletions(-) create mode 100644 XMonad/Layout/FocusTracking.hs diff --git a/CHANGES.md b/CHANGES.md index ae921450..31c161c8 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -4,6 +4,10 @@ ### Breaking Changes + * Deprecated the `XMonad.Layout.StateFull` module and + `XMonad.Layout.TrackFloating.(t|T)rackFloating` in favour of + `XMonad.Layout.FocusTracking`. + * Dropped support for GHC 8.4. * `XMonad.Util.ExclusiveScratchpads` @@ -77,6 +81,10 @@ ### New Modules + * `XMonad.Layout.FocusTracking`. + + - Replaces `X.L.StateFull` and half of `X.L.TrackFloating`. + * `XMonad.Actions.MostRecentlyUsed` - Tab through windows by recency of use. Based on the Alt+Tab behaviour diff --git a/XMonad/Layout/FocusTracking.hs b/XMonad/Layout/FocusTracking.hs new file mode 100644 index 00000000..3915f2b8 --- /dev/null +++ b/XMonad/Layout/FocusTracking.hs @@ -0,0 +1,85 @@ +{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-} +{- | + +Module : XMonad.Layout.FocusTracking +Description : Track focus in the tiled layer. +Copyright : (c) 2010 & 2013 Adam Vogt + 2011 Willem Vanlint + 2018 & 2022 L.S.Leary +License : BSD-style (see xmonad/LICENSE) + +Maintainer : @LSLeary (on github) +Stability : unstable +Portability : unportable + +FocusTracking simply holds onto the last true focus it was given and continues +to use it as the focus for the transformed layout until it sees another. It can +be used to improve the behaviour of a child layout that has not been given the +focused window, or equivalently, that of the layout itself when a float has +focus. + +Relevant issues: + + * + * + +-------------------------------------------------------------------------------- +-} +module XMonad.Layout.FocusTracking + ( -- * Usage + -- $usage + FocusTracking(..) + , focusTracking + ) where + +import XMonad.Prelude +import XMonad +import XMonad.Layout.LayoutModifier +import XMonad.Util.Stack (findZ) +import qualified XMonad.StackSet as W + +-- $usage +-- +-- To use the module, first import it: +-- +-- > import XMonad.Layout.FocusTracking +-- +-- Then, a focus-dependent layout can be made to fall back on the last focus it +-- saw, for example: +-- +-- > main = xmonad def +-- > { layoutHook = someParentLayoutWith aChild (focusTracking anotherChild) +-- > , ... +-- > } +-- +-- Or in a simpler case: +-- +-- > main = xmonad def +-- > { layoutHook = myTiledLayout ||| focusTracking Full +-- > , ... +-- > } +-- + +-- | A 'LayoutModifier' that remembers the last focus it saw. +newtype FocusTracking a = FocusTracking (Maybe Window) + deriving (Read, Show) + +instance LayoutModifier FocusTracking Window where + modifyLayoutWithUpdate (FocusTracking mw) ws@W.Workspace{ W.stack = ms } r + = do + xCur <- gets (W.peek . W.view (W.tag ws) . windowset) + let isF = xCur /= (W.focus <$> ms) + -- use the remembered focus point when true focus differs from + -- what this (sub)layout is given, which happens e.g. when true + -- focus is in floating layer or when another sublayout has focus + newStack | isF = (mw >>= \w -> findZ (w==) ms) <|> ms + | otherwise = ms + newState | isF = mw + | otherwise = xCur + ran <- runLayout ws{ W.stack = newStack } r + return (ran, guard (newState /= mw) $> FocusTracking newState) + +-- | Transform a layout into one that remembers and uses the last focus it saw. +focusTracking :: l a -> ModifiedLayout FocusTracking l a +focusTracking = ModifiedLayout (FocusTracking Nothing) + diff --git a/XMonad/Layout/StateFull.hs b/XMonad/Layout/StateFull.hs index 6f3e8a4c..1f5f1828 100644 --- a/XMonad/Layout/StateFull.hs +++ b/XMonad/Layout/StateFull.hs @@ -20,19 +20,18 @@ -- behaviour of a child layout that has not been given the focused window. -------------------------------------------------------------------------------- -module XMonad.Layout.StateFull ( +module XMonad.Layout.StateFull {-# DEPRECATED "Use X.L.TrackFloating." #-} ( -- * Usage -- $Usage pattern StateFull, StateFull, - FocusTracking(..), - focusTracking + FocusTracking, + F.focusTracking ) where -import XMonad hiding ((<&&>)) -import XMonad.Prelude (fromMaybe, (<|>)) -import qualified XMonad.StackSet as W -import XMonad.Util.Stack (findZ) +import XMonad +import XMonad.Layout.LayoutModifier +import qualified XMonad.Layout.FocusTracking as F -- $Usage -- @@ -50,43 +49,14 @@ import XMonad.Util.Stack (findZ) -- > main = xmonad def -- > { layoutHook = someParentLayoutWith aChild (focusTracking anotherChild) } --- | The @FocusTracking@ data type for which the @LayoutClass@ instance is --- provided. -data FocusTracking l a = FocusTracking (Maybe a) (l a) - deriving (Show, Read) - --- | Transform a layout into one that remembers and uses its last focus. -focusTracking :: l a -> FocusTracking l a -focusTracking = FocusTracking Nothing +-- | The @FocusTracking@ type for which the @LayoutClass@ instance is provided. +type FocusTracking = ModifiedLayout F.FocusTracking -- | A type synonym to match the @StateFull@ pattern synonym. type StateFull = FocusTracking Full -- | A pattern synonym for the primary use case of the @FocusTracking@ -- transformer; using @Full@. -pattern StateFull :: FocusTracking Full a -pattern StateFull = FocusTracking Nothing Full +pattern StateFull :: StateFull a +pattern StateFull = ModifiedLayout (F.FocusTracking Nothing) Full -instance LayoutClass l Window => LayoutClass (FocusTracking l) Window where - - description (FocusTracking _ child) - | chDesc == "Full" = "StateFull" - | ' ' `elem` chDesc = "FocusTracking (" ++ chDesc ++ ")" - | otherwise = "FocusTracking " ++ chDesc - where chDesc = description child - - runLayout (W.Workspace i (FocusTracking mOldFoc childL) mSt) sr = do - - mRealFoc <- gets (W.peek . windowset) - let mGivenFoc = W.focus <$> mSt - passedMSt = if mRealFoc == mGivenFoc then mSt - else (mOldFoc >>= \oF -> findZ (==oF) mSt) <|> mSt - - (wrs, mChildL') <- runLayout (W.Workspace i childL passedMSt) sr - let newFT = if mRealFoc /= mGivenFoc then FocusTracking mOldFoc <$> mChildL' - else Just $ FocusTracking mGivenFoc (fromMaybe childL mChildL') - - return (wrs, newFT) - - handleMessage (FocusTracking mf childLayout) m = - (fmap . fmap) (FocusTracking mf) (handleMessage childLayout m) diff --git a/XMonad/Layout/TrackFloating.hs b/XMonad/Layout/TrackFloating.hs index 0d7abae4..8fe52bd3 100644 --- a/XMonad/Layout/TrackFloating.hs +++ b/XMonad/Layout/TrackFloating.hs @@ -2,7 +2,7 @@ {- | Module : XMonad.Layout.TrackFloating -Description : Track focus in the tiled layer. +Description : Let focused tiles track focused floats Copyright : (c) 2010 & 2013 Adam Vogt 2011 Willem Vanlint License : BSD-style (see xmonad/LICENSE) @@ -11,14 +11,9 @@ Maintainer : vogt.adam@gmail.com Stability : unstable Portability : unportable -Layout modifier that tracks focus in the tiled layer while the floating layer -or another sublayout is in use. This is particularly helpful for tiled layouts -where the focus determines what is visible. It can also be used to improve the -behaviour of a child layout that has not been given the focused window. +Provides layout modifier 'UseTransientFor': when a float has focus and is +@WM_TRANSIENT_FOR@ a tile, run the underlying layout as if that tile had focus. -The relevant bugs are Issue 4 and 306: -, - -} module XMonad.Layout.TrackFloating (-- * Usage @@ -37,31 +32,15 @@ module XMonad.Layout.TrackFloating import XMonad.Prelude import XMonad import XMonad.Layout.LayoutModifier +import XMonad.Layout.FocusTracking import XMonad.Util.Stack (findZ) import qualified XMonad.StackSet as W import qualified Data.Traversable as T -newtype TrackFloating a = TrackFloating (Maybe Window) - deriving (Read,Show) - - -instance LayoutModifier TrackFloating Window where - modifyLayoutWithUpdate (TrackFloating mw) ws@W.Workspace{ W.stack = ms } r - = do - xCur <- gets (W.peek . W.view (W.tag ws) . windowset) - let isF = xCur /= (W.focus <$> ms) - -- use the remembered focus point when true focus differs from - -- what this (sub)layout is given, which happens e.g. when true - -- focus is in floating layer or when another sublayout has focus - newStack | isF = (mw >>= \w -> findZ (w==) ms) <|> ms - | otherwise = ms - newState | isF = mw - | otherwise = xCur - ran <- runLayout ws{ W.stack = newStack } r - return (ran, guard (newState /= mw) >> Just (TrackFloating newState)) - +{-# DEPRECATED TrackFloating "Use X.L.FocusTracking.FocusTracking." #-} +type TrackFloating = FocusTracking {- | When focus is on the tiled layer, the underlying layout is run with focus @@ -128,8 +107,9 @@ window regardless of which tiled window was focused before. * the remembered focus hasn't since been killed -} +{-# DEPRECATED trackFloating "Use X.L.FocusTracking.focusTracking." #-} trackFloating :: l a -> ModifiedLayout TrackFloating l a -trackFloating = ModifiedLayout (TrackFloating Nothing) +trackFloating = focusTracking {- $layoutModifier It also corrects focus issues for full-like layouts inside other layout diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal index e284acf0..16a49bc4 100644 --- a/xmonad-contrib.cabal +++ b/xmonad-contrib.cabal @@ -245,6 +245,7 @@ library XMonad.Layout.DwmStyle XMonad.Layout.FixedAspectRatio XMonad.Layout.FixedColumn + XMonad.Layout.FocusTracking XMonad.Layout.Fullscreen XMonad.Layout.Gaps XMonad.Layout.Grid