branch: externals/sly
commit e7f0333b95aade4b63a181bc45fd97edf56df7a7
Author: Mark <[email protected]>
Commit: João Távora <[email protected]>
abcl: fix inspector for a STRUCTURE-OBJECT with no inspectable parts
Unfortunately, not all system defined STRUCTURE-OBJECT instances
implement the getParts() protocol to expose their inspectable parts.
If this is the case, we now emit a message rather than bombing into an
error.
* slynk/backend/abcl.lisp: Rework it.
Cherry-picked-from: SLIME commit a4de28b0c1de98f2bb29cb448c05cb664255ee43
Co-authored-by: João Távora <[email protected]>
---
slynk/backend/abcl.lisp | 23 ++++++++++++-----------
1 file changed, 12 insertions(+), 11 deletions(-)
diff --git a/slynk/backend/abcl.lisp b/slynk/backend/abcl.lisp
index 64bfa11..2bc0c0e 100644
--- a/slynk/backend/abcl.lisp
+++ b/slynk/backend/abcl.lisp
@@ -1351,20 +1351,21 @@
fields)))))
(defmethod emacs-inspect ((object sys::structure-object))
- (let ((structure-def (get (type-of object) 'system::structure-definition )))
- `((:label "Type: ") (:value ,(type-of object)) (:newline)
- (:label "Class: ") (:value ,(class-of object)) (:newline)
- ,@(inspector-structure-slot-names-and-values object))))
+ `((:label "Type: ") (:value ,(type-of object)) (:newline)
+ (:label "Class: ") (:value ,(class-of object)) (:newline)
+ ,@(inspector-structure-slot-names-and-values object)))
(defun inspector-structure-slot-names-and-values (structure)
(let ((structure-def (get (type-of structure)
'system::structure-definition)))
- `((:label "Slots: ") (:newline)
- ,@(loop for slotdef in (sys::dd-slots structure-def)
- for name = (sys::dsd-name slotdef)
- for reader = (sys::dsd-reader slotdef)
- for value = (eval `(,reader ,structure))
- append
- `(" " (:label ,(string-downcase (string name))) ": " (:value
,value) (:newline))))))
+ (if structure-def
+ `((:label "Slots: ") (:newline)
+ ,@(loop for slotdef in (sys::dd-slots structure-def)
+ for name = (sys::dsd-name slotdef)
+ for reader = (sys::dsd-reader slotdef)
+ for value = (eval `(,reader ,structure))
+ append
+ `(" " (:label ,(string-downcase (string name))) ": "
(:value ,value) (:newline))))
+ `("No slots available for inspection."))))
(defmethod emacs-inspect ((object sys::structure-class))
(let* ((name (jss::get-java-field object "name" t))
