procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add file name handler support for 'make-process' (Bug#28691)

Browse source 
* src/process.c (Fmake_process): Add new keyword argument
':file-handler'.
(syms_of_process) <make-process, :file-handler>: Define new symbols.

* lisp/files.el (file-name-non-special): Add support for
'make-process'.

* test/src/process-tests.el (make-process/file-handler/found)
(make-process/file-handler/not-found)
(make-process/file-handler/disable): New unit tests.
(process-tests--file-handler): New helper function.

* test/lisp/files-tests.el
(files-tests-file-name-non-special-make-process): New unit test.

* doc/lispref/files.texi (Magic File Names): Document that
'make-process' can invoke file name handlers.

* doc/lispref/processes.texi (Asynchronous Processes): Document
':file-handlers' argument to 'make-process'.

* etc/NEWS (Lisp Changes in Emacs 27.1): Mention new
:file-handler argument for 'make-process'.
This commit is contained in:
Philipp Stephani 2018-12-17 21:47:46 +01:00 • committed by Philipp Stephani
parent b41789f31f
commit 039be4e025
7 changed files with 100 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
doc/lispref/files.texi
View file

@ -3171,6 +3171,7 @@ first, before handlers for jobs such as remote file access.
@code{make-directory},
@code{make-directory-internal},
@code{make-nearby-temp-file},
@code{make-process},
@code{make-symbolic-link},@*
@code{process-file},
@code{rename-file}, @code{set-file-acl}, @code{set-file-modes},
@ -3227,6 +3228,7 @@ first, before handlers for jobs such as remote file access.
@code{make-auto-save-file-name},
@code{make-direc@discretionary{}{}{}tory},
@code{make-direc@discretionary{}{}{}tory-internal},
@code{make-process},
@code{make-symbolic-link},
@code{process-file},
@code{rename-file}, @code{set-file-acl}, @code{set-file-modes},

10
doc/lispref/processes.texi
View file

@ -696,6 +696,12 @@ non-@code{nil} value should be either a buffer or a pipe process
created with @code{make-pipe-process}, described below. If
@var{stderr} is @code{nil}, standard error is mixed with standard
output, and both are sent to @var{buffer} or @var{filter}.
@item :file-handler @var{file-handler}
If @var{file-handler} is non-@code{nil}, then look for a file name
handler for the current buffer's @code{default-directory}, and invoke
that file handler to make the process. If there is no such handler,
proceed as if @var{file-handler} were @code{nil}.
@end table
The original argument list, modified with the actual connection
@ -704,8 +710,8 @@ information, is available via the @code{process-contact} function.
The current working directory of the subprocess is set to the current
buffer's value of @code{default-directory} if that is local (as
determined by `unhandled-file-name-directory'), or "~" otherwise. If
you want to run a process in a remote directory use
@code{start-file-process}.
you want to run a process in a remote directory, pass
@code{:file-handler t} to @code{make-process}.
@end defun
@defun make-pipe-process &rest args

5
etc/NEWS
View file

@ -1428,6 +1428,11 @@ un-obsoleting it.
+++
** New function 'group-name' returns a group name corresponding to GID.
** 'make-process' now takes a keyword argument ':file-handler'; if
that is non-nil, it will look for a file name handler for the current
buffer's 'default-directory' and invoke that file handler to make the
process. That way 'make-process' can start remote processes.
* Changes in Emacs 27.1 on Non-Free Operating Systems

11
lisp/files.el
View file

@ -7103,7 +7103,8 @@ only these files will be asked to be saved."
(default-directory
(if (memq operation
'(insert-directory process-file start-file-process
shell-command temporary-file-directory))
make-process shell-command
temporary-file-directory))
(directory-file-name
(expand-file-name
(unhandled-file-name-directory default-directory)))
@ -7151,7 +7152,13 @@ only these files will be asked to be saved."
;; These file-notify-* operations take a
;; descriptor.
(file-notify-rm-watch)
(file-notify-valid-p)))
(file-notify-valid-p)
;; `make-process' uses keyword arguments and
;; doesn't mangle its filenames in any way.
;; It already strips /: from the binary
;; filename, so we don't have to do this
;; here.
(make-process)))
;; For all other operations, treat the first
;; argument only as the file name.
'(nil 0))))

17
src/process.c
View file

@ -1661,6 +1661,11 @@ to the standard error of subprocess. Specifying this implies
`:connection-type' is set to `pipe'. If STDERR is nil, standard error
is mixed with standard output and sent to BUFFER or FILTER.
:file-handler FILE-HANDLER -- If FILE-HANDLER is non-nil, then look
for a file name handler for the current buffer's `default-directory'
and invoke that file handler to make the process. If there is no
such handler, proceed as if FILE-HANDLER were nil.
usage: (make-process &rest ARGS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
@ -1674,6 +1679,15 @@ usage: (make-process &rest ARGS) */)
/* Save arguments for process-contact and clone-process. */
contact = Flist (nargs, args);
if (!NILP (Fplist_get (contact, QCfile_handler)))
{
Lisp_Object file_handler
= Ffind_file_name_handler (BVAR (current_buffer, directory),
Qmake_process);
if (!NILP (file_handler))
return CALLN (Fapply, file_handler, Qmake_process, contact);
}
buffer = Fplist_get (contact, QCbuffer);
if (!NILP (buffer))
buffer = Fget_buffer_create (buffer);
@ -8098,6 +8112,8 @@ init_process_emacs (int sockfd)
void
syms_of_process (void)
{
DEFSYM (Qmake_process, "make-process");
#ifdef subprocesses
DEFSYM (Qprocessp, "processp");
@ -8138,6 +8154,7 @@ syms_of_process (void)
DEFSYM (Qreal, "real");
DEFSYM (Qnetwork, "network");
DEFSYM (Qserial, "serial");
DEFSYM (QCfile_handler, ":file-handler");
DEFSYM (QCbuffer, ":buffer");
DEFSYM (QChost, ":host");
DEFSYM (QCservice, ":service");

10
test/lisp/files-tests.el
View file

@ -1109,6 +1109,16 @@ unquoted file names."
(with-temp-buffer
(write-region nil nil nospecial nil :visit))))
(ert-deftest files-tests-file-name-non-special-make-process ()
"Check that the ‘:file-handler’ argument of ‘make-process’
works as expected if the default directory is quoted."
(let ((default-directory (file-name-quote invocation-directory))
(program (file-name-quote
(expand-file-name invocation-name invocation-directory))))
(should (processp (make-process :name "name"
:command (list program "--version")
:file-handler t)))))
(ert-deftest files-tests--insert-directory-wildcard-in-dir-p ()
(let ((alist (list (cons "/home/user/*/.txt" (cons "/home/user/" "*/.txt"))
(cons "/home/user/.txt" nil)

49
test/src/process-tests.el
View file

@ -215,5 +215,54 @@
(string-to-list "stdout\n")
(string-to-list "stderr\n"))))))
(ert-deftest make-process/file-handler/found ()
"Check that the ‘:file-handler’ argument of ‘make-process’
works as expected if a file handler is found."
(let ((file-handler-calls 0))
(cl-flet ((file-handler
(&rest args)
(should (equal default-directory "test-handler:/dir/"))
(should (equal args '(make-process :name "name"
:command ("/some/binary")
:file-handler t)))
(cl-incf file-handler-calls)
'fake-process))
(let ((file-name-handler-alist (list (cons (rx bos "test-handler:")
#'file-handler)))
(default-directory "test-handler:/dir/"))
(should (eq (make-process :name "name"
:command '("/some/binary")
:file-handler t)
'fake-process))
(should (= file-handler-calls 1))))))
(ert-deftest make-process/file-handler/not-found ()
"Check that the ‘:file-handler’ argument of ‘make-process’
works as expected if no file handler is found."
(let ((file-name-handler-alist ())
(default-directory invocation-directory)
(program (expand-file-name invocation-name invocation-directory)))
(should (processp (make-process :name "name"
:command (list program "--version")
:file-handler t)))))
(ert-deftest make-process/file-handler/disable ()
"Check ‘make-process’ works as expected if it shouldn’t use the
file handler."
(let ((file-name-handler-alist (list (cons (rx bos "test-handler:")
#'process-tests--file-handler)))
(default-directory "test-handler:/dir/")
(program (expand-file-name invocation-name invocation-directory)))
(should (processp (make-process :name "name"
:command (list program "--version"))))))
(defun process-tests--file-handler (operation &rest _args)
(cl-ecase operation
(unhandled-file-name-directory "/")
(make-process (ert-fail "file handler called unexpectedly"))))
(put #'process-tests--file-handler 'operations
'(unhandled-file-name-directory make-process))
(provide 'process-tests)
;; process-tests.el ends here.