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

[Helmut Eller]

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

Modified Files:
	swank-cmucl.lisp 
Log Message:
(definition-source-location): Make it backward compatible with 18e.
(class-definitions): Treat condition-classes like built-in classes
(i.e. give up) until we find a better solution.
Date: Tue Apr 20 18:29:43 2004
Author: heller

Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.95 slime/swank-cmucl.lisp:1.96
--- slime/swank-cmucl.lisp:1.95	Sat Apr 17 05:25:58 2004
+++ slime/swank-cmucl.lisp	Tue Apr 20 18:29:43 2004
@@ -743,14 +743,22 @@
           (make-location `(:buffer ,emacs-buffer)
                          `(:position ,(+ emacs-buffer-offset pos))))))))
 
+(defun file-source-location-p (object) 
+  (when (fboundp 'c::file-source-location-p)
+    (c::file-source-location-p object)))
+
+(defun stream-source-location-p (object)
+  (when (fboundp 'c::stream-source-location-p)
+    (c::stream-source-location-p object)))
+
 (defun definition-source-location (object name)
   (let ((source (pcl::definition-source object)))
     (etypecase source
       (null 
        `(:error ,(format nil "No source info for: ~A" object)))
-      (c::file-source-location
+      ((satisfies file-source-location-p)
        (resolve-file-source-location source))
-      (c::stream-source-location
+      ((satisfies stream-source-location-p)
        (resolve-stream-source-location source))
       (pathname 
        (make-name-in-file-location source name))
@@ -768,17 +776,17 @@
           (null '())
           (kernel::structure-class 
            (list (list `(defstruct ,name) (dd-location (find-dd name)))))
+          #+(or)
           (conditions::condition-class
            (list (list `(define-condition ,name) 
                        (condition-class-location class))))
           (kernel::standard-class
            (list (list `(defclass ,name) 
                        (class-location (find-class name)))))
-          (kernel::built-in-class
+          ((or kernel::built-in-class conditions::condition-class)
            (list (list `(kernel::define-type-class ,name)
                        `(:error 
-                         ,(format nil "No source info for built-in-class: ~A"
-                                  name)))))))))
+                         ,(format nil "No source info for ~A" name)))))))))
 
 (defun setf-definitions (name)
   (let ((function (or (ext:info :setf :inverse name)