-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.Commands
-- Description :  Run internal xmonad commands using a dmenu menu.
-- Copyright   :  (c) David Glasser 2007
-- License     :  BSD3
--
-- Maintainer  :  glasser@mit.edu
-- Stability   :  stable
-- Portability :  portable
--
-- Allows you to run internal xmonad commands (X () actions) using
-- a dmenu menu in addition to key bindings.  Requires dmenu and
-- the Dmenu XMonad.Actions module.
--
-----------------------------------------------------------------------------

module XMonad.Actions.Commands (
                             -- * Usage
                             -- $usage
                             commandMap,
                             runCommand,
                             runCommandConfig,
                             runCommand',
                             workspaceCommands,
                             screenCommands,
                             defaultCommands
                              ) where

import XMonad
import XMonad.StackSet hiding (workspaces)
import XMonad.Util.Dmenu (dmenu)

import qualified Data.Map as M
import System.Exit
import XMonad.Prelude

-- $usage
--
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- >    import XMonad.Actions.Commands
--
-- Then add a keybinding to the runCommand action:
--
-- >    , ((modm .|. controlMask, xK_y), commands >>= runCommand)
--
-- and define the list of commands you want to use:
--
-- >    commands :: X [(String, X ())]
-- >    commands = defaultCommands
--
-- Whatever key you bound to will now cause a popup menu of internal
-- xmonad commands to appear.  You can change the commands by changing
-- the contents of the list returned by 'commands'.  (If you like it
-- enough, you may even want to get rid of many of your other key
-- bindings!)
--
-- For detailed instructions on editing your key bindings, see
-- "XMonad.Doc.Extending#Editing_key_bindings".

-- | Create a 'Data.Map.Map' from @String@s to xmonad actions from a
--   list of pairs.
commandMap :: [(String, X ())] -> M.Map String (X ())
commandMap :: [(WorkspaceId, X ())] -> Map WorkspaceId (X ())
commandMap = [(WorkspaceId, X ())] -> Map WorkspaceId (X ())
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList

-- | Generate a list of commands to switch to\/send windows to workspaces.
workspaceCommands :: X [(String, X ())]
workspaceCommands :: X [(WorkspaceId, X ())]
workspaceCommands = (XConf -> [WorkspaceId]) -> X [WorkspaceId]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (XConfig Layout -> [WorkspaceId]
forall (l :: * -> *). XConfig l -> [WorkspaceId]
workspaces (XConfig Layout -> [WorkspaceId])
-> (XConf -> XConfig Layout) -> XConf -> [WorkspaceId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config) X [WorkspaceId]
-> ([WorkspaceId] -> X [(WorkspaceId, X ())])
-> X [(WorkspaceId, X ())]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[WorkspaceId]
spaces -> [(WorkspaceId, X ())] -> X [(WorkspaceId, X ())]
forall (m :: * -> *) a. Monad m => a -> m a
return
                            [( WorkspaceId
m WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId -> WorkspaceId
forall a. Show a => a -> WorkspaceId
show WorkspaceId
i, (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ WorkspaceId -> WindowSet -> WindowSet
f WorkspaceId
i)
                                | WorkspaceId
i <- [WorkspaceId]
spaces
                                , (WorkspaceId -> WindowSet -> WindowSet
f, WorkspaceId
m) <- [(WorkspaceId -> WindowSet -> WindowSet
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
view, WorkspaceId
"view"), (WorkspaceId -> WindowSet -> WindowSet
forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
shift, WorkspaceId
"shift")] ]

-- | Generate a list of commands dealing with multiple screens.
screenCommands :: [(String, X ())]
screenCommands :: [(WorkspaceId, X ())]
screenCommands = [( WorkspaceId
m WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ Int -> WorkspaceId
forall a. Show a => a -> WorkspaceId
show Int
sc, ScreenId -> X (Maybe WorkspaceId)
screenWorkspace (Int -> ScreenId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sc) X (Maybe WorkspaceId) -> (Maybe WorkspaceId -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe WorkspaceId -> (WorkspaceId -> X ()) -> X ())
-> (WorkspaceId -> X ()) -> Maybe WorkspaceId -> X ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Maybe WorkspaceId -> (WorkspaceId -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust ((WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WorkspaceId -> WindowSet -> WindowSet) -> WorkspaceId -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId -> WindowSet -> WindowSet
f))
                      | Int
sc <- [Int
0, Int
1]::[Int] -- TODO: adapt to screen changes
                      , (WorkspaceId -> WindowSet -> WindowSet
f, WorkspaceId
m) <- [(WorkspaceId -> WindowSet -> WindowSet
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
view, WorkspaceId
"screen"), (WorkspaceId -> WindowSet -> WindowSet
forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
shift, WorkspaceId
"screen-to-")]
                 ]

-- | A nice pre-defined list of commands.
defaultCommands :: X [(String, X ())]
defaultCommands :: X [(WorkspaceId, X ())]
defaultCommands = do
    [(WorkspaceId, X ())]
wscmds <- X [(WorkspaceId, X ())]
workspaceCommands
    [(WorkspaceId, X ())] -> X [(WorkspaceId, X ())]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(WorkspaceId, X ())] -> X [(WorkspaceId, X ())])
-> [(WorkspaceId, X ())] -> X [(WorkspaceId, X ())]
forall a b. (a -> b) -> a -> b
$ [(WorkspaceId, X ())]
wscmds [(WorkspaceId, X ())]
-> [(WorkspaceId, X ())] -> [(WorkspaceId, X ())]
forall a. [a] -> [a] -> [a]
++ [(WorkspaceId, X ())]
screenCommands [(WorkspaceId, X ())]
-> [(WorkspaceId, X ())] -> [(WorkspaceId, X ())]
forall a. [a] -> [a] -> [a]
++ [(WorkspaceId, X ())]
otherCommands
 where
    otherCommands :: [(WorkspaceId, X ())]
otherCommands =
        [ (WorkspaceId
"shrink"              , Resize -> X ()
forall a. Message a => a -> X ()
sendMessage Resize
Shrink                               )
        , (WorkspaceId
"expand"              , Resize -> X ()
forall a. Message a => a -> X ()
sendMessage Resize
Expand                               )
        , (WorkspaceId
"next-layout"         , ChangeLayout -> X ()
forall a. Message a => a -> X ()
sendMessage ChangeLayout
NextLayout                           )
        , (WorkspaceId
"default-layout"      , (XConf -> Layout Window) -> X (Layout Window)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (XConfig Layout -> Layout Window
forall (l :: * -> *). XConfig l -> l Window
layoutHook (XConfig Layout -> Layout Window)
-> (XConf -> XConfig Layout) -> XConf -> Layout Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config) X (Layout Window) -> (Layout Window -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Layout Window -> X ()
setLayout         )
        , (WorkspaceId
"restart-wm"          , WorkspaceId -> Bool -> X ()
restart WorkspaceId
"xmonad" Bool
True                            )
        , (WorkspaceId
"restart-wm-no-resume", WorkspaceId -> Bool -> X ()
restart WorkspaceId
"xmonad" Bool
False                           )
        , (WorkspaceId
"xterm"               , WorkspaceId -> X ()
forall (m :: * -> *). MonadIO m => WorkspaceId -> m ()
spawn (WorkspaceId -> X ()) -> X WorkspaceId -> X ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (XConf -> WorkspaceId) -> X WorkspaceId
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (XConfig Layout -> WorkspaceId
forall (l :: * -> *). XConfig l -> WorkspaceId
terminal (XConfig Layout -> WorkspaceId)
-> (XConf -> XConfig Layout) -> XConf -> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  XConf -> XConfig Layout
config)              )
        , (WorkspaceId
"run"                 , WorkspaceId -> X ()
forall (m :: * -> *). MonadIO m => WorkspaceId -> m ()
spawn WorkspaceId
"exe=`dmenu_path | dmenu -b` && exec $exe" )
        , (WorkspaceId
"kill"                , X ()
kill                                             )
        , (WorkspaceId
"refresh"             , X ()
refresh                                          )
        , (WorkspaceId
"focus-up"            , (WindowSet -> WindowSet) -> X ()
windows WindowSet -> WindowSet
forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
focusUp                                  )
        , (WorkspaceId
"focus-down"          , (WindowSet -> WindowSet) -> X ()
windows WindowSet -> WindowSet
forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
focusDown                                )
        , (WorkspaceId
"swap-up"             , (WindowSet -> WindowSet) -> X ()
windows WindowSet -> WindowSet
forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
swapUp                                   )
        , (WorkspaceId
"swap-down"           , (WindowSet -> WindowSet) -> X ()
windows WindowSet -> WindowSet
forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
swapDown                                 )
        , (WorkspaceId
"swap-master"         , (WindowSet -> WindowSet) -> X ()
windows WindowSet -> WindowSet
forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
swapMaster                               )
        , (WorkspaceId
"sink"                , (Window -> X ()) -> X ()
withFocused ((Window -> X ()) -> X ()) -> (Window -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ (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
forall a i l s sd.
Ord a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
sink                     )
        , (WorkspaceId
"quit-wm"             , IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO ()
forall a. IO a
exitSuccess                                   )
        ]

-- | Given a list of command\/action pairs, prompt the user to choose a
--   command using dmenu and return the corresponding action.
runCommand :: [(String, X ())] -> X ()
runCommand :: [(WorkspaceId, X ())] -> X ()
runCommand = ([WorkspaceId] -> X WorkspaceId) -> [(WorkspaceId, X ())] -> X ()
runCommandConfig [WorkspaceId] -> X WorkspaceId
forall (m :: * -> *). MonadIO m => [WorkspaceId] -> m WorkspaceId
dmenu


-- | Given a list of command\/action pairs, prompt the user to choose a
--   command using dmenu-compatible launcher and return the corresponding action.
--   See X.U.Dmenu for compatible launchers.
runCommandConfig :: ([String] -> X String) -> [(String, X ())] -> X()
runCommandConfig :: ([WorkspaceId] -> X WorkspaceId) -> [(WorkspaceId, X ())] -> X ()
runCommandConfig [WorkspaceId] -> X WorkspaceId
f [(WorkspaceId, X ())]
cl = do
  let m :: Map WorkspaceId (X ())
m = [(WorkspaceId, X ())] -> Map WorkspaceId (X ())
commandMap [(WorkspaceId, X ())]
cl
  WorkspaceId
choice <- [WorkspaceId] -> X WorkspaceId
f (Map WorkspaceId (X ()) -> [WorkspaceId]
forall k a. Map k a -> [k]
M.keys Map WorkspaceId (X ())
m)
  X () -> Maybe (X ()) -> X ()
forall a. a -> Maybe a -> a
fromMaybe (() -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (WorkspaceId -> Map WorkspaceId (X ()) -> Maybe (X ())
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup WorkspaceId
choice Map WorkspaceId (X ())
m)

-- | Given the name of a command from 'defaultCommands', return the
--   corresponding action (or the null action if the command is not
--   found).
runCommand' :: String -> X ()
runCommand' :: WorkspaceId -> X ()
runCommand' WorkspaceId
c = do
  Map WorkspaceId (X ())
m <- ([(WorkspaceId, X ())] -> Map WorkspaceId (X ()))
-> X [(WorkspaceId, X ())] -> X (Map WorkspaceId (X ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(WorkspaceId, X ())] -> Map WorkspaceId (X ())
commandMap X [(WorkspaceId, X ())]
defaultCommands
  X () -> Maybe (X ()) -> X ()
forall a. a -> Maybe a -> a
fromMaybe (() -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (WorkspaceId -> Map WorkspaceId (X ()) -> Maybe (X ())
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup WorkspaceId
c Map WorkspaceId (X ())
m)