list-callers.el

[Helmut Eller]

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)