[slime-cvs] CVS slime
CVS User heller
heller at common-lisp.net
Mon Aug 10 19:30:22 UTC 2009
Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv28521
Modified Files:
ChangeLog slime.el swank-backend.lisp swank-ccl.lisp
swank-cmucl.lisp swank-openmcl.lisp swank-sbcl.lisp
swank-scl.lisp swank.lisp
Log Message:
Separate context info from compiler message text.
* swank-backend.lisp (compiler-condition): Add a new slot
:source-context. Remove :short-message.
* swank-cmucl.lisp, swank-sbcl.lisp, swank-scl.lisp,
swank-openmcl.lisp, swank-ccl.lisp: Update callers.
* swank.lisp (make-compiler-note): Use source-context slot.
* slime.el (slime-note.source-context): New.
(slime-insert-compilation-log): Use it.
(slime-note.short-message): Deleted.
--- /project/slime/cvsroot/slime/ChangeLog 2009/08/10 19:30:04 1.1830
+++ /project/slime/cvsroot/slime/ChangeLog 2009/08/10 19:30:22 1.1831
@@ -1,5 +1,18 @@
2009-08-10 Helmut Eller <heller at common-lisp.net>
+ Separate context info from compiler message text.
+
+ * swank-backend.lisp (compiler-condition): Add a new slot
+ :source-context. Remove :short-message.
+ * swank-cmucl.lisp, swank-sbcl.lisp, swank-scl.lisp,
+ swank-openmcl.lisp, swank-ccl.lisp: Update callers.
+ * swank.lisp (make-compiler-note): Use source-context slot.
+ * slime.el (slime-note.source-context): New.
+ (slime-insert-compilation-log): Use it.
+ (slime-note.short-message): Deleted.
+
+2009-08-10 Helmut Eller <heller at common-lisp.net>
+
Don't add linebreaks for one-line messages.
(slime-insert-block): New function.
--- /project/slime/cvsroot/slime/slime.el 2009/08/10 19:30:04 1.1209
+++ /project/slime/cvsroot/slime/slime.el 2009/08/10 19:30:22 1.1210
@@ -2856,7 +2856,7 @@
"Merge NOTES together. Keep the highest severity, concatenate the messages."
(let* ((new-severity (reduce #'slime-most-severe notes
:key #'slime-note.severity))
- (new-message (mapconcat #'slime-note.short-message notes "\n")))
+ (new-message (mapconcat #'slime-note.message notes "\n")))
(let ((new-note (copy-list (car notes))))
(setf (getf new-note :message) new-message)
(setf (getf new-note :severity) new-severity)
@@ -2970,7 +2970,11 @@
(dolist (note notes)
(insert " ")
(insert (slime-severity-label (slime-note.severity note)) ": ")
- (slime-insert-block (slime-note.message note) 4)
+ (slime-insert-block
+ (concat (slime-note.message note)
+ (let ((ctx (slime-note.source-context note)))
+ (if ctx (format "\n%s" ctx))))
+ 4)
(insert "\n"))
(insert "\n")
(slime-make-note-overlay (first notes) start (1- (point))))))
@@ -3073,9 +3077,8 @@
(defun slime-note.message (note)
(plist-get note :message))
-(defun slime-note.short-message (note)
- (or (plist-get note :short-message)
- (plist-get note :message)))
+(defun slime-note.source-context (note)
+ (plist-get note :source-context))
(defun slime-note.location (note)
(plist-get note :location))
--- /project/slime/cvsroot/slime/swank-backend.lisp 2009/08/02 12:57:23 1.179
+++ /project/slime/cvsroot/slime/swank-backend.lisp 2009/08/10 19:30:22 1.180
@@ -16,7 +16,7 @@
#:compiler-condition
#:original-condition
#:message
- #:short-message
+ #:source-context
#:condition
#:severity
#:with-compilation-hooks
@@ -428,9 +428,12 @@
(message :initarg :message
:accessor message)
- (short-message :initarg :short-message
- :initform nil
- :accessor short-message)
+ ;; Macro expansion history etc. which may be helpful in some cases
+ ;; but is often very verbose.
+ (source-context :initarg :source-context
+ :type (or null string)
+ :initform nil
+ :accessor source-context)
(references :initarg :references
:initform nil
--- /project/slime/cvsroot/slime/swank-ccl.lisp 2009/07/27 13:08:17 1.2
+++ /project/slime/cvsroot/slime/swank-ccl.lisp 2009/08/10 19:30:22 1.3
@@ -200,8 +200,8 @@
(signal (make-condition
'compiler-condition
:original-condition condition
- :message (format nil "~A" condition)
- :short-message (compiler-warning-short-message condition)
+ :message (compiler-warning-short-message condition)
+ :source-context nil
:severity (compiler-warning-severity condition)
:location (source-note-to-source-location
(ccl:compiler-warning-source-note condition)
--- /project/slime/cvsroot/slime/swank-cmucl.lisp 2009/06/21 07:22:56 1.212
+++ /project/slime/cvsroot/slime/swank-cmucl.lisp 2009/08/10 19:30:22 1.213
@@ -430,8 +430,8 @@
'compiler-condition
:original-condition condition
:severity (severity-for-emacs condition)
- :short-message (brief-compiler-message-for-emacs condition)
- :message (long-compiler-message-for-emacs condition context)
+ :message (compiler-condition-message condition)
+ :source-context (compiler-error-context context)
:location (if (read-error-p condition)
(read-error-location condition)
(compiler-note-location context)))))
@@ -447,22 +447,24 @@
(defun read-error-p (condition)
(eq (type-of condition) 'c::compiler-read-error))
-(defun brief-compiler-message-for-emacs (condition)
+(defun compiler-condition-message (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."
+(defun compiler-error-context (error-context)
+ "Describe context information for Emacs."
(declare (type (or c::compiler-error-context null) error-context))
(multiple-value-bind (enclosing source)
(if error-context
(values (c::compiler-error-context-enclosing-source error-context)
(c::compiler-error-context-source error-context)))
- (format nil "~@[--> ~{~<~%--> ~1:;~A~> ~}~%~]~@[~{==>~%~A~^~%~}~]~A"
- enclosing source condition)))
+ (if (or enclosing source)
+ (format nil "~@[--> ~{~<~%--> ~1:;~A ~>~}~%~]~
+ ~@[==>~{~&~A~}~]"
+ enclosing source))))
(defun read-error-location (condition)
(let* ((finfo (car (c::source-info-current-file c::*source-info*)))
--- /project/slime/cvsroot/slime/swank-openmcl.lisp 2009/06/30 02:50:25 1.182
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp 2009/08/10 19:30:22 1.183
@@ -233,8 +233,8 @@
(signal (make-condition
'compiler-condition
:original-condition condition
- :message (format nil "~A" condition)
- :short-message (compiler-warning-short-message condition)
+ :message (compiler-warning-short-message condition)
+ :source-context nil
:severity (compiler-warning-severity condition)
:location (source-note-to-source-location
(ccl::compiler-warning-source-note condition)
--- /project/slime/cvsroot/slime/swank-sbcl.lisp 2009/08/04 23:54:55 1.247
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp 2009/08/10 19:30:22 1.248
@@ -443,9 +443,9 @@
(warning :warning)
(reader-error :read-error)
(error :error))
- :short-message (brief-compiler-message-for-emacs condition)
:references (condition-references (real-condition condition))
- :message (long-compiler-message-for-emacs condition context)
+ :message (brief-compiler-message-for-emacs condition)
+ :source-context (compiler-error-context context)
:location (compiler-note-location condition context))))
(defun real-condition (condition)
@@ -519,16 +519,16 @@
(let ((sb-int:*print-condition-references* nil))
(princ-to-string condition)))
-(defun long-compiler-message-for-emacs (condition error-context)
+(defun compiler-error-context (error-context)
"Describe a compiler error for Emacs including context information."
(declare (type (or sb-c::compiler-error-context null) error-context))
(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)))
- (let ((sb-int:*print-condition-references* nil))
- (format nil "~@[--> ~{~<~%--> ~1:;~A~> ~}~%~]~@[~{==>~%~A~%~}~]~A"
- enclosing source condition))))
+ (and (or enclosing source)
+ (format nil "~@[--> ~{~<~%--> ~1:;~A~> ~}~%~]~@[~{==>~%~A~%~}~]"
+ enclosing source))))
(defun compiler-source-path (context)
"Return the source-path for the current compiler error.
--- /project/slime/cvsroot/slime/swank-scl.lisp 2009/06/21 07:22:56 1.33
+++ /project/slime/cvsroot/slime/swank-scl.lisp 2009/08/10 19:30:22 1.34
@@ -488,8 +488,8 @@
'compiler-condition
:original-condition condition
:severity (severity-for-emacs condition)
- :short-message (brief-compiler-message-for-emacs condition)
- :message (long-compiler-message-for-emacs condition context)
+ :message (brief-compiler-message-for-emacs condition)
+ :source-context (compiler-error-context context)
:location (if (read-error-p condition)
(read-error-location condition)
(compiler-note-location context)))))
@@ -512,15 +512,16 @@
the error-context redundant."
(princ-to-string condition))
-(defun long-compiler-message-for-emacs (condition error-context)
+(defun compiler-error-context (error-context)
"Describe a compiler error for Emacs including context information."
(declare (type (or c::compiler-error-context null) error-context))
(multiple-value-bind (enclosing source)
(if error-context
(values (c::compiler-error-context-enclosing-source error-context)
(c::compiler-error-context-source error-context)))
- (format nil "~@[--> ~{~<~%--> ~1:;~A~> ~}~%~]~@[~{==>~%~A~^~%~}~]~A"
- enclosing source condition)))
+ (if (and enclosing source)
+ (format nil "~@[--> ~{~<~%--> ~1:;~A~> ~}~%~]~@[~{==>~%~A~^~%~}~]"
+ enclosing source))))
(defun read-error-location (condition)
(let* ((finfo (car (c::source-info-current-file c::*source-info*)))
--- /project/slime/cvsroot/slime/swank.lisp 2009/08/09 14:07:47 1.656
+++ /project/slime/cvsroot/slime/swank.lisp 2009/08/10 19:30:22 1.657
@@ -2765,8 +2765,8 @@
:severity (severity condition)
:location (location condition)
:references (references condition)
- (let ((s (short-message condition)))
- (if s (list :short-message s)))))
+ (let ((s (source-context condition)))
+ (if s (list :source-context s)))))
(defun collect-notes (function)
(let ((notes '()))
More information about the slime-cvs
mailing list