mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-29 07:58:28 +00:00
Code Issues Releases Activity

Ensure Jsonrpc processes are created in correct buffer

Browse Source 
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
This commit is contained in:
João Távora 2020-06-03 20:53:35 +01:00
parent 7e8c1a6718
commit bd20af2d41
1 changed files with 39 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

74
lisp/jsonrpc.el
View File

@ -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)