Skip to content

Three related patches on error handling. #690

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 3 commits into from
Aug 4, 2014
Merged

Three related patches on error handling. #690

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
37fb62b
Use truename consistently in highlighting compilation errors
vspinu Aug 2, 2014
480ba2f
Implement auto-jumping to error locations
vspinu Aug 4, 2014
fdfc40b
Delete error overlay on modification
vspinu Aug 4, 2014
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions CHANGELOG.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,8 @@

### New features

* New `cider-auto-jump-to-error` control variable for auto jumping to error
location.
* [#537](https://github.com/clojure-emacs/cider/pull/537): New support for
Java symbol lookup from cider-nrepl's info middleware.
* [#570](https://github.com/clojure-emacs/cider/pull/570): Enable toggling
Expand Down
129 changes: 79 additions & 50 deletions cider-interaction.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -64,11 +64,11 @@
(defcustom cider-show-error-buffer t
"Control the popup behavior of cider stacktraces.
The following values are possible t or 'always, 'except-in-repl,
'only-in-repl. Any other value, including nil, will cause the stacktrace
'only-in-repl. Any other value, including nil, will cause the stacktrace
not to be automatically shown.

Irespective of the value of this variable, the `cider-error-buffer' is
always generated in the background. Use `cider-visit-error-buffer' to
always generated in the background. Use `cider-visit-error-buffer' to
navigate to this buffer."
:type '(choice (const :tag "always" t)
(const except-in-repl)
Expand All @@ -79,6 +79,12 @@ navigate to this buffer."
(define-obsolete-variable-alias 'cider-popup-stacktraces
'cider-show-error-buffer "0.7.0")

(defcustom cider-auto-jump-to-error t
"When non-nill automatically jump to error location during interactive compilation."
:type 'boolean
:group 'cider
:package-version '(cider . "0.7.0"))

(defcustom cider-auto-select-error-buffer t
"Controls whether to auto-select the error popup buffer."
:type 'boolean
Expand Down Expand Up @@ -219,7 +225,7 @@ endpoint and Clojure version."
(or (match-string 1 repl-buffer-name) "<no designation>")))

(defun cider-change-buffers-designation ()
"Changes the designation in cider buffer names.
"Change the designation in cider buffer names.
Buffer names changed are cider-repl, nrepl-connection and nrepl-server."
(interactive)
(cider-ensure-connected)
Expand Down Expand Up @@ -551,8 +557,8 @@ If no local or remote file exists, return nil."

(defun cider--url-to-file (url)
"Return the filename from the resource URL.
Uses `url-generic-parse-url' to parse the url. The filename is extracted and
then url decoded. If the decoded filename has a Windows device letter followed
Uses `url-generic-parse-url' to parse the url. The filename is extracted and
then url decoded. If the decoded filename has a Windows device letter followed
by a colon immediately after the leading '/' then the leading '/' is dropped to
create a valid path."
(let ((filename (url-unhex-string (url-filename (url-generic-parse-url url)))))
Expand Down Expand Up @@ -770,9 +776,8 @@ The handler simply inserts the result value in BUFFER."
(lambda (_buffer out)
(cider-repl-emit-interactive-output out))
(lambda (buffer err)
(message "%s" err)
(cider-highlight-compilation-errors
buffer err))
(cider-highlight-compilation-errors buffer err)
(cider-jump-to-error-maybe buffer err))
'()))

(defun cider-emit-interactive-eval-output (output)
Expand All @@ -799,8 +804,8 @@ This is controlled via `cider-interactive-eval-output-destination'."
(cider-emit-interactive-eval-output out))
(lambda (buffer err)
(cider-emit-interactive-eval-output err)
(cider-highlight-compilation-errors
buffer err))
(cider-highlight-compilation-errors buffer err)
(cider-jump-to-error-maybe buffer err))
'()))

(defun cider-load-file-handler (buffer)
Expand All @@ -815,8 +820,8 @@ This is controlled via `cider-interactive-eval-output-destination'."
(cider-emit-interactive-eval-output value))
(lambda (buffer err)
(cider-emit-interactive-eval-output err)
(cider-highlight-compilation-errors
buffer err))
(cider-highlight-compilation-errors buffer err)
(cider-jump-to-error-maybe buffer err))
'()
(lambda (buffer ex root-ex session)
(funcall nrepl-err-handler
Expand Down Expand Up @@ -919,19 +924,23 @@ They exist for compatibility with `next-error'."
(status (when causes
(cider-stacktrace-render buffer (reverse causes))))))))))

(defun cider--show-error-buffer-p (buffer)
"Return non-nil if stacktrace buffer must be shown on error.
Takes into account the current BUFFER and the value of `cider-show-error-buffer'."
(let ((replp (with-current-buffer buffer (derived-mode-p 'cider-repl-mode))))
(memq cider-show-error-buffer
(if replp
'(t always only-in-repl)
'(t always except-in-repl)))))

(defun cider-default-err-handler (buffer ex root-ex session)
"Make an error handler for BUFFER, EX, ROOT-EX and SESSION.
This function determines how the error buffer is shown, and then delegates
the actual error content to the eval or op handler."
(let* ((replp (with-current-buffer buffer (derived-mode-p 'cider-repl-mode)))
(showp (memq cider-show-error-buffer
(if replp
'(t always only-in-repl)
'(t always except-in-repl))))
(error-buffer (if (not showp)
(cider-make-popup-buffer cider-error-buffer)
(cider-popup-buffer cider-error-buffer
cider-auto-select-error-buffer))))
(let* ((error-buffer (if (cider--show-error-buffer-p buffer)
(cider-popup-buffer cider-error-buffer
cider-auto-select-error-buffer)
(cider-make-popup-buffer cider-error-buffer))))
(if (nrepl-op-supported-p "stacktrace")
(cider-default-err-op-handler error-buffer session)
(cider-default-err-eval-handler error-buffer session))))
Expand Down Expand Up @@ -972,42 +981,62 @@ See `compilation-error-regexp-alist' for help on their format.")
(or type 2))
message))))

(defun cider--find-expression-start ()
"Find the beginning a list, vector, map or set outside of a string.
(defun cider--goto-expression-start ()
"Go to the beginning a list, vector, map or set outside of a string.

We do so by starting and the current position and proceeding backwards
until we find a delimiters that's not inside a string."
(while (or (not (looking-at "[({[]")) (eq 'font-lock-string-face (get-text-property (point) 'face)))
(while (or (not (looking-at "[({[]"))
(eq 'font-lock-string-face
(get-text-property (point) 'face)))
(backward-char)))

(defun cider--find-last-error-location (buffer message)
"Return the location (begin . end) in BUFFER from the clojure error MESSAGE.
If location could not be found, return nil."
(save-excursion
(with-current-buffer buffer
(let ((info (cider-extract-error-info cider-compilation-regexp message)))
(when info
(let ((file (nth 0 info))
(line (nth 1 info))
(col (nth 2 info)))
(save-excursion
;; when we don't have a filename or it's different from the one of
;; the current buffer, the line number is relative to form start
(if (and file (equal (file-truename file)
(file-truename (buffer-file-name))))
(goto-char (point-min)) ; start of file
(beginning-of-defun))
(forward-line (1- line))
(move-to-column (or col 0))
(let ((begin (progn (if col (cider--goto-expression-start) (back-to-indentation))
(point)))
(end (progn (if col (forward-list) (move-end-of-line nil))
(point))))
(cons begin end)))))))))

(defun cider-highlight-compilation-errors (buffer message)
"Highlight compilation error line in BUFFER, using MESSAGE."
(with-current-buffer buffer
(let ((info (cider-extract-error-info cider-compilation-regexp message)))
(when info
(let ((file (nth 0 info))
(line (nth 1 info))
(col (nth 2 info))
(face (nth 3 info))
(note (nth 4 info)))
(save-excursion
;; when we don't have a filename or it's different from the one of
;; the current buffer, the line number is relative to form start
(if (and file (equal file (file-truename (buffer-file-name))))
(goto-char (point-min)) ; start of file
(beginning-of-defun))
(forward-line (1- line))
;; if have column, highlight sexp at that point otherwise whole line.
(move-to-column (or col 0))
;; we need to select a region to which to apply the error overlay
;; we try to select the encompassing list, vector, set or map literal
(let ((begin (progn (if col (cider--find-expression-start) (back-to-indentation)) (point)))
(end (progn (if col (forward-list) (move-end-of-line nil)) (point))))
(let ((overlay (make-overlay begin end)))
(overlay-put overlay 'cider-note-p t)
(overlay-put overlay 'face face)
(overlay-put overlay 'cider-note note)
(overlay-put overlay 'help-echo note)))))))))
(-when-let* ((pos (cider--find-last-error-location buffer message))
(overlay (make-overlay (car pos) (cdr pos) buffer))
(info (cider-extract-error-info cider-compilation-regexp message)))
(let ((face (nth 3 info))
(note (nth 4 info)))
(overlay-put overlay 'cider-note-p t)
(overlay-put overlay 'face face)
(overlay-put overlay 'cider-note note)
(overlay-put overlay 'help-echo note)
(overlay-put overlay 'modification-hooks
(list (lambda (o &rest args) (delete-overlay o)))))))

(defun cider-jump-to-error-maybe (buffer err)
"If `cider-auto-jump-to-error' is non-nil, retrieve error location from ERR and jump to it."
(-when-let (pos (and cider-auto-jump-to-error
(cider--find-last-error-location buffer err)))
(with-current-buffer buffer
(goto-char (car pos)))))


(defun cider-need-input (buffer)
"Handle an need-input request from BUFFER."
Expand Down