[slime-cvs] CVS slime/contrib

[CVS User trittweiler]

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

Modified Files:
	ChangeLog slime-autodoc.el swank-arglists.lisp 
Log Message:
	* swank-arglists.lisp (arglist-index): Return NIL if more
	arguments were provided than are allowed.
	(form-path-to-arglist-path): Adapted accordingly.

	* slime-autodoc.el (autodoc.1 [test]): Add relevant test cases.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2010/01/03 14:25:12	1.327
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2010/01/03 15:34:54	1.328
@@ -1,5 +1,13 @@
 2010-01-03  Tobias C. Rittweiler  <tcr at freebits.de>
 
+	* swank-arglists.lisp (arglist-index): Return NIL if more
+	arguments were provided than are allowed.
+	(form-path-to-arglist-path): Adapted accordingly.
+
+	* slime-autodoc.el (autodoc.1 [test]): Add relevant test cases.
+
+2010-01-03  Tobias C. Rittweiler  <tcr at freebits.de>
+
 	* slime-indentation-fu.el, swank-indentation-fu.lisp: Delete
 	contrib. Never worked quite right, and the necessary
 	infrastructure has since been gone.
--- /project/slime/cvsroot/slime/contrib/slime-autodoc.el	2009/12/29 19:41:05	1.28
+++ /project/slime/cvsroot/slime/contrib/slime-autodoc.el	2010/01/03 15:34:54	1.29
@@ -246,9 +246,11 @@
     (buffer-sexpr wished-arglist &optional skip-trailing-test-p)
     ""
     '(("(swank::emacs-connected*HERE*"    "(emacs-connected)")
+      ("(swank::emacs-connected *HERE*"    "(emacs-connected)")
       ("(swank::create-socket*HERE*"      "(create-socket host port)")
       ("(swank::create-socket *HERE*"     "(create-socket ===> host <=== port)")
       ("(swank::create-socket foo *HERE*" "(create-socket host ===> port <===)")
+      ("(swank::create-socket foo bar *HERE*" "(create-socket host port)")
 
       ("#'(lambda () (swank::create-socket*HERE*" "(create-socket host port)")
       ("`(lambda () ,(swank::create-socket*HERE*" "(create-socket host port)")
--- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2009/12/30 10:25:04	1.53
+++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2010/01/03 15:34:54	1.54
@@ -1348,15 +1348,21 @@
                  nil
                  (let* ((idx      (car path))
                         (idx*     (arglist-index idx args arglist))
-                        (arglist* (arglist-ref arglist idx*))
-                        (args*    (provided-arguments-ref args arglist idx*)))
+                        (arglist* (and idx* (arglist-ref arglist idx*)))
+                        (args*    (and idx* (provided-arguments-ref args
+                                                                    arglist
+                                                                    idx*))))
                    ;; The FORM-PATH may be more detailed than ARGLIST;
                    ;; consider (defun foo (x y) ...), a form path may
                    ;; point into the function's lambda-list, but the
                    ;; arglist of DEFUN won't contain as much information.
-                   (if (arglist-p arglist*)
-                       (cons idx* (convert (cdr path) args* arglist*))
-                       (list idx*))))))
+                   ;; So we only recurse if possible.
+                   (cond ((null idx*)
+                          nil)
+                         ((arglist-p arglist*)
+                          (cons idx* (convert (cdr path) args* arglist*)))
+                         (t
+                          (list idx*)))))))
     (convert
      ;; FORM contains irrelevant operator. Adjust FORM-PATH.
      (cond ((null form-path) nil)
@@ -1372,19 +1378,22 @@
 to the argument (NTH `provided-argument-index' `provided-arguments')."
   (let ((positional-args# (positional-args-number arglist))
         (arg-index provided-argument-index))
-    (cond
-      ((< arg-index positional-args#)        ; required + optional
-       arg-index)
-      ((not (arglist.key-p arglist))         ; rest + body
-       (assert (arglist.rest arglist))
-       positional-args#) 
-      (t                                     ; key
-       ;; Find last provided &key parameter
-       (let* ((argument      (nth arg-index provided-arguments))
-              (provided-keys (subseq provided-arguments positional-args#)))
-         (loop for (key value) on provided-keys by #'cddr
-               when (eq value argument) 
-                 return key))))))
+    (with-struct (arglist. key-p rest) arglist
+      (cond
+        ((< arg-index positional-args#) ; required + optional
+         arg-index)
+        ((and (not key-p) (not rest))   ; more provided than allowed
+         nil)
+        ((not key-p)                    ; rest + body
+         (assert (arglist.rest arglist))
+         positional-args#) 
+        (t                              ; key
+         ;; Find last provided &key parameter
+         (let* ((argument      (nth arg-index provided-arguments))
+                (provided-keys (subseq provided-arguments positional-args#)))
+           (loop for (key value) on provided-keys by #'cddr
+                 when (eq value argument) 
+                 return key)))))))
 
 (defun arglist-ref (arglist &rest indices)
   "Returns the parameter in ARGLIST along the INDICIES path. Numbers