Merge pull request #418 from liskin/trackfloating-focustracking

X.L.TrackFloating: Clean up and simplify

XMonad/Layout/StateFull.hs

@@ -35,7 +35,6 @@ import XMonad.Util.Stack (findZ)
 
 import Data.Maybe (fromMaybe)
 import Control.Applicative ((<|>))
-import Control.Monad (join)
 
 -- $Usage
 --
@@ -82,7 +81,7 @@ instance LayoutClass l Window => LayoutClass (FocusTracking l) Window where
     mRealFoc <- gets (W.peek . windowset)
     let mGivenFoc = W.focus <$> mSt
         passedMSt = if mRealFoc == mGivenFoc then mSt
-                    else join (mOldFoc >>= \oF -> findZ (==oF) mSt) <|> 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'

XMonad/Layout/TrackFloating.hs

@@ -11,8 +11,9 @@ Stability   :  unstable
 Portability :  unportable
 
 Layout modifier that tracks focus in the tiled layer while the floating layer
-is in use. This is particularly helpful for tiled layouts where the focus
-determines what is visible.
+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.
 
 The relevant bugs are Issue 4 and 306:
 <http://code.google.com/p/xmonad/issues/detail?id=4>,
@@ -32,56 +33,35 @@ module XMonad.Layout.TrackFloating
      UseTransientFor,
     ) where
 
-import Control.Applicative (liftA2)
+import Control.Applicative ((<|>))
 import Control.Monad
-import Data.Function
-import Data.List
-import Data.Maybe
-import qualified Data.Map as M
-import qualified Data.Set as S
 
 import XMonad
 import XMonad.Layout.LayoutModifier
+import XMonad.Util.Stack (findZ)
 import qualified XMonad.StackSet as W
 
 import qualified Data.Traversable as T
 
 
-data TrackFloating a = TrackFloating
-    { _wasFloating :: Bool,
-      _tiledFocus :: Maybe Window }
-    deriving (Read,Show,Eq)
+data TrackFloating a = TrackFloating (Maybe Window)
+    deriving (Read,Show)
 
 
 instance LayoutModifier TrackFloating Window where
-    modifyLayoutWithUpdate os@(TrackFloating _wasF mw) ws@(W.Workspace{ W.stack = ms }) r
+    modifyLayoutWithUpdate (TrackFloating mw) ws@(W.Workspace{ W.stack = ms }) r
       = do
-        winset <- gets windowset
-        let xCur = fmap W.focus xStack
-            xStack = W.stack $ W.workspace $ W.current winset
-            isF = fmap (\x -> x `M.member` W.floating winset ||
-                            (let (\\\) = (S.\\) `on` (S.fromList . W.integrate')
-                             in x `S.member` (xStack \\\ ms)))
-                        xCur
-            newStack
-              -- focus is floating, so use the remembered focus point
-              | Just isF' <- isF,
-                isF',
-                Just w <- mw,
-                Just s <- ms,
-                Just ns <- find ((==) w . W.focus)
-                    $ zipWith const (iterate W.focusDown' s) (W.integrate s)
-                = Just ns
-              | otherwise
-                = ms
-            newState = case isF of
-              Just True -> mw
-              Just False | Just f <- xCur -> Just f
-              _ -> Nothing
+        xCur <- gets (W.peek . 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,
-                let n = TrackFloating (fromMaybe False isF) newState
-                in guard (n /= os) >> Just n)
+        return (ran, guard (newState /= mw) >> Just (TrackFloating newState))
 
 
 
@@ -101,7 +81,7 @@ instance LayoutModifier UseTransientFor Window where
 
         s0 <- get
         whenJust parent $ \p -> put s0{ windowset = W.focusWindow p (windowset s0) }
-        result <- runLayout ws{ W.stack = fromMaybe ms (liftA2 focusWin ms parent) } r
+        result <- runLayout ws{ W.stack = (parent >>= \p -> findZ (p==) ms) <|> ms } r
 
         m' <- gets (W.peek . windowset)
 
@@ -113,16 +93,6 @@ instance LayoutModifier UseTransientFor Window where
 
 
 
-focusWin :: Eq a => W.Stack a -> a -> Maybe (W.Stack a)
-focusWin st@(W.Stack f u d) w
-        | w `elem` u || w `elem` d = Just . head . filter ((==w) . W.focus)
-            $ iterate (if w `elem` u then W.focusUp'
-                                        else W.focusDown') st
-        | w == f = Just st
-        | otherwise = Nothing
-
-
-
 {- $usage
 
 Apply to your layout in a config like:
@@ -160,7 +130,7 @@ window regardless of which tiled window was focused before.
 
 -}
 trackFloating ::  l a -> ModifiedLayout TrackFloating l a
-trackFloating layout = ModifiedLayout (TrackFloating False Nothing) layout
+trackFloating layout = ModifiedLayout (TrackFloating Nothing) layout
 
 {- $layoutModifier
 It also corrects focus issues for full-like layouts inside other layout

XMonad/Util/Stack.hs

@@ -182,7 +182,7 @@ focusMasterZ (Just s) = Just s
 
 -- | Refocus a @Stack a@ on an element satisfying the predicate, or fail to
 --   @Nothing@.
-findS :: Eq a => (a -> Bool) -> W.Stack a -> Maybe (W.Stack a)
+findS :: (a -> Bool) -> W.Stack a -> Maybe (W.Stack a)
 findS p st = st <$ (guard . p . W.focus) st <|> findUp st <|> findDown st
   where findDown = reverseZ . findUp . reverseS
         findUp s | u:ups <- W.up s = (if p u then Just else findUp)
@@ -190,11 +190,10 @@ findS p st = st <$ (guard . p . W.focus) st <|> findUp st <|> findDown st
                  | otherwise       = Nothing
 
 -- | Refocus a @Zipper a@ on an element satisfying the predicate, or fail to
---   @Nothing@. Never returns @Just Nothing@, so the second layer of @Maybe@ is
---   actually redundant.
-findZ :: Eq a => (a -> Bool) -> Zipper a -> Maybe (Zipper a)
+--   @Nothing@.
+findZ :: (a -> Bool) -> Zipper a -> Zipper a
 findZ _ Nothing   = Nothing
-findZ p (Just st) = Just <$> findS p st
+findZ p (Just st) = findS p st
 
 -- ** Extraction