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

Diff of /slime/swank-allegro.lisp

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

revision 1.129 by heller, Mon Nov 2 09:20:33 2009 UTC revision 1.130 by sboukarev, Fri Dec 11 03:37:17 2009 UTC
# Line 271  Line 271 
271                (list :file (namestring (truename file)))                (list :file (namestring (truename file)))
272                (list :position (1+ pos)))))                (list :position (1+ pos)))))
273            (t            (t
274             (list :error "No error location available.")))))             (make-error-location "No error location available.")))))
275    
276  (defun location-for-reader-error (condition)  (defun location-for-reader-error (condition)
277    (let ((pos  (car (last (slot-value condition 'excl::format-arguments))))    (let ((pos  (car (last (slot-value condition 'excl::format-arguments))))
# Line 283  Line 283 
283                                       ,(- pos *temp-file-header-end-position* 1)))                                       ,(- pos *temp-file-header-end-position* 1)))
284              (make-location `(:file ,(namestring (truename file)))              (make-location `(:file ,(namestring (truename file)))
285                             `(:position ,pos)))                             `(:position ,pos)))
286          (list :error "No error location available."))))          (make-error-location "No error location available."))))
287    
288  (defun handle-undefined-functions-warning (condition)  (defun handle-undefined-functions-warning (condition)
289    (let ((fargs (slot-value condition 'excl::format-arguments)))    (let ((fargs (slot-value condition 'excl::format-arguments)))
# Line 411  Line 411 
411       (list :offset (parse-integer (subseq filename (1+ pos))) 0))))       (list :offset (parse-integer (subseq filename (1+ pos))) 0))))
412    
413  (defun find-fspec-location (fspec type file top-level)  (defun find-fspec-location (fspec type file top-level)
414    (etypecase file    (handler-case
415      (pathname        (etypecase file
416       (find-definition-in-file fspec type file top-level))          (pathname
417      ((member :top-level)             (find-definition-in-file fspec type file top-level))
418       (list :error (format nil "Defined at toplevel: ~A"          ((member :top-level)
419                            (fspec->string fspec))))             (make-error-location "Defined at toplevel: ~A" (fspec->string fspec)))
420      (string          (string
421       (find-definition-in-buffer file))))             (find-definition-in-buffer file)))
422        (error (e)
423          (make-error-location "Error: ~A" e))))
424    
425  (defun fspec->string (fspec)  (defun fspec->string (fspec)
426    (etypecase fspec    (etypecase fspec
# Line 431  Line 433 
433    
434  (defun fspec-definition-locations (fspec)  (defun fspec-definition-locations (fspec)
435    (cond    (cond
436     ((and (listp fspec)      ((and (listp fspec)
437           (eql (car fspec) :top-level-form))            (eql (car fspec) :top-level-form))
438      (destructuring-bind (top-level-form file &optional position) fspec       (destructuring-bind (top-level-form file &optional position) fspec
439        (declare (ignore top-level-form))         (declare (ignore top-level-form))
440        (list         (list fspec
        (list (list nil fspec)  
441               (make-location (list :buffer file) ; FIXME: should use :file               (make-location (list :buffer file) ; FIXME: should use :file
442                              (list :position position)                              (list :position position)
443                              (list :align t))))))                              (list :align t)))))
444     ((and (listp fspec) (eq (car fspec) :internal))      ((and (listp fspec) (eq (car fspec) :internal))
445      (destructuring-bind (_internal next _n) fspec       (destructuring-bind (_internal next _n) fspec
446        (declare (ignore _internal _n))         (declare (ignore _internal _n))
447        (fspec-definition-locations next)))         (fspec-definition-locations next)))
448     (t      (t
449      (let ((defs (excl::find-source-file fspec)))       (let ((defs (excl::find-source-file fspec)))
450        (when (and (null defs)         (when (and (null defs)
451                   (listp fspec)                    (listp fspec)
452                   (string= (car fspec) '#:method))                    (string= (car fspec) '#:method))
453          ;; If methods are defined in a defgeneric form, the source location is           ;; If methods are defined in a defgeneric form, the source location is
454          ;; recorded for the gf but not for the methods. Therefore fall back to           ;; recorded for the gf but not for the methods. Therefore fall back to
455          ;; the gf as the likely place of definition.           ;; the gf as the likely place of definition.
456          (setq defs (excl::find-source-file (second fspec))))           (setq defs (excl::find-source-file (second fspec))))
457        (if (null defs)         (if (null defs)
458            (list             (list
459             (list (list nil fspec)              (list fspec
460                   (list :error                    (make-error-location "Unknown source location for ~A"
461                         (format nil "Unknown source location for ~A"                                         (fspec->string fspec))))
462                                 (fspec->string fspec)))))             (loop for (fspec type file top-level) in defs
463          (loop for (fspec type file top-level) in defs                   collect (list (list type fspec)
464                collect (list (list type fspec)                                 (find-fspec-location fspec type file top-level))))))))
                             (find-fspec-location fspec type file top-level))))))))  
465    
466  (defimplementation find-definitions (symbol)  (defimplementation find-definitions (symbol)
467    (fspec-definition-locations symbol))    (fspec-definition-locations symbol))

Legend:
Removed from v.1.129  
changed lines
  Added in v.1.130

  ViewVC Help
Powered by ViewVC 1.1.5