I think I already sent these some days ago but they never got commited. So I revised them and resend them, in short it's (all concerning the inspector):
- when inspecting gf: - display short docs for gf methods (when available) - sort them by applicability (according to a #lisp suggestion some time ago), although this is still a little buggy but IMO still better than no ordering at all users can specify their own function if they don't like the default by setting `*gf-method-getter*' (feel free to rename this to sth. more sensible) - when inspecting class: - abbrev'd docs for methods specialising on the class - print them one per line - order them by name (not customizable)
-ts
,---- Index: swank.lisp =================================================================== RCS file: /project/slime/cvsroot/slime/swank.lisp,v retrieving revision 1.253 diff -u -r1.253 swank.lisp --- swank.lisp 19 Oct 2004 06:14:17 -0000 1.253 +++ swank.lisp 24 Oct 2004 19:48:01 -0000 @@ -2786,6 +2786,68 @@ collect "#<unbound>" collect '(:newline)))))
+(defvar *gf-method-getter* 'methods-by-applicability + "This function is called to get the methods of a generic function. +The default returns the method sorted by applicability. +See `methods-by-applicability'.") + +;;; Largely inspired by (+ copied from) the McCLIM listener +(defun methods-by-applicability (gf) + "Return methods ordered by qualifiers, then by most specific argument types. + +Qualifier ordering is: :before, :around, primary, and :after. +We use the length of the class precedence list to determine which type is +more specific." + ;;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 + ;; come 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 + ;; FIXME: Taking the CPL as indicator has the problem + ;; that unfinalized classes are most specific. Can we pick + ;; a reasonable default or do something with SUBTYPEP ? + (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<)))) + +(defun abbrev-doc (doc &optional (maxlen 80)) + "Return the first sentence of DOC, but not more than MAXLAN characters." + (subseq doc 0 (min (1+ (or (position #. doc) (1- maxlen))) + maxlen + (length doc)))) + (defmethod inspect-for-emacs ((gf standard-generic-function) (inspector t)) (declare (ignore inspector)) (values "A generic function." @@ -2797,13 +2859,17 @@ "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 (funcall *gf-method-getter* gf) collect `(:value ,method ,(inspector-princ ;; drop the first element (the name of the generic function) (cdr (method-for-inspect-value method)))) collect " " collect (let ((meth method)) `(:action "[remove method]" ,(lambda () (remove-method gf meth)))) + collect '(:newline) + if (documentation method t) + collect " Documentation: " and + collect (abbrev-doc (documentation method t)) collect '(:newline)))))
(defmethod inspect-for-emacs ((method standard-method) (inspector t)) @@ -2860,8 +2926,18 @@ ,@(when (swank-mop:specializer-direct-methods class) `("It is used as a direct specializer in the following methods:" (:newline) ,@(loop - for method in (swank-mop:specializer-direct-methods class) + for method in (sort (copy-list (swank-mop:specializer-direct-methods class)) + #'string< :key (lambda (x) + (symbol-name + (let ((name (swank-mop::generic-function-name + (swank-mop::method-generic-function x)))) + (if (symbolp name) name (second name)))))) + collect " " collect `(:value ,method ,(inspector-princ (method-for-inspect-value method))) + collect '(:newline) + if (documentation method t) + collect " Documentation: " and + collect (abbrev-doc (documentation method t)) and collect '(:newline)))) "Prototype: " ,(if (swank-mop:class-finalized-p class) `(:value ,(swank-mop:class-prototype class))