[slime-cvs] CVS slime/contrib

[CVS User trittweiler]

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv28480/contrib

Modified Files:
	ChangeLog slime-autodoc.el swank-arglists.lisp 
Log Message:
	* swank-arglists.lisp (print-decoded-arglist): Fix printing of
	&any and &key parameters.
	(test-print-arglist): Slightly adapted.

	* slime-autodoc ([test] autodoc.1): Slightly adapted.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/03 22:14:19	1.270
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/11/05 17:33:41	1.271
@@ -1,3 +1,11 @@
+2009-11-05  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* swank-arglists.lisp (print-decoded-arglist): Fix printing of
+	&any and &key parameters.
+	(test-print-arglist): Slightly adapted.
+
+	* slime-autodoc ([test] autodoc.1): Slightly adapted.
+
 2009-11-02  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* swank-arglists.lisp (do-decoded-arglists): Remove L-V-T.
--- /project/slime/cvsroot/slime/contrib/slime-autodoc.el	2009/10/31 22:13:55	1.22
+++ /project/slime/cvsroot/slime/contrib/slime-autodoc.el	2009/11/05 17:33:41	1.23
@@ -293,10 +293,10 @@
        "(symbol-status symbol &optional ===> (package (symbol-package symbol)) <===)")
 
       ("(apply 'swank::eval-for-emacs*HERE*"
-       "(apply ===> 'eval-for-emacs <=== &optional form buffer-package id &rest args)")
+       "(apply 'eval-for-emacs &optional form buffer-package id &rest args)")
 
       ("(apply #'swank::eval-for-emacs*HERE*"
-       "(apply ===> #'eval-for-emacs <=== &optional form buffer-package id &rest args)")
+       "(apply #'eval-for-emacs &optional form buffer-package id &rest args)")
 
       ("(apply 'swank::eval-for-emacs foo *HERE*"
        "(apply 'eval-for-emacs &optional form ===> buffer-package <=== id &rest args)")
--- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2009/11/03 22:14:19	1.39
+++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2009/11/05 17:33:41	1.40
@@ -257,18 +257,18 @@
     (let ((index 0))
       (pprint-logical-block (nil nil :prefix "(" :suffix ")")
         (when operator
-          (print-arg operator))
+          (princ-arg operator))
         (do-decoded-arglist (remove-given-args arglist provided-args)
           (&provided (arg)
              (space)
-             (print-arg arg)
+             (princ-arg arg)
              (incf index))
           (&required (arg)
              (space)
              (if (arglist-p arg)
                  (print-arglist-recursively arg :index index)
                  (with-highlighting (:index index)
-                   (print-arg arg)))
+                   (princ-arg arg)))
              (incf index))
           (&optional :initially
              (when (arglist.optional-args arglist)
@@ -280,7 +280,7 @@
                  (print-arglist-recursively arg :index index)
                  (with-highlighting (:index index)
                    (if (null init-value)
-                       (print-arg arg)
+                       (princ-arg arg)
                        (format t "~:@<~A ~S~@:>" arg init-value))))
              (incf index))
           (&key :initially
@@ -293,9 +293,14 @@
                    (prin1 keyword) (space)
                    (print-arglist-recursively arg :index keyword))
                  (with-highlighting (:index keyword)
-                   (if init
-                       (format t "~:@<~A ~S~@:>" (if keyword keyword arg) init)
-                       (print-arg keyword)))))
+                   (cond ((and init (keywordp keyword))
+                          (format t "~:@<~A ~S~@:>" arg init))
+                         (init
+                          (format t "~:@<(~S ..) ~S~@:>" keyword init))
+                         ((not (keywordp keyword))
+                          (format t "~:@<~S ..~@:>" keyword))
+                         (t
+                          (princ-arg keyword))))))
           (&key :finally
              (when (arglist.allow-other-keys-p arglist)
                (space)
@@ -306,7 +311,7 @@
                (princ '&any)))
           (&any (arg)
              (space)
-             (print-arg arg))
+             (prin1-arg arg))
           (&rest (args bodyp)
              (space)
              (princ (if bodyp '&body '&rest))
@@ -314,15 +319,20 @@
              (if (arglist-p args)
                  (print-arglist-recursively args :index index)
                  (with-highlighting (:index index)
-                   (print-arg args))))
+                   (princ-arg args))))
           ;; FIXME: add &UNKNOWN-JUNK?
           )))))
 
-(defun print-arg (arg)
+(defun princ-arg (arg)
   (princ (if (arglist-dummy-p arg)
              (arglist-dummy.string-representation arg)
              arg)))
 
+(defun prin1-arg (arg)
+  (if (arglist-dummy-p arg)
+      (princ (arglist-dummy.string-representation arg))
+      (prin1 arg)))
+
 (defun print-decoded-arglist-as-template (decoded-arglist &key
                                           (prefix "(") (suffix ")"))
   (let ((first-p t))
@@ -1343,7 +1353,7 @@
     (test '(&whole x y z) "(y z)")
     (test '(x &aux y z) "(x)")
     (test '(x &environment env y) "(x y)")
-    (test '(&key ((function f))) "(&key ((function f)))")
+    (test '(&key ((function f))) "(&key ((function ..)))")
     (test '(eval-when (&any :compile-toplevel :load-toplevel :execute) &body body)
 	  "(eval-when (&any :compile-toplevel :load-toplevel :execute) &body body)")
     (test '(declare (optimize &any (speed 1) (safety 1)))