[slime-cvs] CVS slime

[CVS User heller]

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-goto-location-buffer): Don't goto point-min.
(slime-check-location-buffer-name-sanity)
(slime-check-location-filename-sanity): Separated from
slime-goto-location-buffer.

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/03 21:13:20	1.1628
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/03 21:13:31	1.1629
@@ -1,5 +1,12 @@
 2009-01-03  Helmut Eller  <heller at common-lisp.net>
 
+	* slime.el (slime-goto-location-buffer): Don't goto point-min.
+	(slime-check-location-buffer-name-sanity)
+	(slime-check-location-filename-sanity): Separated from
+	slime-goto-location-buffer.
+
+2009-01-03  Helmut Eller  <heller at common-lisp.net>
+
 	By default, show compiler notes in a buffer with compilation-mode.
 
 	* slime.el (slime-show-compilation-log)
--- /project/slime/cvsroot/slime/slime.el	2009/01/03 21:13:20	1.1092
+++ /project/slime/cvsroot/slime/slime.el	2009/01/03 21:13:31	1.1093
@@ -2900,10 +2900,12 @@
   (cond ((slime-location-p location)
          (destructuring-bind (filename line col)
              (save-excursion
-               (slime-goto-source-location location)
-               (list (or (buffer-file-name) (buffer-name))
-                     (line-number-at-pos)
-                     (1+ (current-column))))
+               (slime-goto-location-buffer (slime-location.buffer location))
+               (save-excursion
+                 (slime-goto-source-location location)
+                 (list (or (buffer-file-name) (buffer-name))
+                       (line-number-at-pos)
+                       (1+ (current-column)))))
            (format "%s:%d:%d:" (or filename "") line col)))
         (t "")))
 
@@ -3348,42 +3350,47 @@
                                  (file-name-directory guessed-target))
                                (file-name-nondirectory target-filename)))))))
 
-(defun slime-goto-location-buffer (buffer)
+(defun slime-check-location-filename-sanity (filename)
   (flet ((file-truename-safe (filename) (and filename (file-truename filename))))
-    (destructure-case buffer
-      ((:file filename)
-       (let ((target-filename (file-truename-safe (slime-from-lisp-filename filename)))
-             (buffer-filename (file-truename-safe (buffer-file-name))))
-         (when buffer-filename
-           (slime-maybe-warn-for-different-source-root target-filename buffer-filename))
-         (unless (and buffer-filename (string= buffer-filename target-filename))
-           (set-buffer (find-file-noselect target-filename t))))
-       (goto-char (point-min)))
-      ((:buffer buffer-name)
-       (let ((old-buffer-filename (file-truename-safe (buffer-file-name)))
-             (target-buffer-filename (file-truename-safe
-                                      (buffer-file-name (get-buffer buffer-name)))))
-         (when (and target-buffer-filename old-buffer-filename)
-           (slime-maybe-warn-for-different-source-root target-buffer-filename
-                                                       old-buffer-filename)))
-       (set-buffer buffer-name)
-       (goto-char (point-min)))
-      ((:source-form string)
-       (set-buffer (get-buffer-create "*SLIME Source Form*"))
-       (erase-buffer)
-       (lisp-mode)
-       (insert string)
-       (goto-char (point-min)))
-      ((:zip file entry)
-       (require 'arc-mode)
-       (set-buffer (find-file-noselect file t))
-       (goto-char (point-min))
-       (re-search-forward (concat "  " entry "$"))
-       (let ((buffer (save-window-excursion
-                       (archive-extract)
-                       (current-buffer))))
-         (set-buffer buffer)
-         (goto-char (point-min)))))))
+    (let ((target-filename (file-truename-safe filename))
+          (buffer-filename (file-truename-safe (buffer-file-name))))
+      (when buffer-filename
+        (slime-maybe-warn-for-different-source-root target-filename buffer-filename)))))
+
+(defun slime-check-location-buffer-name-sanity (buffer-name)
+  (flet ((file-truename-safe (filename) (and filename (file-truename filename))))
+    (let ((old-buffer-filename (file-truename-safe (buffer-file-name)))
+          (target-buffer-filename (file-truename-safe
+                                   (buffer-file-name (get-buffer buffer-name)))))
+      (when (and target-buffer-filename old-buffer-filename)
+        (slime-maybe-warn-for-different-source-root target-buffer-filename
+                                                    old-buffer-filename)))))
+
+(defun slime-goto-location-buffer (buffer)
+  (destructure-case buffer
+    ((:file filename)
+     (let ((filename (slime-from-lisp-filename filename)))
+       (slime-check-location-filename-sanity filename)
+       (set-buffer (find-file-noselect filename))))
+    ((:buffer buffer-name)
+     (slime-check-location-buffer-name-sanity buffer-name)
+     (set-buffer buffer-name))
+    ((:source-form string)
+     (set-buffer (get-buffer-create "*SLIME Source Form*"))
+     (erase-buffer)
+     (lisp-mode)
+     (insert string)
+     (goto-char (point-min)))
+    ((:zip file entry)
+     (require 'arc-mode)
+     (set-buffer (find-file-noselect file t))
+     (goto-char (point-min))
+     (re-search-forward (concat "  " entry "$"))
+     (let ((buffer (save-window-excursion
+                     (archive-extract)
+                     (current-buffer))))
+       (set-buffer buffer)
+       (goto-char (point-min))))))
 
 (defun slime-goto-location-position (position)
   (destructure-case position