[slime-cvs] CVS slime

[CVS User heller]

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

Modified Files:
	ChangeLog slime.el 
Log Message:
Fix the slime-next-location command.

* slime.el (slime-xref-last-buffer): New variable.
(slime-show-xrefs): Initialize it.
(slime-goto-next-xref): Use it.
(slime-search-property): New function.
(slime-xref-buffer): Delted

--- /project/slime/cvsroot/slime/ChangeLog	2009/01/08 06:45:45	1.1647
+++ /project/slime/cvsroot/slime/ChangeLog	2009/01/08 06:45:56	1.1648
@@ -1,5 +1,15 @@
 2009-01-07  Helmut Eller  <heller at common-lisp.net>
 
+	Fix the slime-next-location command.
+
+	* slime.el (slime-xref-last-buffer): New variable.
+	(slime-show-xrefs): Initialize it.
+	(slime-goto-next-xref): Use it.
+	(slime-search-property): New function.
+	(slime-xref-buffer): Delted
+
+2009-01-07  Helmut Eller  <heller at common-lisp.net>
+
 	* swank.lisp (*sldb-pprint-dispatch-table*): Honor *print-escape*
 
 2009-01-07  Helmut Eller  <heller at common-lisp.net>
--- /project/slime/cvsroot/slime/slime.el	2009/01/08 06:45:09	1.1106
+++ /project/slime/cvsroot/slime/slime.el	2009/01/08 06:45:57	1.1107
@@ -376,8 +376,8 @@
   nil
   nil
   ;; Fake binding to coax `define-minor-mode' to create the keymap
-  '((" " 'undefined)))
-
+  '((" " 'undefined))
+  (slime-setup-command-hooks))
 
 (make-variable-buffer-local
  (defvar slime-modeline-string nil
@@ -4892,13 +4892,6 @@
 
 (put 'slime-with-xref-buffer 'lisp-indent-function 1)
 
-(defun slime-xref-buffer ()
-  "Return the XREF results buffer.
-If CREATE is non-nil, create it if necessary."
-  (or (find-if (lambda (b) (string-match "*XREF\\[" (buffer-name b)))
-               (buffer-list))
-      (error "No XREF buffer")))
-
 (defun slime-xref-quit (&optional _)
   "Kill the current xref buffer, restore the window configuration
 if appropriate."
@@ -4938,16 +4931,21 @@
 (defvar slime-next-location-function nil
   "Function to call for going to the next location.")
 
+(defvar slime-xref-last-buffer nil
+  "The most recent XREF results buffer.
+This is used by `slime-goto-next-xref'")
+
 (defun slime-show-xrefs (xrefs type symbol package &optional emacs-snapshot)
   "Show the results of an XREF query."
   (if (null xrefs)
       (message "No references found for %s." symbol)
-    (setq slime-next-location-function 'slime-goto-next-xref)
     (slime-with-xref-buffer (type symbol package emacs-snapshot)
       (slime-insert-xrefs xrefs)
       (goto-char (point-min))
       (forward-line)
-      (skip-chars-forward " \t"))))
+      (skip-chars-forward " \t")
+      (setq slime-next-location-function 'slime-goto-next-xref)
+      (setq slime-xref-last-buffer (current-buffer )))))
 
 
 ;;;;; XREF commands
@@ -5051,20 +5049,34 @@
   (let ((location (slime-xref-location-at-point)))
     (slime-show-source-location location)))
       
-(defun slime-goto-next-xref ()
+(defun slime-goto-next-xref (&optional backward)
   "Goto the next cross-reference location."
-  (let ((location (with-current-buffer (slime-xref-buffer)
-                    (let ((w (display-buffer (current-buffer) t)))
-                      (goto-char (1+ (next-single-char-property-change 
-                                      (point) 'slime-location)))
-                      (set-window-point w (point)))
-                    (cond ((eobp)
-                           (message "No more xrefs.")
-                           nil)
-                          (t 
-                           (slime-xref-location-at-point))))))
-    (when location
-      (slime-pop-to-location location))))
+  (let ((location 
+         (and (buffer-live-p slime-xref-last-buffer)
+              (with-current-buffer slime-xref-last-buffer
+                (slime-search-property 'slime-location backward)))))
+    (cond ((slime-location-p location)
+           (slime-pop-to-location location))
+          ((null location)
+           (message "No more xrefs."))
+          (t ; error
+           (slime-goto-next-xref backward)))))
+
+(defun slime-search-property (prop &optional backward)
+  "Search the next text range where PROP is non-nil.
+If found, return the value of the property; otherwise return nil.
+If BACKWARD is non-nil, search backward."
+  (let ((fun (cond (backward #'previous-single-char-property-change)
+                   (t #'next-single-char-property-change)))
+        (test (lambda () (get-text-property (point) prop)))
+        (start (point)))
+    (while (progn 
+             (goto-char (funcall fun (point) prop))
+             (not (or (funcall test) 
+                      (eobp) 
+                      (bobp)))))
+    (or (funcall test)
+        (progn (goto-char start) nil))))
 
 (defun slime-next-location ()
   "Go to the next location, depending on context.