Stefan Monnier wrote:
The links in the *Backtrace* buffer is extremely handy when searching for an
error. However I am missing a link to where the error originated in my
code. I miss it so much so I consider it a bug ;-)
Looks like the attached patch got lost on the way. Can you resend?
Stefan ;-)
I am sorry you did not receive it. Attached. ;-)
;;; backtr.el --- Finding source code inside a function from *Backtrace* buffer
;; FIX-ME: check for doublette branches
;;; Commentary:
;;
;; This file adds the possibility to move inside a function from the
;; *Backtrace* buffer. Pressing the RET key while over one of the
;; backtrace lines will try to take you to the corresponding position
;; in the source code. However if point is over a symbol or a link the
;; usual action (ie without this file) in the *Backtrace* buffer is
;; used.
;;
;; Some bugs and deficiencies in debug-help-follow are corrected.
;;; History:
;;
;;; Code:
(defun backtr-follow-help-or-goto-line()
"If position is at symbol show help. Otherwise goto source line."
(interactive)
(unless (backtr-debug-help-follow (point))
(backtr-goto-line)))
;; Return non-nil if following help. Stay in *Backtrace*. Remove the
;; unnecessary push-button test. Fix the multiple *Help* buffer bug.
(defun backtr-debug-help-follow (&optional pos)
"Follow cross-reference at POS, defaulting to point.
For the cross-reference format, see `help-make-xrefs'."
(interactive "d")
(require 'help-mode)
(unless pos
(setq pos (point)))
;; check if the symbol under point is a function or variable
(let ((sym
(intern
(save-excursion
(goto-char pos) (skip-syntax-backward "w_")
(buffer-substring (point)
(progn (skip-syntax-forward "w_")
(point)))))))
(when (or (boundp sym) (fboundp sym) (facep sym))
(save-excursion
(with-output-to-temp-buffer (help-buffer)
(set-buffer (help-buffer))
;; First arg of help-do-xref does not seem to be used???
(help-do-xref pos #'help-xref-interned (list sym))
;; Remove the extra [back] link. FIX-ME: can the extra [back] be
avoided???
(goto-char (point-max))
(forward-line -2)
(let ((inhibit-read-only t))
(delete-region (point) (point-max)))
;; Return the text we displayed.
(with-current-buffer standard-output
(buffer-string)))))))
;; Debugging tools
(defun backtr-sit-for(sec)
;;(sit-for sec)
)
(defun backtr-message(&rest arg)
;;(apply 'message arg)
)
(defun backtr-goto-line()
"Goto source line."
(let ((bn "*Backtrace*"))
(unless (equal bn (buffer-name)) (error "Not in %s" bn)))
(let ((started-at (point))
found-fun
(last-fun-call nil)
(to-point (point))
(button-point nil)
(deb-lines nil)
skip-next
)
(save-excursion
(beginning-of-line)
;; Do not do anything on first line
(when (equal " " (char-to-string (following-char)))
(while (and (not last-fun-call)
(setq found-fun (search-forward-regexp "^ \\([a-z-]+\\)"
nil t)))
(backward-char)
;;(when (eq (get-text-property (point) 'category)
'help-function-def-button)
;; eq does not work????
(when (get-text-property (point) 'category)
(setq last-fun-call (text-properties-at (point)))
(setq button-point (copy-marker (point)))
(while (> (progn (beginning-of-line) (point)) to-point)
(let (line
(p (copy-marker (point))))
(forward-line -1)
(beginning-of-line)
(skip-chars-forward " ")
(setq line (buffer-substring-no-properties (point)
(line-end-position)))
(unless skip-next
(let* (
(pos (string-match "\\(?:\\.\\.\\.\\|#\\|\\*\\)" line))
(regexp (if pos (substring line 0 pos) line))
)
;; Can't get the regexp for * to work???
;;(setq regexp (replace-regexp-in-string "\\*" "\\*" regexp
t t))
;;(setq regexp (replace-regexp-in-string "\\*" "." regexp t
t))
(setq regexp (replace-regexp-in-string "(lambda[ ]+"
"(lambda#space#" regexp nil t))
(setq regexp (replace-regexp-in-string "[ ]+" "[ \t\r\n]+"
regexp nil t))
(setq regexp (replace-regexp-in-string "(lambda#space#"
"(lambda[ \t\r\n]*" regexp nil t))
(unless (looking-at regexp) (error "Internal error, not
(looking-at %s)" regexp))
(when (and (< 5 (length regexp)) (equal "mapc(" (substring
regexp 0 5)))
(setq regexp (concat "(mapc[ \t\r\n]+" (substring regexp
5)))
)
(setq deb-lines (cons regexp deb-lines)))
)
(if (equal "(when " (substring line 0 6)) (setq skip-next t)
(setq skip-next nil))
))))))
(when found-fun
(setq deb-lines (reverse deb-lines))
(push-button button-point)
;;(delete-other-windows)
(forward-char)
(setq backtr-hits nil)
(backtr-find 0 deb-lines t)
(setq backtr-hits (reverse backtr-hits))
;;(goto-char (car backtr-hits))
(setq backtr-current-hit nil)
(backtr-next-hit)
(when (< 1 (length backtr-hits))
;;(message "There are %s positions possible, use `backtr-next-hit' for
next (%s)" (length backtr-hits) backtr-hits)
(message "There are %s positions possible, use `backtr-next-hit' for
next" (length backtr-hits))
))))
(defvar backtr-current-hit nil
"Used by `backtr-next-hit' and `backtr-prev-hit'.")
(defvar backtr-hits nil
"Number of final hits when trying to find source code.")
(defun backtr-next-hit()
"Go to next hit in source code."
(interactive)
(if (not backtr-hits)
(message "No backtrace hits active")
(let ((hit (if (not backtr-current-hit) 0 (1+ backtr-current-hit))))
(if (<= (length backtr-hits) hit)
(message "No next hit, use `backtr-prev-hit' to go back.")
(setq backtr-current-hit hit)
(let ((m (nth hit backtr-hits)))
(switch-to-buffer (marker-buffer m))
(goto-char m))))))
(defun backtr-prev-hit()
"Go to prev hit in source code."
(interactive)
(if (not backtr-hits)
(message "No backtrace hits active")
(let ((hit (if (not backtr-current-hit) (1- (length backtr-hits)) (1-
backtr-current-hit))))
(if (< hit 0)
(message "No prev hit, use `backtr-next-hit' to go forward.")
(setq backtr-current-hit hit)
(let ((m (nth hit backtr-hits)))
(switch-to-buffer (marker-buffer m))
(goto-char m))))))
(defun backtr-find(level trace-list find-all)
"From TRACE-LIST find source code position."
(let ((started-at (point))
(trace-tail (cdr trace-list))
found-this-at
start-this
found
end-of-siblings
end-of-parents
(regexp (car trace-list)))
(while (not (or found-this-at end-of-parents))
(backtr-message "backtr-find %s %s" level regexp) (backtr-sit-for 1)
(while (not (or found-this-at end-of-siblings))
(forward-comment 10)
(backtr-sit-for 0.5)
(if (looking-at regexp)
(progn
(backtr-message "OK looking at %s" regexp)(backtr-sit-for 1)
(setq found-this-at (point)))
(condition-case err
(forward-sexp)
(error (setq end-of-siblings t)))
))
(when found-this-at
(if (not trace-tail)
(progn
(setq backtr-hits (cons (point-marker) backtr-hits))
(setq found t))
(setq start-this (point))
(forward-char)
(setq found (backtr-find (1+ level) trace-tail find-all))
(unless found
(backtr-message "back, but not found")(backtr-sit-for 2)
(setq found-this-at nil)
(when start-this (goto-char start-this))
(backtr-sit-for 2)))
(when find-all (setq found-this-at nil))
)
(unless (and found (not find-all))
(condition-case err
(forward-sexp)
(error (setq end-of-parents t)))
(forward-comment 10)(backtr-sit-for 0.1))
)
(unless found-this-at
(backtr-message "going back to started at=%s" started-at)
(backtr-sit-for 2)
(goto-char started-at)
(backtr-sit-for 2))
found))
(eval-after-load 'debug
'(define-key debugger-mode-map [?\r] 'backtr-follow-help-or-goto-line))
(provide 'backtr)
;;; backtr.el ends here
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-devel
