New interactive commands nrepl-log-expand-button/all-buttons

Author: vspinu

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

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 "<backtab>") #'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")))))