[slime-cvs] CVS slime/contrib

[CVS User trittweiler]

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

Modified Files:
	ChangeLog slime-c-p-c.el swank-arglists.lisp 
Log Message:
	* swank-arglists.lisp (delete-given-args): Make sure to properly
	delete provided-args.

	* slime-c-p-c.el (complete-form [test]): Extend. Succeeds now.



--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/12/23 08:55:41	1.318
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/12/25 11:04:00	1.319
@@ -1,3 +1,10 @@
+2009-12-25  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* swank-arglists.lisp (delete-given-args): Make sure to properly
+	delete provided-args.
+
+	* slime-c-p-c.el (complete-form [test]): Extend. Succeeds now.
+
 2009-12-23  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* slime-parse.el (form-up-to-point.1 [test]): Fix test case.
--- /project/slime/cvsroot/slime/contrib/slime-c-p-c.el	2009/12/23 08:52:00	1.18
+++ /project/slime/cvsroot/slime/contrib/slime-c-p-c.el	2009/12/25 11:04:00	1.19
@@ -208,13 +208,21 @@
     (slime-test-expect "Completion set" expected-completions completions)))
 
 (def-slime-test complete-form
-    (buffer-sexpr wished-completion)
+    (buffer-sexpr wished-completion &optional skip-trailing-test-p)
     ""
-    '(("(defmethod swank::arglist-dispatch *HERE*"
-       "(defmethod swank::arglist-dispatch (operator arguments) body...)"))
+    '(("(defmethod arglist-dispatch *HERE*"
+       "(defmethod arglist-dispatch (operator arguments) body...)")
+      ("(with-struct *HERE*"
+       "(with-struct (conc-name names...) obj body...)")
+      ("(with-struct *HERE*"
+       "(with-struct (conc-name names...) obj body...)")
+      ("(with-struct (*HERE*"
+       "(with-struct (conc-name names...)" t)
+      ("(with-struct (foo. bar baz *HERE*"
+       "(with-struct (foo. bar baz names...)" t))
   (slime-check-top-level)
   (with-temp-buffer
-    (setq slime-buffer-package "COMMON-LISP-USER")
+    (setq slime-buffer-package "SWANK")
     (lisp-mode)
     (insert buffer-sexpr)
     (search-backward "*HERE*")
@@ -223,13 +231,14 @@
     (slime-check-completed-form buffer-sexpr wished-completion)
 
     ;; Now the same but with trailing `)' for paredit users...
-    (erase-buffer)
-    (insert buffer-sexpr)
-    (search-backward "*HERE*")
-    (delete-region (match-beginning 0) (match-end 0))
-    (insert ")") (backward-char)
-    (slime-complete-form)
-    (slime-check-completed-form (concat buffer-sexpr ")") wished-completion)
+    (unless skip-trailing-test-p
+      (erase-buffer)
+      (insert buffer-sexpr)
+      (search-backward "*HERE*")
+      (delete-region (match-beginning 0) (match-end 0))
+      (insert ")") (backward-char)
+      (slime-complete-form)
+      (slime-check-completed-form (concat buffer-sexpr ")") wished-completion))
     ))
 
 (defun slime-check-completed-form (buffer-sexpr wished-completion)
--- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2009/12/21 16:23:02	1.49
+++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2009/12/25 11:04:00	1.50
@@ -354,6 +354,7 @@
              (pprint-newline :fill)))
       (pprint-logical-block (nil nil :prefix prefix :suffix suffix)
         (do-decoded-arglist decoded-arglist
+          (&provided ())  ; do nothing; provided args are in the buffer already.
           (&required (arg)
             (space) (print-arg-or-pattern arg))
           (&optional (arg)
@@ -935,6 +936,9 @@
 		    (return-from do-decoded-arglist)
 		    (pop ,list))))
     (do-decoded-arglist decoded-arglist
+      (&provided ()
+       (assert (eq (pop-or-return args)
+                   (pop (arglist.provided-args decoded-arglist)))))
       (&required ()
        (pop-or-return args)
        (pop (arglist.required-args decoded-arglist)))