1;;; cider-inspector.el --- Object inspector -*- lexical-binding: t -*-
2
3;; Copyright © 2013-2021 Vital Reactor, LLC
4;; Copyright © 2014-2021  Bozhidar Batsov and CIDER contributors
5
6;; Author: Ian Eslick <ian@vitalreactor.com>
7;;         Bozhidar Batsov <bozhidar@batsov.com>
8
9;; This program is free software: you can redistribute it and/or modify
10;; it under the terms of the GNU General Public License as published by
11;; the Free Software Foundation, either version 3 of the License, or
12;; (at your option) any later version.
13
14;; This program is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17;; GNU General Public License for more details.
18
19;; You should have received a copy of the GNU General Public License
20;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
21
22;; This file is not part of GNU Emacs.
23
24;;; Commentary:
25
26;; Clojure object inspector inspired by SLIME.
27
28;;; Code:
29
30(require 'cl-lib)
31(require 'easymenu)
32(require 'seq)
33(require 'cider-eval)
34
35;; ===================================
36;; Inspector Key Map and Derived Mode
37;; ===================================
38
39(defconst cider-inspector-buffer "*cider-inspect*")
40
41;;; Customization
42(defgroup cider-inspector nil
43  "Presentation and behavior of the CIDER value inspector."
44  :prefix "cider-inspector-"
45  :group 'cider
46  :package-version '(cider . "0.10.0"))
47
48(defcustom cider-inspector-page-size 32
49  "Default page size in paginated inspector view.
50The page size can be also changed interactively within the inspector."
51  :type '(integer :tag "Page size" 32)
52  :group 'cider-inspector
53  :package-version '(cider . "0.10.0"))
54
55(defcustom cider-inspector-max-atom-length 150
56  "Default max length of nested atoms before they are truncated.
57'Atom' here means any collection member that satisfies (complement coll?).
58The max length can be also changed interactively within the inspector."
59  :type '(integer :tag "Max atom length" 150)
60  :group 'cider-inspector
61  :package-version '(cider . "1.1.0"))
62
63(defcustom cider-inspector-max-coll-size 5
64  "Default number of nested collection members to display before truncating.
65The max size can be also changed interactively within the inspector."
66  :type '(integer :tag "Max collection size" 5)
67  :group 'cider-inspector
68  :package-version '(cider . "1.1.0"))
69
70(defcustom cider-inspector-fill-frame nil
71  "Controls whether the CIDER inspector window fills its frame."
72  :type 'boolean
73  :group 'cider-inspector
74  :package-version '(cider . "0.15.0"))
75
76(defcustom cider-inspector-skip-uninteresting t
77  "Controls whether to skip over uninteresting values in the inspector.
78Only applies to navigation with `cider-inspector-prev-inspectable-object'
79and `cider-inspector-next-inspectable-object', values are still inspectable
80by clicking or navigating to them by other means."
81  :type 'boolean
82  :group 'cider-inspector
83  :package-version '(cider . "0.25.0"))
84
85(defcustom cider-inspector-auto-select-buffer t
86  "Determines if the inspector buffer should be auto selected."
87  :type 'boolean
88  :group 'cider-inspector
89  :package-version '(cider . "0.27.0"))
90
91(defvar cider-inspector-uninteresting-regexp
92  (concat "nil"                      ; nils are not interesting
93          "\\|:" clojure--sym-regexp ; nor keywords
94          "\\|[+-.0-9]+")            ; nor numbers. Note: BigInts, ratios etc. are interesting
95  "Regexp matching values which are not interesting to inspect and can be skipped over.")
96
97(defvar cider-inspector-mode-map
98  (let ((map (make-sparse-keymap)))
99    (set-keymap-parent map cider-popup-buffer-mode-map)
100    (define-key map (kbd "RET") #'cider-inspector-operate-on-point)
101    (define-key map [mouse-1] #'cider-inspector-operate-on-click)
102    (define-key map "l" #'cider-inspector-pop)
103    (define-key map "g" #'cider-inspector-refresh)
104    ;; Page-up/down
105    (define-key map [next] #'cider-inspector-next-page)
106    (define-key map [prior] #'cider-inspector-prev-page)
107    (define-key map " " #'cider-inspector-next-page)
108    (define-key map (kbd "M-SPC") #'cider-inspector-prev-page)
109    (define-key map (kbd "S-SPC") #'cider-inspector-prev-page)
110    (define-key map "s" #'cider-inspector-set-page-size)
111    (define-key map "a" #'cider-inspector-set-max-atom-length)
112    (define-key map "c" #'cider-inspector-set-max-coll-size)
113    (define-key map "d" #'cider-inspector-def-current-val)
114    (define-key map [tab] #'cider-inspector-next-inspectable-object)
115    (define-key map "\C-i" #'cider-inspector-next-inspectable-object)
116    (define-key map [(shift tab)] #'cider-inspector-previous-inspectable-object)
117    ;; Emacs translates S-TAB to BACKTAB on X.
118    (define-key map [backtab] #'cider-inspector-previous-inspectable-object)
119    (easy-menu-define cider-inspector-mode-menu map
120      "Menu for CIDER's inspector."
121      `("CIDER Inspector"
122        ["Inspect" cider-inspector-operate-on-point]
123        ["Pop" cider-inspector-pop]
124        ["Refresh" cider-inspector-refresh]
125        "--"
126        ["Next Inspectable Object" cider-inspector-next-inspectable-object]
127        ["Previous Inspectable Object" cider-inspector-previous-inspectable-object]
128        "--"
129        ["Next Page" cider-inspector-next-page]
130        ["Previous Page" cider-inspector-prev-page]
131        ["Set Page Size" cider-inspector-set-page-size]
132        ["Set Max Atom Length" cider-inspector-set-max-atom-length]
133        ["Set Max Collection Size" cider-inspector-set-max-coll-size]
134        ["Define Var" cider-inspector-def-current-val]
135        "--"
136        ["Quit" cider-popup-buffer-quit-function]
137        ))
138    map))
139
140(define-derived-mode cider-inspector-mode special-mode "Inspector"
141  "Major mode for inspecting Clojure data structures.
142
143\\{cider-inspector-mode-map}"
144  (set-syntax-table clojure-mode-syntax-table)
145  (setq-local electric-indent-chars nil)
146  (setq-local sesman-system 'CIDER)
147  (visual-line-mode 1))
148
149;;;###autoload
150(defun cider-inspect-last-sexp ()
151  "Inspect the result of the the expression preceding point."
152  (interactive)
153  (cider-inspect-expr (cider-last-sexp) (cider-current-ns)))
154
155;;;###autoload
156(defun cider-inspect-defun-at-point ()
157  "Inspect the result of the \"top-level\" expression at point."
158  (interactive)
159  (cider-inspect-expr (cider-defun-at-point) (cider-current-ns)))
160
161;;;###autoload
162(defun cider-inspect-last-result ()
163  "Inspect the most recent eval result."
164  (interactive)
165  (cider-inspect-expr "*1" (cider-current-ns)))
166
167;;;###autoload
168(defun cider-inspect (&optional arg)
169  "Inspect the result of the preceding sexp.
170
171With a prefix argument ARG it inspects the result of the \"top-level\" form.
172With a second prefix argument it prompts for an expression to eval and inspect."
173  (interactive "p")
174  (pcase arg
175    (1 (cider-inspect-last-sexp))
176    (4 (cider-inspect-defun-at-point))
177    (16 (call-interactively #'cider-inspect-expr))))
178
179(defvar cider-inspector-location-stack nil
180  "A stack used to save point locations in inspector buffers.
181These locations are used to emulate `save-excursion' between
182`cider-inspector-push' and `cider-inspector-pop' operations.")
183
184(defvar cider-inspector-page-location-stack nil
185  "A stack used to save point locations in inspector buffers.
186These locations are used to emulate `save-excursion' between
187`cider-inspector-next-page' and `cider-inspector-prev-page' operations.")
188
189(defvar cider-inspector-last-command nil
190  "Contains the value of the most recently used `cider-inspector-*' command.
191This is used as an alternative to the built-in `last-command'.  Whenever we
192invoke any command through \\[execute-extended-command] and its variants,
193the value of `last-command' is not set to the command it invokes.")
194
195(defvar cider-inspector--current-repl nil
196  "Contains the reference to the REPL where inspector was last invoked from.
197This is needed for internal inspector buffer operations (push,
198pop) to execute against the correct REPL session.")
199
200;; Operations
201;;;###autoload
202(defun cider-inspect-expr (expr ns)
203  "Evaluate EXPR in NS and inspect its value.
204Interactively, EXPR is read from the minibuffer, and NS the
205current buffer's namespace."
206  (interactive (list (cider-read-from-minibuffer "Inspect expression: " (cider-sexp-at-point))
207                     (cider-current-ns)))
208  (setq cider-inspector--current-repl (cider-current-repl))
209  (when-let* ((value (cider-sync-request:inspect-expr
210                      expr ns
211                      cider-inspector-page-size
212                      cider-inspector-max-atom-length
213                      cider-inspector-max-coll-size)))
214    (cider-inspector--render-value value)))
215
216(defun cider-inspector-pop ()
217  "Pop the last value off the inspector stack and render it.
218See `cider-sync-request:inspect-pop' and `cider-inspector--render-value'."
219  (interactive)
220  (setq cider-inspector-last-command 'cider-inspector-pop)
221  (when-let* ((value (cider-sync-request:inspect-pop)))
222    (cider-inspector--render-value value)))
223
224(defun cider-inspector-push (idx)
225  "Inspect the value at IDX in the inspector stack and render it.
226See `cider-sync-request:inspect-push' and `cider-inspector--render-value'"
227  (push (point) cider-inspector-location-stack)
228  (when-let* ((value (cider-sync-request:inspect-push idx)))
229    (cider-inspector--render-value value)
230    (cider-inspector-next-inspectable-object 1)))
231
232(defun cider-inspector-refresh ()
233  "Re-render the currently inspected value.
234See `cider-sync-request:inspect-refresh' and `cider-inspector--render-value'"
235  (interactive)
236  (when-let* ((value (cider-sync-request:inspect-refresh)))
237    (cider-inspector--render-value value)))
238
239(defun cider-inspector-next-page ()
240  "Jump to the next page when inspecting a paginated sequence/map.
241
242Does nothing if already on the last page."
243  (interactive)
244  (push (point) cider-inspector-page-location-stack)
245  (when-let* ((value (cider-sync-request:inspect-next-page)))
246    (cider-inspector--render-value value)))
247
248(defun cider-inspector-prev-page ()
249  "Jump to the previous page when expecting a paginated sequence/map.
250
251Does nothing if already on the first page."
252  (interactive)
253  (setq cider-inspector-last-command 'cider-inspector-prev-page)
254  (when-let* ((value (cider-sync-request:inspect-prev-page)))
255    (cider-inspector--render-value value)))
256
257(defun cider-inspector-set-page-size (page-size)
258  "Set the page size in pagination mode to the specified PAGE-SIZE.
259
260Current page will be reset to zero."
261  (interactive (list (read-number "Page size: " cider-inspector-page-size)))
262  (when-let ((value (cider-sync-request:inspect-set-page-size page-size)))
263    (cider-inspector--render-value value)))
264
265(defun cider-inspector-set-max-atom-length (max-length)
266  "Set the max length of nested atoms to MAX-LENGTH."
267  (interactive (list (read-number "Max atom length: " cider-inspector-max-atom-length)))
268  (when-let ((value (cider-sync-request:inspect-set-max-atom-length max-length)))
269    (cider-inspector--render-value value)))
270
271(defun cider-inspector-set-max-coll-size (max-size)
272  "Set the number of nested collection members to display before truncating to MAX-SIZE."
273  (interactive (list (read-number "Max collection size: " cider-inspector-max-coll-size)))
274  (when-let ((value (cider-sync-request:inspect-set-max-coll-size max-size)))
275    (cider-inspector--render-value value)))
276
277(defun cider-inspector-def-current-val (var-name ns)
278  "Defines a var with VAR-NAME in current namespace.
279
280Doesn't modify current page.  When called interactively NS defaults to
281current-namespace."
282  (interactive (let ((ns (cider-current-ns)))
283                 (list (read-from-minibuffer (concat "Var name: " ns "/"))
284                       ns)))
285  (setq cider-inspector--current-repl (cider-current-repl))
286  (when-let* ((value (cider-sync-request:inspect-def-current-val ns var-name)))
287    (cider-inspector--render-value value)
288    (message "%s#'%s/%s = %s" cider-eval-result-prefix ns var-name value)))
289
290;; nREPL interactions
291(defun cider-sync-request:inspect-pop ()
292  "Move one level up in the inspector stack."
293  (thread-first '("op" "inspect-pop")
294    (cider-nrepl-send-sync-request cider-inspector--current-repl)
295    (nrepl-dict-get "value")))
296
297(defun cider-sync-request:inspect-push (idx)
298  "Inspect the inside value specified by IDX."
299  (thread-first `("op" "inspect-push"
300                  "idx" ,idx)
301    (cider-nrepl-send-sync-request cider-inspector--current-repl)
302    (nrepl-dict-get "value")))
303
304(defun cider-sync-request:inspect-refresh ()
305  "Re-render the currently inspected value."
306  (thread-first '("op" "inspect-refresh")
307    (cider-nrepl-send-sync-request cider-inspector--current-repl)
308    (nrepl-dict-get "value")))
309
310(defun cider-sync-request:inspect-next-page ()
311  "Jump to the next page in paginated collection view."
312  (thread-first '("op" "inspect-next-page")
313    (cider-nrepl-send-sync-request cider-inspector--current-repl)
314    (nrepl-dict-get "value")))
315
316(defun cider-sync-request:inspect-prev-page ()
317  "Jump to the previous page in paginated collection view."
318  (thread-first '("op" "inspect-prev-page")
319    (cider-nrepl-send-sync-request cider-inspector--current-repl)
320    (nrepl-dict-get "value")))
321
322(defun cider-sync-request:inspect-set-page-size (page-size)
323  "Set the page size in paginated view to PAGE-SIZE."
324  (thread-first `("op" "inspect-set-page-size"
325                  "page-size" ,page-size)
326    (cider-nrepl-send-sync-request cider-inspector--current-repl)
327    (nrepl-dict-get "value")))
328
329(defun cider-sync-request:inspect-set-max-atom-length (max-length)
330  "Set the max length of nested atoms to MAX-LENGTH."
331  (thread-first `("op" "inspect-set-max-atom-length"
332                  "max-atom-length" ,max-length)
333    (cider-nrepl-send-sync-request cider-inspector--current-repl)
334    (nrepl-dict-get "value")))
335
336(defun cider-sync-request:inspect-set-max-coll-size (max-size)
337  "Set the number of nested collection members to display before truncating to MAX-SIZE."
338  (thread-first `("op" "inspect-set-max-coll-size"
339                  "max-coll-size" ,max-size)
340    (cider-nrepl-send-sync-request cider-inspector--current-repl)
341    (nrepl-dict-get "value")))
342
343(defun cider-sync-request:inspect-def-current-val (ns var-name)
344  "Defines a var with VAR-NAME in NS with the current inspector value."
345  (thread-first `("op" "inspect-def-current-value"
346                  "ns" ,ns
347                  "var-name" ,var-name)
348    (cider-nrepl-send-sync-request cider-inspector--current-repl)
349    (nrepl-dict-get "value")))
350
351(defun cider-sync-request:inspect-expr (expr ns page-size max-atom-length max-coll-size)
352  "Evaluate EXPR in context of NS and inspect its result.
353Set the page size in paginated view to PAGE-SIZE, maximum length of atomic
354collection members to MAX-ATOM-LENGTH, and maximum size of nested collections to
355MAX-COLL-SIZE if non nil."
356  (thread-first (append (nrepl--eval-request expr ns)
357                        `("inspect" "true"
358                          ,@(when page-size
359                              `("page-size" ,page-size))
360                          ,@(when max-atom-length
361                              `("max-atom-length" ,max-atom-length))
362                          ,@(when max-coll-size
363                              `("max-coll-size" ,max-coll-size))))
364    (cider-nrepl-send-sync-request cider-inspector--current-repl)
365    (nrepl-dict-get "value")))
366
367;; Render Inspector from Structured Values
368(defun cider-inspector--render-value (value)
369  "Render VALUE."
370  (cider-make-popup-buffer cider-inspector-buffer 'cider-inspector-mode 'ancillary)
371  (cider-inspector-render cider-inspector-buffer value)
372  (cider-popup-buffer-display cider-inspector-buffer cider-inspector-auto-select-buffer)
373  (when cider-inspector-fill-frame (delete-other-windows))
374  (with-current-buffer cider-inspector-buffer
375    (when (eq cider-inspector-last-command 'cider-inspector-pop)
376      (setq cider-inspector-last-command nil)
377      ;; Prevents error message being displayed when we try to pop
378      ;; from the top-level of a data struture
379      (when cider-inspector-location-stack
380        (goto-char (pop cider-inspector-location-stack))))
381
382    (when (eq cider-inspector-last-command 'cider-inspector-prev-page)
383      (setq cider-inspector-last-command nil)
384      ;; Prevents error message being displayed when we try to
385      ;; go to a prev-page from the first page
386      (when cider-inspector-page-location-stack
387        (goto-char (pop cider-inspector-page-location-stack))))))
388
389(defun cider-inspector-render (buffer str)
390  "Render STR in BUFFER."
391  (with-current-buffer buffer
392    (cider-inspector-mode)
393    (let ((inhibit-read-only t))
394      (condition-case nil
395          (cider-inspector-render* (car (read-from-string str)))
396        (error (insert "\nInspector error for: " str))))
397    (goto-char (point-min))))
398
399(defun cider-inspector-render* (elements)
400  "Render ELEMENTS."
401  (dolist (el elements)
402    (cider-inspector-render-el* el)))
403
404(defun cider-inspector-render-el* (el)
405  "Render EL."
406  (cond ((symbolp el) (insert (symbol-name el)))
407        ((stringp el) (insert (propertize el 'font-lock-face 'font-lock-keyword-face)))
408        ((and (consp el) (eq (car el) :newline))
409         (insert "\n"))
410        ((and (consp el) (eq (car el) :value))
411         (cider-inspector-render-value (cadr el) (cl-caddr el)))
412        (t (message "Unrecognized inspector object: %s" el))))
413
414(defun cider-inspector-render-value (value idx)
415  "Render VALUE at IDX."
416  (cider-propertize-region
417      (list 'cider-value-idx idx
418            'mouse-face 'highlight)
419    (cider-inspector-render-el* (cider-font-lock-as-clojure value))))
420
421
422;; ===================================================
423;; Inspector Navigation (lifted from SLIME inspector)
424;; ===================================================
425
426(defun cider-find-inspectable-object (direction limit)
427  "Find the next/previous inspectable object.
428DIRECTION can be either 'next or 'prev.
429LIMIT is the maximum or minimum position in the current buffer.
430
431Return a list of two values: If an object could be found, the
432starting position of the found object and T is returned;
433otherwise LIMIT and NIL is returned."
434  (let ((finder (cl-ecase direction
435                  (next 'next-single-property-change)
436                  (prev 'previous-single-property-change))))
437    (let ((prop nil) (curpos (point)))
438      (while (and (not prop) (not (= curpos limit)))
439        (let ((newpos (funcall finder curpos 'cider-value-idx nil limit)))
440          (setq prop (get-text-property newpos 'cider-value-idx))
441          (setq curpos newpos)))
442      (list curpos (and prop t)))))
443
444(defun cider-inspector-next-inspectable-object (arg)
445  "Move point to the next inspectable object.
446With optional ARG, move across that many objects.
447If ARG is negative, move backwards."
448  (interactive "p")
449  (let ((maxpos (point-max)) (minpos (point-min))
450        (previously-wrapped-p nil))
451    ;; Forward.
452    (while (> arg 0)
453      (seq-let (pos foundp) (cider-find-inspectable-object 'next maxpos)
454        (if foundp
455            (progn (goto-char pos)
456                   (unless (and cider-inspector-skip-uninteresting
457                                (looking-at-p cider-inspector-uninteresting-regexp))
458                     (setq arg (1- arg))
459                     (setq previously-wrapped-p nil)))
460          (if (not previously-wrapped-p) ; cycle detection
461              (progn (goto-char minpos) (setq previously-wrapped-p t))
462            (error "No inspectable objects")))))
463    ;; Backward.
464    (while (< arg 0)
465      (seq-let (pos foundp) (cider-find-inspectable-object 'prev minpos)
466        ;; CIDER-OPEN-INSPECTOR inserts the title of an inspector page
467        ;; as a presentation at the beginning of the buffer; skip
468        ;; that.  (Notice how this problem can not arise in ``Forward.'')
469        (if (and foundp (/= pos minpos))
470            (progn (goto-char pos)
471                   (unless (and cider-inspector-skip-uninteresting
472                                (looking-at-p cider-inspector-uninteresting-regexp))
473                     (setq arg (1+ arg))
474                     (setq previously-wrapped-p nil)))
475          (if (not previously-wrapped-p) ; cycle detection
476              (progn (goto-char maxpos) (setq previously-wrapped-p t))
477            (error "No inspectable objects")))))))
478
479(defun cider-inspector-previous-inspectable-object (arg)
480  "Move point to the previous inspectable object.
481With optional ARG, move across that many objects.
482If ARG is negative, move forwards."
483  (interactive "p")
484  (cider-inspector-next-inspectable-object (- arg)))
485
486(defun cider-inspector-property-at-point ()
487  "Return property at point."
488  (let* ((properties '(cider-value-idx cider-range-button
489                                       cider-action-number))
490         (find-property
491          (lambda (point)
492            (cl-loop for property in properties
493                     for value = (get-text-property point property)
494                     when value
495                     return (list property value)))))
496    (or (funcall find-property (point))
497        (funcall find-property (max (point-min) (1- (point)))))))
498
499(defun cider-inspector-operate-on-point ()
500  "Invoke the command for the text at point.
5011. If point is on a value then recursively call the inspector on
502that value.
5032. If point is on an action then call that action.
5043. If point is on a range-button fetch and insert the range."
505  (interactive)
506  (seq-let (property value) (cider-inspector-property-at-point)
507    (cl-case property
508      (cider-value-idx
509       (cider-inspector-push value))
510      ;; TODO: range and action handlers
511      (t (error "No object at point")))))
512
513(defun cider-inspector-operate-on-click (event)
514  "Move to EVENT's position and operate the part."
515  (interactive "@e")
516  (let ((point (posn-point (event-end event))))
517    (cond ((and point
518                (or (get-text-property point 'cider-value-idx)))
519           (goto-char point)
520           (cider-inspector-operate-on-point))
521          (t
522           (error "No clickable part here")))))
523
524(provide 'cider-inspector)
525
526;;; cider-inspector.el ends here
527