[slime-cvs] CVS update: slime/swank-sbcl.lisp

[Helmut Eller]

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv19008

Modified Files:
	swank-sbcl.lisp 
Log Message:
(signal-compiler-condition): Initialize short-message slot.
(long-compiler-message-for-emacs): New function.
Date: Mon Feb 16 16:45:22 2004
Author: heller

Index: slime/swank-sbcl.lisp
diff -u slime/swank-sbcl.lisp:1.65 slime/swank-sbcl.lisp:1.66
--- slime/swank-sbcl.lisp:1.65	Sun Feb  8 14:19:42 2004
+++ slime/swank-sbcl.lisp	Mon Feb 16 16:45:22 2004
@@ -121,7 +121,7 @@
         (t
          (unless (sb-int:featurep :linux)
            (warn "~
-You aren't runinng Linux. The values of +o_async+ etc are probably bogus."))
+You aren't running Linux. The values of +o_async+ etc are probably bogus."))
          (let ((fcntl (sb-alien:extern-alien 
                        "fcntl" 
                        (function sb-alien:int sb-alien:int 
@@ -216,7 +216,8 @@
                        (sb-ext:compiler-note :note)
                        (style-warning        :style-warning)
                        (warning              :warning))
-           :message (brief-compiler-message-for-emacs condition context)
+           :short-message (brief-compiler-message-for-emacs condition)
+           :message (long-compiler-message-for-emacs condition context)
            :location (compiler-note-location context))))
 
 
@@ -265,19 +266,22 @@
         (t 
          (list :error "No error location available"))))
 
-
-(defun brief-compiler-message-for-emacs (condition error-context)
+(defun brief-compiler-message-for-emacs (condition)
   "Briefly describe a compiler error for Emacs.
 When Emacs presents the message it already has the source popped up
 and the source form highlighted. This makes much of the information in
 the error-context redundant."
+  (princ-to-string condition))
+
+(defun long-compiler-message-for-emacs (condition error-context)
+  "Describe a compiler error for Emacs including context information."
   (declare (type (or sb-c::compiler-error-context null) error-context))
-  (let ((enclosing 
-         (and error-context
-              (sb-c::compiler-error-context-enclosing-source error-context))))
-    (if enclosing
-        (format nil "--> ~{~<~%--> ~1:;~A~> ~}~%~A" enclosing condition)
-        (format nil "~A" condition))))
+  (multiple-value-bind (enclosing source)
+      (if error-context
+          (values (sb-c::compiler-error-context-enclosing-source error-context)
+                  (sb-c::compiler-error-context-source error-context)))
+    (format nil "~@[--> ~{~<~%--> ~1:;~A~> ~}~%~]~@[~{==>~%~A~^~%~}~]~A"
+            enclosing source condition)))
 
 (defun current-compiler-error-source-path (context)
   "Return the source-path for the current compiler error.