/[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.126 by heller, Thu Oct 28 21:34:36 2004 UTC revision 1.127 by heller, Mon Nov 1 17:18:56 2004 UTC
# Line 291  NIL if we aren't compiling from a buffer Line 291  NIL if we aren't compiling from a buffer
291  (defimplementation swank-compile-file (filename load-p)  (defimplementation swank-compile-file (filename load-p)
292    (clear-xref-info filename)    (clear-xref-info filename)
293    (with-compilation-hooks ()    (with-compilation-hooks ()
294      (let ((*buffer-name* nil))      (let ((*buffer-name* nil)
295              (ext:*ignore-extra-close-parentheses* nil))
296        (multiple-value-bind (output-file warnings-p failure-p)        (multiple-value-bind (output-file warnings-p failure-p)
297            (compile-file filename)            (compile-file filename)
298          (unless failure-p          (unless failure-p
# Line 334  NIL if we aren't compiling from a buffer Line 335  NIL if we aren't compiling from a buffer
335             :severity (severity-for-emacs condition)             :severity (severity-for-emacs condition)
336             :short-message (brief-compiler-message-for-emacs condition)             :short-message (brief-compiler-message-for-emacs condition)
337             :message (long-compiler-message-for-emacs condition context)             :message (long-compiler-message-for-emacs condition context)
338             :location (if (eq (type-of condition) 'c::compiler-read-error)             :location (if (read-error-p condition)
339                           (read-error-location condition)                           (read-error-location condition)
340                           (compiler-note-location context)))))                           (compiler-note-location context)))))
341    
342  (defun severity-for-emacs (condition)  (defun severity-for-emacs (condition)
343    "Return the severity of CONDITION."    "Return the severity of CONDITION."
344    (etypecase condition    (etypecase condition
345        ((satisfies read-error-p) :read-error)
346      (c::compiler-error :error)      (c::compiler-error :error)
347      (c::style-warning :note)      (c::style-warning :note)
348      (c::warning :warning)))      (c::warning :warning)))
349    
350    (defun read-error-p (condition)
351      (eq (type-of condition) 'c::compiler-read-error))
352    
353  (defun brief-compiler-message-for-emacs (condition)  (defun brief-compiler-message-for-emacs (condition)
354    "Briefly describe a compiler error for Emacs.    "Briefly describe a compiler error for Emacs.
355  When Emacs presents the message it already has the source popped up  When Emacs presents the message it already has the source popped up
# Line 368  the error-context redundant." Line 373  the error-context redundant."
373           (pos (c::compiler-read-error-position condition)))           (pos (c::compiler-read-error-position condition)))
374      (cond ((and (eq file :stream) *buffer-name*)      (cond ((and (eq file :stream) *buffer-name*)
375             (make-location (list :buffer *buffer-name*)             (make-location (list :buffer *buffer-name*)
376                            (list :position *buffer-start-position* pos)))                            (list :position (+ *buffer-start-position* pos))))
377            ((and (pathnamep file) (not *buffer-name*))            ((and (pathnamep file) (not *buffer-name*))
378             (make-location (list :file (unix-truename file))             (make-location (list :file (unix-truename file))
379                            (list :position pos)))                            (list :position (1+ pos))))
380            (t (break)))))            (t (break)))))
381    
382  (defun compiler-note-location (context)  (defun compiler-note-location (context)

Legend:
Removed from v.1.126  
changed lines
  Added in v.1.127

  ViewVC Help
Powered by ViewVC 1.1.5