mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 03:20:21 -07:00
66281f07f1
Make 'stackMerge' safer by implicitly appending any leftover elements rather than discarding them. Otherwise on refresh the missing windows will be deleted. This is only necessary if the stack has been shortened - i.e. not required by this module. Minor miscellaneous documentation fixes.
405 lines
16 KiB
Haskell
405 lines
16 KiB
Haskell
-----------------------------------------------------------------------------
|
|
-- |
|
|
-- Module : XMonad.Actions.SwapPromote
|
|
-- Copyright : (c) 2018 Yclept Nemo
|
|
-- License : BSD-style (see LICENSE)
|
|
--
|
|
-- Maintainer :
|
|
-- Stability : unstable
|
|
-- Portability : unportable
|
|
--
|
|
-- Module for tracking master window history per workspace, and associated
|
|
-- functions for manipulating the stack using such history.
|
|
--
|
|
-----------------------------------------------------------------------------
|
|
|
|
|
|
module XMonad.Actions.SwapPromote
|
|
( -- * Usage
|
|
-- $usage
|
|
MasterHistory (..)
|
|
-- * State Accessors
|
|
, getMasterHistoryMap
|
|
, getMasterHistoryFromTag
|
|
, getMasterHistoryCurrent
|
|
, getMasterHistoryFromWindow
|
|
, modifyMasterHistoryFromTag
|
|
, modifyMasterHistoryCurrent
|
|
-- * Log Hook
|
|
, masterHistoryHook
|
|
-- * Log Hook Building Blocks
|
|
, masterHistoryHook'
|
|
, updateMasterHistory
|
|
-- * Actions
|
|
, swapPromote
|
|
, swapPromote'
|
|
, swapIn
|
|
, swapIn'
|
|
, swapHybrid
|
|
, swapHybrid'
|
|
-- * Action Building Blocks
|
|
, swapApply
|
|
, swapPromoteStack
|
|
, swapInStack
|
|
, swapHybridStack
|
|
-- * List Utilities
|
|
, cycleN
|
|
, split
|
|
, split'
|
|
, merge
|
|
, merge'
|
|
-- * Stack Utilities
|
|
, stackSplit
|
|
, stackMerge
|
|
) where
|
|
|
|
|
|
import XMonad
|
|
import qualified XMonad.StackSet as W
|
|
import qualified XMonad.Util.ExtensibleState as XS
|
|
|
|
import qualified Data.Map as M
|
|
import qualified Data.Set as S
|
|
import Data.List
|
|
import Data.Maybe
|
|
import Control.Arrow
|
|
import Control.Monad
|
|
|
|
|
|
-- $usage
|
|
-- Given your configuration file, import this module:
|
|
--
|
|
-- > import XMonad.Actions.SwapPromote
|
|
--
|
|
-- First add 'masterHistoryHook' to your 'logHook' to track master windows per
|
|
-- workspace:
|
|
--
|
|
-- > myLogHook = otherHook >> masterHistoryHook
|
|
--
|
|
-- Then replace xmonad's default promote keybinding with 'swapPromote'':
|
|
--
|
|
-- > , ((mod1Mask, xK_Return), swapPromote' False)
|
|
--
|
|
-- Depending on your xmonad configuration or window actions the master history
|
|
-- may be empty. If this is the case you can still chain another promotion
|
|
-- function:
|
|
--
|
|
-- > import XMonad.Actions.DwmPromote
|
|
-- > , ((mod1Mask, xK_Return), whenX (swapPromote False) dwmpromote)
|
|
--
|
|
-- To be clear, this is only called when the lack of master history hindered
|
|
-- the swap and not other conditions, such as having a only a single window.
|
|
--
|
|
-- While 'swapPromote' preserves window focus, 'swapIn' preserves the focus
|
|
-- position - effectively "swapping" new windows into focus without moving the
|
|
-- zipper. A mix of both, 'swapHybrid' promotes focused non-master windows
|
|
-- while swapping windows into the focused master. This works well on layouts
|
|
-- with large masters. Both come with chainable variants, see 'swapIn'' and
|
|
-- 'swapHybrid''.
|
|
--
|
|
-- So far floating windows have been treated no differently than tiled windows
|
|
-- even though their positions are independent of the stack. Often, yanking
|
|
-- floating windows in and out of the workspace will obliterate the stack
|
|
-- history - particularly frustrating with 'XMonad.Util.Scratchpad' since it is
|
|
-- toggled so frequenty and always replaces the master window. That's why the
|
|
-- swap functions accept a boolean argument; when @True@ non-focused floating
|
|
-- windows will be ignored.
|
|
--
|
|
-- All together:
|
|
--
|
|
-- > , ((mod1Mask, xK_Return), whenX (swapHybrid True) dwmpromote)
|
|
|
|
|
|
-- | Mapping from workspace tag to master history list. The current master is
|
|
-- the head of the list, the previous master the second element, and so on.
|
|
-- Without history, the list is empty.
|
|
newtype MasterHistory = MasterHistory
|
|
{ getMasterHistory :: M.Map WorkspaceId [Window]
|
|
} deriving (Read,Show,Typeable)
|
|
|
|
instance ExtensionClass MasterHistory where
|
|
initialValue = MasterHistory M.empty
|
|
|
|
-- | Return the master history map from the state.
|
|
getMasterHistoryMap :: X (M.Map WorkspaceId [Window])
|
|
getMasterHistoryMap = XS.gets getMasterHistory
|
|
|
|
-- | Return the master history list of a given tag. The master history list may
|
|
-- be empty. An invalid tag will also result in an empty list.
|
|
getMasterHistoryFromTag :: WorkspaceId -> X [Window]
|
|
getMasterHistoryFromTag t = M.findWithDefault [] t <$> getMasterHistoryMap
|
|
|
|
-- | Return the master history list of the current workspace.
|
|
getMasterHistoryCurrent :: X [Window]
|
|
getMasterHistoryCurrent = gets (W.currentTag . windowset)
|
|
>>= getMasterHistoryFromTag
|
|
|
|
-- | Return the master history list of the workspace containing the given
|
|
-- window. Return an empty list if the window is not in the stackset.
|
|
getMasterHistoryFromWindow :: Window -> X [Window]
|
|
getMasterHistoryFromWindow w = gets (W.findTag w . windowset)
|
|
>>= maybe (return []) getMasterHistoryFromTag
|
|
|
|
-- | Modify the master history list of a given workspace, or the empty list of
|
|
-- no such workspace is mapped. The result is then re-inserted into the master
|
|
-- history map.
|
|
modifyMasterHistoryFromTag :: WorkspaceId -> ([Window] -> [Window]) -> X ()
|
|
modifyMasterHistoryFromTag t f = XS.modify $ \(MasterHistory m) ->
|
|
let l = M.findWithDefault [] t m
|
|
in MasterHistory $ M.insert t (f l) m
|
|
|
|
-- | Modify the master history list of the current workspace. While the current
|
|
-- workspace is guaranteed to exist; its master history may not. For more
|
|
-- information see 'modifyMasterHistoryFromTag'.
|
|
modifyMasterHistoryCurrent :: ([Window] -> [Window]) -> X ()
|
|
modifyMasterHistoryCurrent f = gets (W.currentTag . windowset)
|
|
>>= flip modifyMasterHistoryFromTag f
|
|
|
|
-- | A 'logHook' to update the master history mapping. Non-existent workspaces
|
|
-- are removed, and the master history list for the current workspaces is
|
|
-- updated. See 'masterHistoryHook''.
|
|
masterHistoryHook :: X ()
|
|
masterHistoryHook = masterHistoryHook' True updateMasterHistory
|
|
|
|
-- | Backend for 'masterHistoryHook'.
|
|
masterHistoryHook' :: Bool
|
|
-- ^ If @True@, remove non-existent workspaces.
|
|
-> ([Window] -> [Window] -> [Window])
|
|
-- ^ Function used to update the master history list of
|
|
-- the current workspace. First argument is the master
|
|
-- history, second is the integrated stack. See
|
|
-- 'updateMasterHistory' for more details.
|
|
-> X ()
|
|
masterHistoryHook' removeWorkspaces historyModifier = do
|
|
wset <- gets windowset
|
|
let W.Workspace wid _ mst = W.workspace . W.current $ wset
|
|
tags = map W.tag $ W.workspaces wset
|
|
st = W.integrate' mst
|
|
XS.modify $ \(MasterHistory mm) ->
|
|
let mm' = if removeWorkspaces
|
|
then restrictKeys mm $ S.fromList tags
|
|
else mm
|
|
ms = M.findWithDefault [] wid mm'
|
|
ms' = historyModifier ms st
|
|
in MasterHistory $ M.insert wid ms' mm'
|
|
|
|
-- | Less efficient version of 'M.restrictKeys'. Given broader eventual
|
|
-- adoption, replace this with 'M.restrictKeys'.
|
|
restrictKeys :: Ord k => M.Map k a -> S.Set k -> M.Map k a
|
|
restrictKeys m s = M.filterWithKey (\k _ -> k `S.member` s) m
|
|
|
|
-- | Given the current master history list and an integrated stack, return the
|
|
-- new master history list. The current master is either moved (if it exists
|
|
-- within the history) or added to the head of the list, and all missing (i.e.
|
|
-- closed) windows are removed.
|
|
updateMasterHistory :: [Window] -- ^ The master history list.
|
|
-> [Window] -- ^ The integrated stack.
|
|
-> [Window]
|
|
updateMasterHistory _ [] = []
|
|
updateMasterHistory ms ws@(w:_) = (w : delete w ms) `intersect` ws
|
|
|
|
-- | Wrap 'swapPromoteStack'; see also 'swapApply'.
|
|
swapPromote :: Bool -> X Bool
|
|
swapPromote = flip swapApply swapPromoteStack
|
|
|
|
-- | Like 'swapPromote'' but discard the result.
|
|
swapPromote' :: Bool -> X ()
|
|
swapPromote' = void . swapPromote
|
|
|
|
-- | Wrap 'swapInStack'; see also 'swapApply'.
|
|
swapIn :: Bool -> X Bool
|
|
swapIn = flip swapApply swapInStack
|
|
|
|
-- | Like 'swapIn'' but discard the result.
|
|
swapIn' :: Bool -> X ()
|
|
swapIn' = void . swapIn
|
|
|
|
-- | Wrap 'swapHybridStack'; see also 'swapApply'.
|
|
swapHybrid :: Bool -> X Bool
|
|
swapHybrid = flip swapApply swapHybridStack
|
|
|
|
-- | Like 'swapHybrid'' but discard the result.
|
|
swapHybrid' :: Bool -> X ()
|
|
swapHybrid' = void . swapHybrid
|
|
|
|
-- | Apply the given master history stack modifier to the current stack. If
|
|
-- given @True@, all non-focused floating windows will be ignored. Return
|
|
-- @True@ if insufficient history; if so use 'whenX' to sequence a backup
|
|
-- promotion function.
|
|
swapApply :: Bool
|
|
-> (Maybe Window -> W.Stack Window -> (Bool,W.Stack Window))
|
|
-> X Bool
|
|
swapApply ignoreFloats swapFunction = do
|
|
fl <- gets $ W.floating . windowset
|
|
st <- gets $ W.stack . W.workspace . W.current . windowset
|
|
ch <- getMasterHistoryCurrent
|
|
let swapApply' s1 =
|
|
let fl' = if ignoreFloats then M.keysSet fl else S.empty
|
|
ff = (||) <$> (`S.notMember` fl') <*> (== W.focus s1)
|
|
fh = filter ff ch
|
|
pm = listToMaybe . drop 1 $ fh
|
|
(r,s2) = stackSplit s1 fl' :: ([(Int,Window)],W.Stack Window)
|
|
(b,s3) = swapFunction pm s2
|
|
s4 = stackMerge s3 r
|
|
mh = let w = head . W.integrate $ s3
|
|
in const $ w : delete w ch
|
|
in (b,Just s4,mh)
|
|
(x,y,z) = maybe (False,Nothing,id) swapApply' st
|
|
-- Any floating master windows will be added to the history when 'windows'
|
|
-- calls the log hook.
|
|
modifyMasterHistoryCurrent z
|
|
windows $ W.modify Nothing . const $ y
|
|
return x
|
|
|
|
-- | If the focused window is the master window and there is no previous
|
|
-- master, do nothing. Otherwise swap the master with the previous master. If
|
|
-- the focused window is not the master window, swap it with the master window.
|
|
-- In either case focus follows the original window, i.e. the focused window
|
|
-- does not change, only its position.
|
|
--
|
|
-- The first argument is the previous master (which may not exist), the second
|
|
-- a window stack. Return @True@ if the master history hindered the swap; the
|
|
-- history is either empty or out-of-sync. Though the latter shouldn't happen
|
|
-- this function never changes the stack under such circumstances.
|
|
swapPromoteStack :: Maybe Window -> W.Stack Window -> (Bool,W.Stack Window)
|
|
swapPromoteStack _ st@(W.Stack _x [] []) = (False,st)
|
|
swapPromoteStack Nothing st@(W.Stack _x [] _r) = (True,st)
|
|
swapPromoteStack (Just pm) (W.Stack x [] r) =
|
|
let (r',l') = (reverse *** cycleN 1) $ span (/= pm) $ reverse r
|
|
st' = W.Stack x l' r'
|
|
b = null l'
|
|
in (b,st')
|
|
swapPromoteStack _ (W.Stack x l r) =
|
|
let r' = (++ r) . cycleN 1 . reverse $ l
|
|
st' = W.Stack x [] r'
|
|
in (False,st')
|
|
|
|
-- | Perform the same swap as 'swapPromoteStack'. However the new window
|
|
-- receives the focus; it appears to "swap into" the position of the original
|
|
-- window. Under this model focus follows stack position and the zipper does
|
|
-- not move.
|
|
--
|
|
-- See 'swapPromoteStack' for more details regarding the parameters.
|
|
swapInStack :: Maybe Window -> W.Stack Window -> (Bool,W.Stack Window)
|
|
swapInStack _ st@(W.Stack _x [] []) = (False,st)
|
|
swapInStack Nothing st@(W.Stack _x [] _r) = (True,st)
|
|
swapInStack (Just pm) (W.Stack x [] r) =
|
|
let (x',r') = case span (/= pm) r of
|
|
(__,[]) -> (x,r)
|
|
(sl,sr) -> (pm,sl ++ x : drop 1 sr)
|
|
st' = W.Stack x' [] r'
|
|
b = x' == x
|
|
in (b,st')
|
|
swapInStack _ (W.Stack x l r) =
|
|
let l' = init l ++ [x]
|
|
x' = last l
|
|
st' = W.Stack x' l' r
|
|
in (False,st')
|
|
|
|
-- | If the focused window is the master window, use 'swapInStack'. Otherwise use
|
|
-- 'swapPromoteStack'.
|
|
--
|
|
-- See 'swapPromoteStack' for more details regarding the parameters.
|
|
swapHybridStack :: Maybe Window -> W.Stack Window -> (Bool,W.Stack Window)
|
|
swapHybridStack m st@(W.Stack _ [] _) = swapInStack m st
|
|
swapHybridStack m st = swapPromoteStack m st
|
|
|
|
-- | Cycle a list by the given count. If positive, cycle to the left. If
|
|
-- negative, cycle to the right:
|
|
--
|
|
-- >>> cycleN 2 [1,2,3,4,5]
|
|
-- [3,4,5,1,2]
|
|
-- >>> cycleN (-2) [1,2,3,4,5]
|
|
-- [4,5,1,2,3]
|
|
cycleN :: Int -> [a] -> [a]
|
|
cycleN n ls =
|
|
let l = length ls
|
|
in take l $ drop (n `mod` l) $ cycle ls
|
|
|
|
-- | Wrap 'split'' with an initial index of @0@, discarding the list's length.
|
|
split :: (Num a, Enum a) => (b -> Bool) -> [b] -> ([(a,b)],[b])
|
|
split p l =
|
|
let (_,ys,ns) = split' p 0 l
|
|
in (ys,ns)
|
|
|
|
-- | Given a predicate, an initial index and a list, return a tuple containing:
|
|
--
|
|
-- * List length.
|
|
-- * Indexed list of elements which satisfy the predicate. An indexed element
|
|
-- is a tuple containing the element index (offset by the initial index) and
|
|
-- the element.
|
|
-- * List of elements which do not satisfy the predicate.
|
|
--
|
|
-- The initial index and length of the list simplify chaining calls to this
|
|
-- function, such as for zippers of lists.
|
|
split' :: (Num a, Enum a) => (b -> Bool) -> a -> [b] -> (a,[(a,b)],[b])
|
|
split' p i l =
|
|
let accumulate e (c,ys,ns) = if p (snd e)
|
|
then (c+1,e:ys,ns)
|
|
else (c+1,ys,e:ns)
|
|
(c',ys',ns') = foldr accumulate (0,[],[]) $ zip [i..] l
|
|
in (c',ys',snd . unzip $ ns')
|
|
|
|
-- | Wrap 'merge'' with an initial virtual index of @0@. Return only the
|
|
-- unindexed list with elements from the leftover indexed list appended.
|
|
merge :: (Ord a, Num a) => [(a,b)] -> [b] -> [b]
|
|
merge il ul =
|
|
let (_,il',ul') = merge' 0 il ul
|
|
in ul' ++ map snd il'
|
|
|
|
-- | Inverse of 'split'. Merge an indexed list with an unindexed list (see
|
|
-- 'split''). Given a virtual index, an indexed list and an unindexed list,
|
|
-- return a tuple containing:
|
|
--
|
|
-- * Virtual index /after/ the unindexed list
|
|
-- * Remainder of the indexed list
|
|
-- * Merged unindexed list
|
|
--
|
|
-- If the indexed list is empty, this functions consumes the entire unindexed
|
|
-- list. If the unindexed list is empty, this function consumes only adjacent
|
|
-- indexed elements. For example, @[(10,"ten"),(12,"twelve")]@ implies missing
|
|
-- unindexed elements and so once @(10,"ten")@ is consumed this function
|
|
-- concludes.
|
|
--
|
|
-- The indexed list is assumed to have been created by 'split'' and not checked
|
|
-- for correctness. Indices are assumed to be ascending, i.e.
|
|
-- > [(1,"one"),(2,"two"),(4,"four")]
|
|
--
|
|
-- The initial and final virtual indices simplify chaining calls to the this
|
|
-- function, as as for zippers of lists. Positive values shift the unindexed
|
|
-- list towards the tail, as if preceded by that many elements.
|
|
merge' :: (Ord a, Num a) => a -> [(a,b)] -> [b] -> (a,[(a,b)],[b])
|
|
merge' i il@((j,a):ps) ul@(b:bs) = if j <= i
|
|
then let (x,y,z) = merge' (i+1) ps ul
|
|
in (x,y,a:z)
|
|
else let (x,y,z) = merge' (i+1) il bs
|
|
in (x,y,b:z)
|
|
merge' i [] (b:bs) =
|
|
let (x,y,z) = merge' (i+1) [] bs
|
|
in (x,y,b:z)
|
|
merge' i il@((j,a):ps) [] = if j <= i
|
|
then let (x,y,z) = merge' (i+1) ps []
|
|
in (x,y,a:z)
|
|
else (i,il,[])
|
|
merge' i [] [] =
|
|
(i,[],[])
|
|
|
|
-- | Remove all elements of the set from the stack. Skip the currently focused
|
|
-- member. Return an indexed list of excluded elements and the modified stack.
|
|
-- Use 'stackMerge' to re-insert the elements using this list.
|
|
stackSplit :: (Num a, Enum a, Ord b) => W.Stack b -> S.Set b -> ([(a,b)],W.Stack b)
|
|
stackSplit (W.Stack x l r) s =
|
|
let (c,fl,tl) = split' (`S.member` s) 0 (reverse l)
|
|
(_,fr,tr) = split' (`S.member` s) (c+1) r
|
|
in (fl++fr,W.Stack x (reverse tl) tr)
|
|
|
|
-- | Inverse of 'stackSplit'. Given a list of elements and their original
|
|
-- indices, re-insert the elements into these same positions within the stack.
|
|
-- Skip the currently focused member. Works best if the stack's length hasn't
|
|
-- changed, though if shorter any leftover elements will be tacked on.
|
|
stackMerge :: (Ord a, Num a) => W.Stack b -> [(a,b)] -> W.Stack b
|
|
stackMerge (W.Stack x l r) il =
|
|
let (i,il1,l') = merge' 0 il (reverse l)
|
|
(_,il2,r') = merge' (i+1) il1 r
|
|
in W.Stack x (reverse l') (r' ++ map snd il2)
|