Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

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.
  • Loading branch information...
commit 68fc33093cda205ad415c16992a20fff28747b26 1 parent 1a44e33
authored
13  ChangeLog
... ...
@@ -1,5 +1,18 @@
1 1
 2009-08-10  Helmut Eller  <heller@common-lisp.net>
2 2
 
  3
+	Separate context info from compiler message text.
  4
+
  5
+	* swank-backend.lisp (compiler-condition): Add a new slot
  6
+	:source-context.  Remove :short-message.
  7
+	* swank-cmucl.lisp, swank-sbcl.lisp, swank-scl.lisp,
  8
+	swank-openmcl.lisp, swank-ccl.lisp: Update callers.
  9
+	* swank.lisp (make-compiler-note): Use source-context slot.
  10
+	* slime.el (slime-note.source-context): New.
  11
+	(slime-insert-compilation-log): Use it.
  12
+	(slime-note.short-message): Deleted.
  13
+
  14
+2009-08-10  Helmut Eller  <heller@common-lisp.net>
  15
+
3 16
 	Don't add linebreaks for one-line messages.
4 17
 
5 18
 	(slime-insert-block): New function.
13  slime.el
@@ -2856,7 +2856,7 @@ This operation is \"lossy\" in the broad sense but not for display purposes."
2856 2856
   "Merge NOTES together. Keep the highest severity, concatenate the messages."
2857 2857
   (let* ((new-severity (reduce #'slime-most-severe notes
2858 2858
                                :key #'slime-note.severity))
2859  
-         (new-message (mapconcat #'slime-note.short-message notes "\n")))
  2859
+         (new-message (mapconcat #'slime-note.message notes "\n")))
2860 2860
     (let ((new-note (copy-list (car notes))))
2861 2861
       (setf (getf new-note :message) new-message)
2862 2862
       (setf (getf new-note :severity) new-severity)
@@ -2970,7 +2970,11 @@ Each newlines and following indentation is replaced by a single space."
2970 2970
             (dolist (note notes)
2971 2971
               (insert "  ")
2972 2972
               (insert (slime-severity-label (slime-note.severity note)) ": ")
2973  
-              (slime-insert-block (slime-note.message note) 4)
  2973
+              (slime-insert-block
  2974
+               (concat (slime-note.message note)
  2975
+                       (let ((ctx (slime-note.source-context note)))
  2976
+                         (if ctx (format "\n%s" ctx))))
  2977
+               4)
2974 2978
               (insert "\n"))
2975 2979
             (insert "\n")
2976 2980
             (slime-make-note-overlay (first notes) start (1- (point))))))
@@ -3073,9 +3077,8 @@ keys."
3073 3077
 (defun slime-note.message (note)
3074 3078
   (plist-get note :message))
3075 3079
 
3076  
-(defun slime-note.short-message (note)
3077  
-  (or (plist-get note :short-message)
3078  
-      (plist-get note :message)))
  3080
+(defun slime-note.source-context (note)
  3081
+  (plist-get note :source-context))
3079 3082
 
3080 3083
 (defun slime-note.location (note)
3081 3084
   (plist-get note :location))
11  swank-backend.lisp
@@ -16,7 +16,7 @@
16 16
            #:compiler-condition
17 17
            #:original-condition
18 18
            #:message
19  
-           #:short-message
  19
+           #:source-context
20 20
            #:condition
21 21
            #:severity
22 22
            #:with-compilation-hooks
@@ -428,9 +428,12 @@ like `compile-file'")
428 428
    (message :initarg :message
429 429
             :accessor message)
430 430
 
431  
-   (short-message :initarg :short-message
432  
-                  :initform nil
433  
-                  :accessor short-message)
  431
+   ;; Macro expansion history etc. which may be helpful in some cases
  432
+   ;; but is often very verbose.
  433
+   (source-context :initarg :source-context
  434
+                   :type (or null string)
  435
+                   :initform nil
  436
+                   :accessor source-context)
434 437
 
435 438
    (references :initarg :references
436 439
                :initform nil
4  swank-ccl.lisp
@@ -200,8 +200,8 @@
200 200
   (signal (make-condition
201 201
            'compiler-condition
202 202
            :original-condition condition
203  
-           :message (format nil "~A" condition)
204  
-           :short-message (compiler-warning-short-message condition)
  203
+           :message (compiler-warning-short-message condition)
  204
+           :source-context nil
205 205
            :severity (compiler-warning-severity condition)
206 206
            :location (source-note-to-source-location 
207 207
                       (ccl:compiler-warning-source-note condition)
16  swank-cmucl.lisp
@@ -430,8 +430,8 @@ NIL if we aren't compiling from a buffer.")
430 430
            'compiler-condition
431 431
            :original-condition condition
432 432
            :severity (severity-for-emacs condition)
433  
-           :short-message (brief-compiler-message-for-emacs condition)
434  
-           :message (long-compiler-message-for-emacs condition context)
  433
+           :message (compiler-condition-message condition)
  434
+           :source-context (compiler-error-context context)
435 435
            :location (if (read-error-p condition)
436 436
                          (read-error-location condition)
437 437
                          (compiler-note-location context)))))
@@ -447,22 +447,24 @@ NIL if we aren't compiling from a buffer.")
447 447
 (defun read-error-p (condition)
448 448
   (eq (type-of condition) 'c::compiler-read-error))
449 449
 
450  
-(defun brief-compiler-message-for-emacs (condition)
  450
+(defun compiler-condition-message (condition)
451 451
   "Briefly describe a compiler error for Emacs.
452 452
 When Emacs presents the message it already has the source popped up
453 453
 and the source form highlighted. This makes much of the information in
454 454
 the error-context redundant."
455 455
   (princ-to-string condition))
456 456
 
457  
-(defun long-compiler-message-for-emacs (condition error-context)
458  
-  "Describe a compiler error for Emacs including context information."
  457
+(defun compiler-error-context (error-context)
  458
+  "Describe context information for Emacs."
459 459
   (declare (type (or c::compiler-error-context null) error-context))
460 460
   (multiple-value-bind (enclosing source)
461 461
       (if error-context
462 462
           (values (c::compiler-error-context-enclosing-source error-context)
463 463
                   (c::compiler-error-context-source error-context)))
464  
-    (format nil "~@[--> ~{~<~%--> ~1:;~A~> ~}~%~]~@[~{==>~%~A~^~%~}~]~A"
465  
-            enclosing source condition)))
  464
+    (if (or enclosing source)
  465
+        (format nil "~@[--> ~{~<~%--> ~1:;~A ~>~}~%~]~
  466
+                     ~@[==>~{~&~A~}~]"
  467
+                enclosing source))))
466 468
 
467 469
 (defun read-error-location (condition)
468 470
   (let* ((finfo (car (c::source-info-current-file c::*source-info*)))
4  swank-openmcl.lisp
@@ -233,8 +233,8 @@
233 233
   (signal (make-condition
234 234
            'compiler-condition
235 235
            :original-condition condition
236  
-           :message (format nil "~A" condition)
237  
-           :short-message (compiler-warning-short-message condition)
  236
+           :message (compiler-warning-short-message condition)
  237
+           :source-context nil
238 238
            :severity (compiler-warning-severity condition)
239 239
            :location (source-note-to-source-location 
240 240
                       (ccl::compiler-warning-source-note condition)
12  swank-sbcl.lisp
@@ -443,9 +443,9 @@ information."
443 443
                        (warning              :warning)
444 444
                        (reader-error         :read-error)
445 445
                        (error                :error))
446  
-           :short-message (brief-compiler-message-for-emacs condition)
447 446
            :references (condition-references (real-condition condition))
448  
-           :message (long-compiler-message-for-emacs condition context)
  447
+           :message (brief-compiler-message-for-emacs condition)
  448
+           :source-context (compiler-error-context context)
449 449
            :location (compiler-note-location condition context))))
450 450
 
451 451
 (defun real-condition (condition)
@@ -519,16 +519,16 @@ the error-context redundant."
519 519
   (let ((sb-int:*print-condition-references* nil))
520 520
     (princ-to-string condition)))
521 521
 
522  
-(defun long-compiler-message-for-emacs (condition error-context)
  522
+(defun compiler-error-context (error-context)
523 523
   "Describe a compiler error for Emacs including context information."
524 524
   (declare (type (or sb-c::compiler-error-context null) error-context))
525 525
   (multiple-value-bind (enclosing source)
526 526
       (if error-context
527 527
           (values (sb-c::compiler-error-context-enclosing-source error-context)
528 528
                   (sb-c::compiler-error-context-source error-context)))
529  
-    (let ((sb-int:*print-condition-references* nil))
530  
-      (format nil "~@[--> ~{~<~%--> ~1:;~A~> ~}~%~]~@[~{==>~%~A~%~}~]~A"
531  
-              enclosing source condition))))
  529
+    (and (or enclosing source)
  530
+         (format nil "~@[--> ~{~<~%--> ~1:;~A~> ~}~%~]~@[~{==>~%~A~%~}~]"
  531
+                 enclosing source))))
532 532
 
533 533
 (defun compiler-source-path (context)
534 534
   "Return the source-path for the current compiler error.
11  swank-scl.lisp
@@ -488,8 +488,8 @@
488 488
            'compiler-condition
489 489
            :original-condition condition
490 490
            :severity (severity-for-emacs condition)
491  
-           :short-message (brief-compiler-message-for-emacs condition)
492  
-           :message (long-compiler-message-for-emacs condition context)
  491
+           :message (brief-compiler-message-for-emacs condition)
  492
+           :source-context (compiler-error-context context)
493 493
            :location (if (read-error-p condition)
494 494
                          (read-error-location condition)
495 495
                          (compiler-note-location context)))))
@@ -512,15 +512,16 @@
512 512
   the error-context redundant."
513 513
   (princ-to-string condition))
514 514
 
515  
-(defun long-compiler-message-for-emacs (condition error-context)
  515
+(defun compiler-error-context (error-context)
516 516
   "Describe a compiler error for Emacs including context information."
517 517
   (declare (type (or c::compiler-error-context null) error-context))
518 518
   (multiple-value-bind (enclosing source)
519 519
       (if error-context
520 520
           (values (c::compiler-error-context-enclosing-source error-context)
521 521
                   (c::compiler-error-context-source error-context)))
522  
-    (format nil "~@[--> ~{~<~%--> ~1:;~A~> ~}~%~]~@[~{==>~%~A~^~%~}~]~A"
523  
-            enclosing source condition)))
  522
+    (if (and enclosing source)
  523
+        (format nil "~@[--> ~{~<~%--> ~1:;~A~> ~}~%~]~@[~{==>~%~A~^~%~}~]"
  524
+                enclosing source))))
524 525
 
525 526
 (defun read-error-location (condition)
526 527
   (let* ((finfo (car (c::source-info-current-file c::*source-info*)))
4  swank.lisp
@@ -2765,8 +2765,8 @@ The time is measured in seconds."
2765 2765
          :severity (severity condition)
2766 2766
          :location (location condition)
2767 2767
          :references (references condition)
2768  
-         (let ((s (short-message condition)))
2769  
-           (if s (list :short-message s)))))
  2768
+         (let ((s (source-context condition)))
  2769
+           (if s (list :source-context s)))))
2770 2770
 
2771 2771
 (defun collect-notes (function)
2772 2772
   (let ((notes '()))

0 notes on commit 68fc330

Please sign in to comment.
Something went wrong with that request. Please try again.