[slime-cvs] CVS update: slime/slime.el

[Luke Gorrie]

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

Modified Files:
	slime.el 
Log Message:
(slime-merge-notes-for-display): New function to merge together
compiler notes that refer to the same location. This is an
optimization for when there are a lot of compiler notes:
`slime-merge-note-into-overlay' concat'd messages together one by one
in O(n^2) time/space, and became noticably slow in practice with ~100
notes or more.

Date: Thu Mar 25 18:20:33 2004
Author: lgorrie

Index: slime/slime.el
diff -u slime/slime.el:1.241 slime/slime.el:1.242
--- slime/slime.el:1.241	Wed Mar 24 17:27:16 2004
+++ slime/slime.el	Thu Mar 25 18:20:33 2004
@@ -2501,7 +2501,7 @@
   (interactive (list (slime-compiler-notes)))
   (save-excursion
     (slime-remove-old-overlays)
-    (mapc #'slime-overlay-note notes)))
+    (mapc #'slime-overlay-note (slime-merge-notes-for-display notes))))
 
 (defun slime-compiler-notes ()
   "Return all compiler notes, warnings, and errors."
@@ -2518,6 +2518,44 @@
       (goto-char (next-overlay-change (point))))))
 
 
+;;;;; Merging together compiler notes in the same location.
+
+(defun slime-merge-notes-for-display (notes)
+  "Merge together notes that refer to the same location.
+This operation is \"lossy\" in the broad sense but not for display purposes."
+  (mapcar #'slime-merge-notes
+          (slime-group-similar 'slime-notes-in-same-location-p notes)))
+
+(defun slime-merge-notes (notes)
+  "Merge NOTES together. Keep the highest severity, concatenate the messages."
+  (let* ((new-severity (reduce #'slime-most-severe notes :key #'slime-note.severity))
+         (messages (mapcar #'slime-note.message notes))
+         (new-message (apply #'concat (slime-intersperse "\n" messages))))
+    (let ((new-note (copy-list (car notes))))
+      (setf (getf new-note :message) new-message)
+      (setf (getf new-note :severity) new-severity)
+      new-note)))
+
+(defun slime-intersperse (element list)
+  "Intersperse ELEMENT between each element of LIST."
+  (cons (car list)
+        (mapcan (lambda (x) (list element x)) list)))
+
+(defun slime-notes-in-same-location-p (a b)
+  (equal (slime-note.location a) (slime-note.location b)))
+
+(defun slime-group-similar (similar-p list)
+  "Return the list of lists of 'similar' adjacent elements of LIST.
+The function SIMILAR-P is used to test for similarity.
+The order of the input list is preserved."
+  (let ((accumulator (list (list (car list)))))
+    (dolist (x (cdr list))
+      (if (funcall similar-p x (caar accumulator))
+          (push x (car accumulator))
+        (push (list x) accumulator)))
+    (reverse (mapcar #'reverse accumulator))))
+
+
 ;;;;; Compiler notes list
 
 (defun slime-maybe-show-xrefs-for-notes (&optional notes)
@@ -2772,6 +2810,9 @@
       (putp 'help-echo message)
       overlay)))
 
+;;; XXX Obsolete due to `slime-merge-notes-for-display' doing the
+;;; work already -- unless we decide to put several sets of notes on a
+;;; buffer without clearing in between, which only this handles.
 (defun slime-merge-note-into-overlay (overlay severity message)
   "Merge another compiler note into an existing overlay.
 The help text describes both notes, and the highest of the severities