[slime-cvs] CVS update: slime/swank-lispworks.lisp

[Helmut Eller]

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv28968

Modified Files:
	swank-lispworks.lisp 
Log Message:
(describe-symbol-for-emacs): Include information about setf-functions stuff.

(emacs-connected): Add a default method to
defenv-internals:environment-display-debugger.

Date: Wed Jun 30 14:45:07 2004
Author: heller

Index: slime/swank-lispworks.lisp
diff -u slime/swank-lispworks.lisp:1.48 slime/swank-lispworks.lisp:1.49
--- slime/swank-lispworks.lisp:1.48	Sun Jun 27 08:00:43 2004
+++ slime/swank-lispworks.lisp	Wed Jun 30 14:45:07 2004
@@ -25,6 +25,10 @@
    stream:stream-line-column
    ))
 
+(when (fboundp 'dspec::define-form-parser)
+  (dspec::define-form-parser defimplementation (name args &rest body)
+    `(defmethod ,name ,args , at body)))
+
 ;;; TCP server
 
 (defimplementation preferred-communication-style ()
@@ -76,7 +80,10 @@
         (env &key restarts condition)
       (declare (ignore restarts))
       (funcall (find-symbol (string :swank-debugger-hook) :swank)
-               condition *debugger-hook*))))
+               condition *debugger-hook*))
+    (defmethod env-internals:environment-display-debugger
+        (env)
+      *debug-io*)))
 
 ;;; Unix signals
 
@@ -145,6 +152,10 @@
                           (not (generic-function-p (fdefinition symbol))))
                      (doc 'function)))
       (maybe-push
+       :setf (let ((setf-name (sys:underlying-setf-name `(setf ,symbol))))
+               (if (fboundp setf-name)
+                   (doc 'setf))))
+      (maybe-push
        :class (if (find-class symbol nil) 
                   (doc 'class)))
       result)))
@@ -153,7 +164,8 @@
   (ecase type
     (:variable (describe-symbol symbol))
     (:class (describe (find-class symbol)))
-    ((:function :generic-function) (describe-function symbol))))
+    ((:function :generic-function) (describe-function symbol))
+    (:setf (describe-function (sys:underlying-setf-name `(setf ,symbol))))))
 
 (defun describe-function (symbol)
   (cond ((fboundp symbol)