[slime-devel] the inspector
Thomas Schilling
tjs_ng at yahoo.de
Thu Sep 16 00:23:16 UTC 2004
Inlined is a little patch to have method documentation displayed and have
methods sorted by specifity. This resulted from a #lisp discussion and is
pretty much inspired by the McCLIM lister. (I think we can steal even more
from there ;) )
Hm, McCLIM is GPL. Does that interfere with Slime's license?
Unfortunately I had to change the swank-mop, which will break Slime on
every implementation other than acl62. We could avoid this by simply
moving my changes to swank-allegro.lisp, but I think this also fixes a bug
for all other implementations.
Ok, to call it by name, the current implementation had problems with
eql-specializers. So I added the eql-spezializer class to the mop. (In
clisp we this should probably simply be an alias for cons.)
At best the sorting should be customizable. Also it currently doesn't
consider argument-precedence order and has problems with non-finalized
classes (which I currently don't know how to solve).
Oh, and finally some little typo fixes.
,--- Patches ---
Index: swank-backend.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-backend.lisp,v
retrieving revision 1.67
diff -u -r1.67 swank-backend.lisp
--- swank-backend.lisp 14 Sep 2004 16:01:07 -0000 1.67
+++ swank-backend.lisp 16 Sep 2004 00:15:50 -0000
@@ -42,6 +42,7 @@
#:standard-slot-definition
#:standard-method
#:standard-class
+ #:eql-specializer
;; standard-class readers
#:class-default-initargs
#:class-direct-default-initargs
Index: swank-allegro.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-allegro.lisp,v
retrieving revision 1.57
diff -u -r1.57 swank-allegro.lisp
--- swank-allegro.lisp 14 Sep 2004 21:24:58 -0000 1.57
+++ swank-allegro.lisp 16 Sep 2004 00:16:13 -0000
@@ -36,6 +36,7 @@
mop::standard-slot-definition
cl:method
cl:standard-class
+ mop:eql-specializer
;; standard-class readers
mop:class-default-initargs
mop:class-direct-default-initargs
@@ -73,6 +74,10 @@
(defun swank-mop:slot-definition-documentation (slot)
(documentation slot))
+
+(defmethod swank-mop:class-name ((x swank-mop:eql-specializer))
+ `(eql ,(mop:eql-specializer-object x)))
+
;;;; TCP Server
Index: swank.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank.lisp,v
retrieving revision 1.237
diff -u -r1.237 swank.lisp
--- swank.lisp 15 Sep 2004 17:29:39 -0000 1.237
+++ swank.lisp 16 Sep 2004 00:21:25 -0000
@@ -2531,7 +2531,7 @@
(values "An array."
`("Dimensions: " (:value ,(array-dimensions array))
(:newline)
- "It's element type is: " (:value ,(array-element-type array))
+ "Its element type is: " (:value ,(array-element-type array))
(:newline)
"Total size: " (:value ,(array-total-size array))
(:newline)
@@ -2583,7 +2583,7 @@
" " (:action ,(format nil "[remove name ~S (does not
affect class object)]" symbol)
(lambda () (setf (find-class symbol)
nil)))))))
(values "A symbol."
- `("It's name is: " (:value ,(symbol-name symbol))
+ `("Its name is: " (:value ,(symbol-name symbol))
(:newline)
;; check to see whether it is a global variable, a
;; constant, or a symbol macro.
@@ -2665,18 +2665,61 @@
collect "#<unbound>"
collect '(:newline)))))
+
+(defun sorted-methods (gf)
+ ;;FIXME: How to deal with argument-precedence-order?
+ (let* ((methods (copy-list (swank-mop:generic-function-methods gf)))
+ (lambda-list (swank-mop:generic-function-lambda-list gf)))
+ ;; sorter function (most specific is defined as smaller)
+ (flet ((method< (meth1 meth2)
+ ;; First ordering rule is by qualifiers, that is
:before-methods
+ ;; com before :around methods, before primary methods, before
+ ;; :after methods, other qualifiers are treated like none at
all
+ ;; (so like primary methods)
+ (let ((qualifier-order '(:before :around nil :after)))
+ (let ((q1 (or (position (first
(swank-mop:method-qualifiers meth1)) qualifier-order) 2))
+ (q2 (or (position (first
(swank-mop:method-qualifiers meth2)) qualifier-order) 2)))
+ (cond ((< q1 q2) (return-from method< t))
+ ((> q1 q2) (return-from method< nil)))))
+ ;; If qualifiers are equal, go by arguments
+ (loop for sp1 in (swank-mop:method-specializers meth1)
+ for sp2 in (swank-mop:method-specializers meth2)
+ do (cond
+ ((eq sp1 sp2)) ;; continue comparision
+ ;; an eql specializer is most specific
+ ((typep sp1 'swank-mop:eql-specializer)
+ (return-from method< t))
+ ((typep sp2 'swank-mop:eql-specializer)
+ (return-from method< nil))
+ ;; otherwise the longer the CPL the more specific
+ ;; the specializer is
+ (t (let ((l1 (if (swank-mop:class-finalized-p sp1)
+ (length
(swank-mop:class-precedence-list sp1))
+ 0))
+ (l2 (if (swank-mop:class-finalized-p sp2)
+ (length
(swank-mop:class-precedence-list sp2))
+ 0)))
+ (cond
+ ((> l1 l2)
+ (return-from method< t))
+ ((< l1 l2)
+ (return-from method< nil))))))
+ finally (return nil))))
+ (declare (dynamic-extent #'method<))
+ (sort methods #'method<))))
+
(defmethod inspect-for-emacs ((gf standard-generic-function) (inspector
t))
(declare (ignore inspector))
(values "A generic function."
`("Name: " (:value ,(swank-mop:generic-function-name gf))
(:newline)
- "It's argument list is: " ,(princ-to-string
(swank-mop:generic-function-lambda-list gf)) (:newline)
+ "Its argument list is: " ,(princ-to-string
(swank-mop:generic-function-lambda-list gf)) (:newline)
"Documentation: " (:newline)
,(princ-to-string (documentation gf t)) (:newline)
- "It's method class is: " (:value
,(swank-mop:generic-function-method-class gf)) (:newline)
+ "Its method class is: " (:value
,(swank-mop:generic-function-method-class gf)) (:newline)
"It uses " (:value
,(swank-mop:generic-function-method-combination gf)) " method
combination." (:newline)
"Methods: " (:newline)
,@(loop
- for method in (swank-mop:generic-function-methods gf)
+ for method in (sorted-methods gf)
collect `(:value ,method
, (with-output-to-string (meth)
(let ((specs
(swank-mop:method-specializers method))
@@ -2690,6 +2733,13 @@
collect " "
collect (let ((meth method))
`(:action "[remove method]" ,(lambda ()
(remove-method gf meth))))
+ collect '(:newline)
+ collect " Documentation: "
+ ;; Display the first sentence or the first 50 characters
of the docstring
+ ;; FIXME: Idea's for something less random to chop the
docline?
+ collect (let ((doc (documentation method t)))
+ (or (subseq doc 0 (min (1+ (or (position #\.
doc) 49)) 50))
+ "None"))
collect '(:newline)))))
(defmethod inspect-for-emacs ((method standard-method) (inspector t))
More information about the slime-devel
mailing list