Please find below a patch that makes C-c C-s (slime-insert-arglist) much more useful. Instead of inserting a formal argument list, it inserts a template for a function call; this makes a difference for functions with optional and keyword arguments. After inserting the arguments, point is left on the first argument, like ILISP's C-u M-x arglist-lisp does; this allows editing the arguments easily.
Index: slime.el =================================================================== RCS file: /project/slime/cvsroot/slime/slime.el,v retrieving revision 1.443 diff -u -p -u -r1.443 slime.el --- slime.el 16 Dec 2004 22:24:41 -0000 1.443 +++ slime.el 17 Dec 2004 13:24:07 -0000 @@ -4227,7 +4227,17 @@ more than one space." "Insert the argument list for NAME behind the symbol point is currently looking at." (interactive (list (slime-read-symbol-name "Arglist of: "))) - (insert (slime-eval `(swank:arglist-for-insertion ',name)))) + (let ((arglist (slime-eval `(swank:arglist-for-insertion ',name)))) + (cond + ((eq arglist :not-available) + (error "Arglist not available")) + ((string-match "^(" arglist) + (insert " ") + (save-excursion + (insert (substring arglist 1)))) + (t + (save-excursion + (insert arglist))))))
(defun slime-get-arglist (symbol-name) "Return the argument list for SYMBOL-NAME."
Index: swank.lisp =================================================================== RCS file: /project/slime/cvsroot/slime/swank.lisp,v retrieving revision 1.272 diff -u -p -u -r1.272 swank.lisp --- swank.lisp 16 Dec 2004 21:16:50 -0000 1.272 +++ swank.lisp 17 Dec 2004 13:25:18 -0000 @@ -1143,17 +1143,108 @@ pretty printing of (function foo) as #'f (*print-length* 10) (*print-circle* t)) (format nil "~A => ~A" sym (symbol-value sym)))))))
+(defun decode-keyword-arg (arg) + "Decode a keyword item of formal argument list. +Return three values: keyword, argument name, default arg." + (cond + ((symbolp arg) + (values (intern (symbol-name arg) keyword-package) + arg + nil)) + ((and (consp arg) + (consp (car arg))) + (values (caar arg) + (cadar arg) + (cadr arg))) + ((consp arg) + (values (intern (symbol-name (car arg)) keyword-package) + (car arg) + (cadr arg))) + (t + (error "Bad keyword item of formal argument list")))) +(progn + (assert (equal (multiple-value-list (decode-keyword-arg 'x)) '(:x x nil))) + (assert (equal (multiple-value-list (decode-keyword-arg '(x t))) '(:x x t))) + (assert (equal (multiple-value-list (decode-keyword-arg '((:x y)))) '(:x y nil))) + (assert (equal (multiple-value-list (decode-keyword-arg '((:x y) t))) '(:x y t)))) +(defun decode-optional-arg (arg) + "Decode an optional item of a formal argument list. +Return two values: argument name, default arg." + (etypecase arg + (symbol + (values arg nil)) + (list + (values (car arg) (cadr arg))))) +(progn + (assert (equal (multiple-value-list (decode-optional-arg 'x)) '(x nil))) + (assert (equal (multiple-value-list (decode-optional-arg '(x t))) '(x t)))) + +(defun arglist-to-template-string (arglist package) + "Print the list ARGLIST for insertion as a template for a function call." + (setq arglist (clean-arglist arglist)) + (etypecase arglist + (null "()") + (cons + (with-output-to-string (*standard-output*) + (with-standard-io-syntax + (let ((*package* package) (*print-case* :downcase) + (*print-pretty* t) (*print-circle* nil) (*print-readably* nil) + (*print-level* 10) (*print-length* 20)) + (pprint-logical-block (nil nil :prefix "(" :suffix ")") + (let ((mode nil)) + (loop + (let ((arg (pop arglist))) + (typecase arg + ((member &key &optional &rest &body) + (setq mode arg)) + (string + (princ arg) + (unless (null arglist) + (write-char #\space))) + (t + (case mode + (&key + (multiple-value-bind (keyword arg-symbol default-arg) + (decode-keyword-arg arg) + (declare (ignore default-arg)) + (write keyword) + (write-char #\space) + (princ arg-symbol))) + (&optional + (multiple-value-bind (arg-symbol default-arg) + (decode-optional-arg arg) + (declare (ignore default-arg)) + (write-char #[) + (princ arg-symbol) + (write-char #]))) + (&body + (pprint-newline :mandatory) + (princ arg) + (princ "...")) + (&rest + (princ arg) + (princ "...")) + (otherwise + (princ arg))) + (unless (null arglist) + (write-char #\space))))) + (when (null arglist) (return)) + (pprint-newline :fill)))))))))) + +(defun test-print-template (list string) + (string= (arglist-to-template-string list (find-package :swank)) string)) + (defslimefun arglist-for-insertion (name) (with-buffer-syntax () (cond ((valid-operator-name-p name) (let ((arglist (arglist (parse-symbol name)))) (etypecase arglist ((member :not-available) - " <not available>") + :not-available) (list - (arglist-to-string arglist *buffer-package*))))) + (arglist-to-template-string arglist *buffer-package*))))) (t - " <not available>")))) + :not-available))))
;;;; Evaluation
Sorry to follow up to my own message, but would any of the developers like to take a look at the patch I sent?
Matthias Koeppe mkoeppe+slime@merkur.math.uni-magdeburg.de writes:
Sorry to follow up to my own message, but would any of the developers like to take a look at the patch I sent?
I applied the patch with minor changes. Please try to keep functions a little shorter. Patches will then be committed quicker :-)
Helmut.