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

* 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'.

diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index 5b428b6205d109dafe2c3e6babb389a67eba9ff5..d929978b6ea3361906bb73a5d4e98ca57cb0628a 100644 (file)
--- 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 402691c6bcfe7b9e23531ed7f46ee07b8a2fc0f9..d72f5b880a20e02406d239017fded7fefae52658 100644 (file)
--- 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 ea3e4d566f87dcde1d15f0c9974e550df82c8532..253edd593ed397f02f56e0335c719058e7664e9d 100644 (file)
--- 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.
+
 \f
 * Changes in Emacs 27.1 on Non-Free Operating Systems
 

diff --git a/lisp/files.el b/lisp/files.el
index fb6cf0193a92531bf644f10ec430e9c98ed83692..448df62710cd4d084258abc08c82efd95aa55dc7 100644 (file)
--- 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 8e0b2349f9d6dc6721c0ca5c47a54cd313d4b840..5895f77446b285d295e3674dc51e2d5bdc75fca7 100644 (file)
--- 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 3b192ee8727deeb555539cc52954cbe4d67c9cbd..9d827e865d9174dc4a43b8635649c9b3dceb07c0 100644 (file)
--- 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 551b34ff37193fe0799cdba8f81f0fccbf8e4bb0..af5bc737574f4d0d88b3d80785be3bdf2c91bc28 100644 (file)
--- 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.