branch: externals/sly
commit edf5d52c9c0429a4b82879091c0f1f4cbc012ffe
Author: Zachary Beane <x...@xach.com>
Commit: João Távora <joaotav...@gmail.com>
sbcl: Filter out invalid definition sources in find-definitions
They can't be visited, so filtering them eliminates this error:
Error: DEFINITION-SOURCE of blah did not contain meaningful
information
* slynk/backend/sbcl.lisp (categorize-definition-source): Move up.
(find-definitions) Use it.
This commonly arises when a method is defined without a corresponding
defgeneric.
Cherry-picked-from: SLIME commit 8c758ba4aae8cccc8a4575e9b3f83cd42b0f5586
Co-authored-by: João Távora <joaotav...@gmail.com>
---
slynk/backend/sbcl.lisp | 26 ++++++++++++++------------
1 file changed, 14 insertions(+), 12 deletions(-)
diff --git a/slynk/backend/sbcl.lisp b/slynk/backend/sbcl.lisp
index 9d6737f..739f0ba 100644
--- a/slynk/backend/sbcl.lisp
+++ b/slynk/backend/sbcl.lisp
@@ -826,9 +826,22 @@ QUALITIES is an alist with (quality . value)"
name
(sb-introspect::definition-source-description source-location)))
+(defun categorize-definition-source (definition-source)
+ (with-definition-source (pathname form-path character-offset plist)
+ definition-source
+ (let ((file-p (and pathname (probe-file pathname)
+ (or form-path character-offset))))
+ (cond ((and (getf plist :emacs-buffer) file-p) :buffer-and-file)
+ ((getf plist :emacs-buffer) :buffer)
+ (file-p :file)
+ (pathname :file-without-position)
+ (t :invalid)))))
+
(defimplementation find-definitions (name)
(loop for type in *definition-types* by #'cddr
- for defsrcs = (sb-introspect:find-definition-sources-by-name name type)
+ for defsrcs = (remove :invalid
+ (sb-introspect:find-definition-sources-by-name
name type)
+ :key #'categorize-definition-source)
append (loop for defsrc in defsrcs collect
(list (make-dspec type name defsrc)
(converting-errors-to-error-location
@@ -882,17 +895,6 @@ QUALITIES is an alist with (quality . value)"
(t (error "Malformed syntax in WITH-STRUCT: ~A" name))))
,@body)))))
-(defun categorize-definition-source (definition-source)
- (with-definition-source (pathname form-path character-offset plist)
- definition-source
- (let ((file-p (and pathname (probe-file pathname)
- (or form-path character-offset))))
- (cond ((and (getf plist :emacs-buffer) file-p) :buffer-and-file)
- ((getf plist :emacs-buffer) :buffer)
- (file-p :file)
- (pathname :file-without-position)
- (t :invalid)))))
-
#+#.(slynk-backend:with-symbol 'definition-source-form-number 'sb-introspect)
(defun form-number-position (definition-source stream)
(let* ((tlf-number (car (sb-introspect:definition-source-form-path
definition-source)))
