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

[Helmut Eller]

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

Modified Files:
	swank-sbcl.lisp 
Log Message:
Distinguish macro and special operators from functions.
Date: Wed Jun  1 14:22:46 2005
Author: heller

Index: slime/swank-sbcl.lisp
diff -u slime/swank-sbcl.lisp:1.132 slime/swank-sbcl.lisp:1.133
--- slime/swank-sbcl.lisp:1.132	Wed Apr 20 14:43:49 2005
+++ slime/swank-sbcl.lisp	Wed Jun  1 14:22:45 2005
@@ -594,20 +594,25 @@
   "Return a plist describing SYMBOL.
 Return NIL if the symbol is unbound."
   (let ((result '()))
-    (labels ((doc (kind)
-	       (or (documentation symbol kind) :not-documented))
-	     (maybe-push (property value)
-	       (when value
-		 (setf result (list* property value result)))))
+    (flet ((doc (kind)
+             (or (documentation symbol kind) :not-documented))
+           (maybe-push (property value)
+             (when value
+               (setf result (list* property value result)))))
       (maybe-push
        :variable (multiple-value-bind (kind recorded-p)
 		     (sb-int:info :variable :kind symbol)
 		   (declare (ignore kind))
 		   (if (or (boundp symbol) recorded-p)
 		       (doc 'variable))))
-      (maybe-push
-       :function (if (fboundp symbol) 
-		     (doc 'function)))
+      (when (fboundp symbol)
+	(maybe-push
+	 (cond ((macro-function symbol)     :macro)
+	       ((special-operator-p symbol) :special-operator)
+	       ((typep (fdefinition symbol) 'generic-function)
+                :generic-function)
+	       (t :function))
+	 (doc 'function)))
       (maybe-push
        :setf (if (or (sb-int:info :setf :inverse symbol)
 		     (sb-int:info :setf :expander symbol))
@@ -1130,8 +1135,10 @@
 (defimplementation quit-lisp ()
   #+sb-thread
   (dolist (thread (remove (current-thread) (all-threads)))
-    (ignore-errors (sb-thread:terminate-thread thread)))
+    (ignore-errors (sb-thread:interrupt-thread 
+                    thread (lambda () (sb-ext:quit :recklessly-p t)))))
   (sb-ext:quit))
+
 
 
 ;;Trace implementations