{-# language DeriveGeneric, DeriveAnyClass #-}
----------------------------------------------------------------------
-- |
-- Module      : XMonad.Actions.GroupNavigation
-- Description : Cycle through groups of windows across workspaces.
-- Copyright   : (c) nzeh@cs.dal.ca
-- License     : BSD3-style (see LICENSE)
--
-- Maintainer  : nzeh@cs.dal.ca
-- Stability   : unstable
-- Portability : unportable
--
-- Provides methods for cycling through groups of windows across
-- workspaces, ignoring windows that do not belong to this group.  A
-- group consists of all windows matching a user-provided boolean
-- query.
--
-- Also provides a method for jumping back to the most recently used
-- window in any given group, and predefined groups.
--
----------------------------------------------------------------------

module XMonad.Actions.GroupNavigation ( -- * Usage
                                        -- $usage
                                        Direction (..)
                                      , nextMatch
                                      , nextMatchOrDo
                                      , nextMatchWithThis
                                      , historyHook

                                        -- * Utilities
                                        -- $utilities
                                      , 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

{- $usage

Import the module into your @xmonad.hs@:

> import XMonad.Actions.GroupNavigation

To support cycling forward and backward through all xterm windows, add
something like this to your keybindings:

> , ((modm              , xK_t), nextMatch Forward  (className =? "XTerm"))
> , ((modm .|. shiftMask, xK_t), nextMatch Backward (className =? "XTerm"))

These key combinations do nothing if there is no xterm window open.
If you rather want to open a new xterm window if there is no open
xterm window, use 'nextMatchOrDo' instead:

> , ((modm              , xK_t), nextMatchOrDo Forward  (className =? "XTerm") (spawn "xterm"))
> , ((modm .|. shiftMask, xK_t), nextMatchOrDo Backward (className =? "XTerm") (spawn "xterm"))

You can use 'nextMatchWithThis' with an arbitrary query to cycle
through all windows for which this query returns the same value as the
current window.  For example, to cycle through all windows in the same
window class as the current window use:

> , ((modm , xK_f), nextMatchWithThis Forward  className)
> , ((modm , xK_b), nextMatchWithThis Backward className)

Finally, you can define keybindings to jump to the most recent window
matching a certain Boolean query.  To do this, you need to add
'historyHook' to your logHook:

> main = xmonad $ def { logHook = historyHook }

Then the following keybindings, for example, allow you to return to
the most recent xterm or emacs window or to simply to the most recent
window:

> , ((modm .|. controlMask, xK_e),         nextMatch History (className =? "Emacs"))
> , ((modm .|. controlMask, xK_t),         nextMatch History (className =? "XTerm"))
> , ((modm                , xK_BackSpace), nextMatch History (return True))

Again, you can use 'nextMatchOrDo' instead of 'nextMatch' if you want
to execute an action if no window matching the query exists. -}

--- Basic cyclic navigation based on queries -------------------------

-- | The direction in which to look for the next match
data Direction = Forward  -- ^ Forward from current window or workspace
               | Backward -- ^ Backward from current window or workspace
               | History  -- ^ Backward in history

-- | Focuses the next window for which the given query produces the
-- same result as the currently focused window.  Does nothing if there
-- is no focused window (i.e., the current workspace is empty).
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)

-- | Focuses the next window that matches the given boolean query.
-- Does nothing if there is no such window.  This is the same as
-- 'nextMatchOrDo' with alternate action @return ()@.
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 ())

-- | Focuses the next window that matches the given boolean query.  If
-- there is no such window, perform the given action instead.
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

-- Produces the action to perform depending on whether there's a
-- matching window
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)

-- Returns the list of windows ordered by workspace as specified in
-- @xmonad.hs@.
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

-- Returns the ordered workspace list as specified in @xmonad.hs@.
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)

--- History navigation, requires a layout modifier -------------------

-- The state extension that holds the history information
data HistoryDB = HistoryDB (Maybe Window) -- currently focused window
                           (Seq Window)   -- previously focused windows
               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

-- | Action that needs to be executed as a logHook to maintain the
-- focus history of all windows as the WindowSet changes.
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

-- Updates the history in response to a WindowSet change
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

--- Some sequence helpers --------------------------------------------

-- Rotates the sequence by one position
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'

-- Rotates the sequence until an element matching the given condition
-- is at the beginning of the sequence.
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

--- A monadic find ---------------------------------------------------

-- Applies the given action to every sequence element in turn until
-- the first element is found for which the action returns true.  The
-- remaining elements in the sequence are ignored.
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'


-- $utilities
-- #utilities#
-- Below are handy queries for use with 'nextMatch', 'nextMatchOrDo',
-- and 'nextMatchWithThis'.

-- | A query that matches all windows on visible workspaces. This is
-- useful for configurations with multiple screens, and matches even
-- invisible windows.
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