-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Prompt.Window
-- Description :  A prompt for bringing windows to you, and bring you to windows.
-- Copyright   :  Devin Mullins <me@twifkak.com>
--                Andrea Rossato <andrea.rossato@unibz.it>
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Devin  Mullins <me@twifkak.com>
--                Andrea Rossato <andrea.rossato@unibz.it>
-- Stability   :  unstable
-- Portability :  unportable
--
-- xprompt operations to bring windows to you, and bring you to windows.
--
-----------------------------------------------------------------------------

module XMonad.Prompt.Window
    (
    -- * Usage
    -- $usage
    WindowPrompt(..),
    windowPrompt,
    windowMultiPrompt,
    allWindows,
    allApplications,
    wsWindows,
    XWindowMap,
    ) where

import XMonad.Prelude (forM)
import qualified Data.Map as M

import qualified XMonad.StackSet as W
import XMonad
import XMonad.Prompt
import XMonad.Actions.CopyWindow
import XMonad.Actions.WindowBringer
import XMonad.Util.NamedWindows

-- $usage
-- WindowPrompt brings windows to you and you to windows. That is to
-- say, it pops up a prompt with window names, in case you forgot
-- where you left your XChat. It also offers helpers to build the
-- subset of windows which is used for the prompt completion.
--
-- You can use this module with the following in your @xmonad.hs@:
--
-- > import XMonad.Prompt
-- > import XMonad.Prompt.Window
--
-- and in the keys definition:
--
-- > , ((modm .|. shiftMask, xK_g     ), windowPrompt def Goto wsWindows)
-- > , ((modm .|. shiftMask, xK_b     ), windowPrompt def Bring allWindows)
--
-- The autoComplete option is a handy complement here:
--
-- > , ((modm .|. shiftMask, xK_g     ), windowPrompt
-- >                                        def { autoComplete = Just 500000 }
-- >                                        Goto allWindows)
--
-- The \'500000\' is the number of microseconds to pause before sending you to
-- your new window. This is useful so that you don't accidentally send some
-- keystrokes to the selected client.
--
-- For detailed instruction on editing the key binding see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.

-- Describe actions that can applied  on the selected window
data WindowPrompt = Goto | Bring | BringCopy | BringToMaster | WithWindow String (Window ->  X())
instance XPrompt WindowPrompt where
    showXPrompt :: WindowPrompt -> WorkspaceId
showXPrompt WindowPrompt
Goto      = WorkspaceId
"Go to window: "
    showXPrompt WindowPrompt
Bring     = WorkspaceId
"Bring window: "
    showXPrompt WindowPrompt
BringToMaster
                          = WorkspaceId
"Bring window to master: "
    showXPrompt WindowPrompt
BringCopy = WorkspaceId
"Bring a copy: "
    showXPrompt (WithWindow WorkspaceId
xs Window -> X ()
_) = WorkspaceId
xs
    commandToComplete :: WindowPrompt -> WorkspaceId -> WorkspaceId
commandToComplete WindowPrompt
_ WorkspaceId
c = WorkspaceId
c
    nextCompletion :: WindowPrompt -> WorkspaceId -> [WorkspaceId] -> WorkspaceId
nextCompletion      WindowPrompt
_ = WorkspaceId -> [WorkspaceId] -> WorkspaceId
getNextCompletion

-- | Internal type used for the multiple mode prompt.
data WindowModePrompt =
  WindowModePrompt WindowPrompt (M.Map String Window) (String -> String -> Bool)

instance XPrompt WindowModePrompt where
    showXPrompt :: WindowModePrompt -> WorkspaceId
showXPrompt (WindowModePrompt WindowPrompt
action Map WorkspaceId Window
_ WorkspaceId -> WorkspaceId -> Bool
_) =
        WindowPrompt -> WorkspaceId
forall t. XPrompt t => t -> WorkspaceId
showXPrompt WindowPrompt
action

    completionFunction :: WindowModePrompt -> ComplFunction
completionFunction (WindowModePrompt WindowPrompt
_ Map WorkspaceId Window
winmap WorkspaceId -> WorkspaceId -> Bool
predicate) WorkspaceId
s =
        [WorkspaceId] -> IO [WorkspaceId]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([WorkspaceId] -> IO [WorkspaceId])
-> (Map WorkspaceId Window -> [WorkspaceId])
-> Map WorkspaceId Window
-> IO [WorkspaceId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkspaceId -> Bool) -> [WorkspaceId] -> [WorkspaceId]
forall a. (a -> Bool) -> [a] -> [a]
filter (WorkspaceId -> WorkspaceId -> Bool
predicate WorkspaceId
s) ([WorkspaceId] -> [WorkspaceId])
-> (Map WorkspaceId Window -> [WorkspaceId])
-> Map WorkspaceId Window
-> [WorkspaceId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((WorkspaceId, Window) -> WorkspaceId)
-> [(WorkspaceId, Window)] -> [WorkspaceId]
forall a b. (a -> b) -> [a] -> [b]
map (WorkspaceId, Window) -> WorkspaceId
forall a b. (a, b) -> a
fst ([(WorkspaceId, Window)] -> [WorkspaceId])
-> (Map WorkspaceId Window -> [(WorkspaceId, Window)])
-> Map WorkspaceId Window
-> [WorkspaceId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map WorkspaceId Window -> [(WorkspaceId, Window)]
forall k a. Map k a -> [(k, a)]
M.toList (Map WorkspaceId Window -> IO [WorkspaceId])
-> Map WorkspaceId Window -> IO [WorkspaceId]
forall a b. (a -> b) -> a -> b
$ Map WorkspaceId Window
winmap

    modeAction :: WindowModePrompt -> WorkspaceId -> WorkspaceId -> X ()
modeAction (WindowModePrompt WindowPrompt
action Map WorkspaceId Window
winmap WorkspaceId -> WorkspaceId -> Bool
_) WorkspaceId
buf WorkspaceId
auto = do
        let name :: WorkspaceId
name = if WorkspaceId -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null WorkspaceId
auto then WorkspaceId
buf else WorkspaceId
auto
            a :: WorkspaceId -> X ()
a = case WindowPrompt
action of
                  WindowPrompt
Goto           -> WorkspaceId -> X ()
gotoAction
                  WindowPrompt
Bring          -> WorkspaceId -> X ()
bringAction
                  WindowPrompt
BringCopy      -> WorkspaceId -> X ()
bringCopyAction
                  WindowPrompt
BringToMaster  -> WorkspaceId -> X ()
bringToMaster
                  WithWindow WorkspaceId
_ Window -> X ()
f -> (Window -> X ()) -> WorkspaceId -> X ()
forall {m :: * -> *}.
Monad m =>
(Window -> m ()) -> WorkspaceId -> m ()
withWindow Window -> X ()
f
        WorkspaceId -> X ()
a WorkspaceId
name
      where
        withWindow :: (Window -> m ()) -> WorkspaceId -> m ()
withWindow Window -> m ()
f     = (Maybe Window -> (Window -> m ()) -> m ())
-> (Window -> m ()) -> Maybe Window -> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Maybe Window -> (Window -> m ()) -> m ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Window -> m ()
f (Maybe Window -> m ())
-> (WorkspaceId -> Maybe Window) -> WorkspaceId -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkspaceId -> Map WorkspaceId Window -> Maybe Window)
-> Map WorkspaceId Window -> WorkspaceId -> Maybe Window
forall a b c. (a -> b -> c) -> b -> a -> c
flip WorkspaceId -> Map WorkspaceId Window -> Maybe Window
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Map WorkspaceId Window
winmap
        winAction :: (Window -> WindowSet -> WindowSet) -> WorkspaceId -> X ()
winAction Window -> WindowSet -> WindowSet
a      = (Window -> X ()) -> WorkspaceId -> X ()
forall {m :: * -> *}.
Monad m =>
(Window -> m ()) -> WorkspaceId -> m ()
withWindow ((WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (Window -> WindowSet -> WindowSet) -> Window -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> WindowSet -> WindowSet
a)
        gotoAction :: WorkspaceId -> X ()
gotoAction       = (Window -> WindowSet -> WindowSet) -> WorkspaceId -> X ()
winAction Window -> WindowSet -> WindowSet
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
W.focusWindow
        bringAction :: WorkspaceId -> X ()
bringAction      = (Window -> WindowSet -> WindowSet) -> WorkspaceId -> X ()
winAction Window -> WindowSet -> WindowSet
bringWindow
        bringCopyAction :: WorkspaceId -> X ()
bringCopyAction  = (Window -> WindowSet -> WindowSet) -> WorkspaceId -> X ()
winAction Window -> WindowSet -> WindowSet
bringCopyWindow
        bringToMaster :: WorkspaceId -> X ()
bringToMaster    = (Window -> WindowSet -> WindowSet) -> WorkspaceId -> X ()
winAction (\Window
w WindowSet
s -> WindowSet -> WindowSet
forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.shiftMaster (WindowSet -> WindowSet)
-> (WindowSet -> WindowSet) -> WindowSet -> WindowSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> WindowSet -> WindowSet
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
W.focusWindow Window
w (WindowSet -> WindowSet) -> WindowSet -> WindowSet
forall a b. (a -> b) -> a -> b
$ Window -> WindowSet -> WindowSet
bringWindow Window
w WindowSet
s)

-- | A helper to get the map of all windows.
allWindows :: XWindowMap
allWindows :: XWindowMap
allWindows = XWindowMap
windowMap

-- | A helper to get the map of all applications
allApplications :: XWindowMap
allApplications :: XWindowMap
allApplications = XWindowMap
windowAppMap

-- | A helper to get the map of windows of the current workspace.
wsWindows :: XWindowMap
wsWindows :: XWindowMap
wsWindows = (WindowSet -> X [Window]) -> X [Window]
forall a. (WindowSet -> X a) -> X a
withWindowSet ([Window] -> X [Window]
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Window] -> X [Window])
-> (WindowSet -> [Window]) -> WindowSet -> X [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> [Window]
forall i l a s sd. StackSet i l a s sd -> [a]
W.index) X [Window] -> ([Window] -> XWindowMap) -> XWindowMap
forall a b. X a -> (a -> X b) -> X b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Window] -> XWindowMap
winmap
    where
      winmap :: [Window] -> XWindowMap
winmap = ([(WorkspaceId, Window)] -> Map WorkspaceId Window)
-> X [(WorkspaceId, Window)] -> XWindowMap
forall a b. (a -> b) -> X a -> X b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(WorkspaceId, Window)] -> Map WorkspaceId Window
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (X [(WorkspaceId, Window)] -> XWindowMap)
-> ([Window] -> X [(WorkspaceId, Window)])
-> [Window]
-> XWindowMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window -> X (WorkspaceId, Window))
-> [Window] -> X [(WorkspaceId, Window)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Window -> X (WorkspaceId, Window)
pair
      pair :: Window -> X (WorkspaceId, Window)
pair Window
w = do WorkspaceId
name <- NamedWindow -> WorkspaceId
forall a. Show a => a -> WorkspaceId
show (NamedWindow -> WorkspaceId) -> X NamedWindow -> X WorkspaceId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Window -> X NamedWindow
getName Window
w
                  (WorkspaceId, Window) -> X (WorkspaceId, Window)
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (WorkspaceId
name, Window
w)

-- | A Map where keys are pretty printable window names and values are
-- Xmonad windows identifier.
type XWindowMap = X (M.Map String Window)

-- | Pops open a prompt with window titles belonging to
-- winmap. Choose one, and an action is applied on the
-- selected window, according to WindowPrompt.
windowPrompt :: XPConfig -> WindowPrompt -> XWindowMap -> X ()
windowPrompt :: XPConfig -> WindowPrompt -> XWindowMap -> X ()
windowPrompt XPConfig
c WindowPrompt
t XWindowMap
winmap = do
  Map WorkspaceId Window
wm <- XWindowMap
winmap
  let mode :: WindowModePrompt
mode     = WindowPrompt
-> Map WorkspaceId Window
-> (WorkspaceId -> WorkspaceId -> Bool)
-> WindowModePrompt
WindowModePrompt WindowPrompt
t Map WorkspaceId Window
wm (XPConfig -> WorkspaceId -> WorkspaceId -> Bool
searchPredicate XPConfig
c)
      action :: WorkspaceId -> WorkspaceId -> X ()
action   = WindowModePrompt -> WorkspaceId -> WorkspaceId -> X ()
forall t. XPrompt t => t -> WorkspaceId -> WorkspaceId -> X ()
modeAction WindowModePrompt
mode
      compList :: ComplFunction
compList = WindowModePrompt -> ComplFunction
forall t. XPrompt t => t -> ComplFunction
completionFunction WindowModePrompt
mode
  WindowPrompt
-> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
mkXPrompt WindowPrompt
t XPConfig
c ComplFunction
compList (\WorkspaceId
s -> WorkspaceId -> WorkspaceId -> X ()
action WorkspaceId
s WorkspaceId
s)

-- | Like 'windowPrompt', but uses the multiple modes feature of
-- @Prompt@ (via 'mkXPromptWithModes').
--
-- Given a list of actions along with the windows they should work
-- with, display the appropriate prompt with the ability to switch
-- between them using the @changeModeKey@.
--
-- For example, to have a prompt that first shows you all windows, but
-- allows you to narrow the list down to just the windows on the
-- current workspace:
--
-- > windowMultiPrompt config [(Goto, allWindows), (Goto, wsWindows)]
windowMultiPrompt :: XPConfig -> [(WindowPrompt, XWindowMap)] -> X ()
windowMultiPrompt :: XPConfig -> [(WindowPrompt, XWindowMap)] -> X ()
windowMultiPrompt XPConfig
c [(WindowPrompt, XWindowMap)]
modes = do
  [XPType]
modes' <- [(WindowPrompt, XWindowMap)]
-> ((WindowPrompt, XWindowMap) -> X XPType) -> X [XPType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(WindowPrompt, XWindowMap)]
modes (((WindowPrompt, XWindowMap) -> X XPType) -> X [XPType])
-> ((WindowPrompt, XWindowMap) -> X XPType) -> X [XPType]
forall a b. (a -> b) -> a -> b
$ \(WindowPrompt
t, XWindowMap
wm) -> do
    Map WorkspaceId Window
wm' <- XWindowMap
wm
    XPType -> X XPType
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (XPType -> X XPType)
-> (WindowModePrompt -> XPType) -> WindowModePrompt -> X XPType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowModePrompt -> XPType
forall p. XPrompt p => p -> XPType
XPT (WindowModePrompt -> X XPType) -> WindowModePrompt -> X XPType
forall a b. (a -> b) -> a -> b
$ WindowPrompt
-> Map WorkspaceId Window
-> (WorkspaceId -> WorkspaceId -> Bool)
-> WindowModePrompt
WindowModePrompt WindowPrompt
t Map WorkspaceId Window
wm' (XPConfig -> WorkspaceId -> WorkspaceId -> Bool
searchPredicate XPConfig
c)

  [XPType] -> XPConfig -> X ()
mkXPromptWithModes [XPType]
modes' XPConfig
c

-- | Brings a copy of the specified window into the current workspace.
bringCopyWindow :: Window -> WindowSet -> WindowSet
bringCopyWindow :: Window -> WindowSet -> WindowSet
bringCopyWindow Window
w WindowSet
ws = Window -> WorkspaceId -> WindowSet -> WindowSet
forall a i s l sd.
(Eq a, Eq i, Eq s) =>
a -> i -> StackSet i l a s sd -> StackSet i l a s sd
copyWindow Window
w (WindowSet -> WorkspaceId
forall i l a s sd. StackSet i l a s sd -> i
W.currentTag WindowSet
ws) WindowSet
ws