From 4c3b9a8ebc6693e238dbadd26f1cdad4bacff0c2 Mon Sep 17 00:00:00 2001 From: Vitalie Spinu Date: Mon, 10 Oct 2016 09:54:14 +0200 Subject: [PATCH 1/5] [Fix #1859] In message log insert large objects on request only --- CHANGELOG.md | 1 + nrepl-client.el | 116 ++++++++++++++++++++++++++++++------------------ 2 files changed, 73 insertions(+), 44 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 99d97103c..8e4891c42 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -26,6 +26,7 @@ within the scope of your current Emacs session. * Add option to define exclusions for injected dependecies. Fixes [#1824](https://github.com/clojure-emacs/cider/issues/1824): Can no longer jack-in to an inherited clojure version. * [#1820](https://github.com/clojure-emacs/cider/issues/1820): Don't try to display eldoc in EDN buffers. * [#1823](https://github.com/clojure-emacs/cider/issues/1823): Fix column location metadata set by interactive evaluation. +* [#1859](https://github.com/clojure-emacs/cider/issues/1859): Remove the overhead of nREPL message log. ## 0.13.0 (2016-07-25) diff --git a/nrepl-client.el b/nrepl-client.el index 0fc2cb169..3c383a4dc 100644 --- a/nrepl-client.el +++ b/nrepl-client.el @@ -1098,7 +1098,8 @@ The message is logged to a buffer described by (delete-region (point-min) (- (point) 1))) (goto-char (point-max)) (nrepl--pp (nrepl-decorate-msg msg type) - (nrepl--message-color (lax-plist-get (cdr msg) "id"))) + (nrepl--message-color (lax-plist-get (cdr msg) "id")) + t) (when-let ((win (get-buffer-window))) (set-window-point win (point-max))) (setq buffer-read-only t)))) @@ -1134,7 +1135,16 @@ Set this to nil to prevent truncation." (defun nrepl--expand-button (button) "Expand the text hidden under overlay BUTTON." - (delete-overlay button)) + (let* ((start (overlay-start button)) + (end (overlay-end button)) + (obj (overlay-get button :nrepl-object)) + (inhibit-read-only t)) + (save-excursion + (goto-char start) + (delete-overlay button) + (delete-region start end) + (nrepl--pp obj) + (delete-char -1)))) (defun nrepl--expand-button-mouse (event) "Expand the text hidden under overlay button. @@ -1145,49 +1155,67 @@ EVENT gives the button position on window." (with-selected-window window (nrepl--expand-button (button-at point)))))) -(define-button-type 'nrepl--collapsed-dict - 'display "..." - 'action #'nrepl--expand-button - 'face 'link - 'help-echo "RET: Expand dict.") - -(defun nrepl--pp (object &optional foreground) - "Pretty print nREPL OBJECT, delimited using FOREGROUND." - (if (not (and (listp object) - (memq (car object) '(<-- --> dict)))) - (progn (when (stringp object) - (setq object (substring-no-properties object))) - (pp object (current-buffer)) - (unless (listp object) (insert "\n"))) +(defun nrepl--insert-button (label object) + "Insert button with LABEL and :nrepl-object property as OBJECT." + (insert-button label + :nrepl-object object + 'action #'nrepl--expand-button + 'face 'link + 'help-echo "RET: Expand object." + ;; Workaround for bug#1568. + 'local-map '(keymap (mouse-1 . nrepl--expand-button-mouse))) + (insert "\n")) + +(defun nrepl--pp-listlike (object &optional foreground button) + "Pretty print nREPL list like OBJECT. +FOREGROUND and BUTTON are as in `nrepl--pp'." + (cl-flet ((color (str) + (propertize str 'face + (append '(:weight ultra-bold) + (when foreground `(:foreground ,foreground)))))) (let ((head (format "(%s" (car object)))) - (cl-flet ((color (str) - (propertize str 'face (append '(:weight ultra-bold) - (when foreground `(:foreground ,foreground)))))) - (insert (color head)) - (let ((indent (+ 2 (- (current-column) (length head)))) - (l (point))) - (if (null (cdr object)) - (insert ")\n") - (insert " \n") - (cl-loop for l on (cdr object) by #'cddr - do (let ((str (format "%s%s " (make-string indent ?\s) - (propertize (car l) 'face - ;; Only highlight top-level keys. - (unless (eq (car object) 'dict) - 'font-lock-keyword-face))))) - (insert str) - (nrepl--pp (cadr l)))) - (when (eq (car object) 'dict) - (delete-char -1) - (let ((truncate-lines t)) - (when (and nrepl-dict-max-message-size - (> (count-screen-lines l (point) t) - nrepl-dict-max-message-size)) - (make-button (1+ l) (point) - :type 'nrepl--collapsed-dict - ;; Workaround for bug#1568. - 'local-map '(keymap (mouse-1 . nrepl--expand-button-mouse)))))) - (insert (color ")\n")))))))) + (insert (color head)) + (let ((indent (+ 2 (- (current-column) (length head)))) + (l (point))) + (if (null (cdr object)) + (insert ")\n") + (insert " \n") + (cl-loop for l on (cdr object) by #'cddr + do (let ((str (format "%s%s " (make-string indent ?\s) + (propertize (car l) 'face + ;; Only highlight top-level keys. + (unless (eq (car object) 'dict) + 'font-lock-keyword-face))))) + (insert str) + (nrepl--pp (cadr l) nil button))) + (when (eq (car object) 'dict) + (delete-char -1)) + (insert (color ")\n"))))))) + +(defun nrepl--pp (object &optional foreground button) + "Pretty print nREPL OBJECT, delimited using FOREGROUND. +If BUTTON is non-nil, try making a button from OBJECT instead of inserting +it into the buffer." + (if-let ((head (car-safe object))) + ;; listlike objects + (cond + ((memq head '(<-- -->)) + (nrepl--pp-listlike object foreground button)) + ((eq head 'dict) + (if (and button (> (length object) 1)) + (nrepl--insert-button "(dict ...)" object) + (nrepl--pp-listlike object foreground button))) + (t + (if (and button (> (length object) 10)) + (nrepl--insert-button (format "(%s ...)" (prin1-to-string head)) object) + (pp object (current-buffer))))) + ;; non-list objects + (if (stringp object) + (if (and button (> (length object) 80)) + (nrepl--insert-button (format "\"%s...\"" (substring object 0 40)) object) + (insert (prin1-to-string object) "\n")) + (pp object (current-buffer)) + (insert "\n")))) (defun nrepl-messages-buffer-name (conn) "Return the name for the message buffer matching CONN." From 9ab6251d5815cbce0fecf74afa37eb365126d695 Mon Sep 17 00:00:00 2001 From: Vitalie Spinu Date: Mon, 10 Oct 2016 15:28:21 +0200 Subject: [PATCH 2/5] Explicitly list unfolding parameters in nrepl--pp --- CHANGELOG.md | 2 +- nrepl-client.el | 51 +++++++++++++++++++++++++------------------------ 2 files changed, 27 insertions(+), 26 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 8e4891c42..92a6ad2a5 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -26,7 +26,7 @@ within the scope of your current Emacs session. * Add option to define exclusions for injected dependecies. Fixes [#1824](https://github.com/clojure-emacs/cider/issues/1824): Can no longer jack-in to an inherited clojure version. * [#1820](https://github.com/clojure-emacs/cider/issues/1820): Don't try to display eldoc in EDN buffers. * [#1823](https://github.com/clojure-emacs/cider/issues/1823): Fix column location metadata set by interactive evaluation. -* [#1859](https://github.com/clojure-emacs/cider/issues/1859): Remove the overhead of nREPL message log. +* [#1859](https://github.com/clojure-emacs/cider/issues/1859): Make nREPL message log much faster. `nrepl-dict-max-message-size` custom variable was removed. ## 0.13.0 (2016-07-25) diff --git a/nrepl-client.el b/nrepl-client.el index 3c383a4dc..0cb5dcd0b 100644 --- a/nrepl-client.el +++ b/nrepl-client.el @@ -1128,11 +1128,6 @@ If ID is nil, return nil." (mod (length nrepl-message-colors)) (nth nrepl-message-colors)))) -(defcustom nrepl-dict-max-message-size 5 - "Max number of lines a dict can have before being truncated. -Set this to nil to prevent truncation." - :type 'integer) - (defun nrepl--expand-button (button) "Expand the text hidden under overlay BUTTON." (let* ((start (overlay-start button)) @@ -1196,26 +1191,32 @@ FOREGROUND and BUTTON are as in `nrepl--pp'." "Pretty print nREPL OBJECT, delimited using FOREGROUND. If BUTTON is non-nil, try making a button from OBJECT instead of inserting it into the buffer." - (if-let ((head (car-safe object))) - ;; listlike objects - (cond - ((memq head '(<-- -->)) - (nrepl--pp-listlike object foreground button)) - ((eq head 'dict) - (if (and button (> (length object) 1)) - (nrepl--insert-button "(dict ...)" object) - (nrepl--pp-listlike object foreground button))) - (t - (if (and button (> (length object) 10)) - (nrepl--insert-button (format "(%s ...)" (prin1-to-string head)) object) - (pp object (current-buffer))))) - ;; non-list objects - (if (stringp object) - (if (and button (> (length object) 80)) - (nrepl--insert-button (format "\"%s...\"" (substring object 0 40)) object) - (insert (prin1-to-string object) "\n")) - (pp object (current-buffer)) - (insert "\n")))) + (let ((min-dict-fold-size 1) + (min-list-fold-size 10) + (min-string-fold-size 60)) + (if-let ((head (car-safe object))) + ;; list-like objects + (cond + ;; top level dicts (always unfolded) + ((memq head '(<-- -->)) + (nrepl--pp-listlike object foreground button)) + ;; inner dicts + ((eq head 'dict) + (if (and button (> (length object) min-dict-fold-size)) + (nrepl--insert-button "(dict ...)" object) + (nrepl--pp-listlike object foreground button))) + ;; lists + (t + (if (and button (> (length object) min-list-fold-size)) + (nrepl--insert-button (format "(%s ...)" (prin1-to-string head)) object) + (pp object (current-buffer))))) + ;; non-list objects + (if (stringp object) + (if (and button (> (length object) min-string-fold-size)) + (nrepl--insert-button (format "\"%s...\"" (substring object 0 min-string-fold-size)) object) + (insert (prin1-to-string object) "\n")) + (pp object (current-buffer)) + (insert "\n"))))) (defun nrepl-messages-buffer-name (conn) "Return the name for the message buffer matching CONN." From 44b640170d7e49ff238d614acf35c21bd635c7c6 Mon Sep 17 00:00:00 2001 From: Vitalie Spinu Date: Mon, 10 Oct 2016 16:02:50 +0200 Subject: [PATCH 3/5] New interactive commands `nrepl-log-expand-button/all-buttons` --- CHANGELOG.md | 2 ++ nrepl-client.el | 71 +++++++++++++++++++++++++++++++------------------ 2 files changed, 47 insertions(+), 26 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 92a6ad2a5..062ca93ac 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,6 +14,7 @@ within the scope of your current Emacs session. * [#1748](https://github.com/clojure-emacs/cider/issues/1748): Add new interactive command `cider-pprint-eval-last-sexp-to-repl`. * [#1789](https://github.com/clojure-emacs/cider/issues/1789): Make it easy to change the connection of the cider-scratch buffer from the mode's menu. * New interactive command `cider-toggle-buffer-connection`. +* [#1861](https://github.com/clojure-emacs/cider/issues/1861): New interactive commands in message log buffer `nrepl-log-expand-button` and `nrepl-log-expand-all-buttons`. ### Changes @@ -28,6 +29,7 @@ within the scope of your current Emacs session. * [#1823](https://github.com/clojure-emacs/cider/issues/1823): Fix column location metadata set by interactive evaluation. * [#1859](https://github.com/clojure-emacs/cider/issues/1859): Make nREPL message log much faster. `nrepl-dict-max-message-size` custom variable was removed. + ## 0.13.0 (2016-07-25) ### New Features diff --git a/nrepl-client.el b/nrepl-client.el index 0cb5dcd0b..9a3466002 100644 --- a/nrepl-client.el +++ b/nrepl-client.el @@ -1061,6 +1061,8 @@ operations.") (define-key map (kbd "n") #'next-line) (define-key map (kbd "p") #'previous-line) (define-key map (kbd "TAB") #'forward-button) + (define-key map (kbd "e") #'nrepl-log-expand-button) + (define-key map (kbd "E") #'nrepl-log-expand-all-buttons) (define-key map (kbd "") #'backward-button) map)) @@ -1120,26 +1122,35 @@ This in effect enables or disables the logging of nREPL messages." :type '(repeat color) :group 'nrepl) -(defun nrepl--message-color (id) - "Return the color to use when pretty-printing the nREPL message with ID. -If ID is nil, return nil." - (when id - (thread-first (string-to-number id) - (mod (length nrepl-message-colors)) - (nth nrepl-message-colors)))) - -(defun nrepl--expand-button (button) - "Expand the text hidden under overlay BUTTON." - (let* ((start (overlay-start button)) - (end (overlay-end button)) - (obj (overlay-get button :nrepl-object)) - (inhibit-read-only t)) +(defun nrepl-log-expand-button (&optional button) + "Expand the objects hidden in BUTTON's :nrepl-object property. +BUTTON defaults the button at point." + (interactive) + (if-let ((button (or button (button-at (point))))) + (let* ((start (overlay-start button)) + (end (overlay-end button)) + (obj (overlay-get button :nrepl-object)) + (inhibit-read-only t)) + (save-excursion + (goto-char start) + (delete-overlay button) + (delete-region start end) + (nrepl--pp obj) + (delete-char -1))) + (error "No button at point"))) + +(defun nrepl-log-expand-all-buttons () + "Expand all buttons in nREPL log buffer." + (interactive) + (if (not (eq major-mode 'nrepl-messages-mode)) + (user-error "Not in a `nrepl-messages-mode'") (save-excursion - (goto-char start) - (delete-overlay button) - (delete-region start end) - (nrepl--pp obj) - (delete-char -1)))) + (let* ((pos (point-min)) + (button (next-button pos))) + (while button + (setq pos (overlay-start button)) + (nrepl-log-expand-button button) + (setq button (next-button pos))))))) (defun nrepl--expand-button-mouse (event) "Expand the text hidden under overlay button. @@ -1148,19 +1159,27 @@ EVENT gives the button position on window." (pcase (elt event 1) (`(,window ,_ ,_ ,_ ,_ ,point . ,_) (with-selected-window window - (nrepl--expand-button (button-at point)))))) + (nrepl-log-expand-button (button-at point)))))) -(defun nrepl--insert-button (label object) +(defun nrepl-log-insert-button (label object) "Insert button with LABEL and :nrepl-object property as OBJECT." (insert-button label :nrepl-object object - 'action #'nrepl--expand-button + 'action #'nrepl-log-expand-button 'face 'link 'help-echo "RET: Expand object." ;; Workaround for bug#1568. 'local-map '(keymap (mouse-1 . nrepl--expand-button-mouse))) (insert "\n")) +(defun nrepl--message-color (id) + "Return the color to use when pretty-printing the nREPL message with ID. +If ID is nil, return nil." + (when id + (thread-first (string-to-number id) + (mod (length nrepl-message-colors)) + (nth nrepl-message-colors)))) + (defun nrepl--pp-listlike (object &optional foreground button) "Pretty print nREPL list like OBJECT. FOREGROUND and BUTTON are as in `nrepl--pp'." @@ -1197,23 +1216,23 @@ it into the buffer." (if-let ((head (car-safe object))) ;; list-like objects (cond - ;; top level dicts (always unfolded) + ;; top level dicts (always expanded) ((memq head '(<-- -->)) (nrepl--pp-listlike object foreground button)) ;; inner dicts ((eq head 'dict) (if (and button (> (length object) min-dict-fold-size)) - (nrepl--insert-button "(dict ...)" object) + (nrepl-log-insert-button "(dict ...)" object) (nrepl--pp-listlike object foreground button))) ;; lists (t (if (and button (> (length object) min-list-fold-size)) - (nrepl--insert-button (format "(%s ...)" (prin1-to-string head)) object) + (nrepl-log-insert-button (format "(%s ...)" (prin1-to-string head)) object) (pp object (current-buffer))))) ;; non-list objects (if (stringp object) (if (and button (> (length object) min-string-fold-size)) - (nrepl--insert-button (format "\"%s...\"" (substring object 0 min-string-fold-size)) object) + (nrepl-log-insert-button (format "\"%s...\"" (substring object 0 min-string-fold-size)) object) (insert (prin1-to-string object) "\n")) (pp object (current-buffer)) (insert "\n"))))) From 445db7a834aa8067cd76fc0a85f718e29ef3c301 Mon Sep 17 00:00:00 2001 From: Vitalie Spinu Date: Mon, 10 Oct 2016 16:09:22 +0200 Subject: [PATCH 4/5] Rename logging nREPL function with nrepl-log- prefix --- nrepl-client.el | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/nrepl-client.el b/nrepl-client.el index 9a3466002..ad287368a 100644 --- a/nrepl-client.el +++ b/nrepl-client.el @@ -1099,8 +1099,8 @@ The message is logged to a buffer described by (re-search-forward "^(" nil t) (delete-region (point-min) (- (point) 1))) (goto-char (point-max)) - (nrepl--pp (nrepl-decorate-msg msg type) - (nrepl--message-color (lax-plist-get (cdr msg) "id")) + (nrepl-log-pp-object (nrepl-decorate-msg msg type) + (nrepl-log--message-color (lax-plist-get (cdr msg) "id")) t) (when-let ((win (get-buffer-window))) (set-window-point win (point-max))) @@ -1135,7 +1135,7 @@ BUTTON defaults the button at point." (goto-char start) (delete-overlay button) (delete-region start end) - (nrepl--pp obj) + (nrepl-log-pp-object obj) (delete-char -1))) (error "No button at point"))) @@ -1152,7 +1152,7 @@ BUTTON defaults the button at point." (nrepl-log-expand-button button) (setq button (next-button pos))))))) -(defun nrepl--expand-button-mouse (event) +(defun nrepl-log--expand-button-mouse (event) "Expand the text hidden under overlay button. EVENT gives the button position on window." (interactive "e") @@ -1169,10 +1169,10 @@ EVENT gives the button position on window." 'face 'link 'help-echo "RET: Expand object." ;; Workaround for bug#1568. - 'local-map '(keymap (mouse-1 . nrepl--expand-button-mouse))) + 'local-map '(keymap (mouse-1 . nrepl-log--expand-button-mouse))) (insert "\n")) -(defun nrepl--message-color (id) +(defun nrepl-log--message-color (id) "Return the color to use when pretty-printing the nREPL message with ID. If ID is nil, return nil." (when id @@ -1180,9 +1180,9 @@ If ID is nil, return nil." (mod (length nrepl-message-colors)) (nth nrepl-message-colors)))) -(defun nrepl--pp-listlike (object &optional foreground button) +(defun nrepl-log--pp-listlike (object &optional foreground button) "Pretty print nREPL list like OBJECT. -FOREGROUND and BUTTON are as in `nrepl--pp'." +FOREGROUND and BUTTON are as in `nrepl-log-pp-object'." (cl-flet ((color (str) (propertize str 'face (append '(:weight ultra-bold) @@ -1201,12 +1201,12 @@ FOREGROUND and BUTTON are as in `nrepl--pp'." (unless (eq (car object) 'dict) 'font-lock-keyword-face))))) (insert str) - (nrepl--pp (cadr l) nil button))) + (nrepl-log-pp-object (cadr l) nil button))) (when (eq (car object) 'dict) (delete-char -1)) (insert (color ")\n"))))))) -(defun nrepl--pp (object &optional foreground button) +(defun nrepl-log-pp-object (object &optional foreground button) "Pretty print nREPL OBJECT, delimited using FOREGROUND. If BUTTON is non-nil, try making a button from OBJECT instead of inserting it into the buffer." @@ -1218,12 +1218,12 @@ it into the buffer." (cond ;; top level dicts (always expanded) ((memq head '(<-- -->)) - (nrepl--pp-listlike object foreground button)) + (nrepl-log--pp-listlike object foreground button)) ;; inner dicts ((eq head 'dict) (if (and button (> (length object) min-dict-fold-size)) (nrepl-log-insert-button "(dict ...)" object) - (nrepl--pp-listlike object foreground button))) + (nrepl-log--pp-listlike object foreground button))) ;; lists (t (if (and button (> (length object) min-list-fold-size)) From 7006247a9193c00b3fa4350bafbae53f34aa570c Mon Sep 17 00:00:00 2001 From: Vitalie Spinu Date: Mon, 10 Oct 2016 16:50:46 +0200 Subject: [PATCH 5/5] Use keymap instead of local-map for mouse events in nrepl buttons #1568, 814692dd7c5e5a9 --- nrepl-client.el | 25 ++++++++++++------------- 1 file changed, 12 insertions(+), 13 deletions(-) diff --git a/nrepl-client.el b/nrepl-client.el index ad287368a..c62143ac5 100644 --- a/nrepl-client.el +++ b/nrepl-client.el @@ -1058,11 +1058,12 @@ operations.") (defvar nrepl-messages-mode-map (let ((map (make-sparse-keymap))) - (define-key map (kbd "n") #'next-line) - (define-key map (kbd "p") #'previous-line) + (define-key map (kbd "n") #'next-line) + (define-key map (kbd "p") #'previous-line) (define-key map (kbd "TAB") #'forward-button) - (define-key map (kbd "e") #'nrepl-log-expand-button) - (define-key map (kbd "E") #'nrepl-log-expand-all-buttons) + (define-key map (kbd "RET") #'nrepl-log-expand-button) + (define-key map (kbd "e") #'nrepl-log-expand-button) + (define-key map (kbd "E") #'nrepl-log-expand-all-buttons) (define-key map (kbd "") #'backward-button) map)) @@ -1086,11 +1087,8 @@ operations.") (defun nrepl-log-message (msg type) "Log the nREPL MSG. - -TYPE is either request or response. - -The message is logged to a buffer described by -`nrepl-message-buffer-name-template'." +TYPE is either request or response. The message is logged to a buffer +described by `nrepl-message-buffer-name-template'." (when nrepl-log-messages (with-current-buffer (nrepl-messages-buffer (current-buffer)) (setq buffer-read-only nil) @@ -1100,8 +1098,8 @@ The message is logged to a buffer described by (delete-region (point-min) (- (point) 1))) (goto-char (point-max)) (nrepl-log-pp-object (nrepl-decorate-msg msg type) - (nrepl-log--message-color (lax-plist-get (cdr msg) "id")) - t) + (nrepl-log--message-color (lax-plist-get (cdr msg) "id")) + t) (when-let ((win (get-buffer-window))) (set-window-point win (point-max))) (setq buffer-read-only t)))) @@ -1168,8 +1166,9 @@ EVENT gives the button position on window." 'action #'nrepl-log-expand-button 'face 'link 'help-echo "RET: Expand object." - ;; Workaround for bug#1568. - 'local-map '(keymap (mouse-1 . nrepl-log--expand-button-mouse))) + ;; Workaround for bug#1568 (don't use local-map here; it + ;; overwrites major mode map.) + 'keymap `(keymap (mouse-1 . nrepl-log--expand-button-mouse))) (insert "\n")) (defun nrepl-log--message-color (id)