Merge pull request #253 from LSLeary/statefull

StateFull: Fixing Full (and other layouts we lie to)

CHANGES.md

@@ -91,6 +91,15 @@
 
 ### New Modules
 
+  * `XMonad.Layout.StateFull`
+
+    Provides StateFull: a stateful form of Full that does not misbehave when
+    floats are focused, and the FocusTracking layout transformer by means of
+    which StateFull is implemented. 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.
+
   * `XMonad.Hooks.Focus`
 
     A new module extending ManageHook EDSL to work on focused windows and

XMonad/Layout/StateFull.hs

@@ -0,0 +1,95 @@
+{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses #-}
+{-# LANGUAGE PatternSynonyms #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.StateFull
+-- Description :  The StateFull Layout & FocusTracking Layout Transformer
+-- Copyright   :  (c) 2018  L. S. Leary
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  L. S. Leary
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Provides StateFull: a stateful form of Full that does not misbehave when
+-- floats are focused, and the FocusTracking layout transformer by means of
+-- which StateFull is implemented. 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.
+--------------------------------------------------------------------------------
+
+module XMonad.Layout.StateFull (
+  -- * Usage
+  -- $Usage
+  pattern StateFull,
+  StateFull,
+  FocusTracking(..),
+  focusTracking
+) where
+
+import XMonad hiding ((<&&>))
+import qualified XMonad.StackSet as W
+import XMonad.Util.Stack (findZ)
+
+import Data.Maybe (fromMaybe)
+import Control.Applicative ((<|>))
+import Control.Monad (join)
+
+-- $Usage
+--
+-- To use it, first you need to:
+--
+-- > import XMonad.Layout.StateFull
+--
+-- Then to toggle your tiled layout with @StateFull@, you can do:
+--
+-- > main = xmonad def { layoutHook = someTiledLayout ||| StateFull }
+--
+-- Or, some child layout that depends on focus information can be made to fall
+-- back on the last focus it had:
+--
+-- > 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
+
+-- | 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 :: StateFull a
+pattern StateFull = 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 join (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)

XMonad/Util/Stack.hs

@@ -38,6 +38,8 @@ module XMonad.Util.Stack ( -- * Usage
                          , focusUpZ
                          , focusDownZ
                          , focusMasterZ
+                         , findS
+                         , findZ
                            -- ** Extraction
                          , getFocusZ
                          , getIZ
@@ -73,10 +75,13 @@ module XMonad.Util.Stack ( -- * Usage
                          , mapE_
                          , mapEM
                          , mapEM_
+                         , reverseS
+                         , reverseZ
                          ) where
 
 import qualified XMonad.StackSet as W
-import Control.Monad (liftM)
+import Control.Applicative ((<|>))
+import Control.Monad (guard,liftM)
 import Data.List (sortBy)
 
 
@@ -175,6 +180,22 @@ focusMasterZ (Just (W.Stack f up down)) | not $ null up
     = Just $ W.Stack (last up) [] (reverse (init up) ++ [f] ++ down)
 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 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)
+                                   $ W.Stack u ups (W.focus s : W.down s)
+                 | 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)
+findZ _ Nothing   = Nothing
+findZ p (Just st) = Just <$> findS p st
+
 -- ** Extraction
 
 -- | Get the focused element
@@ -338,3 +359,11 @@ fromE (Left a) = a
 -- | Tag the element with 'Right' if the property is true, 'Left' otherwise
 tagBy :: (a -> Bool) -> a -> Either a a
 tagBy p a = if p a then Right a else Left a
+
+-- | Reverse a @Stack a@; O(1).
+reverseS :: W.Stack a -> W.Stack a
+reverseS (W.Stack foc ups downs) = W.Stack foc downs ups
+
+-- | Reverse a @Zipper a@; O(1).
+reverseZ :: Zipper a -> Zipper a
+reverseZ = (reverseS <$>)

xmonad-contrib.cabal

@@ -273,6 +273,7 @@ library
                         XMonad.Layout.Spiral
                         XMonad.Layout.Square
                         XMonad.Layout.StackTile
+                        XMonad.Layout.StateFull
                         XMonad.Layout.Stoppable
                         XMonad.Layout.SubLayouts
                         XMonad.Layout.TabBarDecoration