--- ChangeLog	2005/04/27 19:16:21	1.1
+++ ChangeLog	2005/05/26 15:19:21
@@ -1,3 +1,11 @@
+2005-05-21  Joerg Hoehle <hoehle@users.sourceforge.net>
+
+	* swank-cmucl.lisp, swank-sbcl.lisp, swank-clisp.lisp
+	(describe-symbol-for-emacs): Distinguish macro and special
+	operators from functions.
+	* slime.el (slime-print-apropos): Must keep in sync with above,
+	therefore added :macro and :special-operator properties.
+	
 2005-04-27  Helmut Eller  <heller@common-lisp.net>
 
 	* swank-cmucl.lisp (+header-type-symbols+): Drop the third arg to
--- slime.el	2005/04/27 19:16:21	1.1
+++ slime.el	2005/05/26 14:33:41
@@ -5858,6 +5858,8 @@
 	    in '((:variable "Variable")
 		 (:function "Function")
 		 (:generic-function "Generic Function")
+                 (:macro "Macro")
+                 (:special-operator "Special Operator")
 		 (:setf "Setf")
 		 (:type "Type")
 		 (:class "Class")
@@ -5865,6 +5867,7 @@
                  (:alien-struct "Alien struct")
                  (:alien-union "Alien type")
                  (:alien-enum "Alien enum"))
+            ;; Properties not listed here will not show up in the buffer
 	    do
 	    (let ((value (plist-get plist prop))
 		  (start (point)))
--- swank-backend.lisp	2005/04/27 19:16:21	1.1
+++ swank-backend.lisp	2005/05/26 19:20:46
@@ -377,11 +377,12 @@
 The property list has an entry for each interesting aspect of the
 symbol. The recognised keys are:
 
-  :VARIABLE :FUNCTION :SETF :TYPE :CLASS :MACRO :COMPILER-MACRO
-  :ALIEN-TYPE :ALIEN-STRUCT :ALIEN-UNION :ALIEN-ENUM
+  :VARIABLE :FUNCTION :SETF :SPECIAL-OPERATOR :MACRO :COMPILER-MACRO
+  :TYPE :CLASS :ALIEN-TYPE :ALIEN-STRUCT :ALIEN-UNION :ALIEN-ENUM
 
 The value of each property is the corresponding documentation string,
-or :NOT-DOCUMENTED. It is legal to include keys not listed here.
+or :NOT-DOCUMENTED. It is legal to include keys not listed here (but
+slime-print-apropos in Emacs must know about them).
 
 Properties should be included if and only if they are applicable to
 the symbol. For example, only (and all) fbound symbols should include
@@ -660,7 +661,7 @@
   "Return an inspector object suitable for passing to inspect-for-emacs.")
 
 (definterface inspect-for-emacs (object inspector)
-   "Explain to emacs how to inspect OBJECT.
+   "Explain to Emacs how to inspect OBJECT.
 
 The argument INSPECTOR is an object representing how to get at
 the internals of OBJECT, it is usually an implementation specific
--- swank-clisp.lisp	2005/04/27 19:16:21	1.1
+++ swank-clisp.lisp	2005/05/26 14:31:27
@@ -143,16 +143,24 @@
   "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)))))
-      (when (fboundp symbol)
-	(if (macro-function symbol)
-	    (setf (getf result :macro) (doc 'function))
-	    (setf (getf result :function) (doc 'function))))
+    (flet ((doc (kind)
+	     (or (documentation symbol kind) :not-documented))
+	   (maybe-push (property value)
+	     (when value
+	       (setf result (list* property value result)))))
+      ;; slime.el:slime-print-apropos must also know these properties.
       (maybe-push :variable (when (boundp symbol) (doc 'variable)))
+      (when (fboundp symbol)
+	(maybe-push
+	 ;; Report WHEN etc. as macros, even though they may be
+	 ;; implemented as special operators.
+	 (if (macro-function symbol) :macro
+	     (typecase (fdefinition symbol)
+	       (generic-function :generic-function)
+	       (function         :function)
+	       ;; (type-of 'progn) -> ext:special-operator
+	       (t                :special-operator)))
+	 (doc 'function)))
       (maybe-push :class (when (find-class symbol nil) 
 			   (doc 'type))) ;this should be fixed
       result)))
--- swank-cmucl.lisp	2005/04/27 19:16:21	1.1
+++ swank-cmucl.lisp	2005/05/26 14:28:11
@@ -1170,21 +1170,21 @@
            (maybe-push (property value)
              (when value
                (setf result (list* property value result)))))
+      ;; slime.el:slime-print-apropos must also know these properties.
       (maybe-push
        :variable (multiple-value-bind (kind recorded-p)
 		     (ext:info variable kind symbol)
 		   (declare (ignore kind))
 		   (if (or (boundp symbol) recorded-p)
 		       (doc 'variable))))
-      (maybe-push
-       :generic-function 
-       (if (and (fboundp symbol)
-                (typep (fdefinition symbol) 'generic-function))
-           (doc 'function)))
-      (maybe-push
-       :function (if (and (fboundp symbol)
-                          (not (typep (fdefinition symbol) 'generic-function)))
-                     (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 (ext:info setf inverse symbol)
 		     (ext:info setf expander symbol))
--- swank-sbcl.lisp	2005/04/27 19:16:21	1.1
+++ swank-sbcl.lisp	2005/05/26 15:17:48
@@ -594,20 +594,26 @@
   "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)))))
+      ;; slime.el:slime-print-apropos must also know these properties.
       (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))
