code.delx.au - gnu-emacs/blob - 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 ;;;###autoload
  85 (defun find-function-noselect (function &optional path)
  86   "Returns list (BUFFER POINT) pointing to the definition of FUNCTION.
  87
  88 Finds the Emacs Lisp library containing the definition of FUNCTION
  89 in a buffer and places point before the definition.  The buffer is
  90 not selected.
  91
  92 If the optional argument PATH is given, the library where FUNCTION is
  93 defined is searched in PATH instead of `load-path' (see
  94 `find-function-source-path')."
  95   (and (subrp (symbol-function function))
  96        (error "%s is a primitive function" function))
  97   (if (not function)
  98       (error "You didn't specify a function"))
  99   (let ((def (symbol-function function))
 100         library aliases)
 101     (while (symbolp def)
 102       (or (eq def function)
 103           (if aliases
 104               (setq aliases (concat aliases
 105                                     (format ", which is an alias for %s"
 106                                             (symbol-name def))))
 107             (setq aliases (format "an alias for %s" (symbol-name
 108                                                        def)))))
 109       (setq function (symbol-function function)
 110             def (symbol-function function)))
 111     (if aliases
 112         (message aliases))
 113     (setq library
 114           (cond ((eq (car-safe def) 'autoload)
 115                  (nth 1 def))
 116                 ((describe-function-find-file function))))
 117     (if (null library)
 118         (error "`%s' is not in `load-history'" function))
 119     (if (string-match "\\(\\.elc?\\'\\)" library)
 120         (setq library (substring library 0 (match-beginning 1))))
 121     (let* ((path (or path find-function-source-path))
 122            (compression (or (rassq 'jka-compr-handler file-name-handler-alist)
 123                             (member 'crypt-find-file-hook find-file-hooks)))
 124            (filename (or (locate-library (concat library ".el")
 125                                          t path)
 126                          (locate-library library t path)
 127                          (if compression
 128                              (or (locate-library (concat library ".el.gz")
 129                                                  t path)
 130                                  (locate-library (concat library ".gz")
 131                                                  t path))))))
 132       (if (not filename)
 133           (error "The library \"%s\" is not in the path." library))
 134       (save-excursion
 135         (set-buffer (find-file-noselect filename))
 136         (save-match-data
 137           (let (;; avoid defconst, defgroup, defvar (any others?)
 138                 (regexp (format "^\\s-*(def[^cgv\W]\\w+\\s-+%s\\s-"
 139                                 (regexp-quote (symbol-name function))))
 140                 (syntable (syntax-table)))
 141             (set-syntax-table emacs-lisp-mode-syntax-table)
 142             (goto-char (point-min))
 143             (if (prog1
 144                     (re-search-forward regexp nil t)
 145                   (set-syntax-table syntable))
 146                 (progn
 147                   (beginning-of-line)
 148                   (list (current-buffer) (point)))
 149               (error "Cannot find definition of %s" function))))))))
 150
 151 (defun function-at-point ()
 152   (or (condition-case ()
 153           (let ((stab (syntax-table)))
 154             (unwind-protect
 155                 (save-excursion
 156                   (set-syntax-table emacs-lisp-mode-syntax-table)
 157                   (or (not (zerop (skip-syntax-backward "_w")))
 158                       (eq (char-syntax (char-after (point))) ?w)
 159                       (eq (char-syntax (char-after (point))) ?_)
 160                       (forward-sexp -1))
 161                   (skip-chars-forward "`'")
 162                   (let ((obj (read (current-buffer))))
 163                     (and (symbolp obj) (fboundp obj) obj)))
 164               (set-syntax-table stab)))
 165         (error nil))
 166       (condition-case ()
 167           (save-excursion
 168             (save-restriction
 169               (narrow-to-region (max (point-min) (- (point) 1000)) (point-max))
 170               (backward-up-list 1)
 171               (forward-char 1)
 172               (let (obj)
 173                 (setq obj (read (current-buffer)))
 174                 (and (symbolp obj) (fboundp obj) obj))))
 175         (error nil))))
 176
 177 (defun find-function-read-function ()
 178   "Read and return a function, defaulting to the one near point.
 179
 180 The function named by `find-function-function' is used to select the
 181 default function."
 182   (let ((fn (funcall find-function-function))
 183         (enable-recursive-minibuffers t)
 184         val)
 185     (setq val (completing-read
 186                (if fn
 187                    (format "Find function (default %s): " fn)
 188                  "Find function: ")
 189                obarray 'fboundp t))
 190     (list (if (equal val "")
 191               fn (intern val)))))
 192
 193 (defun find-function-do-it (function path switch-fn)
 194   "Find Emacs Lisp FUNCTION in PATH and display it with SWITCH-FN.
 195 Point is saved if FUNCTION is in the current buffer."
 196   (let ((orig-point (point))
 197         (buffer-point (find-function-noselect function path)))
 198     (if buffer-point
 199         (progn
 200           (if (eq (current-buffer) (car buffer-point))
 201               (push-mark orig-point))
 202           (funcall switch-fn (car buffer-point))
 203           (goto-char (elt buffer-point 1))
 204           (recenter 0)))))
 205
 206 ;;;###autoload
 207 (defun find-function (function &optional path)
 208   "Find the definition of the function near point in the current window.
 209
 210 Finds the Emacs Lisp library containing the definition of the function
 211 near point (selected by `find-function-function') and places point
 212 before the definition.  Point is saved if FUNCTION is in the current
 213 buffer.
 214
 215 If the optional argument PATH is given, the library where FUNCTION is
 216 defined is searched in PATH instead of `load-path'"
 217   (interactive (find-function-read-function))
 218   (find-function-do-it function path 'switch-to-buffer))
 219
 220 ;;;###autoload
 221 (defun find-function-other-window (function &optional path)
 222   "Find the definition of the function near point in the other window.
 223
 224 Finds the Emacs Lisp package containing the definition of the function
 225 near point (selected by `find-function-function') and places point
 226 before the definition.  Point is saved if FUNCTION is in the current
 227 buffer.
 228
 229 If the optional argument PATH is given, the package where FUNCTION is
 230 defined is searched in PATH instead of `load-path'"
 231   (interactive (find-function-read-function))
 232   (find-function-do-it function path 'switch-to-buffer-other-window))
 233
 234 ;;;###autoload
 235 (defun find-function-other-frame (function &optional path)
 236   "Find the definition of the function near point in the another frame.
 237
 238 Finds the Emacs Lisp package containing the definition of the function
 239 near point (selected by `find-function-function') and places point
 240 before the definition.  Point is saved if FUNCTION is in the current
 241 buffer.
 242
 243 If the optional argument PATH is given, the package where FUNCTION is
 244 defined is searched in PATH instead of `load-path'"
 245   (interactive (find-function-read-function))
 246   (find-function-do-it function path 'switch-to-buffer-other-frame))
 247
 248 ;;;###autoload
 249 (defun find-function-on-key (key)
 250   "Find the function that KEY invokes.  KEY is a string.
 251 Point is saved if FUNCTION is in the current buffer."
 252   (interactive "kFind function on key: ")
 253   (save-excursion
 254     (let ((modifiers (event-modifiers (aref key 0)))
 255           window position)
 256       ;; For a mouse button event, go to the button it applies to
 257       ;; to get the right key bindings.  And go to the right place
 258       ;; in case the keymap depends on where you clicked.
 259       (if (or (memq 'click modifiers) (memq 'down modifiers)
 260               (memq 'drag modifiers))
 261           (setq window (posn-window (event-start (aref key 0)))
 262                 position (posn-point (event-start (aref key 0)))))
 263       (if (windowp window)
 264           (progn
 265             (set-buffer (window-buffer window))
 266             (goto-char position)))
 267       ;; Ok, now look up the key and name the command.
 268       (let ((defn (key-binding key)))
 269         (if (or (null defn) (integerp defn))
 270             (message "%s is undefined" (key-description key))
 271           (if (consp defn)
 272               (message (if (windowp window)
 273                            "%s at that spot runs %s"
 274                          "%s runs %s")
 275                        (key-description key) (prin1-to-string defn))
 276             (find-function-other-window defn)))))))
 277
 278 (provide 'find-func)
 279
 280 ;;; find-func.el ends here
 281