comparison lisp/prim/find-func.el @ 203:850242ba4a81 r20-3b28

Import from CVS: tag r20-3b28
author cvs
date Mon, 13 Aug 2007 10:02:21 +0200
parents
children e45d5e7c476e
comparison
equal deleted inserted replaced
202:61eefc8fc970 203:850242ba4a81
1 ;;; find-func.el --- find the definition of the Emacs Lisp 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, functions
8 ;; Created: 97/07/25
9 ;; URL: <http://www.kurims.kyoto-u.ac.jp/~petersen/emacs-lisp/>
10
11 ;; $Id: find-func.el,v 1.1 1997/10/10 01:39:52 steve Exp $
12
13 ;; This file is part of XEmacs.
14
15 ;; XEmacs is free software; you can redistribute it and/or modify it
16 ;; under the terms of the GNU General Public License as published by
17 ;; the Free Software Foundation; either version 2, or (at your option)
18 ;; any later version.
19
20 ;; XEmacs is distributed in the hope that it will be useful, but
21 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
23 ;; General Public License for more details.
24
25 ;; You should have received a copy of the GNU General Public License
26 ;; along with XEmacs; see the file COPYING. If not, write to the
27 ;; Free Software Foundation, 59 Temple Place - Suite 330,
28 ;; Boston, MA 02111-1307, USA.
29
30 ;;; Commentary:
31 ;;
32 ;; The funniest thing about this is that I can't imagine why a package
33 ;; so obviously useful as this hasn't been written before!!
34 ;;
35 ;; Put this file in your `load-path', byte-compile it and add the
36 ;; following code in your init file:
37 ;;
38 ;; ;;; find-func
39 ;; (load "find-func")
40 ;; (global-set-key [(control ?c) ?f] 'find-function)
41 ;; (global-set-key [(control ?c) ?4 ?f] 'find-function-other-window)
42 ;; (global-set-key [(control ?c) ?5 ?f] 'find-function-other-frame)
43 ;; (global-set-key [(control ?c) ?k] 'find-function-on-key)
44 ;;
45 ;; and away you go! It does pretty much what you would expect,
46 ;; putting the cursor at the definition of the function at point.
47 ;;
48 ;; In XEmacs the source file of dumped functions is recorded (and can
49 ;; be accessed with the function `compiled-function-annotation', which
50 ;; doesn't exist in Emacs), so in XEmacs non-primitive dumped
51 ;; functions can also be found. Unfortunately this is not possible in
52 ;; Emacs. It would be nice if the location of primitive functions in
53 ;; the C code was also recorded!
54
55 ;; The code is adapted from `describe-function', `describe-key'
56 ;; ("help.el") and `fff-find-loaded-emacs-lisp-function' (Noah Friedman's
57 ;; "fff.el").
58
59 ;;; To do:
60 ;;
61 ;; o improve handling of advice'd functions? (at the moment it goes to
62 ;; the advice, not the actual definition)
63 ;;
64 ;; o `find-function-other-frame' is not quite right when the function
65 ;; is in the current buffer.
66 ;;
67 ;;;; Code:
68
69 (defgroup find-function nil
70 "Find the definition of the Emacs Lisp function near point."
71 :group 'lisp)
72
73 ;;; User variables:
74
75 (defcustom find-function-source-path nil
76 "The default list of directories where find-function searches.
77
78 If this variable is `nil' then find-function searches `load-path' by
79 default."
80 :type '(choice (const :tag "Use `load-path'" nil)
81 (repeat :tag "Directories"
82 :menu-tag "List"
83 :value ("")
84 directory))
85 :group 'find-function)
86
87
88 ;;; Functions:
89
90 (defun find-function-noselect (function)
91 "Returns a pair `(buffer . point)' pointing to the definition of FUNCTION.
92
93 Finds the Emacs Lisp library containing the definition of FUNCTION
94 in a buffer and the point of the definition. The buffer is
95 not selected.
96
97 The library where FUNCTION is defined is searched for in
98 `find-function-source-path', if non `nil', otherwise in `load-path'."
99 (and (subrp (symbol-function function))
100 (error "%s is a primitive function" function))
101 (if (not function)
102 (error "You didn't specify a function"))
103 (let ((def (symbol-function function))
104 library aliases)
105 (while (symbolp def)
106 (or (eq def function)
107 (if aliases
108 (setq aliases (concat aliases
109 (format ", which is an alias for %s"
110 (symbol-name def))))
111 (setq aliases (format "an alias for %s" (symbol-name def)))))
112 (setq function (symbol-function function)
113 def (symbol-function function)))
114 (if aliases
115 (message aliases))
116 (setq library
117 (cond ((eq (car-safe def) 'autoload)
118 (nth 1 def))
119 ((describe-function-find-file function))
120 ((compiled-function-p def)
121 (substring (compiled-function-annotation def) 0 -4))))
122 (if (null library)
123 (error (format "Don't know where `%s' is defined" function)))
124 (if (string-match "\\.el\\(c\\)\\'" library)
125 (setq library (substring library 0 (match-beginning 1))))
126 (let* ((path find-function-source-path)
127 (filename (if (file-exists-p library)
128 library
129 (if (string-match "\\(\\.el\\)\\'" library)
130 (setq library (substring library 0
131 (match-beginning
132 1))))
133 (or (locate-library (concat library ".el") t path)
134 (locate-library library t path)))))
135 (if (not filename)
136 (error "The library \"%s\" is not in the path." library))
137 (with-current-buffer (find-file-noselect filename)
138 (save-match-data
139 (let (;; avoid defconst, defgroup, defvar (any others?)
140 (regexp
141 (format "^\\s-*(def[^cgv\W]\\w+\\*?\\s-+%s\\s-" function))
142 (syntable (syntax-table)))
143 (set-syntax-table emacs-lisp-mode-syntax-table)
144 (goto-char (point-min))
145 (if (prog1
146 (re-search-forward regexp nil t)
147 (set-syntax-table syntable))
148 (progn
149 (beginning-of-line)
150 (cons (current-buffer) (point)))
151 (error "Cannot find definition of `%s'" function))))))))
152
153 (defun find-function-read-function ()
154 "Read and return a function, defaulting to the one near point.
155
156 The function named by `find-function-function' is used to select the
157 default function."
158 (let ((fn (funcall find-function-function))
159 (enable-recursive-minibuffers t)
160 val)
161 (setq val (completing-read
162 (if fn
163 (format "Find function (default %s): " fn)
164 "Find function: ")
165 obarray 'fboundp t nil 'function-history))
166 (list (if (equal val "")
167 fn (intern val)))))
168
169 (defun find-function-do-it (function switch-fn)
170 "Find Emacs Lisp FUNCTION in a buffer and display it with SWITCH-FN.
171 Point is saved in the buffer if it is one of the current buffers."
172 (let ((orig-point (point))
173 (orig-buffers (buffer-list))
174 (buffer-point (find-function-noselect function)))
175 (when buffer-point
176 (funcall switch-fn (car buffer-point))
177 (when (memq (car buffer-point) orig-buffers)
178 (push-mark orig-point))
179 (goto-char (cdr buffer-point))
180 (recenter 0))))
181
182 ;;;###autoload
183 (defun find-function (function)
184 "Find the definition of the function near point in the current window.
185
186 Finds the Emacs Lisp library containing the definition of the function
187 near point (selected by `find-function-function') in a buffer and
188 places point before the definition. Point is saved in the buffer if
189 it is one of the current buffers.
190
191 The library where FUNCTION is defined is searched for in
192 `find-function-source-path', if non `nil', otherwise in `load-path'."
193 (interactive (find-function-read-function))
194 (find-function-do-it function 'switch-to-buffer))
195
196 ;;;###autoload
197 (defun find-function-other-window (function)
198 "Find the definition of the function near point in the other window.
199
200 Finds the Emacs Lisp library containing the definition of the function
201 near point (selected by `find-function-function') in a buffer and
202 places point before the definition. Point is saved in the buffer if
203 it is one of the current buffers.
204
205 The library where FUNCTION is defined is searched for in
206 `find-function-source-path', if non `nil', otherwise in `load-path'."
207 (interactive (find-function-read-function))
208 (find-function-do-it function 'switch-to-buffer-other-window))
209
210 ;;;###autoload
211 (defun find-function-other-frame (function)
212 "Find the definition of the function near point in the another frame.
213
214 Finds the Emacs Lisp library containing the definition of the function
215 near point (selected by `find-function-function') in a buffer and
216 places point before the definition. Point is saved in the buffer if
217 it is one of the current buffers.
218
219 The library where FUNCTION is defined is searched for in
220 `find-function-source-path', if non `nil', otherwise in `load-path'."
221 (interactive (find-function-read-function))
222 (find-function-do-it function 'switch-to-buffer-other-frame))
223
224 ;;;###autoload
225 (defun find-function-on-key (key)
226 "Find the function that KEY invokes. KEY is a string.
227 Point is saved if FUNCTION is in the current buffer."
228 (interactive "kFind function on key: ")
229 (let ((defn (key-or-menu-binding key)))
230 (if (or (null defn) (integerp defn))
231 (message "%s is undefined" (key-description key))
232 (if (and (consp defn) (not (eq 'lambda (car-safe defn))))
233 (message "runs %s" (prin1-to-string defn))
234 (find-function-other-window defn)))))
235
236 ;;;###autoload
237 (defun find-function-at-point ()
238 "Find directly the function at point in the other window."
239 (interactive)
240 (let ((symb (function-at-point)))
241 (when symb
242 (find-function-other-window symb))))
243
244 ;; (define-key ctl-x-map "F" 'find-function) ; conflicts with `facemenu-keymap'
245
246 ;;;###autoload
247 (define-key ctl-x-4-map "F" 'find-function-other-window)
248 ;;;###autoload
249 (define-key ctl-x-5-map "F" 'find-function-other-frame)
250 ;;;###autoload
251 (define-key ctl-x-map "K" 'find-function-on-key)
252
253 (provide 'find-func)
254 ;;; find-func.el ends here