From 039be4e02513e03ae465efae5694bd4e28a74dbe Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Mon, 17 Dec 2018 21:47:46 +0100 Subject: [PATCH] Add file name handler support for 'make-process' (Bug#28691) * src/process.c (Fmake_process): Add new keyword argument ':file-handler'. (syms_of_process) : 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'. --- doc/lispref/files.texi | 2 ++ doc/lispref/processes.texi | 10 ++++++-- etc/NEWS | 5 ++++ lisp/files.el | 11 +++++++-- src/process.c | 17 +++++++++++++ test/lisp/files-tests.el | 10 ++++++++ test/src/process-tests.el | 49 ++++++++++++++++++++++++++++++++++++++ 7 files changed, 100 insertions(+), 4 deletions(-) diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 5b428b6205d..d929978b6ea 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -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}, diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 402691c6bcf..d72f5b880a2 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -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 diff --git a/etc/NEWS b/etc/NEWS index ea3e4d566f8..253edd593ed 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -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 diff --git a/lisp/files.el b/lisp/files.el index fb6cf0193a9..448df62710c 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -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)))) diff --git a/src/process.c b/src/process.c index 8e0b2349f9d..5895f77446b 100644 --- a/src/process.c +++ b/src/process.c @@ -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"); diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 3b192ee8727..9d827e865d9 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -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) diff --git a/test/src/process-tests.el b/test/src/process-tests.el index 551b34ff371..af5bc737574 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -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. -- 2.39.5