lisp/emacs-lisp/find-func.el

   1 ;;; find-func.el --- find the definition of the elisp function near point
   2
   3 ;; Copyright (C) 1997 Free Software Foundation, Inc.
   4
   5 ;; Author: Jens Petersen <petersen@kurims.kyoto-u.ac.jp>
   6 ;; Maintainer: petersen@kurims.kyoto-u.ac.jp
   7 ;; Keywords: emacs-lisp, help, functions
   8 ;; Created: 97/07/25
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Commentary:
  28 ;;
  29 ;; The funniest thing about this is that I can't imagine why a package
  30 ;; so obviously useful as this hasn't been written before!!
  31 ;; This probably belongs in "help.el" or somewhere like that.
  32 ;;
  33 ;; Put this file in your `load-path', byte-compile it and add the
  34 ;; following code in your init file:
  35 ;;
  36 ;; ;;; find-func
  37 ;; (load "find-function")
  38 ;; (global-set-key [(control ?c) ?f] 'find-function)
  39 ;; (global-set-key [(control ?c) ?4 ?f] 'find-function-other-window)
  40 ;; (global-set-key [(control ?c) ?5 ?f] 'find-function-other-frame)
  41 ;; (global-set-key [(control ?c) ?k] 'find-function-on-key)
  42 ;;
  43 ;; and away you go!  It does pretty much what you would expect,
  44 ;; putting the cursor at the definition of the function at point.
  45 ;;
  46 ;; The code is adapted from `describe-function', `describe-key'
  47 ;; ("help.el") and `fff-find-loaded-emacs-lisp-function' (Noah Friedman's
  48 ;; "fff.el").
  49
  50 ;;; To do:
  51 ;;
  52 ;; o custom?
  53 ;;
  54 ;; o improve handling of advice'd functions? (at the moment it goes to
  55 ;; the advice, not the actual definition)
  56
  57 ;;;; Code:
  58
  59 ;;; User variables:
  60 (defgroup find-function nil
  61   "Find the definition of the elisp function near point."
  62   :prefix "find-function"
  63   :group 'lisp)
  64
  65 (defcustom find-function-function 'function-at-point
  66   "*The function used by `find-function' to select the function near
  67 point.
  68
  69 For example `function-at-point' or `function-called-at-point'."
  70   :type 'function
  71   :group 'find-function)
  72
  73 (defcustom find-function-source-path nil
  74   "The default list of directories where find-function searches.
  75
  76 If this variable is `nil' then find-function searches `load-path' by
  77 default."
  78   :type '(repeat directory)
  79   :group 'find-function)
  80
  81
  82 ;;; Functions:
  83
  84 (defun find-function-noselect (function &optional path)
  85   "Returns list `(buffer point)' pointing to the definition of FUNCTION.
  86
  87 Finds the Emacs Lisp library containing the definition of FUNCTION
  88 in a buffer and places point before the definition.  The buffer is
  89 not selected.
  90
  91 If the optional argument PATH is given, the library where FUNCTION is
  92 defined is searched in PATH instead of `load-path' (see
  93 `find-function-source-path')."
  94   (and (subrp (symbol-function function))
  95        (error "%s is a primitive function" function))
  96   (if (not function)
  97       (error "You didn't specify a function"))
  98   (let ((def (symbol-function function))
  99         library aliases)
 100     (while (symbolp def)
 101       (or (eq def function)
 102           (if aliases
 103               (setq aliases (concat aliases
 104                                     (format ", which is an alias for %s"
 105                                             (symbol-name def))))
 106             (setq aliases (format "an alias for %s" (symbol-name
 107                                                        def)))))
 108       (setq function (symbol-function function)
 109             def (symbol-function function)))
 110     (if aliases
 111         (message aliases))
 112     (setq library
 113           (cond ((eq (car-safe def) 'autoload)
 114                  (nth 1 def))
 115                 ((describe-function-find-file function))))
 116     (if (null library)
 117         (error (format "`%s' is not in `load-history'" function)))
 118     (if (string-match "\\(\\.elc?\\'\\)" library)
 119         (setq library (substring library 0 (match-beginning 1))))
 120     (let* ((path (or path find-function-source-path))
 121            (compression (or (rassq 'jka-compr-handler file-name-handler-alist)
 122                             (member 'crypt-find-file-hook find-file-hooks)))
 123            (filename (or (locate-library (concat library ".el")
 124                                          t path)
 125                          (locate-library library t path)
 126                          (if compression
 127                              (or (locate-library (concat library ".el.gz")
 128                                                  t path)
 129                                  (locate-library (concat library ".gz")
 130                                                  t path))))))
 131       (if (not filename)
 132           (error "The library \"%s\" is not in the path." library))
 133       (save-excursion
 134         (set-buffer (find-file-noselect filename))
 135         (save-match-data
 136           (let (;; avoid defconst, defgroup, defvar (any others?)
 137                 (regexp (format "^\\s-*(def[^cgv\W]\\w+\\s-+%s\\s-" function))
 138                 (syntable (syntax-table)))
 139             (set-syntax-table emacs-lisp-mode-syntax-table)
 140             (goto-char (point-min))
 141             (if (prog1
 142                     (re-search-forward regexp nil t)
 143                   (set-syntax-table syntable))
 144                 (progn
 145                   (beginning-of-line)
 146                   (list (current-buffer) (point)))
 147               (error "Cannot find definition of %s" function))))))))
 148
 149 (defun function-at-point ()
 150   (or (condition-case ()
 151           (let ((stab (syntax-table)))
 152             (unwind-protect
 153                 (save-excursion
 154                   (set-syntax-table emacs-lisp-mode-syntax-table)
 155                   (or (not (zerop (skip-syntax-backward "_w")))
 156                       (eq (char-syntax (char-after (point))) ?w)
 157                       (eq (char-syntax (char-after (point))) ?_)
 158                       (forward-sexp -1))
 159                   (skip-chars-forward "`'")
 160                   (let ((obj (read (current-buffer))))
 161                     (and (symbolp obj) (fboundp obj) obj)))
 162               (set-syntax-table stab)))
 163         (error nil))
 164       (condition-case ()
 165           (save-excursion
 166             (save-restriction
 167               (narrow-to-region (max (point-min) (- (point) 1000)) (point-max))
 168               (backward-up-list 1)
 169               (forward-char 1)
 170               (let (obj)
 171                 (setq obj (read (current-buffer)))
 172                 (and (symbolp obj) (fboundp obj) obj))))
 173         (error nil))))
 174
 175 (defun find-function-read-function ()
 176   "Read and return a function, defaulting to the one near point.
 177
 178 The function named by `find-function-function' is used to select the
 179 default function."
 180   (let ((fn (funcall find-function-function))
 181         (enable-recursive-minibuffers t)
 182         val)
 183     (setq val (completing-read
 184                (if fn
 185                    (format "Find function (default %s): " fn)
 186                  "Find function: ")
 187                obarray 'fboundp t))
 188     (list (if (equal val "")
 189               fn (intern val)))))
 190
 191 (defun find-function-do-it (function path switch-fn)
 192   "find elisp FUNCTION in PATH and display it with SWITCH-FN.
 193 Point is saved if FUNCTION is in the current buffer."
 194   (let ((orig-point (point))
 195         (buffer-point (find-function-noselect function path)))
 196     (if buffer-point
 197         (progn
 198           (if (eq (current-buffer) (car buffer-point))
 199               (push-mark orig-point))
 200           (funcall switch-fn (car buffer-point))
 201           (goto-char (elt buffer-point 1))
 202           (recenter 0)))))
 203
 204 ;;;###autoload
 205 (defun find-function (function &optional path)
 206   "Find the definition of the function near point in the current window.
 207
 208 Finds the Emacs Lisp library containing the definition of the function
 209 near point (selected by `find-function-function') and places point
 210 before the definition.  Point is saved if FUNCTION is in the current
 211 buffer.
 212
 213 If the optional argument PATH is given, the library where FUNCTION is
 214 defined is searched in PATH instead of `load-path'"
 215   (interactive (find-function-read-function))
 216   (find-function-do-it function path 'switch-to-buffer))
 217
 218 ;;;###autoload
 219 (defun find-function-other-window (function &optional path)
 220   "Find the definition of the function near point in the other window.
 221
 222 Finds the Emacs Lisp package containing the definition of the function
 223 near point (selected by `find-function-function') and places point
 224 before the definition.  Point is saved if FUNCTION is in the current
 225 buffer.
 226
 227 If the optional argument PATH is given, the package where FUNCTION is
 228 defined is searched in PATH instead of `load-path'"
 229   (interactive (find-function-read-function))
 230   (find-function-do-it function path 'switch-to-buffer-other-window))
 231
 232 ;;;###autoload
 233 (defun find-function-other-frame (function &optional path)
 234   "Find the definition of the function near point in the another frame.
 235
 236 Finds the Emacs Lisp package containing the definition of the function
 237 near point (selected by `find-function-function') and places point
 238 before the definition.  Point is saved if FUNCTION is in the current
 239 buffer.
 240
 241 If the optional argument PATH is given, the package where FUNCTION is
 242 defined is searched in PATH instead of `load-path'"
 243   (interactive (find-function-read-function))
 244   (find-function-do-it function path 'switch-to-buffer-other-frame))
 245
 246 ;;;###autoload
 247 (defun find-function-on-key (key)
 248   "Find the function that KEY invokes.  KEY is a string.
 249 Point is saved if FUNCTION is in the current buffer."
 250   (interactive "kFind function on key: ")
 251   (let ((defn (key-binding key)))
 252     (if (or (null defn) (integerp defn))
 253         (message "%s is undefined" (key-description key))
 254       (if (and (consp defn) (not (eq 'lambda (car-safe defn))))
 255           (message "runs %s" (prin1-to-string defn))
 256         (find-function-other-window defn)))))
 257
 258 (provide 'find-func)
 259
 260 ;;; find-func.el ends here
 261