[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
list-callers.el
From: |
Helmut Eller |
Subject: |
list-callers.el |
Date: |
Tue, 04 May 2004 21:48:57 GMT |
User-agent: |
Gnus/5.110001 (No Gnus v0.1) Emacs/20.7 (gnu/linux) |
Aloha,
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.
Cheers,
Helmut .
;;; 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.
;;
;;; Commentary
;;
;; 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.
;;
;; This works by groveling trough all function object referenced my
;; named functions. It is only a heuristic but works good enough for
;; simple uses. Things may get slow if your Emacs image is really
;; large and contains huge interlinked objects. There seems to be a
;; bug with cyclic datastructures, but this usually only leads to a
;; stack overflow.
;;
(eval-and-compile
(require 'cl))
(defsubst lc-byte-code-constants (bytecode)
(aref bytecode 2))
(defun lc-refers-symbol-p (object symbol seen-nodes)
"Test if OBJECT refers SYMBOL in one way or another.
SEEN-NODES is used to detect cycles. It contains the objects we have
already visited."
(if (memq object seen-nodes)
nil
(push object seen-nodes)
(etypecase object
(symbol
(eq object symbol))
((or number string bool-vector char-table buffer frame subr)
nil)
(cons
(or (lc-refers-symbol-p (car object) symbol seen-nodes)
(lc-refers-symbol-p (cdr object) symbol seen-nodes)))
(vector
(loop for elt across object
thereis (lc-refers-symbol-p elt symbol seen-nodes)))
(byte-code-function
(lc-refers-symbol-p (lc-byte-code-constants object)
symbol seen-nodes)))))
(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-refers-symbol-p (symbol-function atom)
symbol
'()))
(push atom referrers))))
referrers))
(defun lc-list-callers (symbol)
"List the callers of the function at point."
(interactive (list (cond (prefix-arg
(read-from-minibuffer "name: " nil nil t))
(t (intern (thing-at-point 'symbol))))))
(cond ((or (not symbol)
(not (symbolp symbol)))
(error "bad argument: %S" symbol))
(t
(let* ((referrers (lc-find-referrers symbol))
(referrers (sort referrers #'string<)))
(lc-display-callers referrers)))))
(defun lc-find-function-at-point-other-window ()
(interactive)
(destructuring-bind (buffer &rest point)
(find-function-noselect (function-at-point))
(with-current-buffer buffer
(goto-char point)
(save-selected-window
(let ((win (display-buffer buffer t)))
(set-window-point win (point))
(select-window win)
(recenter 3))))))
(defun lc-display-callers (callers)
(with-output-to-temp-buffer "*Callers*"
(with-current-buffer standard-output
(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)
(dolist (symbol callers)
(let ((start (point)))
(insert (symbol-name symbol))
(add-text-properties
start (point)
(list 'help-xref (list 'describe-function symbol)
'local-map keymap))
(insert "\n")))))))
(mapc #'byte-compile
'(lc-refers-symbol-p
lc-byte-code-constants
lc-find-referrers
lc-list-callers
lc-display-callers))
(define-key emacs-lisp-mode-map "\C-c<" 'lc-list-callers)
- list-callers.el,
Helmut Eller <=