emacs-diffs
[Top][All Lists]
Advanced

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

master b23daca: Consolidate lisp/jsonrpc.el logging in single events buf


From: João Távora
Subject: master b23daca: Consolidate lisp/jsonrpc.el logging in single events buffer
Date: Fri, 1 May 2020 12:01:34 -0400 (EDT)

branch: master
commit b23daca20788ab6b54362c5bdb0470887de106fb
Author: João Távora <address@hidden>
Commit: João Távora <address@hidden>

    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 <address@hidden>.
    
    * 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
---
 lisp/jsonrpc.el | 50 +++++++++++++++++++++++++++++++++++++++-----------
 1 file changed, 39 insertions(+), 11 deletions(-)

diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el
index 65c0df8..69ee941 100644
--- a/lisp/jsonrpc.el
+++ b/lisp/jsonrpc.el
@@ -5,7 +5,7 @@
 ;; Author: João Távora <address@hidden>
 ;; 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" "")



reply via email to

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