Hi, I am sending below a little patch for the new slime-complete-form functionality. Cheers, Matthias 2005-02-22 Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de> * swank.lisp (print-decoded-arglist-as-template): If keyword is not a keyword symbol, quote it in the template. (extra-keywords): Return a secondary value (allow-other-keys). For make-instance, try to finalize the class if it is not finalized yet (fix for Allegro CL 6.2). If class is not finalizable, use direct slots instead of slots and indicate that the keywords are not complete. (enrich-decoded-arglist-with-extra-keywords): New function, use the secondary value of extra-keywords. (arglist-for-insertion, complete-form): Use it here. * swank-backend.lisp (:swank-mop package): Export finalize-inheritance. Index: swank-backend.lisp =================================================================== RCS file: /project/slime/cvsroot/slime/swank-backend.lisp,v retrieving revision 1.79 diff -u -p -r1.79 swank-backend.lisp --- swank-backend.lisp 20 Feb 2005 20:20:39 -0000 1.79 +++ swank-backend.lisp 22 Feb 2005 22:12:32 -0000 @@ -83,7 +83,8 @@ #:slot-definition-readers #:slot-definition-writers ;; generic function protocol - #:compute-applicable-methods-using-classes)) + #:compute-applicable-methods-using-classes + #:finalize-inheritance)) (in-package :swank-backend) Index: swank.lisp =================================================================== RCS file: /project/slime/cvsroot/slime/swank.lisp,v retrieving revision 1.280 diff -u -p -r1.280 swank.lisp --- swank.lisp 20 Feb 2005 20:29:14 -0000 1.280 +++ swank.lisp 22 Feb 2005 22:12:34 -0000 @@ -1327,7 +1327,9 @@ whether &allow-other-keys appears somewh (format t "[~A]" arg)) (dolist (keyword (arglist.keyword-args decoded-arglist)) (space) - (format t "~W ~A" keyword keyword)) + (format t "~W ~A" + (if (keywordp keyword) keyword `',keyword) + keyword)) (when (and (arglist.rest decoded-arglist) (or (not (arglist.keyword-args decoded-arglist)) (arglist.allow-other-keys-p decoded-arglist))) @@ -1338,8 +1340,9 @@ whether &allow-other-keys appears somewh (pprint-newline :fill)) (defgeneric extra-keywords (operator &rest args) - (:documentation "Return a list of extra keywords of OPERATOR (a symbol) -when applied to the (unevaluated) ARGS.")) + (:documentation "Return a list of extra keywords of OPERATOR (a +symbol) when applied to the (unevaluated) ARGS. As a secondary value, +return whether other keys are allowed.")) (defmethod extra-keywords (operator &rest args) ;; default method @@ -1358,20 +1361,44 @@ when applied to the (unevaluated) ARGS." (eq (car class-name-form) 'quote)) (let* ((class-name (cadr class-name-form)) (class (find-class class-name nil))) + (unless (swank-mop:class-finalized-p class) + ;; Try to finalize the class, which can fail if + ;; superclasses are not defined yet + (handler-case (swank-mop:finalize-inheritance class) + (program-error (c) + (declare (ignore c))))) (when class ;; We have the case (make-instance 'CLASS ...) ;; with a known CLASS. - (let ((slot-init-keywords - (loop for slot in (swank-mop:class-slots class) - append (swank-mop:slot-definition-initargs slot))) - (initialize-instance-keywords - (applicable-methods-keywords #'initialize-instance - (list class)))) - (return-from extra-keywords - (append slot-init-keywords - initialize-instance-keywords)))))))) + (multiple-value-bind (slots allow-other-keys-p) + (if (swank-mop:class-finalized-p class) + (values (swank-mop:class-slots class) nil) + (values (swank-mop:class-direct-slots class) t)) + (let ((slot-init-keywords + (loop for slot in slots + append (swank-mop:slot-definition-initargs slot))) + (initialize-instance-keywords + (applicable-methods-keywords #'initialize-instance + (list class)))) + (return-from extra-keywords + (values (append slot-init-keywords + initialize-instance-keywords) + allow-other-keys-p))))))))) (call-next-method)) +(defun enrich-decoded-arglist-with-extra-keywords (decoded-arglist form) + (multiple-value-bind (extra-keywords extra-aok) + (apply #'extra-keywords form) + (with-str + ;; enrich the list of keywords with the extra keywords + (setf (arglist.keyword-args decoded-arglist) + (remove-duplicates + (append (arglist.keyword-args decoded-arglist) + extra-keywords))) + (setf (arglist.allow-other-keys-p decoded-arglist) + (or (arglist.allow-other-keys-p decoded-arglist) extra-aok))) + decoded-arglist) + (defslimefun arglist-for-insertion (name) (with-buffer-syntax () (let ((symbol (parse-symbol name))) @@ -1383,13 +1410,9 @@ when applied to the (unevaluated) ARGS." ((member :not-available) :not-available) (list - (let ((decoded-arglist (decode-arglist arglist)) - (extra-keywords (extra-keywords symbol))) - ;; enrich the list of keywords with the extra keywords - (setf (arglist.keyword-args decoded-arglist) - (remove-duplicates - (append (arglist.keyword-args decoded-arglist) - extra-keywords))) + (let ((decoded-arglist (decode-arglist arglist))) + (enrich-decoded-arglist-with-extra-keywords decoded-arglist + (list symbol)) (decoded-arglist-to-template-string decoded-arglist *buffer-package*)))))) (t @@ -1426,13 +1449,8 @@ by adding a template for the missing arg ((member :not-available) :not-available) (list - (let ((decoded-arglist (decode-arglist arglist)) - (extra-keywords (apply #'extra-keywords form))) - ;; enrich the list of keywords with the extra keywords - (setf (arglist.keyword-args decoded-arglist) - (remove-duplicates - (append (arglist.keyword-args decoded-arglist) - extra-keywords))) + (let ((decoded-arglist (decode-arglist arglist))) + (enrich-decoded-arglist-with-extra-keywords decoded-arglist form) ;; get rid of formal args already provided (remove-actual-args decoded-arglist argument-forms) (return-from complete-form -- Matthias Koeppe -- http://www.math.uni-magdeburg.de/~mkoeppe