/[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.31 by dbarlow, Sat Nov 29 23:31:29 2003 UTC revision 1.32 by heller, Sun Nov 30 08:15:42 2003 UTC
# Line 188  information." Line 188  information."
188    "Determine from CONTEXT the current compiler source location."    "Determine from CONTEXT the current compiler source location."
189    (let* ((file-name (sb-c::compiler-error-context-file-name context))    (let* ((file-name (sb-c::compiler-error-context-file-name context))
190           (file-pos (sb-c::compiler-error-context-file-position context))           (file-pos (sb-c::compiler-error-context-file-position context))
191           (file (if (typep file-name 'pathname)           (source-path (current-compiler-error-source-path context)))
192                     (namestring file-name)      (cond ((and (boundp '*buffername*) *buffername*)
193                     file-name)))             ;; account for the added lambda, replace leading
194      (list :sbcl             ;; position with 0
195            :buffername    (if (boundp '*buffername*) *buffername*)             (make-location
196            :buffer-offset (if (boundp '*buffer-offset*) *buffer-offset*)              (list :buffer *buffername*)
197            :position      file-pos              (list :source-path (cons 0 (cddr source-path)) *buffer-offset*)))
198            :filename      (etypecase file            (t
199                             (symbol file)             (etypecase file-name
200                             ((or string pathname)               (pathname
201                              (namestring (truename file))))                (make-location
202            :source-path   (current-compiler-error-source-path context))))                 (list :file (namestring (truename file-name)))
203                   (list :source-path source-path file-pos))))))))
204    
205  (defun brief-compiler-message-for-emacs (condition error-context)  (defun brief-compiler-message-for-emacs (condition error-context)
206    "Briefly describe a compiler error for Emacs.    "Briefly describe a compiler error for Emacs.
# Line 240  compiler state." Line 241  compiler state."
241    
242  (defmethod compile-string-for-emacs (string &key buffer position)  (defmethod compile-string-for-emacs (string &key buffer position)
243    (with-compilation-hooks ()    (with-compilation-hooks ()
244      (let ((*package* *buffer-package*))      (let ((*package* *buffer-package*)
245        (prog1            (*buffername* buffer)
246            (eval (from-string            (*buffer-offset* position))
247                   (format nil "(funcall (compile nil '(lambda () ~A)))"        (eval (from-string
248                           string)))               (format nil "(funcall (compile nil '(lambda () ~A)))"
249          (loop for n  in *compiler-notes*                       string))))))
               for loc = (getf n :location)  
               for (_ . l) = loc  
               for sp = (getf l :source-path)  
               ;; account for the added lambda, replace leading  
               ;; position with 0  
               do (setf (getf l :source-path) (cons 0 (cddr sp))  
                        (getf l :buffername) buffer  
                        (getf l :buffer-offset) position))))))  
250    
251  ;;;; xref stuff doesn't exist for sbcl yet  ;;;; xref stuff doesn't exist for sbcl yet
252    
# Line 284  This is useful when debugging the defini Line 277  This is useful when debugging the defini
277    "Try to find the canonical source location of FUNCTION."    "Try to find the canonical source location of FUNCTION."
278    (let* ((def (sb-introspect:find-definition-source function))    (let* ((def (sb-introspect:find-definition-source function))
279           (pathname (sb-introspect:definition-source-pathname def))           (pathname (sb-introspect:definition-source-pathname def))
280           (path (sb-introspect:definition-source-form-path def)))           (path (sb-introspect:definition-source-form-path def))
281      (list :sbcl           (position (sb-introspect:definition-source-character-offset def)))
282            :filename (and pathname (namestring (truename pathname)))      (unless pathname
283            :position (sb-introspect:definition-source-character-offset def)        (return-from function-source-location
284            :path path          (list :error (format nil "No filename for: ~S" fname))))
285            ;; source-paths depend on the file having been compiled with      (multiple-value-bind (truename condition)
286            ;; lotsa debugging.  If not present, return the function name          (ignore-errors (truename pathname))
287            ;; for emacs to attempt to find with a regex        (when condition
288            :function-name (unless path fname))))          (return-from function-source-location
289              (list :error (format nil "~A" condition))))
290          (make-location
291           (list :file (namestring truename))
292           ;; source-paths depend on the file having been compiled with
293           ;; lotsa debugging.  If not present, return the function name
294           ;; for emacs to attempt to find with a regex
295           (cond (path (list :source-path path position))
296                 (t (list :function-name fname)))))))
297    
298  (defmethod function-source-location-for-emacs (fname-string)  (defmethod function-source-location-for-emacs (fname-string)
299    "Return the source-location of FNAME's definition."    "Return the source-location of FNAME's definition."
# Line 314  This is useful when debugging the defini Line 315  This is useful when debugging the defini
315        (if *debug-definition-finding*        (if *debug-definition-finding*
316            (finder fname)            (finder fname)
317            (handler-case (finder fname)            (handler-case (finder fname)
318              (error (e) (list :error (format nil "Error: ~A" e))))))))              (error (e)
319                  (list :error (format nil "Error: ~A" e))))))))
320    
321    (defslimefun find-function-locations (name)
322      (list (function-source-location-for-emacs name)))
323    
324  (defmethod describe-symbol-for-emacs (symbol)  (defmethod describe-symbol-for-emacs (symbol)
325    "Return a plist describing SYMBOL.    "Return a plist describing SYMBOL.
# Line 390  Return NIL if the symbol is unbound." Line 395  Return NIL if the symbol is unbound."
395           (*debugger-hook* nil)           (*debugger-hook* nil)
396           (*readtable* (or sb-debug:*debug-readtable* *readtable*))           (*readtable* (or sb-debug:*debug-readtable* *readtable*))
397           (*print-level* nil #+nil sb-debug:*debug-print-level*)           (*print-level* nil #+nil sb-debug:*debug-print-level*)
398           (*print-length* nil #+nil sb-debug:*debug-print-length*))           (*print-length* nil #+nil sb-debug:*debug-print-length*)
399             (*print-readably* nil))
400      (handler-bind ((sb-di:debug-condition      (handler-bind ((sb-di:debug-condition
401                      (lambda (condition)                      (lambda (condition)
402                        (signal (make-condition                        (signal (make-condition
# Line 421  format suitable for Emacs." Line 427  format suitable for Emacs."
427  (defun format-frame-for-emacs (frame)  (defun format-frame-for-emacs (frame)
428    (list (sb-di:frame-number frame)    (list (sb-di:frame-number frame)
429          (with-output-to-string (*standard-output*)          (with-output-to-string (*standard-output*)
430            (let ((*print-pretty* nil))            (let ((*print-pretty* *sldb-pprint-frames*))
431              (sb-debug::print-frame-call frame :verbosity 1 :number t)))))              (sb-debug::print-frame-call frame :verbosity 1 :number t)))))
432    
433  (defun compute-backtrace (start end)  (defun compute-backtrace (start end)
# Line 478  stack." Line 484  stack."
484    (let* ((debug-source (sb-di:code-location-debug-source code-location))    (let* ((debug-source (sb-di:code-location-debug-source code-location))
485           (from (sb-di:debug-source-from debug-source))           (from (sb-di:debug-source-from debug-source))
486           (name (sb-di:debug-source-name debug-source)))           (name (sb-di:debug-source-name debug-source)))
487      (list      (ecase from
488       :sbcl        (:file
489       :from from         ;; XXX: code-location-source-path reads the source !!
490       :filename (if (eq from :file)         (let ((source-path (code-location-source-path code-location))
491                     (namestring (truename name)))               (position (code-location-file-position code-location)))
492       :position (if (eq from :file)           (make-location
493                     (code-location-file-position code-location))            (list :file (namestring (truename name)))
494       :info (and (debug-source-info-from-emacs-buffer-p debug-source)            (list :source-path source-path position))))
495                  (sb-c::debug-source-info debug-source))        (:lisp
496       :path (code-location-source-path code-location)         (make-location
497       :source-form          (list :source-form (with-output-to-string (*standard-output*)
498       (unless (or (eq from :file)                               (sb-debug::print-code-location-source-form
499                   (debug-source-info-from-emacs-buffer-p debug-source))                                code-location 100)))
500           (with-output-to-string (*standard-output*)          (list :position 0))))))
            (sb-debug::print-code-location-source-form  code-location 100))))))  
501    
502  (defun safe-source-location-for-emacs (code-location)  (defun safe-source-location-for-emacs (code-location)
503    (handler-case (source-location-for-emacs code-location)    (handler-case (source-location-for-emacs code-location)
504      (t (c) (list :error (princ-to-string c)))))      (t (c) (list :error (format nil "~A" c)))))
505    
506  (defmethod frame-source-location-for-emacs (index)  (defmethod frame-source-location-for-emacs (index)
507    (safe-source-location-for-emacs    (safe-source-location-for-emacs

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

  ViewVC Help
Powered by ViewVC 1.1.5