aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJoão Távora2018-08-10 01:15:25 +0100
committerJoão Távora2018-08-10 01:21:16 +0100
commit9bb52a8e8fa9cd7ce65945373e694041f192ded8 (patch)
tree41308908a54826412c4bd45dc7fa22bef120eb10
parent53483df0de0085dbc9ef0b15a0f629ab808b0147 (diff)
downloademacs-9bb52a8e8fa9cd7ce65945373e694041f192ded8.tar.gz
emacs-9bb52a8e8fa9cd7ce65945373e694041f192ded8.zip
Allow completely disabling event logging in jsonrpc.el
Pretty printing the event sexp can be very slow when very big messages are involved. * lisp/jsonrpc.el (Version): Bump to 1.0.3 (jsonrpc-connection): Tweak docstring for jsonrpc--event-buffer-scrollback-size. (jsonrpc--log-event): Only log if max size is positive.
-rw-r--r--lisp/jsonrpc.el69
1 files changed, 35 insertions, 34 deletions
diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el
index a137616ecae..f3e0982139c 100644
--- a/lisp/jsonrpc.el
+++ b/lisp/jsonrpc.el
@@ -6,7 +6,7 @@
6;; Maintainer: João Távora <joaotavora@gmail.com> 6;; Maintainer: João Távora <joaotavora@gmail.com>
7;; Keywords: processes, languages, extensions 7;; Keywords: processes, languages, extensions
8;; Package-Requires: ((emacs "25.2")) 8;; Package-Requires: ((emacs "25.2"))
9;; Version: 1.0.2 9;; Version: 1.0.3
10 10
11;; This is an Elpa :core package. Don't use functionality that is not 11;; This is an Elpa :core package. Don't use functionality that is not
12;; compatible with Emacs 25.2. 12;; compatible with Emacs 25.2.
@@ -78,7 +78,7 @@
78 (-events-buffer-scrollback-size 78 (-events-buffer-scrollback-size
79 :initarg :events-buffer-scrollback-size 79 :initarg :events-buffer-scrollback-size
80 :accessor jsonrpc--events-buffer-scrollback-size 80 :accessor jsonrpc--events-buffer-scrollback-size
81 :documentation "If non-nil, maximum size of events buffer.") 81 :documentation "Max size of events buffer. 0 disables, nil means infinite.")
82 (-deferred-actions 82 (-deferred-actions
83 :initform (make-hash-table :test #'equal) 83 :initform (make-hash-table :test #'equal)
84 :accessor jsonrpc--deferred-actions 84 :accessor jsonrpc--deferred-actions
@@ -652,38 +652,39 @@ TIMEOUT is nil)."
652CONNECTION is the current connection. MESSAGE is a JSON-like 652CONNECTION is the current connection. MESSAGE is a JSON-like
653plist. TYPE is a symbol saying if this is a client or server 653plist. TYPE is a symbol saying if this is a client or server
654originated." 654originated."
655 (with-current-buffer (jsonrpc-events-buffer connection) 655 (let ((max (jsonrpc--events-buffer-scrollback-size connection)))
656 (cl-destructuring-bind (&key method id error &allow-other-keys) message 656 (when (or (null max) (cl-plusp max))
657 (let* ((inhibit-read-only t) 657 (with-current-buffer (jsonrpc-events-buffer connection)
658 (subtype (cond ((and method id) 'request) 658 (cl-destructuring-bind (&key method id error &allow-other-keys) message
659 (method 'notification) 659 (let* ((inhibit-read-only t)
660 (id 'reply) 660 (subtype (cond ((and method id) 'request)
661 (t 'message))) 661 (method 'notification)
662 (type 662 (id 'reply)
663 (concat (format "%s" (or type 'internal)) 663 (t 'message)))
664 (if type 664 (type
665 (format "-%s" subtype))))) 665 (concat (format "%s" (or type 'internal))
666 (goto-char (point-max)) 666 (if type
667 (prog1 667 (format "-%s" subtype)))))
668 (let ((msg (format "%s%s%s %s:\n%s\n" 668 (goto-char (point-max))
669 type 669 (prog1
670 (if id (format " (id:%s)" id) "") 670 (let ((msg (format "%s%s%s %s:\n%s\n"
671 (if error " ERROR" "") 671 type
672 (current-time-string) 672 (if id (format " (id:%s)" id) "")
673 (pp-to-string message)))) 673 (if error " ERROR" "")
674 (when error 674 (current-time-string)
675 (setq msg (propertize msg 'face 'error))) 675 (pp-to-string message))))
676 (insert-before-markers msg)) 676 (when error
677 ;; Trim the buffer if it's too large 677 (setq msg (propertize msg 'face 'error)))
678 (let ((max (jsonrpc--events-buffer-scrollback-size connection))) 678 (insert-before-markers msg))
679 (when max 679 ;; Trim the buffer if it's too large
680 (save-excursion 680 (when max
681 (goto-char (point-min)) 681 (save-excursion
682 (while (> (buffer-size) max) 682 (goto-char (point-min))
683 (delete-region (point) (progn (forward-line 1) 683 (while (> (buffer-size) max)
684 (forward-sexp 1) 684 (delete-region (point) (progn (forward-line 1)
685 (forward-line 2) 685 (forward-sexp 1)
686 (point)))))))))))) 686 (forward-line 2)
687 (point)))))))))))))
687 688
688(provide 'jsonrpc) 689(provide 'jsonrpc)
689;;; jsonrpc.el ends here 690;;; jsonrpc.el ends here