{-# language DeriveGeneric, DeriveAnyClass #-}
module XMonad.Actions.GroupNavigation (
Direction (..)
, nextMatch
, nextMatchOrDo
, nextMatchWithThis
, historyHook
, isOnAnyVisibleWS
) where
import Control.Monad.Reader (ask, asks)
import Control.Monad.State (gets)
import Control.DeepSeq
import Data.Map ((!))
import qualified Data.Map as Map
import Data.Sequence (Seq, ViewL (EmptyL, (:<)), viewl, (<|), (><), (|>))
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import Graphics.X11.Types
import GHC.Generics
import Prelude hiding (drop, elem, filter, null, reverse)
import XMonad.Core
import XMonad.ManageHook
import XMonad.Operations (windows, withFocused)
import XMonad.Prelude (elem, foldl', (>=>))
import qualified XMonad.StackSet as SS
import qualified XMonad.Util.ExtensibleState as XS
data Direction = Forward
| Backward
| History
nextMatchWithThis :: Eq a => Direction -> Query a -> X ()
nextMatchWithThis :: forall a. Eq a => Direction -> Query a -> X ()
nextMatchWithThis Direction
dir Query a
qry = (Window -> X ()) -> X ()
withFocused forall a b. (a -> b) -> a -> b
$ \Window
win -> do
a
prop <- forall a. Query a -> Window -> X a
runQuery Query a
qry Window
win
Direction -> Query Bool -> X ()
nextMatch Direction
dir (Query a
qry forall a. Eq a => Query a -> a -> Query Bool
=? a
prop)
nextMatch :: Direction -> Query Bool -> X ()
nextMatch :: Direction -> Query Bool -> X ()
nextMatch Direction
dir Query Bool
qry = Direction -> Query Bool -> X () -> X ()
nextMatchOrDo Direction
dir Query Bool
qry (forall (m :: * -> *) a. Monad m => a -> m a
return ())
nextMatchOrDo :: Direction -> Query Bool -> X () -> X ()
nextMatchOrDo :: Direction -> Query Bool -> X () -> X ()
nextMatchOrDo Direction
dir Query Bool
qry X ()
act = Direction -> X (Seq Window)
orderedWindowList Direction
dir
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Query Bool -> X () -> Seq Window -> X ()
focusNextMatchOrDo Query Bool
qry X ()
act
focusNextMatchOrDo :: Query Bool -> X () -> Seq Window -> X ()
focusNextMatchOrDo :: Query Bool -> X () -> Seq Window -> X ()
focusNextMatchOrDo Query Bool
qry X ()
act = forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> Seq a -> m (Maybe a)
findM (forall a. Query a -> Window -> X a
runQuery Query Bool
qry)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall b a. b -> (a -> b) -> Maybe a -> b
maybe X ()
act ((WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a i l sd.
(Eq s, Eq a, Eq i) =>
a -> StackSet i l a s sd -> StackSet i l a s sd
SS.focusWindow)
orderedWindowList :: Direction -> X (Seq Window)
orderedWindowList :: Direction -> X (Seq Window)
orderedWindowList Direction
History = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(HistoryDB Maybe Window
w Seq Window
ws) -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Seq Window
ws (Seq Window
ws forall a. Seq a -> a -> Seq a
|>) Maybe Window
w) forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
orderedWindowList Direction
dir = forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
ss -> do
Seq WorkspaceId
wsids <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall a. [a] -> Seq a
Seq.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: * -> *). XConfig l -> [WorkspaceId]
workspaces forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config)
let wspcs :: Seq WindowSpace
wspcs = WindowSet -> Seq WorkspaceId -> Seq WindowSpace
orderedWorkspaceList WindowSet
ss Seq WorkspaceId
wsids
wins :: Seq Window
wins = forall {a}. Direction -> Seq a -> Seq a
dirfun Direction
dir
forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Seq a -> Seq a -> Seq a
(><) forall a. Seq a
Seq.empty
forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. [a] -> Seq a
Seq.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe (Stack a) -> [a]
SS.integrate' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
SS.stack) Seq WindowSpace
wspcs
cur :: Maybe Window
cur = forall i l a s sd. StackSet i l a s sd -> Maybe a
SS.peek WindowSet
ss
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Seq Window
wins (forall {a}. Eq a => Seq a -> a -> Seq a
rotfun Seq Window
wins) Maybe Window
cur
where
dirfun :: Direction -> Seq a -> Seq a
dirfun Direction
Backward = forall a. Seq a -> Seq a
Seq.reverse
dirfun Direction
_ = forall a. a -> a
id
rotfun :: Seq a -> a -> Seq a
rotfun Seq a
wins a
x = forall a. Seq a -> Seq a
rotate forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Seq a -> Seq a
rotateTo (forall a. Eq a => a -> a -> Bool
== a
x) Seq a
wins
orderedWorkspaceList :: WindowSet -> Seq String -> Seq WindowSpace
orderedWorkspaceList :: WindowSet -> Seq WorkspaceId -> Seq WindowSpace
orderedWorkspaceList WindowSet
ss Seq WorkspaceId
wsids = forall a. (a -> Bool) -> Seq a -> Seq a
rotateTo forall {l} {a}. Workspace WorkspaceId l a -> Bool
isCurWS Seq WindowSpace
wspcs'
where
wspcs :: [WindowSpace]
wspcs = forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
SS.workspaces WindowSet
ss
wspcsMap :: Map WorkspaceId WindowSpace
wspcsMap = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Map WorkspaceId WindowSpace
m WindowSpace
ws -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (forall i l a. Workspace i l a -> i
SS.tag WindowSpace
ws) WindowSpace
ws Map WorkspaceId WindowSpace
m) forall k a. Map k a
Map.empty [WindowSpace]
wspcs
wspcs' :: Seq WindowSpace
wspcs' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map WorkspaceId WindowSpace
wspcsMap forall k a. Ord k => Map k a -> k -> a
!) Seq WorkspaceId
wsids
isCurWS :: Workspace WorkspaceId l a -> Bool
isCurWS Workspace WorkspaceId l a
ws = forall i l a. Workspace i l a -> i
SS.tag Workspace WorkspaceId l a
ws forall a. Eq a => a -> a -> Bool
== forall i l a. Workspace i l a -> i
SS.tag (forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
SS.workspace forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
SS.current WindowSet
ss)
data HistoryDB = HistoryDB (Maybe Window)
(Seq Window)
deriving (ReadPrec [HistoryDB]
ReadPrec HistoryDB
Int -> ReadS HistoryDB
ReadS [HistoryDB]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HistoryDB]
$creadListPrec :: ReadPrec [HistoryDB]
readPrec :: ReadPrec HistoryDB
$creadPrec :: ReadPrec HistoryDB
readList :: ReadS [HistoryDB]
$creadList :: ReadS [HistoryDB]
readsPrec :: Int -> ReadS HistoryDB
$creadsPrec :: Int -> ReadS HistoryDB
Read, Int -> HistoryDB -> ShowS
[HistoryDB] -> ShowS
HistoryDB -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [HistoryDB] -> ShowS
$cshowList :: [HistoryDB] -> ShowS
show :: HistoryDB -> WorkspaceId
$cshow :: HistoryDB -> WorkspaceId
showsPrec :: Int -> HistoryDB -> ShowS
$cshowsPrec :: Int -> HistoryDB -> ShowS
Show, forall x. Rep HistoryDB x -> HistoryDB
forall x. HistoryDB -> Rep HistoryDB x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HistoryDB x -> HistoryDB
$cfrom :: forall x. HistoryDB -> Rep HistoryDB x
Generic, HistoryDB -> ()
forall a. (a -> ()) -> NFData a
rnf :: HistoryDB -> ()
$crnf :: HistoryDB -> ()
NFData)
instance ExtensionClass HistoryDB where
initialValue :: HistoryDB
initialValue = Maybe Window -> Seq Window -> HistoryDB
HistoryDB forall a. Maybe a
Nothing forall a. Seq a
Seq.empty
extensionType :: HistoryDB -> StateExtension
extensionType = forall a. (Read a, Show a, ExtensionClass a) => a -> StateExtension
PersistentExtension
historyHook :: X ()
historyHook :: X ()
historyHook = (forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put forall a b. (a -> b) -> a -> b
$!) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NFData a => a -> a
force forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HistoryDB -> X HistoryDB
updateHistory forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
updateHistory :: HistoryDB -> X HistoryDB
updateHistory :: HistoryDB -> X HistoryDB
updateHistory (HistoryDB Maybe Window
oldcur Seq Window
oldhist) = forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
ss ->
let newcur :: Maybe Window
newcur = forall i l a s sd. StackSet i l a s sd -> Maybe a
SS.peek WindowSet
ss
wins :: Set Window
wins = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a i l s sd. Eq a => StackSet i l a s sd -> [a]
SS.allWindows WindowSet
ss
newhist :: Seq Window
newhist = forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Window
wins) (forall {a}. Maybe a -> Seq a -> Seq a
ins Maybe Window
oldcur Seq Window
oldhist)
in forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe Window -> Seq Window -> HistoryDB
HistoryDB Maybe Window
newcur (forall {a}. Eq a => Maybe a -> Seq a -> Seq a
del Maybe Window
newcur Seq Window
newhist)
where
ins :: Maybe a -> Seq a -> Seq a
ins Maybe a
x Seq a
xs = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Seq a
xs (forall a. a -> Seq a -> Seq a
<| Seq a
xs) Maybe a
x
del :: Maybe a -> Seq a -> Seq a
del Maybe a
x Seq a
xs = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Seq a
xs (\a
x' -> forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (forall a. Eq a => a -> a -> Bool
/= a
x') Seq a
xs) Maybe a
x
rotate :: Seq a -> Seq a
rotate :: forall a. Seq a -> Seq a
rotate Seq a
xs = forall {a}. ViewL a -> Seq a
rotate' (forall a. Seq a -> ViewL a
viewl Seq a
xs)
where
rotate' :: ViewL a -> Seq a
rotate' ViewL a
EmptyL = forall a. Seq a
Seq.empty
rotate' (a
x' :< Seq a
xs') = Seq a
xs' forall a. Seq a -> a -> Seq a
|> a
x'
rotateTo :: (a -> Bool) -> Seq a -> Seq a
rotateTo :: forall a. (a -> Bool) -> Seq a -> Seq a
rotateTo a -> Bool
cond Seq a
xs = let (Seq a
lxs, Seq a
rxs) = forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
Seq.breakl a -> Bool
cond Seq a
xs in Seq a
rxs forall a. Seq a -> Seq a -> Seq a
>< Seq a
lxs
findM :: Monad m => (a -> m Bool) -> Seq a -> m (Maybe a)
findM :: forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> Seq a -> m (Maybe a)
findM a -> m Bool
cond Seq a
xs = forall {m :: * -> *} {a}.
Monad m =>
(a -> m Bool) -> ViewL a -> m (Maybe a)
findM' a -> m Bool
cond (forall a. Seq a -> ViewL a
viewl Seq a
xs)
where
findM' :: (a -> m Bool) -> ViewL a -> m (Maybe a)
findM' a -> m Bool
_ ViewL a
EmptyL = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
findM' a -> m Bool
qry (a
x' :< Seq a
xs') = do
Bool
isMatch <- a -> m Bool
qry a
x'
if Bool
isMatch
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
x')
else forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> Seq a -> m (Maybe a)
findM a -> m Bool
qry Seq a
xs'
isOnAnyVisibleWS :: Query Bool
isOnAnyVisibleWS :: Query Bool
isOnAnyVisibleWS = do
Window
w <- forall r (m :: * -> *). MonadReader r m => m r
ask
WindowSet
ws <- forall a. X a -> Query a
liftX forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
let allVisible :: [Window]
allVisible = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall a. Stack a -> [a]
SS.integrate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
SS.stack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
SS.workspace) (forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
SS.current WindowSet
wsforall a. a -> [a] -> [a]
:forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
SS.visible WindowSet
ws)
visibleWs :: Bool
visibleWs = Window
w forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
allVisible
unfocused :: Bool
unfocused = forall a. a -> Maybe a
Just Window
w forall a. Eq a => a -> a -> Bool
/= forall i l a s sd. StackSet i l a s sd -> Maybe a
SS.peek WindowSet
ws
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool
visibleWs Bool -> Bool -> Bool
&& Bool
unfocused