[slime-cvs] CVS slime

[CVS User sboukarev]

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

Modified Files:
	ChangeLog swank-allegro.lisp swank-backend.lisp swank-ccl.lisp 
	swank-clisp.lisp swank-ecl.lisp swank-lispworks.lisp 
	swank-sbcl.lisp 
Log Message:
* swank-backend.lisp (type-specifier-p): New.
Implement it for ACL, ECL, CCL, Clisp, SBCL, LW.

* contrib/swank-util.lisp (symbol-classification-string): Use
type-specifier-p.


--- /project/slime/cvsroot/slime/ChangeLog	2013/01/12 12:32:20	1.2389
+++ /project/slime/cvsroot/slime/ChangeLog	2013/02/02 10:11:16	1.2390
@@ -1,3 +1,8 @@
+2013-02-02  Stas Boukarev  <stassats at gmail.com>
+
+	* swank-backend.lisp (type-specifier-p): New.
+	Implement it for ACL, ECL, CCL, Clisp, SBCL, LW.
+
 2013-01-12  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-backend.lisp: Add a couple of ignore declarations.
--- /project/slime/cvsroot/slime/swank-allegro.lisp	2012/12/03 03:35:09	1.157
+++ /project/slime/cvsroot/slime/swank-allegro.lisp	2013/02/02 10:11:16	1.158
@@ -140,6 +140,11 @@
     (:class
      (describe (find-class symbol)))))
 
+(defimplementation type-specifier-p (symbol)
+  (or (ignore-errors
+       (subtypep nil symbol))
+      (not (eq (type-specifier-arglist symbol) :not-available))))
+
 ;;;; Debugger
 
 (defvar *sldb-topframe*)
--- /project/slime/cvsroot/slime/swank-backend.lisp	2013/01/12 12:32:21	1.223
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2013/02/02 10:11:16	1.224
@@ -781,6 +781,11 @@
                   :not-available))
       (t :not-available))))
 
+(definterface type-specifier-p (symbol)
+  "Determine if SYMBOL is a type-specifier."
+  (or (documentation symbol 'type)
+      (not (eq (type-specifier-arglist symbol) :not-available))))
+
 (definterface function-name (function)
   "Return the name of the function object FUNCTION.
 
--- /project/slime/cvsroot/slime/swank-ccl.lisp	2013/01/07 13:01:28	1.31
+++ /project/slime/cvsroot/slime/swank-ccl.lisp	2013/02/02 10:11:16	1.32
@@ -694,6 +694,10 @@
     (loop for i below (ccl:uvsize object) append 
           (label-value-line (princ-to-string i) (ccl:uvref object i)))))
 
+(defimplementation type-specifier-p (symbol)
+  (or (ccl:type-specifier-p symbol)
+      (not (eq (type-specifier-arglist symbol) :not-available))))
+
 ;;; Multiprocessing
 
 (defvar *known-processes* 
--- /project/slime/cvsroot/slime/swank-clisp.lisp	2012/08/04 23:48:19	1.102
+++ /project/slime/cvsroot/slime/swank-clisp.lisp	2013/02/02 10:11:16	1.103
@@ -308,6 +308,11 @@
     (:function (describe (symbol-function symbol)))
     (:class (describe (find-class symbol)))))
 
+(defimplementation type-specifier-p (symbol)
+  (or (ignore-errors
+       (subtypep nil symbol))
+      (not (eq (type-specifier-arglist symbol) :not-available))))
+
 (defun fspec-pathname (spec)
   (let ((path spec)
 	type
--- /project/slime/cvsroot/slime/swank-ecl.lisp	2013/01/11 23:36:35	1.82
+++ /project/slime/cvsroot/slime/swank-ecl.lisp	2013/02/02 10:11:16	1.83
@@ -345,6 +345,10 @@
     (:class (documentation name 'class))
     (t nil)))
 
+(defimplementation type-specifier-p (symbol)
+  (or (subtypep nil symbol)
+      (not (eq (type-specifier-arglist symbol) :not-available))))
+
 
 ;;; Debugging
 
--- /project/slime/cvsroot/slime/swank-lispworks.lisp	2012/04/07 09:35:42	1.151
+++ /project/slime/cvsroot/slime/swank-lispworks.lisp	2013/02/02 10:11:16	1.152
@@ -297,6 +297,11 @@
   (when (fboundp sym)
     (describe-function sym)))
 
+(defimplementation type-specifier-p (symbol)
+  (or (ignore-errors
+       (subtypep nil symbol))
+      (not (eq (type-specifier-arglist symbol) :not-available))))
+
 ;;; Debugging
 
 (defclass slime-env (env:environment) 
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2013/01/09 14:29:28	1.327
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2013/02/02 10:11:16	1.328
@@ -438,6 +438,9 @@
       (sb-introspect:deftype-lambda-list typespec-operator)
     (if foundp arglist (call-next-method))))
 
+(defimplementation type-specifier-p (symbol)
+  (or (sb-ext:valid-type-specifier-p symbol)
+      (not (eq (type-specifier-arglist symbol) :not-available))))
 
 (defvar *buffer-name* nil)
 (defvar *buffer-tmpfile* nil)