[slime-cvs] CVS slime

[CVS User heller]

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv27817

Modified Files:
	ChangeLog slime.el 
Log Message:
Don't add linebreaks for one-line messages.

(slime-insert-block): New function.
(slime-insert-compilation-log): Use it.
(slime-indent-rigidly): Use insert-before-markers, otherwise point
ends up at before a bunch of inserted spaces.

--- /project/slime/cvsroot/slime/ChangeLog	2009/08/10 19:29:55	1.1829
+++ /project/slime/cvsroot/slime/ChangeLog	2009/08/10 19:30:04	1.1830
@@ -1,5 +1,14 @@
 2009-08-10  Helmut Eller  <heller at common-lisp.net>
 
+	Don't add linebreaks for one-line messages.
+
+	(slime-insert-block): New function.
+	(slime-insert-compilation-log): Use it.
+	(slime-indent-rigidly): Use insert-before-markers, otherwise point
+	ends up at before a bunch of inserted spaces.
+
+2009-08-10  Helmut Eller  <heller at common-lisp.net>
+
 	Various compilation related changes.
 
 	* slime.el (slime-show-note-counts): Don't show 0 values.
--- /project/slime/cvsroot/slime/slime.el	2009/08/10 19:29:55	1.1208
+++ /project/slime/cvsroot/slime/slime.el	2009/08/10 19:30:04	1.1209
@@ -909,13 +909,14 @@
 
 (defun slime-indent-rigidly (start end column)
   ;; Similar to `indent-rigidly' but doesn't inherit text props.
-  (save-excursion
-    (goto-char end)
-    (beginning-of-line)
-    (while (and (<= start (point))
-                (progn
-                  (save-excursion (insert-char ?\  column))
-                  (zerop (forward-line -1)))))))
+  (let ((indent (make-string column ?\ )))
+    (save-excursion
+      (goto-char end)
+      (beginning-of-line)
+      (while (and (<= start (point))
+                  (progn
+                    (insert-before-markers indent)
+                    (zerop (forward-line -1))))))))
 
 (defun slime-insert-indented (&rest strings)
   "Insert all arguments rigidly indented."
@@ -2944,7 +2945,7 @@
       (with-current-buffer "*SLIME Compilation*"
         (let ((inhibit-read-only t))
           (goto-char (point-max))
-          (insert "\nCompilation " (if successp "succeeded." "failed."))
+          (insert "Compilation " (if successp "succeeded." "failed."))
           (goto-char (point-min))
           (display-buffer (current-buffer)))))))
 
@@ -2960,24 +2961,30 @@
     (with-temp-message "Preparing compilation log..."
       (let ((inhibit-read-only t)
             (inhibit-modification-hooks t)) ; inefficient font-lock-hook
-        (insert (format "cd %s\n%d compiler notes:\n" 
+        (insert (format "cd %s\n%d compiler notes:\n\n"
                         default-directory (length notes)))
         (dolist (notes grouped-notes)
           (let ((loc (gethash (first notes) canonicalized-locs-table))
-                (start (1+ (point))))   ; 1+ due to \n
-            (insert 
-             (format "\n%s:\n" (slime-canonicalized-location-to-string loc)))
+                (start (point)))
+            (insert (slime-canonicalized-location-to-string loc) ":\n")
             (dolist (note notes)
-              (insert (format "  %s:\n" (slime-severity-label 
-                                         (slime-note.severity note))))
-              (slime-with-rigid-indentation 4
-                (insert (slime-note.message note))
-                (insert "\n")))
-            (slime-make-note-overlay (first notes) start (point)))))
+              (insert "  ")
+              (insert (slime-severity-label (slime-note.severity note)) ": ")
+              (slime-insert-block (slime-note.message note) 4)
+              (insert "\n"))
+            (insert "\n")
+            (slime-make-note-overlay (first notes) start (1- (point))))))
       (compilation-mode)
       (set (make-local-variable 'compilation-skip-threshold) 0)
       (setq next-error-last-buffer (current-buffer)))))
 
+(defun slime-insert-block (string indentation)
+  "Insert TEXT.  If it takes multiple lines, indent it."
+  (cond ((string-match "\n" string)
+         (insert "\n")
+         (slime-with-rigid-indentation indentation (insert string)))
+        (t (insert string))))
+
 (defun slime-canonicalized-location (location)
   "Takes a `slime-location' and returns a list consisting of
 file/buffer name, line, and column number."
@@ -2993,7 +3000,11 @@
   (if loc
       (destructuring-bind (filename line col) loc
         (format "%s:%d:%d" 
-                (if filename (file-relative-name filename) "") 
+                (cond ((not filename) "")
+                      ((let ((rel (file-relative-name filename)))
+                         (if (< (length rel) (length filename))
+                             rel)))
+                      (t filename))
                 line col))
       (format "Unknown location")))