1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00

* lisp/emacs-lisp/debug.el (debugger-make-xrefs): Preserve point. (Bug#9462)

This commit is contained in:
Glenn Morris 2011-09-13 17:02:27 -04:00
parent 85e9c04bf3
commit 8e39b2e837
2 changed files with 69 additions and 63 deletions

View file

@ -1,3 +1,8 @@
2011-09-13 Glenn Morris <rgm@gnu.org>
* emacs-lisp/debug.el (debugger-make-xrefs):
Preserve point. (Bug#9462)
2011-09-13 Chong Yidong <cyd@stupidchicken.com> 2011-09-13 Chong Yidong <cyd@stupidchicken.com>
* window.el (window-deletable-p): Use next-frame. * window.el (window-deletable-p): Use next-frame.

View file

@ -342,71 +342,72 @@ That buffer should be current already."
"Attach cross-references to function names in the `*Backtrace*' buffer." "Attach cross-references to function names in the `*Backtrace*' buffer."
(interactive "b") (interactive "b")
(with-current-buffer (or buffer (current-buffer)) (with-current-buffer (or buffer (current-buffer))
(setq buffer (current-buffer)) (save-excursion
(let ((inhibit-read-only t) (setq buffer (current-buffer))
(old-end (point-min)) (new-end (point-min))) (let ((inhibit-read-only t)
;; If we saved an old backtrace, find the common part (old-end (point-min)) (new-end (point-min)))
;; between the new and the old. ;; If we saved an old backtrace, find the common part
;; Compare line by line, starting from the end, ;; between the new and the old.
;; because that's the part that is likely to be unchanged. ;; Compare line by line, starting from the end,
(if debugger-previous-backtrace ;; because that's the part that is likely to be unchanged.
(let (old-start new-start (all-match t)) (if debugger-previous-backtrace
(goto-char (point-max)) (let (old-start new-start (all-match t))
(with-temp-buffer (goto-char (point-max))
(insert debugger-previous-backtrace) (with-temp-buffer
(while (and all-match (not (bobp))) (insert debugger-previous-backtrace)
(setq old-end (point)) (while (and all-match (not (bobp)))
(forward-line -1) (setq old-end (point))
(setq old-start (point)) (forward-line -1)
(with-current-buffer buffer (setq old-start (point))
(setq new-end (point)) (with-current-buffer buffer
(forward-line -1) (setq new-end (point))
(setq new-start (point))) (forward-line -1)
(if (not (zerop (setq new-start (point)))
(let ((case-fold-search nil)) (if (not (zerop
(compare-buffer-substrings (let ((case-fold-search nil))
(current-buffer) old-start old-end (compare-buffer-substrings
buffer new-start new-end)))) (current-buffer) old-start old-end
(setq all-match nil)))) buffer new-start new-end))))
;; Now new-end is the position of the start of the (setq all-match nil))))
;; unchanged part in the current buffer, and old-end is ;; Now new-end is the position of the start of the
;; the position of that same text in the saved old ;; unchanged part in the current buffer, and old-end is
;; backtrace. But we must subtract (point-min) since strings are ;; the position of that same text in the saved old
;; indexed in origin 0. ;; backtrace. But we must subtract (point-min) since strings are
;; indexed in origin 0.
;; Replace the unchanged part of the backtrace ;; Replace the unchanged part of the backtrace
;; with the text from debugger-previous-backtrace, ;; with the text from debugger-previous-backtrace,
;; since that already has the proper xrefs. ;; since that already has the proper xrefs.
;; With this optimization, we only need to scan ;; With this optimization, we only need to scan
;; the changed part of the backtrace. ;; the changed part of the backtrace.
(delete-region new-end (point-max)) (delete-region new-end (point-max))
(goto-char (point-max)) (goto-char (point-max))
(insert (substring debugger-previous-backtrace (insert (substring debugger-previous-backtrace
(- old-end (point-min)))) (- old-end (point-min))))
;; Make the unchanged part of the backtrace inaccessible ;; Make the unchanged part of the backtrace inaccessible
;; so it won't be scanned. ;; so it won't be scanned.
(narrow-to-region (point-min) new-end))) (narrow-to-region (point-min) new-end)))
;; Scan the new part of the backtrace, inserting xrefs. ;; Scan the new part of the backtrace, inserting xrefs.
(goto-char (point-min)) (goto-char (point-min))
(while (progn (while (progn
(goto-char (+ (point) 2)) (goto-char (+ (point) 2))
(skip-syntax-forward "^w_") (skip-syntax-forward "^w_")
(not (eobp))) (not (eobp)))
(let* ((beg (point)) (let* ((beg (point))
(end (progn (skip-syntax-forward "w_") (point))) (end (progn (skip-syntax-forward "w_") (point)))
(sym (intern-soft (buffer-substring-no-properties (sym (intern-soft (buffer-substring-no-properties
beg end))) beg end)))
(file (and sym (symbol-file sym 'defun)))) (file (and sym (symbol-file sym 'defun))))
(when file (when file
(goto-char beg) (goto-char beg)
;; help-xref-button needs to operate on something matched ;; help-xref-button needs to operate on something matched
;; by a regexp, so set that up for it. ;; by a regexp, so set that up for it.
(re-search-forward "\\(\\sw\\|\\s_\\)+") (re-search-forward "\\(\\sw\\|\\s_\\)+")
(help-xref-button 0 'help-function-def sym file))) (help-xref-button 0 'help-function-def sym file)))
(forward-line 1)) (forward-line 1))
(widen)) (widen))
(setq debugger-previous-backtrace (buffer-string)))) (setq debugger-previous-backtrace (buffer-string)))))
(defun debugger-step-through () (defun debugger-step-through ()
"Proceed, stepping through subexpressions of this expression. "Proceed, stepping through subexpressions of this expression.