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

Diff of /slime/swank-sbcl.lisp

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

revision 1.218 by trittweiler, Fri Sep 12 12:27:38 2008 UTC revision 1.219 by heller, Wed Sep 17 06:19:49 2008 UTC
# Line 371  information." Line 371  information."
371  (defun locate-compiler-note (file source-path source)  (defun locate-compiler-note (file source-path source)
372    (cond ((and (not (eq file :lisp)) *buffer-name*)    (cond ((and (not (eq file :lisp)) *buffer-name*)
373           ;; Compiling from a buffer           ;; Compiling from a buffer
374           (let ((position (+ *buffer-offset*           (make-location (list :buffer *buffer-name*)
375                              (source-path-string-position                          (list :offset  *buffer-offset*
376                               source-path *buffer-substring*))))                                (source-path-string-position
377             (make-location (list :buffer *buffer-name*)                                 source-path *buffer-substring*))))
                           (list :position position))))  
378          ((and (pathnamep file) (null *buffer-name*))          ((and (pathnamep file) (null *buffer-name*))
379           ;; Compiling from a file           ;; Compiling from a file
380           (make-location (list :file (namestring file))           (make-location (list :file (namestring file))
381                          (list :position                          (list :position (1+ (source-path-file-position
382                                (1+ (source-path-file-position                                               source-path file)))))
                                    source-path file)))))  
383          ((and (eq file :lisp) (stringp source))          ((and (eq file :lisp) (stringp source))
384           ;; Compiling macro generated code           ;; Compiling macro generated code
385           (make-location (list :source-form source)           (make-location (list :source-form source)
# Line 590  This is useful when debugging the defini Line 588  This is useful when debugging the defini
588                           character-offset))                           character-offset))
589                  (snippet (string-path-snippet emacs-string form-path pos)))                  (snippet (string-path-snippet emacs-string form-path pos)))
590             (make-location `(:buffer ,emacs-buffer)             (make-location `(:buffer ,emacs-buffer)
591                            `(:position ,(+ pos emacs-position))                            `(:offset ,emacs-position ,pos)
592                            `(:snippet ,snippet))))                            `(:snippet ,snippet))))
593          ((not pathname)          ((not pathname)
594           `(:error ,(format nil "Source definition of ~A ~A not found"           `(:error ,(format nil "Source definition of ~A ~A not found"
# Line 603  This is useful when debugging the defini Line 601  This is useful when debugging the defini
601             (make-location `(:file ,namestring)             (make-location `(:file ,namestring)
602                            ;; /file positions/ in Common Lisp start                            ;; /file positions/ in Common Lisp start
603                            ;; from 0, in Emacs they start from 1.                            ;; from 0, in Emacs they start from 1.
604                            `(:position ,(1+ pos))                            `(:position (1+ ,pos))
605                            `(:snippet ,snippet))))))))                            `(:snippet ,snippet))))))))
606    
607  (defun string-path-snippet (string form-path position)  (defun string-path-snippet (string form-path position)
# Line 905  stack." Line 903  stack."
903  (defun lisp-source-location (code-location)  (defun lisp-source-location (code-location)
904    (let ((source (prin1-to-string    (let ((source (prin1-to-string
905                   (sb-debug::code-location-source-form code-location 100))))                   (sb-debug::code-location-source-form code-location 100))))
906      (make-location `(:source-form ,source) '(:position 0))))      (make-location `(:source-form ,source) '(:position 1))))
907    
908  (defun emacs-buffer-source-location (code-location plist)  (defun emacs-buffer-source-location (code-location plist)
909    (if (code-location-has-debug-block-info-p code-location)    (if (code-location-has-debug-block-info-p code-location)
# Line 916  stack." Line 914  stack."
914                 (snipped (with-input-from-string (s emacs-string)                 (snipped (with-input-from-string (s emacs-string)
915                            (read-snippet s pos))))                            (read-snippet s pos))))
916            (make-location `(:buffer ,emacs-buffer)            (make-location `(:buffer ,emacs-buffer)
917                           `(:position ,(+ emacs-position pos))                           `(:offset ,emacs-position ,pos)
918                           `(:snippet ,snipped))))                           `(:snippet ,snipped))))
919        (fallback-source-location code-location)))        (fallback-source-location code-location)))
920    
# Line 930  stack." Line 928  stack."
928          (let* ((pos (stream-source-position code-location s))          (let* ((pos (stream-source-position code-location s))
929                 (snippet (read-snippet s pos)))                 (snippet (read-snippet s pos)))
930            (make-location `(:file ,filename)            (make-location `(:file ,filename)
931                           `(:position ,(1+ pos))                           `(:position ,pos)
932                           `(:snippet ,snippet)))))))                           `(:snippet ,snippet)))))))
933    
934  (defun code-location-debug-source-name (code-location)  (defun code-location-debug-source-name (code-location)

Legend:
Removed from v.1.218  
changed lines
  Added in v.1.219

  ViewVC Help
Powered by ViewVC 1.1.5