From: João Távora <joaotavora@gmail.com>
Date: Fri, 1 May 2020 12:24:56 +0000 (+0100)
Subject: Consolidate lisp/jsonrpc.el logging in single events buffer
X-Git-Tag: emacs-28.0.90~7471
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=b23daca20788ab6b54362c5bdb0470887de106fb;p=emacs.git

Consolidate lisp/jsonrpc.el logging in single events buffer

For inferior processes having useful stderr, it is no longer
cumbersome to switch between different buffers to correlate error
messages with transport-level JSONRPC messages.

The existing stderr and stdout buffers can still be found hidden away
from the normal buffer list.

An original idea of Tobias Rittweiler <trittweiler@gmail.com>.

* lisp/jsonrpc.el (initialize-instance jsonrpc-process-connection):
Setup after-change functions stderr buffer.  Hide stderr and stdout
buffers.
(jsonrpc--log-event): Don't output extra newline.  Tweak log format.
(Version): Bump to 1.0.10
---

diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el
index 65c0df8f57c..69ee94159d7 100644
--- a/lisp/jsonrpc.el
+++ b/lisp/jsonrpc.el
@@ -5,7 +5,7 @@
 ;; Author: João Távora <joaotavora@gmail.com>
 ;; Keywords: processes, languages, extensions
 ;; Package-Requires: ((emacs "25.2"))
-;; Version: 1.0.9
+;; Version: 1.0.10
 
 ;; This is an Elpa :core package.  Don't use functionality that is not
 ;; compatible with Emacs 25.2.
@@ -364,21 +364,49 @@ connection object, called when the process dies .")
 
 (cl-defmethod initialize-instance ((conn jsonrpc-process-connection) slots)
   (cl-call-next-method)
-  (let* ((proc (plist-get slots :process))
-         (proc (if (functionp proc) (funcall proc) proc))
-         (buffer (get-buffer-create (format "*%s output*" (process-name proc))))
-         (stderr (get-buffer-create (format "*%s stderr*" (process-name proc)))))
+  (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))
     (setf (jsonrpc--process conn) proc)
-    (set-process-buffer proc buffer)
-    (process-put proc 'jsonrpc-stderr stderr)
+    (set-process-buffer proc (get-buffer-create (format " *%s output*" name)))
     (set-process-filter proc #'jsonrpc--process-filter)
     (set-process-sentinel proc #'jsonrpc--process-sentinel)
     (with-current-buffer (process-buffer proc)
       (buffer-disable-undo)
       (set-marker (process-mark proc) (point-min))
-      (let ((inhibit-read-only t)) (erase-buffer) (read-only-mode t) proc))
-    (with-current-buffer stderr
-      (buffer-disable-undo))
+      (let ((inhibit-read-only t)) (erase-buffer) (read-only-mode t)))
     (process-put proc 'jsonrpc-connection conn)))
 
 (cl-defmethod jsonrpc-connection-send ((connection jsonrpc-process-connection)
@@ -682,7 +710,7 @@ originated."
                               (format "-%s" subtype)))))
             (goto-char (point-max))
             (prog1
-                (let ((msg (format "%s%s%s %s:\n%s\n"
+                (let ((msg (format "[%s]%s%s %s:\n%s"
                                    type
                                    (if id (format " (id:%s)" id) "")
                                    (if error " ERROR" "")