summaryrefslogtreecommitdiff
path: root/lisp/jsonrpc.el
diff options
context:
space:
mode:
authorJoão Távora <joaotavora@gmail.com>2018-08-10 01:15:25 +0100
committerJoão Távora <joaotavora@gmail.com>2018-08-10 01:21:16 +0100
commit9bb52a8e8fa9cd7ce65945373e694041f192ded8 (patch)
tree41308908a54826412c4bd45dc7fa22bef120eb10 /lisp/jsonrpc.el
parent53483df0de0085dbc9ef0b15a0f629ab808b0147 (diff)
downloademacs-9bb52a8e8fa9cd7ce65945373e694041f192ded8.tar.gz
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.
Diffstat (limited to 'lisp/jsonrpc.el')
-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 @@
;; Maintainer: João Távora <joaotavora@gmail.com>
;; Keywords: processes, languages, extensions
;; Package-Requires: ((emacs "25.2"))
-;; Version: 1.0.2
+;; Version: 1.0.3
;; This is an Elpa :core package. Don't use functionality that is not
;; compatible with Emacs 25.2.
@@ -78,7 +78,7 @@
(-events-buffer-scrollback-size
:initarg :events-buffer-scrollback-size
:accessor jsonrpc--events-buffer-scrollback-size
- :documentation "If non-nil, maximum size of events buffer.")
+ :documentation "Max size of events buffer. 0 disables, nil means infinite.")
(-deferred-actions
:initform (make-hash-table :test #'equal)
:accessor jsonrpc--deferred-actions
@@ -652,38 +652,39 @@ TIMEOUT is nil)."
CONNECTION is the current connection. MESSAGE is a JSON-like
plist. TYPE is a symbol saying if this is a client or server
originated."
- (with-current-buffer (jsonrpc-events-buffer connection)
- (cl-destructuring-bind (&key method id error &allow-other-keys) message
- (let* ((inhibit-read-only t)
- (subtype (cond ((and method id) 'request)
- (method 'notification)
- (id 'reply)
- (t 'message)))
- (type
- (concat (format "%s" (or type 'internal))
- (if type
- (format "-%s" subtype)))))
- (goto-char (point-max))
- (prog1
- (let ((msg (format "%s%s%s %s:\n%s\n"
- type
- (if id (format " (id:%s)" id) "")
- (if error " ERROR" "")
- (current-time-string)
- (pp-to-string message))))
- (when error
- (setq msg (propertize msg 'face 'error)))
- (insert-before-markers msg))
- ;; Trim the buffer if it's too large
- (let ((max (jsonrpc--events-buffer-scrollback-size connection)))
- (when max
- (save-excursion
- (goto-char (point-min))
- (while (> (buffer-size) max)
- (delete-region (point) (progn (forward-line 1)
- (forward-sexp 1)
- (forward-line 2)
- (point))))))))))))
+ (let ((max (jsonrpc--events-buffer-scrollback-size connection)))
+ (when (or (null max) (cl-plusp max))
+ (with-current-buffer (jsonrpc-events-buffer connection)
+ (cl-destructuring-bind (&key method id error &allow-other-keys) message
+ (let* ((inhibit-read-only t)
+ (subtype (cond ((and method id) 'request)
+ (method 'notification)
+ (id 'reply)
+ (t 'message)))
+ (type
+ (concat (format "%s" (or type 'internal))
+ (if type
+ (format "-%s" subtype)))))
+ (goto-char (point-max))
+ (prog1
+ (let ((msg (format "%s%s%s %s:\n%s\n"
+ type
+ (if id (format " (id:%s)" id) "")
+ (if error " ERROR" "")
+ (current-time-string)
+ (pp-to-string message))))
+ (when error
+ (setq msg (propertize msg 'face 'error)))
+ (insert-before-markers msg))
+ ;; Trim the buffer if it's too large
+ (when max
+ (save-excursion
+ (goto-char (point-min))
+ (while (> (buffer-size) max)
+ (delete-region (point) (progn (forward-line 1)
+ (forward-sexp 1)
+ (forward-line 2)
+ (point)))))))))))))
(provide 'jsonrpc)
;;; jsonrpc.el ends here