mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-07-26 09:41:52 -07:00
Merge pull request #253 from LSLeary/statefull
StateFull: Fixing Full (and other layouts we lie to)
This commit is contained in:
@@ -91,6 +91,15 @@
|
|||||||
|
|
||||||
### New Modules
|
### 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`
|
* `XMonad.Hooks.Focus`
|
||||||
|
|
||||||
A new module extending ManageHook EDSL to work on focused windows and
|
A new module extending ManageHook EDSL to work on focused windows and
|
||||||
|
95
XMonad/Layout/StateFull.hs
Normal file
95
XMonad/Layout/StateFull.hs
Normal file
@@ -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)
|
@@ -38,6 +38,8 @@ module XMonad.Util.Stack ( -- * Usage
|
|||||||
, focusUpZ
|
, focusUpZ
|
||||||
, focusDownZ
|
, focusDownZ
|
||||||
, focusMasterZ
|
, focusMasterZ
|
||||||
|
, findS
|
||||||
|
, findZ
|
||||||
-- ** Extraction
|
-- ** Extraction
|
||||||
, getFocusZ
|
, getFocusZ
|
||||||
, getIZ
|
, getIZ
|
||||||
@@ -73,10 +75,13 @@ module XMonad.Util.Stack ( -- * Usage
|
|||||||
, mapE_
|
, mapE_
|
||||||
, mapEM
|
, mapEM
|
||||||
, mapEM_
|
, mapEM_
|
||||||
|
, reverseS
|
||||||
|
, reverseZ
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified XMonad.StackSet as W
|
import qualified XMonad.StackSet as W
|
||||||
import Control.Monad (liftM)
|
import Control.Applicative ((<|>))
|
||||||
|
import Control.Monad (guard,liftM)
|
||||||
import Data.List (sortBy)
|
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)
|
= Just $ W.Stack (last up) [] (reverse (init up) ++ [f] ++ down)
|
||||||
focusMasterZ (Just s) = Just s
|
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
|
-- ** Extraction
|
||||||
|
|
||||||
-- | Get the focused element
|
-- | Get the focused element
|
||||||
@@ -338,3 +359,11 @@ fromE (Left a) = a
|
|||||||
-- | Tag the element with 'Right' if the property is true, 'Left' otherwise
|
-- | Tag the element with 'Right' if the property is true, 'Left' otherwise
|
||||||
tagBy :: (a -> Bool) -> a -> Either a a
|
tagBy :: (a -> Bool) -> a -> Either a a
|
||||||
tagBy p a = if p a then Right a else Left 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 <$>)
|
||||||
|
@@ -273,6 +273,7 @@ library
|
|||||||
XMonad.Layout.Spiral
|
XMonad.Layout.Spiral
|
||||||
XMonad.Layout.Square
|
XMonad.Layout.Square
|
||||||
XMonad.Layout.StackTile
|
XMonad.Layout.StackTile
|
||||||
|
XMonad.Layout.StateFull
|
||||||
XMonad.Layout.Stoppable
|
XMonad.Layout.Stoppable
|
||||||
XMonad.Layout.SubLayouts
|
XMonad.Layout.SubLayouts
|
||||||
XMonad.Layout.TabBarDecoration
|
XMonad.Layout.TabBarDecoration
|
||||||
|
Reference in New Issue
Block a user