[slime-cvs] CVS slime/contrib

[CVS User sboukarev]

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

Modified Files:
	ChangeLog slime-repl.el 
Log Message:
* slime-repl.el (slime-call-defun): Handle setf-functions.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2010/07/04 15:55:29	1.395
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2010/07/16 07:34:23	1.396
@@ -1,3 +1,7 @@
+2010-07-16  Stas Boukarev  <stassats at gmail.com>
+
+	* slime-repl.el (slime-call-defun): Handle setf-functions.
+
 2010-07-04  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-asdf.lisp (asdf:operation-done-p): Fix reloading on
--- /project/slime/cvsroot/slime/contrib/slime-repl.el	2010/05/28 14:15:30	1.46
+++ /project/slime/cvsroot/slime/contrib/slime-repl.el	2010/07/16 07:34:23	1.47
@@ -1437,9 +1437,16 @@
 (defun slime-call-defun ()
   "Insert a call to the toplevel form defined around point into the REPL."
   (interactive)
-  (flet ((insert-call (symbol &key (function t)
-                              defclass)
-           (let* ((qualified-symbol-name (slime-qualify-cl-symbol-name symbol))
+  (flet ((insert-call (name &key (function t)
+                            defclass)
+           (let* ((setf (and function
+                               (consp name)
+                               (= (length name) 2)
+                               (eql (car name) 'setf)))
+                  (symbol (if setf
+                              (cadr name)
+                              name))
+                  (qualified-symbol-name (slime-qualify-cl-symbol-name symbol))
                   (symbol-name (slime-cl-symbol-name qualified-symbol-name))
                   (symbol-package (slime-cl-symbol-package qualified-symbol-name))
                   (call (if (equalp (slime-lisp-package) symbol-package)
@@ -1450,12 +1457,17 @@
              (insert (if function
                          "("
                          " "))
+             (when setf
+               (insert "setf ("))
              (if defclass
                  (insert "make-instance '"))
              (insert call)
-             (when function
-               (insert " ")
-               (save-excursion (insert ")")))
+             (cond (setf
+                    (insert " ")
+                    (save-excursion (insert ") )")))
+                   (function
+                    (insert " ")
+                    (save-excursion (insert ")"))))
              (unless function
                (goto-char slime-repl-input-start-mark)))))           
     (let ((toplevel (slime-parse-toplevel-form)))