[slime-cvs] CVS slime/contrib

[CVS User trittweiler]

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

Modified Files:
	ChangeLog slime-autodoc.el swank-arglists.lisp 
Log Message:
	* swank-arglists.lisp (extract-local-op-arglists): Fix for
	`(labels ((foo (x) ...)|'.

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


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2010/02/20 18:46:24	1.348
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2010/03/07 14:09:51	1.349
@@ -1,3 +1,10 @@
+2010-03-07  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* swank-arglists.lisp (extract-local-op-arglists): Fix for
+	`(labels ((foo (x) ...)|'.
+
+	* slime-autodoc.el (autodoc.1): Add test cases.
+
 2010-02-20  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* slime-fancy.el: Call init function for fancy
--- /project/slime/cvsroot/slime/contrib/slime-autodoc.el	2010/02/15 21:42:37	1.35
+++ /project/slime/cvsroot/slime/contrib/slime-autodoc.el	2010/03/07 14:09:51	1.36
@@ -316,7 +316,14 @@
        "(declare ((string &optional ===> size <===) &rest variables))")
       ("(declare (type (string *HERE*"
        "(declare (type (string &optional ===> size <===) &rest variables))")
-      )
+
+      ;; Test local functions
+      ("(flet ((foo (x y) (+ x y))) (foo *HERE*" "(foo ===> x <=== y)")
+      ("(macrolet ((foo (x y) `(+ ,x ,y))) (foo *HERE*" "(foo ===> x <=== y)")
+      ("(labels ((foo (x y) (+ x y))) (foo *HERE*" "(foo ===> x <=== y)")
+      ("(labels ((foo (x y) (+ x y)) 
+                 (bar (y) (foo *HERE*" 
+       "(foo ===> x <=== y)"))
   (slime-check-top-level)
   (with-temp-buffer
     (setq slime-buffer-package "COMMON-LISP-USER")
--- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2010/01/06 18:23:44	1.57
+++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2010/03/07 14:09:51	1.58
@@ -1285,22 +1285,23 @@
   (:method ((operator (eql 'cl:flet)) args)
     (let ((defs (first args))
           (body (rest args)))
-      (cond ((null body) nil)           ; `(flet ((foo (x) |'
-            ((atom defs) nil)           ; `(flet ,foo (|'
+      (cond ((null body) nil)            ; `(flet ((foo (x) |'
+            ((atom defs) nil)            ; `(flet ,foo (|'
             (t (%collect-op/argl-alist defs)))))
   ;; LABELS
   (:method ((operator (eql 'cl:labels)) args)
     ;; Notice that we only have information to "look backward" and
     ;; show arglists of previously occuring local functions.
-    (let ((defs (first args))
-          (body (rest args)))
-      (cond ((atom defs) nil)
-            ((not (null body))
-             (extract-local-op-arglists 'cl:flet args))
-            (t
-             (let ((def.body (cddr (car (last defs)))))
-               (when def.body
-                 (%collect-op/argl-alist defs)))))))
+    (destructuring-bind (defs . body) args
+      (unless (atom defs)                ; `(labels ,foo (|'
+        (let ((current-def (car (last defs))))
+          (cond ((atom current-def) nil) ; `(labels ((foo (x) ...)|'
+                ((not (null body))
+                 (extract-local-op-arglists 'cl:flet args))
+                (t
+                 (let ((def.body (cddr current-def)))
+                   (when def.body
+                     (%collect-op/argl-alist defs)))))))))
   ;; MACROLET
   (:method ((operator (eql 'cl:macrolet)) args)
     (extract-local-op-arglists 'cl:labels args)))