mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-26 10:49:33 +00:00
Code Issues Releases Activity

Allow completely disabling event logging in jsonrpc.el

Browse Source 
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.
This commit is contained in:
João Távora 2018-08-10 01:15:25 +01:00
parent 53483df0de
commit 9bb52a8e8f
1 changed files with 35 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
lisp/jsonrpc.el
View File

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