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))