emacs-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

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


From: Philipp Stephani
Subject: [PATCH] Add file name handler support for 'make-process' (Bug#28691)
Date: Mon, 17 Dec 2018 00:39:36 +0100

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

* test/src/process-tests.el (make-process/file-handler): New unit
test.
---
 etc/NEWS                  |  4 ++++
 src/process.c             | 15 +++++++++++++++
 test/src/process-tests.el | 22 ++++++++++++++++++++++
 3 files changed, 41 insertions(+)

diff --git a/etc/NEWS b/etc/NEWS
index c88f6ef5ca..0a5f915b33 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1407,6 +1407,10 @@ 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 search for a file name handler for
+'default-directory'.
+
 
 * Changes in Emacs 27.1 on Non-Free Operating Systems
 
diff --git a/src/process.c b/src/process.c
index 8e0b2349f9..852431f421 100644
--- a/src/process.c
+++ b/src/process.c
@@ -1661,6 +1661,9 @@ 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 search
+for a file name handler for `default-directory'.
+
 usage: (make-process &rest ARGS)  */)
   (ptrdiff_t nargs, Lisp_Object *args)
 {
@@ -1674,6 +1677,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 +8110,8 @@ init_process_emacs (int sockfd)
 void
 syms_of_process (void)
 {
+  DEFSYM (Qmake_process, "make-process");
+
 #ifdef subprocesses
 
   DEFSYM (Qprocessp, "processp");
@@ -8138,6 +8152,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/src/process-tests.el b/test/src/process-tests.el
index 551b34ff37..3e72e9210d 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -215,5 +215,27 @@ process-tests--mixable
                                       (string-to-list "stdout\n")
                                       (string-to-list "stderr\n"))))))
 
+(ert-deftest make-process/file-handler ()
+  "Check that the ‘:file-handler’ argument of ‘make-process’
+works as expected."
+  (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 ("/bin/true")
+                                                  :file-handler t)))
+               (cl-incf file-handler-calls)
+               'fake-process))
+      (let ((file-name-handler-alist
+             (cons (cons (rx bos "test-handler:") #'file-handler)
+                   file-name-handler-alist))
+            (default-directory "test-handler:/dir/"))
+        (should (eq (make-process :name "name"
+                                  :command '("/bin/true")
+                                  :file-handler t)
+                    'fake-process))
+        (should (= file-handler-calls 1))))))
+
 (provide 'process-tests)
 ;; process-tests.el ends here.
-- 
2.20.0.405.gbc1bbc6f85-goog




reply via email to

[Prev in Thread] Current Thread [Next in Thread]