Copyright | (C) 2007 Spencer Janssen Andrea Rossato glasser@mit.edu 2022 Tony Zorman |
---|---|
License | BSD-style (see LICENSE) |
Maintainer | Tony Zorman <soliditsallgood@mailbox.org> |
Stability | unstable |
Portability | unportable |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
This module provides several commands to run an external process. Additionally, it provides an abstraction—particularly geared towards programs like terminals or Emacs—to specify these processes from XMonad in a compositional way.
Originally, this module was composed of functions formerly defined in
XMonad.Util.Dmenu (by Spencer Janssen), XMonad.Util.Dzen (by
glasser@mit.edu) and XMonad.Util.RunInXTerm
(by Andrea Rossato).
Synopsis
- runProcessWithInput :: MonadIO m => FilePath -> [String] -> String -> m String
- runProcessWithInputAndWait :: MonadIO m => FilePath -> [String] -> String -> Int -> m ()
- safeSpawn :: MonadIO m => FilePath -> [String] -> m ()
- safeSpawnProg :: MonadIO m => FilePath -> m ()
- unsafeSpawn :: MonadIO m => String -> m ()
- runInTerm :: String -> String -> X ()
- safeRunInTerm :: String -> String -> X ()
- seconds :: Rational -> Int
- spawnPipe :: MonadIO m => String -> m Handle
- spawnPipeWithLocaleEncoding :: MonadIO m => String -> m Handle
- spawnPipeWithUtf8Encoding :: MonadIO m => String -> m Handle
- spawnPipeWithNoEncoding :: MonadIO m => String -> m Handle
- data ProcessConfig = ProcessConfig {
- editor :: !String
- emacsLispDir :: !FilePath
- emacsElpaDir :: !FilePath
- emacs :: !String
- type Input = ShowS
- spawnExternalProcess :: ProcessConfig -> XConfig l -> XConfig l
- proc :: X Input -> X ()
- getInput :: X Input -> X String
- toInput :: String -> X Input
- inEditor :: X Input
- inTerm :: X Input
- termInDir :: X Input
- inProgram :: String -> X Input
- (>->) :: X Input -> X Input -> X Input
- (>-$) :: X Input -> X String -> X Input
- (>&&>) :: X Input -> X Input -> X Input
- (>||>) :: X Input -> X Input -> X Input
- inWorkingDir :: X Input
- eval :: String -> X Input
- execute :: String -> X Input
- executeNoQuote :: String -> X Input
- setXClass :: String -> X Input
- asString :: String -> String
- data EmacsLib
- setFrameName :: String -> X Input
- withEmacsLibs :: [EmacsLib] -> X Input
- inEmacs :: X Input
- elispFun :: String -> String
- asBatch :: X Input
- require :: String -> String
- progn :: [String] -> String
- quote :: String -> String
- findFile :: String -> String
- list :: [String] -> String
- saveExcursion :: [String] -> String
- hPutStr :: Handle -> String -> IO ()
- hPutStrLn :: Handle -> String -> IO ()
Usage
You can use this module by importing it in your xmonad.hs
import XMonad.Util.Run
It then all depends on what you want to do:
- If you want to compositionally spawn programs, see the relevant extended documentation.
- For an example usage of
runInTerm
see XMonad.Prompt.Ssh. - For an example usage of
runProcessWithInput
see XMonad.Util.Dmenu, or XMonad.Prompt.Shell. - For an example usage of
runProcessWithInputAndWait
see XMonad.Util.Dzen.
runProcessWithInput :: MonadIO m => FilePath -> [String] -> String -> m String Source #
Returns the output.
runProcessWithInputAndWait :: MonadIO m => FilePath -> [String] -> String -> Int -> m () Source #
Wait is in μ (microseconds)
safeSpawn :: MonadIO m => FilePath -> [String] -> m () Source #
safeSpawn
bypasses spawn
, because spawn passes
strings to /bin/sh to be interpreted as shell commands. This is
often what one wants, but in many cases the passed string will contain
shell metacharacters which one does not want interpreted as such (URLs
particularly often have shell metacharacters like '&' in them). In
this case, it is more useful to specify a file or program to be run
and a string to give it as an argument so as to bypass the shell and
be certain the program will receive the string as you typed it.
Examples:
, ((modm, xK_Print), unsafeSpawn "import -window root $HOME/xwd-$(date +%s)$$.png") , ((modm, xK_d ), safeSpawn "firefox" [])
Note that the unsafeSpawn example must be unsafe and not safe because
it makes use of shell interpretation by relying on $HOME
and
interpolation, whereas the safeSpawn example can be safe because
Firefox doesn't need any arguments if it is just being started.
safeSpawnProg :: MonadIO m => FilePath -> m () Source #
Simplified safeSpawn
; only takes a program (and no arguments):
, ((modm, xK_d ), safeSpawnProg "firefox")
unsafeSpawn :: MonadIO m => String -> m () Source #
runInTerm :: String -> String -> X () Source #
Open a terminal emulator. The terminal emulator is specified in the default configuration as xterm by default. It is then
asked to pass the shell a command with certain options. This is unsafe in the sense of unsafeSpawn
seconds :: Rational -> Int Source #
Multiplies by ONE MILLION, for functions that take microseconds.
Use like:
(5.5 `seconds`)
In GHC 7 and later, you must either enable the PostfixOperators extension (by adding
{-# LANGUAGE PostfixOperators #-}
to the top of your file) or use seconds in prefix form:
seconds 5.5
spawnPipeWithUtf8Encoding :: MonadIO m => String -> m Handle Source #
Same as spawnPipe
, but forces the UTF-8 encoding regardless of locale.
spawnPipeWithNoEncoding :: MonadIO m => String -> m Handle Source #
Same as spawnPipe
, but forces the char8
encoding, so unicode strings
need encodeString
. Should never be needed, but
some X functions return already encoded Strings, so it may possibly be
useful for someone.
Compositionally Spawning Processes
To use the provided EDSL, you must first add the spawnExternalProcess
combinator to your xmonad configuration, like so:
main = xmonad $ … $ spawnExternalProcess def $ … $ def
See ProcessConfig
for a list of all default configuration options, in
case you'd like to change them—especially if you want to make use of the
Emacs integration.
After that, the real fun begins! The format for spawning these
processes is always the same: a call to proc
, its argument being a
bunch of function calls, separated by the pipe operator (>->)
. You
can just bind the resulting function to a key; no additional plumbing
required. For example, using XMonad.Util.EZConfig syntax and with
terminal = "alacritty"
in you XMonad configuration, spawning a ghci
session with a special class name, "calculator", would look like
("M-y", proc $ inTerm >-> setXClass "calculator" >-> execute "ghci")
which would translate, more or less, to /usr/bin/sh -c "alacritty
--class calculator -e ghci"
. The usefulness of this notation becomes
apparent with more complicated examples:
proc $ inEmacs >-> withEmacsLibs [OwnFile "mailboxes"] >-> execute (elispFun "notmuch") >-> setFrameName "mail"
This is equivalent to spawning
emacs -l /home/slot/.config/emacs/lisp/mailboxes.el -e '(notmuch)' -F '(quote (name . "mail"))'
Notice how we did not have to specify the whole path to mailboxes.el
,
since we had set the correct emacsLispDir
upon starting xmonad. This
becomes especially relevant when running Emacs in batch mode, where one
has to include [M,Non-GNU]ELPA packages in the call, whose exact names
may change at any time. Then the following
do url <- getSelection -- from XMonad.Util.XSelection proc $ inEmacs >-> withEmacsLibs [ElpaLib "dash", ElpaLib "s", OwnFile "arXiv-citation"] >-> asBatch >-> execute (elispFun $ "arXiv-citation" <> asString url)
becomes
emacs -L /home/slot/.config/emacs/elpa/dash-20220417.2250 -L /home/slot/.config/emacs/elpa/s-20210616.619 -l /home/slot/.config/emacs/lisp/arXiv-citation.el --batch -e '(arXiv-citation "<url-in-the-primary-selection>")'
which would be quite bothersome to type indeed!
A blog post going into some more detail and also explaining how to integrate this new language with the XMonad.Util.NamedScratchpad module is available here.
Configuration and Running
data ProcessConfig Source #
Additional information that might be useful when spawning external programs.
ProcessConfig | |
|
Instances
Default ProcessConfig Source # | |
Defined in XMonad.Util.Run def :: ProcessConfig # |
spawnExternalProcess :: ProcessConfig -> XConfig l -> XConfig l Source #
Given a ProcessConfig
, remember it for spawning external
processes later on.
Programs
Spawn the terminal
in some directory; it must
support the --working-directory
option.
General Combinators
(>&&>) :: X Input -> X Input -> X Input infixr 2 Source #
a >&&> b
glues the different inputs a
and b
by means of &&
.
For example,
pure "do something" >&&> pure "do another thing"
would result in do something && do another thing
being executed by a
shell.
inWorkingDir :: X Input Source #
Spawn thing in the current working directory. thing must
support a --working-directory
option.
eval :: String -> X Input Source #
Eval(uate) the argument. Current thing must support a --eval
option.
execute :: String -> X Input Source #
Execute the argument. Current thing must support a -e
option.
For programs such as Emacs, eval
may be the safer option; while
emacsclient
supports -e
, the emacs
executable itself does not.
Note that this function always wraps its argument in single quotes;
see executeNoQuote
for an alternative.
executeNoQuote :: String -> X Input Source #
Like execute
, but doesn't wrap its argument in single quotes.
setXClass :: String -> X Input Source #
Set the appropriate X class for a window. This will more often than not actually be the instance name.
asString :: String -> String Source #
Treat an argument as a string; i.e., wrap it with quotes.
>>>
asString "string"
" \"string\" "
Emacs Integration
An Emacs library.
OwnFile !String | A file from |
ElpaLib !String | A directory in |
Special !String | Special files; these will not be looked up somewhere, but forwarded verbatim (as a path). |
setFrameName :: String -> X Input Source #
Set a frame name for the emacsclient
.
Note that this uses the -F
option to set the
frame parameters
alist, which the emacs
executable does not support.
withEmacsLibs :: [EmacsLib] -> X Input Source #
Load some Emacs libraries. This is useful when executing scripts in batch mode.
elispFun :: String -> String Source #
Transform the given input into an elisp function; i.e., surround it with parentheses.
>>>
elispFun "arxiv-citation URL"
" '( arxiv-citation URL )' "
require :: String -> String Source #
Require a package.
>>>
require "arxiv-citation"
"(require (quote arxiv-citation))"
progn :: [String] -> String Source #
Wrap the given commands in a progn
. The given commands need not
be wrapped in parentheses (but can); this will be done by the
function. For example:
>>>
progn [require "this-lib", "function-from-this-lib arg", "(other-function arg2)"]
"(progn (require (quote this-lib)) (function-from-this-lib arg) (other-function arg2))"
findFile :: String -> String Source #
Call find-file
.
>>>
findFile "/path/to/file"
"(find-file \"/path/to/file\" )"
list :: [String] -> String Source #
Make a list of the given inputs.
>>>
list ["foo", "bar", "baz", "qux"]
"(list foo bar baz qux)"
saveExcursion :: [String] -> String Source #
Like progn
, but with save-excursion
.
>>>
saveExcursion [require "this-lib", "function-from-this-lib arg", "(other-function arg2)"]
"(save-excursion (require (quote this-lib)) (function-from-this-lib arg) (other-function arg2))"
Re-exports
hPutStr :: Handle -> String -> IO () #
Computation hPutStr
hdl s
writes the string
s
to the file or channel managed by hdl
.
This operation may fail with:
isFullError
if the device is full; orisPermissionError
if another system resource limit would be exceeded.