diff options
| author | João Távora | 2018-08-10 01:15:25 +0100 |
|---|---|---|
| committer | João Távora | 2018-08-10 01:21:16 +0100 |
| commit | 9bb52a8e8fa9cd7ce65945373e694041f192ded8 (patch) | |
| tree | 41308908a54826412c4bd45dc7fa22bef120eb10 | |
| parent | 53483df0de0085dbc9ef0b15a0f629ab808b0147 (diff) | |
| download | emacs-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.el | 69 |
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)." | |||
| 652 | CONNECTION is the current connection. MESSAGE is a JSON-like | 652 | CONNECTION is the current connection. MESSAGE is a JSON-like |
| 653 | plist. TYPE is a symbol saying if this is a client or server | 653 | plist. TYPE is a symbol saying if this is a client or server |
| 654 | originated." | 654 | originated." |
| 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 |