[slime-cvs] CVS slime

heller heller at common-lisp.net
Thu Aug 23 19:03:37 UTC 2007


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

Modified Files:
	ChangeLog swank-abcl.lisp swank-allegro.lisp 
	swank-backend.lisp swank-clisp.lisp swank-cmucl.lisp 
	swank-corman.lisp swank-lispworks.lisp swank-openmcl.lisp 
	swank-sbcl.lisp swank-scl.lisp 
Log Message:
Introduce backend-inspector class.

* swank-backend.lisp (backend-inspector): New class. Introduce a named
  class to give as another way to dispatch to backend methods.

* swank-cmucl.lisp: Use backend-inspector class.
* swank-sbcl.lisp: Use backend-inspector class.
* swank-clisp.lisp: Use backend-inspector class.
* swank-lispworks.lisp: Use backend-inspector class.
* swank-allegro.lisp: Use backend-inspector class.
* swank-openmcl.lisp: Use backend-inspector class.
* swank-abcl.lisp: Use backend-inspector class.
* swank-corman.lisp: Use backend-inspector class.
* swank-scl.lisp: Use backend-inspector class.



--- /project/slime/cvsroot/slime/ChangeLog	2007/08/23 18:09:21	1.1151
+++ /project/slime/cvsroot/slime/ChangeLog	2007/08/23 19:03:37	1.1152
@@ -8,6 +8,19 @@
 
 	* swank-loader.lisp (*contribs*): Add 'swank-fancy-inspector.
 
+	* swank-backend.lisp (backend-inspector): New class.  Introduce a
+	named class to give as another way to dispatch to backend methods.
+
+	* swank-cmucl.lisp: Use backend-inspector class.
+	* swank-sbcl.lisp: Use backend-inspector class.
+	* swank-clisp.lisp: Use backend-inspector class.
+	* swank-lispworks.lisp: Use backend-inspector class.
+	* swank-allegro.lisp: Use backend-inspector class.
+	* swank-openmcl.lisp: Use backend-inspector class.
+	* swank-abcl.lisp: Use backend-inspector class.
+	* swank-corman.lisp: Use backend-inspector class.
+	* swank-scl.lisp: Use backend-inspector class.
+
 2007-08-23  Tobias C. Rittweiler <tcr at freebits.de>
 
 	Added arglist display for declaration specifiers and type
--- /project/slime/cvsroot/slime/swank-abcl.lisp	2006/11/19 21:33:03	1.41
+++ /project/slime/cvsroot/slime/swank-abcl.lisp	2007/08/23 19:03:37	1.42
@@ -10,7 +10,6 @@
 
 (in-package :swank-backend)
 
-
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (require :collect) ;just so that it doesn't spoil the flying letters
   (require :pprint))
@@ -392,13 +391,13 @@
 
 ;;;; Inspecting
 
-(defclass abcl-inspector (inspector)
-  ())
+(defclass abcl-inspector (backend-inspector) ())
 
 (defimplementation make-default-inspector ()
   (make-instance 'abcl-inspector))
 
-(defmethod inspect-for-emacs ((slot mop::slot-definition) (inspector abcl-inspector))
+(defmethod inspect-for-emacs ((slot mop::slot-definition) 
+                              (inspector backend-inspector))
   (declare (ignore inspector))
   (values "A slot." 
           `("Name: " (:value ,(mop::%slot-definition-name slot))
@@ -414,7 +413,7 @@
             "  Function: " (:value ,(mop::%slot-definition-initfunction slot))
             (:newline))))
 
-(defmethod inspect-for-emacs ((f function) (inspector abcl-inspector))
+(defmethod inspect-for-emacs ((f function) (inspector backend-inspector))
   (declare (ignore inspector))
   (values "A function."
           `(,@(when (function-name f)
@@ -432,7 +431,7 @@
 
 #|
 
-(defmethod inspect-for-emacs ((o t) (inspector abcl-inspector))
+(defmethod inspect-for-emacs ((o t) (inspector backend-inspector))
   (let* ((class (class-of o))
          (slots (mop::class-slots class)))
     (values (format nil "~A~%   is a ~A" o class)
--- /project/slime/cvsroot/slime/swank-allegro.lisp	2006/12/19 10:47:36	1.95
+++ /project/slime/cvsroot/slime/swank-allegro.lisp	2007/08/23 19:03:37	1.96
@@ -568,8 +568,7 @@
 
 ;;;; Inspecting
 
-(defclass acl-inspector (inspector)
-  ())
+(defclass acl-inspector (backend-inspector) ())
 
 (defimplementation make-default-inspector ()
   (make-instance 'acl-inspector))
@@ -584,15 +583,16 @@
              (when doc
                `("Documentation:" (:newline) ,doc))))))
 
-(defmethod inspect-for-emacs ((o t) (inspector acl-inspector))
+(defmethod inspect-for-emacs ((o t) (inspector backend-inspector))
   inspector
   (values "A value." (allegro-inspect o)))
 
-(defmethod inspect-for-emacs ((o function) (inspector acl-inspector))
+(defmethod inspect-for-emacs ((o function) (inspector backend-inspector))
   inspector
   (values "A function." (allegro-inspect o)))
 
-(defmethod inspect-for-emacs ((o standard-object) (inspector acl-inspector))
+(defmethod inspect-for-emacs ((o standard-object) 
+                              (inspector backend-inspector))
   inspector
   (values (format nil "~A is a standard-object." o) (allegro-inspect o)))
 
--- /project/slime/cvsroot/slime/swank-backend.lisp	2007/08/23 16:20:22	1.120
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2007/08/23 19:03:37	1.121
@@ -879,6 +879,8 @@
 Implementations should sub class in order to dispatch off of the
 inspect-for-emacs method."))
 
+(defclass backend-inspector (inspector) ())
+
 (definterface make-default-inspector ()
   "Return an inspector object suitable for passing to inspect-for-emacs.")
 
@@ -1104,4 +1106,4 @@
     (unsigned-byte      . (&optional size))
     (values             . (&rest typespecs))
     (vector             . (&optional element-type size))
-    ))
\ No newline at end of file
+    ))
--- /project/slime/cvsroot/slime/swank-clisp.lisp	2007/04/08 14:02:37	1.63
+++ /project/slime/cvsroot/slime/swank-clisp.lisp	2007/08/23 19:03:37	1.64
@@ -627,12 +627,11 @@
 
 ;;;; Inspecting
 
-(defclass clisp-inspector (inspector) ())
+(defclass clisp-inspector (backend-inspector) ())
 
-(defimplementation make-default-inspector ()
-  (make-instance 'clisp-inspector))
+(defimplementation make-default-inspector () (make-instance 'clisp-inspector))
 
-(defmethod inspect-for-emacs ((o t) (inspector clisp-inspector))
+(defmethod inspect-for-emacs ((o t) (inspector backend-inspector))
   (declare (ignore inspector))
   (let* ((*print-array* nil) (*print-pretty* t)
          (*print-circle* t) (*print-escape* t)
--- /project/slime/cvsroot/slime/swank-cmucl.lisp	2007/01/10 23:53:47	1.170
+++ /project/slime/cvsroot/slime/swank-cmucl.lisp	2007/08/23 19:03:37	1.171
@@ -1817,8 +1817,7 @@
 
 ;;;; Inspecting
 
-(defclass cmucl-inspector (inspector)
-  ())
+(defclass cmucl-inspector (backend-inspector) ())
 
 (defimplementation make-default-inspector ()
   (make-instance 'cmucl-inspector))
@@ -1865,7 +1864,7 @@
                                   :key #'symbol-value)))
           (format t ", type: ~A" type-symbol))))))
 
-(defmethod inspect-for-emacs ((o t) (inspector cmucl-inspector))
+(defmethod inspect-for-emacs ((o t) (inspector backend-inspector))
   (cond ((di::indirect-value-cell-p o)
          (values (format nil "~A is a value cell." o)
                  `("Value: " (:value ,(c:value-cell-ref o)))))
@@ -1883,7 +1882,7 @@
                 (loop for value in parts  for i from 0 
                       append (label-value-line i value))))))
 
-(defmethod inspect-for-emacs ((o function) (inspector cmucl-inspector))
+(defmethod inspect-for-emacs ((o function) (inspector backend-inspector))
   (declare (ignore inspector))
   (let ((header (kernel:get-type o)))
     (cond ((= header vm:function-header-type)
@@ -1912,7 +1911,7 @@
            (call-next-method)))))
 
 (defmethod inspect-for-emacs ((o kernel:funcallable-instance)
-                              (i cmucl-inspector))
+                              (i backend-inspector))
   (declare (ignore i))
   (values 
    (format nil "~A is a funcallable-instance." o)
@@ -1922,7 +1921,7 @@
             (:layout  (kernel:%funcallable-instance-layout o)))
            (nth-value 1 (cmucl-inspect o)))))
 
-(defmethod inspect-for-emacs ((o kernel:code-component) (_ cmucl-inspector))
+(defmethod inspect-for-emacs ((o kernel:code-component) (_ backend-inspector))
   (declare (ignore _))
   (values (format nil "~A is a code data-block." o)
           (append 
@@ -1950,7 +1949,7 @@
                          (ash (kernel:%code-code-size o) vm:word-shift)
                          :stream s))))))))
 
-(defmethod inspect-for-emacs ((o kernel:fdefn) (inspector cmucl-inspector))
+(defmethod inspect-for-emacs ((o kernel:fdefn) (inspector backend-inspector))
   (declare (ignore inspector))
   (values (format nil "~A is a fdenf object." o)
           (label-value-line*
@@ -1960,7 +1959,7 @@
                         (sys:int-sap (kernel:get-lisp-obj-address o))
                         (* vm:fdefn-raw-addr-slot vm:word-bytes))))))
 
-(defmethod inspect-for-emacs ((o array) (inspector cmucl-inspector))
+(defmethod inspect-for-emacs ((o array) (inspector backend-inspector))
   inspector
   (if (typep o 'simple-array)
       (call-next-method)
@@ -1976,7 +1975,7 @@
                (:displaced-p (kernel:%array-displaced-p o))
                (:dimensions (array-dimensions o))))))
 
-(defmethod inspect-for-emacs ((o simple-vector) (inspector cmucl-inspector))
+(defmethod inspect-for-emacs ((o simple-vector) (inspector backend-inspector))
   inspector
   (values (format nil "~A is a simple-vector." o)
           (append 
--- /project/slime/cvsroot/slime/swank-corman.lisp	2006/11/19 21:33:03	1.10
+++ /project/slime/cvsroot/slime/swank-corman.lisp	2007/08/23 19:03:37	1.11
@@ -387,7 +387,7 @@
 ;; Hack to make swank.lisp load, at least
 (defclass file-stream ())
 
-(defclass corman-inspector (inspector)
+(defclass corman-inspector (backend-inspector)
   ())
 
 (defimplementation make-default-inspector ()
@@ -400,7 +400,7 @@
               collect ", ")))
 
 (defmethod inspect-for-emacs ((class standard-class)
-                              (inspector corman-inspector))
+                              (inspector backend-inspector))
   (declare (ignore inspector))
   (values "A class."
           `("Name: " (:value ,(class-name class))
@@ -438,9 +438,9 @@
                   '("#<N/A (class not finalized)>"))
             (:newline))))
 
-(defmethod inspect-for-emacs ((slot cons) (inspector corman-inspector))
+(defmethod inspect-for-emacs ((slot cons) (inspector backend-inspector))
   ;; Inspects slot definitions
-  (declare (ignore corman-inspector))
+  (declare (ignore inspector))
   (if (eq (car slot) :name)
       (values "A slot." 
               `("Name: " (:value ,(swank-mop:slot-definition-name slot))
@@ -475,7 +475,7 @@
                               (not (probe-file pathname)))
                     (label-value-line "Truename" (truename pathname))))))
 
-(defmethod inspect-for-emacs ((o t) (inspector corman-inspector))
+(defmethod inspect-for-emacs ((o t) (inspector backend-inspector))
   (cond ((cl::structurep o) (inspect-structure o))
 	(t (call-next-method))))
 
--- /project/slime/cvsroot/slime/swank-lispworks.lisp	2007/05/17 16:52:31	1.91
+++ /project/slime/cvsroot/slime/swank-lispworks.lisp	2007/08/23 19:03:37	1.92
@@ -636,25 +636,24 @@
           append (frob-locs dspec (dspec:dspec-definition-locations dspec)))))
 
 ;;; Inspector
-(defclass lispworks-inspector (inspector)
-  ())
+(defclass lispworks-inspector (backend-inspector) ())
 
 (defimplementation make-default-inspector ()
   (make-instance 'lispworks-inspector))
 
-(defmethod inspect-for-emacs ((o t) (inspector lispworks-inspector))
+(defmethod inspect-for-emacs ((o t) (inspector backend-inspector))
   (declare (ignore inspector))
   (lispworks-inspect o))
 
 (defmethod inspect-for-emacs ((o function) 
-                              (inspector lispworks-inspector))
+                              (inspector backend-inspector))
   (declare (ignore inspector))
   (lispworks-inspect o))
 
 ;; FIXME: slot-boundp-using-class in LW works with names so we can't
 ;; use our method in swank.lisp.
 (defmethod inspect-for-emacs ((o standard-object) 
-                              (inspector lispworks-inspector))
+                              (inspector backend-inspector))
   (declare (ignore inspector))
   (lispworks-inspect o))
 
--- /project/slime/cvsroot/slime/swank-openmcl.lisp	2007/04/16 14:47:34	1.118
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp	2007/08/23 19:03:37	1.119
@@ -784,8 +784,7 @@
 
 ;;;; Inspection
 
-(defclass openmcl-inspector (inspector)
-  ())
+(defclass openmcl-inspector (backend-inspector) ())
 
 (defimplementation make-default-inspector ()
   (make-instance 'openmcl-inspector))
@@ -796,7 +795,7 @@
 	(string (gethash typecode *value2tag*))
 	(string (nth typecode '(tag-fixnum tag-list tag-misc tag-imm))))))
 
-(defmethod inspect-for-emacs ((o t) (inspector openmcl-inspector))
+(defmethod inspect-for-emacs ((o t) (inspector backend-inspector))
   (declare (ignore inspector))
   (let* ((i (inspector::make-inspector o))
 	 (count (inspector::compute-line-count i))
@@ -815,7 +814,7 @@
                 (pprint o s)))
             lines)))
 
-(defmethod inspect-for-emacs :around ((o t) (inspector openmcl-inspector))
+(defmethod inspect-for-emacs :around ((o t) (inspector backend-inspector))
   (if (or (uvector-inspector-p o)
           (not (ccl:uvectorp o)))
       (call-next-method)
@@ -835,7 +834,8 @@
   (:method ((object t)) nil)
   (:method ((object uvector-inspector)) t))
 
-(defmethod inspect-for-emacs ((uv uvector-inspector) (inspector openmcl-inspector))
+(defmethod inspect-for-emacs ((uv uvector-inspector) 
+                              (inspector backend-inspector))
   (with-slots (object)
       uv
     (values (format nil "The UVECTOR for ~S." object)
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2007/08/23 16:20:11	1.179
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2007/08/23 19:03:37	1.180
@@ -981,13 +981,12 @@
 
 ;;;; Inspector
 
-(defclass sbcl-inspector (inspector)
-  ())
+(defclass sbcl-inspector (make-inspector) ())
 
 (defimplementation make-default-inspector ()
   (make-instance 'sbcl-inspector))
 
-(defmethod inspect-for-emacs ((o t) (inspector sbcl-inspector))
+(defmethod inspect-for-emacs ((o t) (inspector backend-inspector))
   (declare (ignore inspector))
   (cond ((sb-di::indirect-value-cell-p o)
          (values "A value cell." (label-value-line*
@@ -1000,7 +999,7 @@
                (values text (loop for value in parts  for i from 0
                                   append (label-value-line i value))))))))
 
-(defmethod inspect-for-emacs ((o function) (inspector sbcl-inspector))
+(defmethod inspect-for-emacs ((o function) (inspector backend-inspector))
   (declare (ignore inspector))
   (let ((header (sb-kernel:widetag-of o)))
     (cond ((= header sb-vm:simple-fun-header-widetag)
@@ -1022,7 +1021,7 @@
                                   i (sb-kernel:%closure-index-ref o i))))))
 	  (t (call-next-method o)))))
 
-(defmethod inspect-for-emacs ((o sb-kernel:code-component) (_ sbcl-inspector))
+(defmethod inspect-for-emacs ((o sb-kernel:code-component) (_ backend-inspector))
   (declare (ignore _))
   (values (format nil "~A is a code data-block." o)
           (append
@@ -1051,13 +1050,13 @@
                          (ash (sb-kernel:%code-code-size o) sb-vm:word-shift)
                          :stream s))))))))
 
-(defmethod inspect-for-emacs ((o sb-ext:weak-pointer) (inspector sbcl-inspector))
+(defmethod inspect-for-emacs ((o sb-ext:weak-pointer) (inspector backend-inspector))
   (declare (ignore inspector))
   (values "A weak pointer."
           (label-value-line*
            (:value (sb-ext:weak-pointer-value o)))))
 
-(defmethod inspect-for-emacs ((o sb-kernel:fdefn) (inspector sbcl-inspector))
+(defmethod inspect-for-emacs ((o sb-kernel:fdefn) (inspector backend-inspector))
   (declare (ignore inspector))
   (values "A fdefn object."
           (label-value-line*
@@ -1065,7 +1064,7 @@
            (:function (sb-kernel:fdefn-fun o)))))
 
 (defmethod inspect-for-emacs :around ((o generic-function)
-                                      (inspector sbcl-inspector))
+                                      (inspector backend-inspector))
   (declare (ignore inspector))
   (multiple-value-bind (title contents) (call-next-method)
     (values title
--- /project/slime/cvsroot/slime/swank-scl.lisp	2006/11/19 21:33:03	1.12
+++ /project/slime/cvsroot/slime/swank-scl.lisp	2007/08/23 19:03:37	1.13
@@ -1691,8 +1691,7 @@
 
 ;;;; Inspecting
 
-(defclass scl-inspector (inspector)
-  ())
+(defclass scl-inspector (backend-inspector) ())
 
 (defimplementation make-default-inspector ()
   (make-instance 'scl-inspector))
@@ -1739,7 +1738,7 @@
                                   :key #'symbol-value)))
           (format t ", type: ~A" type-symbol))))))
 
-(defmethod inspect-for-emacs ((o t) (inspector scl-inspector))
+(defmethod inspect-for-emacs ((o t) (inspector backend-inspector))
   (cond ((di::indirect-value-cell-p o)
          (values (format nil "~A is a value cell." o)
                  `("Value: " (:value ,(c:value-cell-ref o)))))
@@ -1758,7 +1757,7 @@
                 (loop for value in parts  for i from 0 
                       append (label-value-line i value))))))
 
-(defmethod inspect-for-emacs ((o function) (inspector scl-inspector))
+(defmethod inspect-for-emacs ((o function) (inspector backend-inspector))
   (declare (ignore inspector))
   (let ((header (kernel:get-type o)))
     (cond ((= header vm:function-header-type)
@@ -1788,7 +1787,7 @@
            (call-next-method)))))
 
 
-(defmethod inspect-for-emacs ((o kernel:code-component) (_ scl-inspector))
+(defmethod inspect-for-emacs ((o kernel:code-component) (_ backend-inspector))
   (declare (ignore _))
   (values (format nil "~A is a code data-block." o)
           (append 
@@ -1816,7 +1815,7 @@
                          (ash (kernel:%code-code-size o) vm:word-shift)
                          :stream s))))))))
 
-(defmethod inspect-for-emacs ((o kernel:fdefn) (inspector scl-inspector))
+(defmethod inspect-for-emacs ((o kernel:fdefn) (inspector backend-inspector))
   (declare (ignore inspector))
   (values (format nil "~A is a fdenf object." o)
           (label-value-line*
@@ -1826,7 +1825,7 @@
                         (sys:int-sap (kernel:get-lisp-obj-address o))
                         (* vm:fdefn-raw-addr-slot vm:word-bytes))))))
 
-(defmethod inspect-for-emacs ((o array) (inspector scl-inspector))
+(defmethod inspect-for-emacs ((o array) (inspector backend-inspector))
   inspector
   (cond ((kernel:array-header-p o)
          (values (format nil "~A is an array." o)
@@ -1846,7 +1845,7 @@
                   (:header (describe-primitive-type o))
                   (:length (length o)))))))
 
-(defmethod inspect-for-emacs ((o simple-vector) (inspector scl-inspector))
+(defmethod inspect-for-emacs ((o simple-vector) (inspector backend-inspector))
   inspector
   (values (format nil "~A is a vector." o)
           (append 




More information about the slime-cvs mailing list