-----------------------------------------------------------------------------
-- |
-- 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 :: [(String, X ())] -> Map String (X ())
commandMap = [(String, X ())] -> Map String (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 [(String, X ())]
workspaceCommands = (XConf -> [String]) -> X [String]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (XConfig Layout -> [String]
forall (l :: * -> *). XConfig l -> [String]
workspaces (XConfig Layout -> [String])
-> (XConf -> XConfig Layout) -> XConf -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config) X [String]
-> ([String] -> X [(String, X ())]) -> X [(String, X ())]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[String]
spaces -> [(String, X ())] -> X [(String, X ())]
forall (m :: * -> *) a. Monad m => a -> m a
return
                            [( String
m String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
i, (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ String -> WindowSet -> WindowSet
f String
i)
                                | String
i <- [String]
spaces
                                , (String -> WindowSet -> WindowSet
f, String
m) <- [(String -> 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, String
"view"), (String -> 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, String
"shift")] ]

-- | Generate a list of commands dealing with multiple screens.
screenCommands :: [(String, X ())]
screenCommands :: [(String, X ())]
screenCommands = [( String
m String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
sc, ScreenId -> X (Maybe String)
screenWorkspace (Int -> ScreenId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sc) X (Maybe String) -> (Maybe String -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe String -> (String -> X ()) -> X ())
-> (String -> X ()) -> Maybe String -> X ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Maybe String -> (String -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust ((WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (String -> WindowSet -> WindowSet) -> String -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> WindowSet -> WindowSet
f))
                      | Int
sc <- [Int
0, Int
1]::[Int] -- TODO: adapt to screen changes
                      , (String -> WindowSet -> WindowSet
f, String
m) <- [(String -> 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, String
"screen"), (String -> 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, String
"screen-to-")]
                 ]

-- | A nice pre-defined list of commands.
defaultCommands :: X [(String, X ())]
defaultCommands :: X [(String, X ())]
defaultCommands = do
    [(String, X ())]
wscmds <- X [(String, X ())]
workspaceCommands
    [(String, X ())] -> X [(String, X ())]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, X ())] -> X [(String, X ())])
-> [(String, X ())] -> X [(String, X ())]
forall a b. (a -> b) -> a -> b
$ [(String, X ())]
wscmds [(String, X ())] -> [(String, X ())] -> [(String, X ())]
forall a. [a] -> [a] -> [a]
++ [(String, X ())]
screenCommands [(String, X ())] -> [(String, X ())] -> [(String, X ())]
forall a. [a] -> [a] -> [a]
++ [(String, X ())]
otherCommands
 where
    otherCommands :: [(String, X ())]
otherCommands =
        [ (String
"shrink"              , Resize -> X ()
forall a. Message a => a -> X ()
sendMessage Resize
Shrink                               )
        , (String
"expand"              , Resize -> X ()
forall a. Message a => a -> X ()
sendMessage Resize
Expand                               )
        , (String
"next-layout"         , ChangeLayout -> X ()
forall a. Message a => a -> X ()
sendMessage ChangeLayout
NextLayout                           )
        , (String
"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         )
        , (String
"restart-wm"          , String -> Bool -> X ()
restart String
"xmonad" Bool
True                            )
        , (String
"restart-wm-no-resume", String -> Bool -> X ()
restart String
"xmonad" Bool
False                           )
        , (String
"xterm"               , String -> X ()
forall (m :: * -> *). MonadIO m => String -> m ()
spawn (String -> X ()) -> X String -> X ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (XConf -> String) -> X String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (XConfig Layout -> String
forall (l :: * -> *). XConfig l -> String
terminal (XConfig Layout -> String)
-> (XConf -> XConfig Layout) -> XConf -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  XConf -> XConfig Layout
config)              )
        , (String
"run"                 , String -> X ()
forall (m :: * -> *). MonadIO m => String -> m ()
spawn String
"exe=`dmenu_path | dmenu -b` && exec $exe" )
        , (String
"kill"                , X ()
kill                                             )
        , (String
"refresh"             , X ()
refresh                                          )
        , (String
"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                                  )
        , (String
"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                                )
        , (String
"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                                   )
        , (String
"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                                 )
        , (String
"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                               )
        , (String
"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                     )
        , (String
"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 :: [(String, X ())] -> X ()
runCommand = ([String] -> X String) -> [(String, X ())] -> X ()
runCommandConfig [String] -> X String
forall (m :: * -> *). MonadIO m => [String] -> m String
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 :: ([String] -> X String) -> [(String, X ())] -> X ()
runCommandConfig [String] -> X String
f [(String, X ())]
cl = do
  let m :: Map String (X ())
m = [(String, X ())] -> Map String (X ())
commandMap [(String, X ())]
cl
  String
choice <- [String] -> X String
f (Map String (X ()) -> [String]
forall k a. Map k a -> [k]
M.keys Map String (X ())
m)
  X () -> Maybe (X ()) -> X ()
forall a. a -> Maybe a -> a
fromMaybe (() -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (String -> Map String (X ()) -> Maybe (X ())
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
choice Map String (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' :: String -> X ()
runCommand' String
c = do
  Map String (X ())
m <- ([(String, X ())] -> Map String (X ()))
-> X [(String, X ())] -> X (Map String (X ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(String, X ())] -> Map String (X ())
commandMap X [(String, X ())]
defaultCommands
  X () -> Maybe (X ()) -> X ()
forall a. a -> Maybe a -> a
fromMaybe (() -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (String -> Map String (X ()) -> Maybe (X ())
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
c Map String (X ())
m)