[slime-cvs] CVS slime

[trittweiler]

Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv13384

Modified Files:
	swank.lisp 
Log Message:

* swank.lisp (classify-symbol, symbol-classification->string): Add
  classification of symbols denoting type specifier, and denoting
  constants.


--- /project/slime/cvsroot/slime/swank.lisp	2008/02/28 19:43:58	1.538
+++ /project/slime/cvsroot/slime/swank.lisp	2008/03/14 14:04:31	1.539
@@ -493,30 +493,38 @@
 
 
 (defun classify-symbol (symbol)
-  "Returns a list of classifiers that classify SYMBOL according
-to its underneath objects (e.g. :BOUNDP if SYMBOL constitutes a
-special variable.) The list may contain the following classification
-keywords: :BOUNDP, :FBOUNDP, :GENERIC-FUNCTION, :CLASS, :MACRO, 
-:SPECIAL-OPERATOR, and/or :PACKAGE"
+  "Returns a list of classifiers that classify SYMBOL according to its
+underneath objects (e.g. :BOUNDP if SYMBOL constitutes a special
+variable.) The list may contain the following classification
+keywords: :BOUNDP, :FBOUNDP, :CONSTANT, :GENERIC-FUNCTION,
+:TYPESPEC, :CLASS, :MACRO, :SPECIAL-OPERATOR, and/or :PACKAGE"
   (check-type symbol symbol)
-  (let (result)
-    (when (boundp symbol)             (push :boundp result))
-    (when (fboundp symbol)            (push :fboundp result))
-    (when (find-class symbol nil)     (push :class result))
-    (when (macro-function symbol)     (push :macro result))
-    (when (special-operator-p symbol) (push :special-operator result))
-    (when (find-package symbol)       (push :package result))
-    (when (typep (ignore-errors (fdefinition symbol))
-                 'generic-function)
-      (push :generic-function result))
-    result))
+  (flet ((type-specifier-p (s)
+           (or (documentation s 'type)
+               (not (eq (type-specifier-arglist s) :not-available)))))
+    (let (result)
+      (when (boundp symbol)             (push (if (constantp symbol)
+                                                  :constant :boundp) result))
+      (when (fboundp symbol)            (push :fboundp result))
+      (when (type-specifier-p symbol)   (push :typespec result))
+      (when (find-class symbol nil)     (push :class result))
+      (when (macro-function symbol)     (push :macro result))
+      (when (special-operator-p symbol) (push :special-operator result))
+      (when (find-package symbol)       (push :package result))
+      (when (typep (ignore-errors (fdefinition symbol))
+                   'generic-function)
+        (push :generic-function result))
+
+      result)))
 
 (defun symbol-classification->string (flags)
-  (format nil "~A~A~A~A~A~A~A"
-          (if (member :boundp flags) "b" "-")
+  (format nil "~A~A~A~A~A~A~A~A"
+          (if (or (member :boundp flags)
+                  (member :constant flags)) "b" "-")
           (if (member :fboundp flags) "f" "-")
           (if (member :generic-function flags) "g" "-")
           (if (member :class flags) "c" "-")
+          (if (member :typespec flags) "t" "-")
           (if (member :macro flags) "m" "-")
           (if (member :special-operator flags) "s" "-")
           (if (member :package flags) "p" "-")))