[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Wed, 05 May 2004 19:37:47 GMT
Gnus/5.110001 (No Gnus v0.1) Emacs/20.7 (gnu/linux)
Helmut Eller <address@hidden> writes:
> This is a little tool to find the callers of a Lisp function.
> Position point over an interesting function name and call it with `M-x
> lc-list-callers'. This pops you in a window with a list of the
> callers of that function.
Here's the second version with some fine tuning. The main entry point
was renamed to M-x list-callers. Lists are now scanned iteratively to
avoid the most common stack overflows. The window configuration gets
now restored after pressing `q'.
;;; list-callers.el --- Find the callers of a Lisp function
;; Copyright (C) 2004 Helmut Eller
;; You can redistribute this file under the terms of the GNU General
;; Public License.
;; This is a little tool to find the callers of a Lisp function.
;; Position point over an interesting function name and call it with
;; `M-x list-callers'. This pops you in a window with a list of the
;; callers of that function.
;; The tool grovels through all named function objects to see if the
;; function references the symbol. It is only a heuristic, but works
;; good enough for simple cases. Things may get slow if your Emacs
;; image is really large and contains huge interlinked objects.
;; The code should work with GNU Emacs 20 and Emacs 21. XEmacs is not
;; Andrew M. Scott for valuable feedback and pointing out that
;; function-at-point is not pre-loaded.
(defsubst lc-byte-code-constants (bytecode)
"Access the constant vector of the bytecode-function BYTECODE."
(aref bytecode 2))
(defun lc-references-symbol-p (object symbol seen-nodes)
"Test if OBJECT contains a reference to SYMBOL.
SEEN-NODES is used to detect cycles."
(if (memq object seen-nodes)
(push object seen-nodes)
(eq object symbol))
(let ((flag nil))
;; iterate over lists to save stack space
(while (and (not flag)
(setq flag (lc-references-symbol-p (car object) symbol seen-nodes))
(setq object (cdr object))
(cond ((memq object seen-nodes)
(setq object nil))
(push object seen-nodes))))
(lc-references-symbol-p object symbol seen-nodes))))
((or number string bool-vector char-table buffer frame subr)
(loop for elt across object
thereis (lc-references-symbol-p elt symbol seen-nodes)))
(lc-references-symbol-p (lc-byte-code-constants object)
(defun lc-find-referrers (symbol)
"Return a list of all named functions referring SYMBOL."
(check-type symbol symbol)
(let ((referrers '()))
(mapatoms (lambda (atom)
(when (and (fboundp atom)
(lc-references-symbol-p (symbol-function atom)
(push atom referrers))))
(defun lc-find-function-at-point-other-window ()
"Display the source of the function at point in other window."
(destructuring-bind (buffer &rest point)
(let ((win (display-buffer buffer t)))
(set-window-point win (point))
(defvar lc-old-window-config nil
"Buffer local variable use to restore the window configuration.")
(defun lc-display-callers (callers)
"Display a buffer to browse a list of CALLERS."
(with-current-buffer (get-buffer-create "*callers*")
(setq buffer-read-only nil)
(set (make-local-variable 'lc-old-window-config)
(let ((keymap (make-sparse-keymap)))
(define-key keymap [return] 'lc-find-function-at-point-other-window)
(define-key keymap (kbd "RET") 'lc-find-function-at-point-other-window)
(define-key keymap [?q] 'lc-quit)
(dolist (symbol callers)
(let ((start (point)))
(insert (symbol-name symbol) "\n")))
(setq buffer-read-only t)
(select-window (display-buffer (current-buffer))))))
(defun lc-quit ()
"Kill the *callers* buffer and restore the window configuration."
(let ((buffer (current-buffer)))
(defun lc-read-function-name ()
"Read a function name much like C-h f does. Return a symbol."
(let* ((default (function-called-at-point))
(format "Function (default %s): " default))
(t "Function: "))
obarray 'fboundp t nil nil (symbol-name default))))
(when (equal string "")
(error "No function name specified"))
(defun list-callers (symbol)
"List the callers of the function at point.
If called non-interactively display the callers of SYMBOL."
(interactive (list (lc-read-function-name)))
(cond ((or (not symbol)
(not (symbolp symbol)))
(error "Bad argument: %S" symbol))
(let* ((referrers (lc-find-referrers symbol))
(referrers (sort referrers #'string<)))
;;; list-callers.el ends here
- list-callers.el, Helmut Eller, 2004/05/04
- Re: list-callers.el,
Helmut Eller <=