/[slime]/slime/swank-cmucl.lisp
ViewVC logotype

Diff of /slime/swank-cmucl.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.95 by heller, Sat Apr 17 09:25:58 2004 UTC revision 1.96 by heller, Tue Apr 20 22:29:43 2004 UTC
# Line 743  NAME can any valid function name (e.g, ( Line 743  NAME can any valid function name (e.g, (
743            (make-location `(:buffer ,emacs-buffer)            (make-location `(:buffer ,emacs-buffer)
744                           `(:position ,(+ emacs-buffer-offset pos))))))))                           `(:position ,(+ emacs-buffer-offset pos))))))))
745    
746    (defun file-source-location-p (object)
747      (when (fboundp 'c::file-source-location-p)
748        (c::file-source-location-p object)))
749    
750    (defun stream-source-location-p (object)
751      (when (fboundp 'c::stream-source-location-p)
752        (c::stream-source-location-p object)))
753    
754  (defun definition-source-location (object name)  (defun definition-source-location (object name)
755    (let ((source (pcl::definition-source object)))    (let ((source (pcl::definition-source object)))
756      (etypecase source      (etypecase source
757        (null        (null
758         `(:error ,(format nil "No source info for: ~A" object)))         `(:error ,(format nil "No source info for: ~A" object)))
759        (c::file-source-location        ((satisfies file-source-location-p)
760         (resolve-file-source-location source))         (resolve-file-source-location source))
761        (c::stream-source-location        ((satisfies stream-source-location-p)
762         (resolve-stream-source-location source))         (resolve-stream-source-location source))
763        (pathname        (pathname
764         (make-name-in-file-location source name))         (make-name-in-file-location source name))
# Line 768  NAME can any valid function name (e.g, ( Line 776  NAME can any valid function name (e.g, (
776            (null '())            (null '())
777            (kernel::structure-class            (kernel::structure-class
778             (list (list `(defstruct ,name) (dd-location (find-dd name)))))             (list (list `(defstruct ,name) (dd-location (find-dd name)))))
779              #+(or)
780            (conditions::condition-class            (conditions::condition-class
781             (list (list `(define-condition ,name)             (list (list `(define-condition ,name)
782                         (condition-class-location class))))                         (condition-class-location class))))
783            (kernel::standard-class            (kernel::standard-class
784             (list (list `(defclass ,name)             (list (list `(defclass ,name)
785                         (class-location (find-class name)))))                         (class-location (find-class name)))))
786            (kernel::built-in-class            ((or kernel::built-in-class conditions::condition-class)
787             (list (list `(kernel::define-type-class ,name)             (list (list `(kernel::define-type-class ,name)
788                         `(:error                         `(:error
789                           ,(format nil "No source info for built-in-class: ~A"                           ,(format nil "No source info for ~A" name)))))))))
                                   name)))))))))  
790    
791  (defun setf-definitions (name)  (defun setf-definitions (name)
792    (let ((function (or (ext:info :setf :inverse name)    (let ((function (or (ext:info :setf :inverse name)

Legend:
Removed from v.1.95  
changed lines
  Added in v.1.96

  ViewVC Help
Powered by ViewVC 1.1.5