From: João Távora <joaotavora@gmail.com>
Date: Wed, 3 Jun 2020 19:53:35 +0000 (+0100)
Subject: Ensure Jsonrpc processes are created in correct buffer
X-Git-Tag: emacs-28.0.90~7219
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=bd20af2d41f24c9e59acb867a1a4485284cb2a65;p=emacs.git

Ensure Jsonrpc processes are created in correct buffer

Report and original implementation by Steve Purcell
<steve@sanityinc.com>.  See also See
https://github.com/joaotavora/eglot/pull/493 for details

* lisp/jsonrpc.el (initialize-instance): Make process in original
buffer.
(Version): Bump to 1.0.12
---

diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el
index 42e7701af18..ff8f250a22e 100644
--- a/lisp/jsonrpc.el
+++ b/lisp/jsonrpc.el
@@ -4,7 +4,7 @@
 
 ;; Author: João Távora <joaotavora@gmail.com>
 ;; Keywords: processes, languages, extensions
-;; Version: 1.0.11
+;; Version: 1.0.12
 ;; Package-Requires: ((emacs "25.2"))
 
 ;; This is a GNU ELPA :core package.  Avoid functionality that is not
@@ -364,40 +364,44 @@ connection object, called when the process dies .")
 (cl-defmethod initialize-instance ((conn jsonrpc-process-connection) slots)
   (cl-call-next-method)
   (cl-destructuring-bind (&key ((:process proc)) name &allow-other-keys) slots
-    ;; FIXME: notice the undocumented bad coupling in the buffer name.
-    ;; The client making the process _must_ use a buffer named exactly
-    ;; like this property when calling `make-process'.  If there were
-    ;; a `set-process-stderr' like there is `set-process-buffer' we
-    ;; wouldn't need this and could use a pipe with a process filter
-    ;; instead of `after-change-functions'.  Alternatively, we need a
-    ;; new initarg (but maybe not a slot).
-    (with-current-buffer (get-buffer-create (format "*%s stderr*" name))
-      (let ((inhibit-read-only t)
-            (hidden-name (concat " " (buffer-name))))
-        (erase-buffer)
-        (buffer-disable-undo)
-        (add-hook
-         'after-change-functions
-         (lambda (beg _end _pre-change-len)
-           (cl-loop initially (goto-char beg)
-                    do (forward-line)
-                    when (bolp)
-                    for line = (buffer-substring
-                                (line-beginning-position 0)
-                                (line-end-position 0))
-                    do (with-current-buffer (jsonrpc-events-buffer conn)
-                         (goto-char (point-max))
-                         (let ((inhibit-read-only t))
-                           (insert (format "[stderr] %s\n" line))))
-                    until (eobp)))
-         nil t)
-        ;; If we are correctly coupled to the client, it should pick up
-        ;; the current buffer immediately.
-        (setq proc (if (functionp proc) (funcall proc) proc))
-        (ignore-errors (kill-buffer hidden-name))
-        (rename-buffer hidden-name)
-        (process-put proc 'jsonrpc-stderr (current-buffer))
-        (read-only-mode t)))
+    ;; FIXME: notice the undocumented bad coupling in the stderr
+    ;; buffer name, it must be named exactly like this we expect when
+    ;; calling `make-process'.  If there were a `set-process-stderr'
+    ;; like there is `set-process-buffer' we wouldn't need this and
+    ;; could use a pipe with a process filter instead of
+    ;; `after-change-functions'.  Alternatively, we need a new initarg
+    ;; (but maybe not a slot).
+    (let ((calling-buffer (current-buffer)))
+      (with-current-buffer (get-buffer-create (format "*%s stderr*" name))
+        (let ((inhibit-read-only t)
+              (hidden-name (concat " " (buffer-name))))
+          (erase-buffer)
+          (buffer-disable-undo)
+          (add-hook
+           'after-change-functions
+           (lambda (beg _end _pre-change-len)
+             (cl-loop initially (goto-char beg)
+                      do (forward-line)
+                      when (bolp)
+                      for line = (buffer-substring
+                                  (line-beginning-position 0)
+                                  (line-end-position 0))
+                      do (with-current-buffer (jsonrpc-events-buffer conn)
+                           (goto-char (point-max))
+                           (let ((inhibit-read-only t))
+                             (insert (format "[stderr] %s\n" line))))
+                      until (eobp)))
+           nil t)
+          ;; If we are correctly coupled to the client, the process
+          ;; now created should pick up the current stderr buffer,
+          ;; which we immediately rename
+          (setq proc (if (functionp proc)
+                         (with-current-buffer calling-buffer (funcall proc))
+                       proc))
+          (ignore-errors (kill-buffer hidden-name))
+          (rename-buffer hidden-name)
+          (process-put proc 'jsonrpc-stderr (current-buffer))
+          (read-only-mode t))))
     (setf (jsonrpc--process conn) proc)
     (set-process-buffer proc (get-buffer-create (format " *%s output*" name)))
     (set-process-filter proc #'jsonrpc--process-filter)