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

Diff of /slime/swank-lispworks.lisp

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

revision 1.32 by heller, Tue Mar 9 20:07:58 2004 UTC revision 1.33 by heller, Wed Mar 10 08:24:45 2004 UTC
# Line 157  Return NIL if the symbol is unbound." Line 157  Return NIL if the symbol is unbound."
157    
158  (defun interesting-frame-p (frame)  (defun interesting-frame-p (frame)
159    (or (dbg::call-frame-p frame)    (or (dbg::call-frame-p frame)
160          (dbg::derived-call-frame-p frame)
161          (dbg::foreign-frame-p frame)
162          (dbg::interpreted-call-frame-p frame)
163        ;;(dbg::catch-frame-p frame)        ;;(dbg::catch-frame-p frame)
164        ))        ))
165    
# Line 203  Return NIL if the symbol is unbound." Line 206  Return NIL if the symbol is unbound."
206  (defimplementation frame-source-location-for-emacs (frame)  (defimplementation frame-source-location-for-emacs (frame)
207    (let ((frame (nth-frame frame)))    (let ((frame (nth-frame frame)))
208      (if (dbg::call-frame-p frame)      (if (dbg::call-frame-p frame)
209          (let ((func (dbg::call-frame-function-name frame)))          (let ((name (dbg::call-frame-function-name frame)))
210            (if func            (if name
211                (cadr (name-source-location func)))))))                (function-name-location name))))))
212    
213  (defimplementation eval-in-frame (form frame-number)  (defimplementation eval-in-frame (form frame-number)
214    (let ((frame (nth-frame frame-number)))    (let ((frame (nth-frame frame-number)))
# Line 223  Return NIL if the symbol is unbound." Line 226  Return NIL if the symbol is unbound."
226    
227  ;;; Definition finding  ;;; Definition finding
228    
229  (defun name-source-location (name)  (defun function-name-location (name)
230    (first (name-source-locations name)))    (let ((defs (find-definitions name)))
231        (cond (defs (cadr (first defs)))
232  (defun name-source-locations (name)            (t (list :error (format nil "Source location not available for: ~S"
233    (let ((locations (dspec:find-name-locations dspec:*dspec-classes* name)))                                    name))))))
     (cond ((not locations)  
            (list :error (format nil "Cannot find source for ~S" name)))  
           (t  
            (loop for (dspec location) in locations  
                  collect (list dspec (make-dspec-location dspec location)))))))  
234    
235  (defimplementation find-definitions (name)  (defimplementation find-definitions (name)
236    (name-source-locations name))    (let ((locations (dspec:find-name-locations dspec:*dspec-classes* name)))
237        (loop for (dspec location) in locations
238              collect (list dspec (make-dspec-location dspec location)))))
239    
240  ;;; Compilation  ;;; Compilation
241    
# Line 278  Return NIL if the symbol is unbound." Line 278  Return NIL if the symbol is unbound."
278               (delete-file binary-filename))))               (delete-file binary-filename))))
279      (delete-file filename)))      (delete-file filename)))
280    
 ;; XXX handle all cases in dspec:*dspec-classes*  
281  (defun dspec-buffer-position (dspec)  (defun dspec-buffer-position (dspec)
282    (etypecase dspec    (list :function-name (string (dspec:dspec-primary-name dspec))))
     (cons (ecase (car dspec)  
             ((defun defmacro defgeneric defvar defstruct  
                     method structure package)  
              `(:function-name ,(symbol-name (cadr dspec))))  
             ;; XXX this isn't quite right  
             (lw:top-level-form `(:source-path ,(cdr dspec) nil))))  
     (symbol `(:function-name ,(symbol-name dspec)))))  
283    
284  (defun emacs-buffer-location-p (location)  (defun emacs-buffer-location-p (location)
285    (and (consp location)    (and (consp location)
# Line 309  Return NIL if the symbol is unbound." Line 301  Return NIL if the symbol is unbound."
301        ((or pathname string)        ((or pathname string)
302         (make-location `(:file ,(filename location))         (make-location `(:file ,(filename location))
303                        (dspec-buffer-position dspec)))                        (dspec-buffer-position dspec)))
304        ((member :listener)        (symbol `(:error ,(format nil "Cannot resolve location: ~S" location)))
        `(:error ,(format nil "Function defined in listener: ~S" dspec)))  
       ((member :unknown)  
        `(:error ,(format nil "Function location unkown: ~S" dspec)))  
305        ((satisfies emacs-buffer-location-p)        ((satisfies emacs-buffer-location-p)
306         (destructuring-bind (_ buffer offset string) location         (destructuring-bind (_ buffer offset string) location
307           (declare (ignore _ offset string))           (declare (ignore _ offset string))

Legend:
Removed from v.1.32  
changed lines
  Added in v.1.33

  ViewVC Help
Powered by ViewVC 1.1.5