Skip to content

Commit 55cd244

Browse files
bbatsovbbatsov
committed
Merge pull request #521 from jeffvalk/master
Allow more control of stacktrace formatting.
2 parents e0ad599 + 9b382a4 commit 55cd244

File tree

4 files changed

+346
-2
lines changed

4 files changed

+346
-2
lines changed

‎CHANGELOG.md

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -22,6 +22,8 @@ cider-nrepl's info middleware for jump-to-definition.
2222
* STDERR ouput is now font-locked with `cider-repl-err-output-face` to make it
2323
visually distinctive from `cider-repl-output-face` (used for STDOUT output).
2424
* New interactive command `cider-scratch`.
25+
* [#521](https://github.com/clojure-emacs/cider/pull/521) New interactive
26+
stacktrace filtering/navigation using cider-nrepl's stacktrace middleware.
2527

2628
### Changes
2729

‎README.md

Lines changed: 20 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -195,6 +195,15 @@ than the REPL:
195195
(setq cider-auto-select-error-buffer t)
196196
```
197197

198+
* If using the `wrap-stacktrace` middleware from `cider-nrepl`, error buffer
199+
stacktraces may be filtered by default. Valid filter types include `java`,
200+
`clj`, `repl`, `tooling`, and `dup`. Setting this to `nil` will show all
201+
stacktrace frames.
202+
203+
```el
204+
(setq cider-stacktrace-default-filters '(tooling dup))
205+
```
206+
198207
* The REPL buffer name has the format `*cider-repl project-name*`.
199208
Change the separator from space to something else by overriding `nrepl-buffer-name-separator`.
200209

@@ -547,6 +556,17 @@ Keyboard shortcut | Description
547556
<kbd>l</kbd> | pop to the parent object
548557
<kbd>g</kbd> | refresh the inspector (e.g. if viewing an atom/ref/agent)
549558

559+
### cider-stacktrace-mode
560+
561+
Keyboard shortcut | Description
562+
--------------------------------|-------------------------------
563+
<kbd>Return</kbd> | navigate to the source location (if available) for the stacktrace frame
564+
<kbd>j</kbd> | toggle display of java frames
565+
<kbd>c</kbd> | toggle display of clj frames
566+
<kbd>r</kbd> | toggle display of repl frames
567+
<kbd>t</kbd> | toggle display of tooling frames (e.g. compiler, nREPL middleware)
568+
<kbd>d</kbd> | toggle display of duplicate frames
569+
<kbd>a</kbd> | toggle display of all frames
550570

551571
### Managing multiple sessions
552572

‎cider-interaction.el

Lines changed: 28 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -32,6 +32,7 @@
3232

3333
(require 'cider-client)
3434
(require 'cider-util)
35+
(require 'cider-stacktrace)
3536

3637
(require 'clojure-mode)
3738
(require 'dash)
@@ -831,8 +832,8 @@ They exist for compatibility with `next-error'."
831832
(goto-next-note-boundary))
832833
(goto-next-note-boundary)))
833834

834-
(defun cider-default-err-handler (buffer ex root-ex session)
835-
"Make an error handler for BUFFER, EX, ROOT-EX and SESSION."
835+
(defun cider-default-err-eval-handler (buffer ex root-ex session)
836+
"Make an error handler for BUFFER, EX, ROOT-EX and SESSION without middleware support."
836837
;; TODO: use ex and root-ex as fallback values to display when pst/print-stack-trace-not-found
837838
(let ((replp (with-current-buffer buffer (derived-mode-p 'cider-repl-mode))))
838839
(if (or (and cider-repl-popup-stacktraces replp)
@@ -852,6 +853,31 @@ They exist for compatibility with `next-error'."
852853
(with-current-buffer cider-error-buffer
853854
(compilation-minor-mode +1))))))
854855

856+
(defun cider-default-err-op-handler (buffer ex root-ex session)
857+
"Make an error handler for BUFFER, EX, ROOT-EX and SESSION with middleware support."
858+
(let ((replp (with-current-buffer buffer (derived-mode-p 'cider-repl-mode))))
859+
(when (or (and cider-repl-popup-stacktraces replp)
860+
(and cider-popup-stacktraces (not replp)))
861+
(let (causes frames)
862+
(nrepl-send-request
863+
(list "op" "stacktrace" "session" session)
864+
(lambda (response)
865+
(nrepl-dbind-response response (message name status)
866+
(cond (message (setq causes (cons response causes)))
867+
(name (setq frames (cons response frames)))
868+
(status (when (and causes frames)
869+
(cider-stacktrace-render
870+
(cider-popup-buffer cider-error-buffer
871+
cider-auto-select-error-buffer)
872+
(reverse causes)
873+
(reverse frames))))))))))))
874+
875+
(defun cider-default-err-handler (buffer ex root-ex session)
876+
"Make an error handler for BUFFER, EX, ROOT-EX and SESSION."
877+
(if (nrepl-op-supported-p "stacktrace")
878+
(cider-default-err-op-handler buffer ex root-ex session)
879+
(cider-default-err-eval-handler buffer ex root-ex session)))
880+
855881
(defvar cider-compilation-regexp
856882
'("\\(?:.*\\(warning, \\)\\|.*?\\(, compiling\\):(\\)\\([^:]*\\):\\([[:digit:]]+\\)\\(?::\\([[:digit:]]+\\)\\)?\\(\\(?: - \\(.*\\)\\)\\|)\\)" 3 4 5 (1))
857883
"Specifications for matching errors and warnings in Clojure stacktraces.

‎cider-stacktrace.el

Lines changed: 296 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,296 @@
1+
;;; cider-stacktrace.el --- Stacktrace navigator -*- lexical-binding: t -*-
2+
3+
;; Copyright © 2014 Jeff Valk
4+
5+
;; Author: Jeff Valk <[email protected]>
6+
7+
;; This program is free software: you can redistribute it and/or modify
8+
;; it under the terms of the GNU General Public License as published by
9+
;; the Free Software Foundation, either version 3 of the License, or
10+
;; (at your option) any later version.
11+
12+
;; This program is distributed in the hope that it will be useful,
13+
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14+
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15+
;; GNU General Public License for more details.
16+
17+
;; You should have received a copy of the GNU General Public License
18+
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
19+
20+
;; This file is not part of GNU Emacs.
21+
22+
;;; Commentary:
23+
24+
;; Stacktrace filtering and stack frame source navigation
25+
26+
;;; Code:
27+
28+
(require 'button)
29+
30+
31+
;; Variables
32+
33+
(defgroup cider-stacktrace nil
34+
"Stacktrace filtering and navigation."
35+
:prefix "cider-stacktrace-"
36+
:group 'cider)
37+
38+
(defcustom cider-stacktrace-default-filters '(tooling dup)
39+
"Frame types to omit from initial stacktrace display."
40+
:type 'list
41+
:group 'cider-stacktrace)
42+
43+
44+
;; Faces
45+
46+
(defface cider-stacktrace-error-class-face
47+
'((t (:inherit font-lock-warning-face)))
48+
"Face for exception class names"
49+
:group 'cider-stacktrace)
50+
51+
(defface cider-stacktrace-filter-shown-face
52+
'((t (:inherit button :underline t)))
53+
"Face for filter buttons representing frames currently visible"
54+
:group 'cider-stacktrace)
55+
56+
(defface cider-stacktrace-filter-hidden-face
57+
'((t (:inherit button :underline nil)))
58+
"Face for filter buttons representing frames currently filtered out"
59+
:group 'cider-stacktrace)
60+
61+
(defface cider-stacktrace-face
62+
'((t (:inherit default)))
63+
"Face for stack frame text"
64+
:group 'cider-stacktrace)
65+
66+
(defface cider-stacktrace-ns-face
67+
'((t (:inherit font-lock-comment-face)))
68+
"Face for stack frame namespace name"
69+
:group 'cider-stacktrace)
70+
71+
(defface cider-stacktrace-fn-face
72+
'((t (:inherit cider-stacktrace-face :weight bold)))
73+
"Face for stack frame function name"
74+
:group 'cider-stacktrace)
75+
76+
77+
;; Mode & key bindings
78+
79+
(defvar cider-stacktrace-mode-map
80+
(let ((map (make-sparse-keymap)))
81+
(define-key map "j" 'cider-stacktrace-toggle-java)
82+
(define-key map "c" 'cider-stacktrace-toggle-clj)
83+
(define-key map "r" 'cider-stacktrace-toggle-repl)
84+
(define-key map "t" 'cider-stacktrace-toggle-tooling)
85+
(define-key map "d" 'cider-stacktrace-toggle-duplicates)
86+
(define-key map "a" 'cider-stacktrace-show-all)
87+
map))
88+
89+
(define-minor-mode cider-stacktrace-mode
90+
"CIDER Stacktrace Buffer Mode."
91+
nil
92+
(" CIDER Stacktrace")
93+
cider-stacktrace-mode-map
94+
(setq buffer-read-only t)
95+
(setq-local truncate-lines t)
96+
(setq-local cider-stacktrace-hidden-frame-count 0)
97+
(setq-local cider-stacktrace-filters cider-stacktrace-default-filters))
98+
99+
100+
;; Stacktrace filtering
101+
102+
(defun cider-stacktrace-indicate-filters (filters)
103+
"Update enabled state of filter buttons. Find buttons with a 'filter property;
104+
if filter is a member of FILTERS, or if filter is nil ('show all') and the
105+
argument list is non-nil, fontify the button as disabled. Upon finding text with
106+
a 'hidden-count property, stop searching and update the hidden count text."
107+
(with-current-buffer (get-buffer cider-error-buffer)
108+
(save-excursion
109+
(goto-char (point-min))
110+
(let ((inhibit-read-only t)
111+
(get-face (lambda (hide)
112+
(if hide
113+
'cider-stacktrace-filter-hidden-face
114+
'cider-stacktrace-filter-shown-face))))
115+
;; Toggle buttons
116+
(while (not (or (get-text-property (point) 'hidden-count) (eobp)))
117+
(let ((button (button-at (point))))
118+
(when button
119+
(let* ((filter (button-get button 'filter))
120+
(face (funcall get-face (if filter
121+
(member filter filters)
122+
filters))))
123+
(button-put button 'face face)))
124+
(goto-char (or (next-property-change (point))
125+
(point-max)))))
126+
;; Update hidden count
127+
(when (and (get-text-property (point) 'hidden-count)
128+
(re-search-forward "[0-9]+" (line-end-position) t))
129+
(replace-match
130+
(number-to-string cider-stacktrace-hidden-frame-count)))))))
131+
132+
(defun cider-stacktrace-apply-filters (filters)
133+
"Set visibility on stack frames using FILTERS.
134+
Update `cider-stacktrace-hidden-frame-count' and indicate filters applied."
135+
(with-current-buffer (get-buffer cider-error-buffer)
136+
(save-excursion
137+
(goto-char (point-min))
138+
(let ((inhibit-read-only t)
139+
(hidden 0))
140+
(while (not (eobp))
141+
(let* ((flags (get-text-property (point) 'flags))
142+
(hide (if (intersection filters flags) t nil)))
143+
(when hide (setq hidden (+ 1 hidden)))
144+
(put-text-property (point) (line-beginning-position 2) 'invisible hide))
145+
(forward-line 1))
146+
(setq cider-stacktrace-hidden-frame-count hidden)))
147+
(cider-stacktrace-indicate-filters filters)))
148+
149+
150+
;; Interactive functions
151+
152+
(defun cider-stacktrace-show-all ()
153+
"Reset `cider-stacktrace-filters', and apply filters."
154+
(interactive)
155+
(cider-stacktrace-apply-filters
156+
(setq cider-stacktrace-filters nil)))
157+
158+
(defun cider-stacktrace-toggle (flag)
159+
"Update `cider-stacktrace-filters' to add or remove FLAG, and apply filters."
160+
(cider-stacktrace-apply-filters
161+
(setq cider-stacktrace-filters
162+
(if (memq flag cider-stacktrace-filters)
163+
(remq flag cider-stacktrace-filters)
164+
(cons flag cider-stacktrace-filters)))))
165+
166+
(defun cider-stacktrace-toggle-java ()
167+
"Toggle display of Java stack frames."
168+
(interactive)
169+
(cider-stacktrace-toggle 'java))
170+
171+
(defun cider-stacktrace-toggle-clj ()
172+
"Toggle display of Clojure stack frames."
173+
(interactive)
174+
(cider-stacktrace-toggle 'clj))
175+
176+
(defun cider-stacktrace-toggle-repl ()
177+
"Toggle display of REPL stack frames."
178+
(interactive)
179+
(cider-stacktrace-toggle 'repl))
180+
181+
(defun cider-stacktrace-toggle-tooling ()
182+
"Toggle display of Tooling stack frames (compiler, nREPL middleware, etc)."
183+
(interactive)
184+
(cider-stacktrace-toggle 'tooling))
185+
186+
(defun cider-stacktrace-toggle-duplicates ()
187+
"Toggle display of stack frames that are duplicates of their descendents."
188+
(interactive)
189+
(cider-stacktrace-toggle 'dup))
190+
191+
192+
;; Text button functions
193+
194+
(defun cider-stacktrace-filter (button)
195+
"Apply filter(s) indicated by the BUTTON."
196+
(with-temp-message "Filters may also be toggled with the keyboard."
197+
(let ((flag (button-get button 'filter)))
198+
(if flag
199+
(cider-stacktrace-toggle flag)
200+
(cider-stacktrace-show-all)))
201+
(sit-for 5)))
202+
203+
(defun cider-stacktrace-navigate (button)
204+
"Navigate to the stack frame represented by the BUTTON."
205+
(let ((var (button-get button 'var))
206+
(line (button-get button 'line)))
207+
(condition-case nil
208+
(let* ((info (cider-var-info var))
209+
(file (cadr (assoc "file" info))))
210+
(cider-jump-to-def-for (vector file file line)))
211+
(error "No source info"))))
212+
213+
214+
;; Rendering
215+
216+
(defun cider-stacktrace-render-cause (buffer cause note)
217+
"Emit into BUFFER the CAUSE exception class, message, and data, and NOTE."
218+
(with-current-buffer buffer
219+
(nrepl-dbind-response cause (class message data)
220+
(put-text-property 0 (length class)
221+
'font-lock-face
222+
'cider-stacktrace-error-class-face
223+
class)
224+
(insert note " " class " " message)
225+
(newline)
226+
(when data
227+
(insert (cider-font-lock-as-clojure data))
228+
(newline)))))
229+
230+
(defun cider-stacktrace-render-filters (buffer filters)
231+
"Emit into BUFFER toggle buttons for each of the FILTERS."
232+
(with-current-buffer buffer
233+
(insert " Show: ")
234+
(dolist (filter filters)
235+
(insert-text-button (first filter)
236+
'filter (second filter)
237+
'follow-link t
238+
'action 'cider-stacktrace-filter
239+
'help-echo (format "Toggle %s stack frames"
240+
(first filter)))
241+
(insert " "))
242+
(let ((hidden "(0 frames hidden)"))
243+
(put-text-property 0 (length hidden) 'hidden-count t hidden)
244+
(insert " " hidden))
245+
(newline)))
246+
247+
(defun cider-stacktrace-render-frame (buffer frame)
248+
"Emit into BUFFER function call site info for the stack FRAME.
249+
This associates text properties to enable filtering and source navigation."
250+
(with-current-buffer buffer
251+
(nrepl-dbind-response frame (file line flags class method name var ns fn)
252+
(let ((flags (mapcar 'intern flags))) ; strings -> symbols
253+
(insert-text-button (format "%30s:%5d %s/%s"
254+
(if (member 'repl flags) "REPL" file) line
255+
(if (member 'clj flags) ns class)
256+
(if (member 'clj flags) fn method))
257+
'name name 'var var 'line line 'flags flags
258+
'follow-link t
259+
'action 'cider-stacktrace-navigate
260+
'help-echo "View source at this location"
261+
'face 'cider-stacktrace-face)
262+
(save-excursion
263+
(let ((p3 (point))
264+
(p1 (search-backward " "))
265+
(p2 (search-forward "/")))
266+
(put-text-property p1 p2 'face 'cider-stacktrace-ns-face)
267+
(put-text-property p2 p3 'face 'cider-stacktrace-fn-face)))
268+
(newline)))))
269+
270+
(defun cider-stacktrace-render (buffer causes frames)
271+
"Emit into BUFFER useful stacktrace information for the CAUSES and FRAMES."
272+
(with-current-buffer buffer
273+
(let ((inhibit-read-only t))
274+
;; Exceptions
275+
(cider-stacktrace-render-cause buffer (first causes) "Unhandled")
276+
(dolist (cause (rest causes))
277+
(cider-stacktrace-render-cause buffer cause "Caused by"))
278+
(newline)
279+
;; Stacktrace filters
280+
(cider-stacktrace-render-filters
281+
buffer
282+
`(("Clojure" clj) ("Java" java) ("REPL" repl)
283+
("Tooling" tooling) ("Duplicates" dup) ("All" ,nil)))
284+
(newline)
285+
;; Stacktrace frames
286+
(dolist (frame frames)
287+
(cider-stacktrace-render-frame buffer frame)))
288+
;; Set mode, apply filters, move point to first stacktrace frame.
289+
(cider-stacktrace-mode 1)
290+
(cider-stacktrace-apply-filters cider-stacktrace-filters)
291+
(goto-char (next-single-property-change (point-min) 'flags))
292+
(font-lock-refresh-defaults)))
293+
294+
(provide 'cider-stacktrace)
295+
296+
;;; cider-stacktrace.el ends here

0 commit comments

Comments
 (0)