1;;; find-func.el --- find the definition of the Emacs Lisp function near point
2
3;; Copyright (C) 1997, 1999, 2001, 2002, 2003, 2004,
4;;   2005, 2006, 2007 Free Software Foundation, Inc.
5
6;; Author: Jens Petersen <petersen@kurims.kyoto-u.ac.jp>
7;; Maintainer: petersen@kurims.kyoto-u.ac.jp
8;; Keywords: emacs-lisp, functions, variables
9;; Created: 97/07/25
10
11;; This file is part of GNU Emacs.
12
13;; GNU Emacs is free software; you can redistribute it and/or modify
14;; it under the terms of the GNU General Public License as published by
15;; the Free Software Foundation; either version 2, or (at your option)
16;; any later version.
17
18;; GNU Emacs is distributed in the hope that it will be useful,
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
21;; GNU General Public License for more details.
22
23;; You should have received a copy of the GNU General Public License
24;; along with GNU Emacs; see the file COPYING.  If not, write to the
25;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
26;; Boston, MA 02110-1301, USA.
27
28;;; Commentary:
29;;
30;; The funniest thing about this is that I can't imagine why a package
31;; so obviously useful as this hasn't been written before!!
32;; ;;; find-func
33;; (find-function-setup-keys)
34;;
35;; or just:
36;;
37;; (load "find-func")
38;;
39;; if you don't like the given keybindings and away you go!  It does
40;; pretty much what you would expect, putting the cursor at the
41;; definition of the function or variable at point.
42;;
43;; The code started out from `describe-function', `describe-key'
44;; ("help.el") and `fff-find-loaded-emacs-lisp-function' (Noah Friedman's
45;; "fff.el").
46
47;;; Code:
48
49(require 'loadhist)
50
51;;; User variables:
52
53(defgroup find-function nil
54  "Finds the definition of the Emacs Lisp symbol near point."
55;;   :prefix "find-function"
56  :group 'lisp)
57
58(defconst find-function-space-re "\\(?:\\s-\\|\n\\|;.*\n\\)+")
59
60(defcustom find-function-regexp
61  ;; Match things like (defun foo ...), (defmacro foo ...),
62  ;; (define-skeleton foo ...), (define-generic-mode 'foo ...),
63  ;;  (define-derived-mode foo ...), (define-minor-mode foo)
64  (concat
65   "^\\s-*(\\(def\\(ine-skeleton\\|ine-generic-mode\\|ine-derived-mode\\|\
66ine\\(?:-global\\)?-minor-mode\\|ine-compilation-mode\\|un-cvs-mode\\|\
67foo\\|[^icfgv]\\(\\w\\|\\s_\\)+\\*?\\)\\|easy-mmode-define-[a-z-]+\\|easy-menu-define\\|\
68menu-bar-make-toggle\\)"
69   find-function-space-re
70   "\\('\\|\(quote \\)?%s\\(\\s-\\|$\\|\(\\|\)\\)")
71  "The regexp used by `find-function' to search for a function definition.
72Note it must contain a `%s' at the place where `format'
73should insert the function name.  The default value avoids `defconst',
74`defgroup', `defvar', `defface'.
75
76Please send improvements and fixes to the maintainer."
77  :type 'regexp
78  :group 'find-function
79  :version "21.1")
80
81(defcustom find-variable-regexp
82  (concat
83   "^\\s-*(\\(def[^fumag]\\(\\w\\|\\s_\\)+\\*?\\|\
84easy-mmode-def\\(map\\|syntax\\)\\|easy-menu-define\\)"
85   find-function-space-re
86   "%s\\(\\s-\\|$\\)")
87  "The regexp used by `find-variable' to search for a variable definition.
88Note it must contain a `%s' at the place where `format'
89should insert the variable name.  The default value
90avoids `defun', `defmacro', `defalias', `defadvice', `defgroup', `defface'.
91
92Please send improvements and fixes to the maintainer."
93  :type 'regexp
94  :group 'find-function
95  :version "21.1")
96
97(defcustom find-face-regexp
98  (concat"^\\s-*(defface" find-function-space-re "%s\\(\\s-\\|$\\)")
99  "The regexp used by `find-face' to search for a face definition.
100Note it must contain a `%s' at the place where `format'
101should insert the face name.
102
103Please send improvements and fixes to the maintainer."
104  :type 'regexp
105  :group 'find-function
106  :version "22.1")
107
108(defvar find-function-regexp-alist
109  '((nil . find-function-regexp)
110    (defvar . find-variable-regexp)
111    (defface . find-face-regexp))
112  "Alist mapping definition types into regexp variables.
113Each regexp variable's value should actually be a format string
114to be used to substitute the desired symbol name into the regexp.")
115(put 'find-function-regexp-alist 'risky-local-variable t)
116
117(defcustom find-function-source-path nil
118  "The default list of directories where `find-function' searches.
119
120If this variable is nil then `find-function' searches `load-path' by
121default."
122  :type '(repeat directory)
123  :group 'find-function)
124
125(defcustom find-function-recenter-line 1
126  "The window line-number from which to start displaying a symbol definition.
127A value of nil implies center the beginning of the definition.
128See `find-function' and `find-variable'."
129  :type '(choice (const :tag "Center" nil)
130		 integer)
131  :group 'find-function
132  :version "20.3")
133
134(defcustom find-function-after-hook nil
135  "Hook run after finding symbol definition.
136
137See the functions `find-function' and `find-variable'."
138  :group 'find-function
139  :version "20.3")
140
141;;; Functions:
142
143(defun find-library-suffixes ()
144  (let ((suffixes nil))
145    (dolist (suffix (get-load-suffixes) (nreverse suffixes))
146      (unless (string-match "elc" suffix) (push suffix suffixes)))))
147
148(defun find-library-name (library)
149  "Return the absolute file name of the Lisp source of LIBRARY."
150  ;; If the library is byte-compiled, try to find a source library by
151  ;; the same name.
152  (if (string-match "\\.el\\(c\\(\\..*\\)?\\)\\'" library)
153      (setq library (replace-match "" t t library)))
154  (or (locate-file library
155		   (or find-function-source-path load-path)
156		   (append (find-library-suffixes) load-file-rep-suffixes))
157      (error "Can't find library %s" library)))
158
159(defvar find-function-C-source-directory
160  (let ((dir (expand-file-name "src" source-directory)))
161    (when (and (file-directory-p dir) (file-readable-p dir))
162      dir))
163  "Directory where the C source files of Emacs can be found.
164If nil, do not try to find the source code of functions and variables
165defined in C.")
166
167(defun find-function-C-source (fun-or-var file type)
168  "Find the source location where FUN-OR-VAR is defined in FILE.
169TYPE should be nil to find a function, or `defvar' to find a variable."
170  (unless find-function-C-source-directory
171    (setq find-function-C-source-directory
172	  (read-directory-name "Emacs C source dir: " nil nil t)))
173  (setq file (expand-file-name file find-function-C-source-directory))
174  (unless (file-readable-p file)
175    (error "The C source file %s is not available"
176	   (file-name-nondirectory file)))
177  (unless type
178    (setq fun-or-var (indirect-function fun-or-var)))
179  (with-current-buffer (find-file-noselect file)
180    (goto-char (point-min))
181    (unless (re-search-forward
182	     (if type
183		 (concat "DEFVAR[A-Z_]*[ \t\n]*([ \t\n]*\""
184			 (regexp-quote (symbol-name fun-or-var))
185			 "\"")
186	       (concat "DEFUN[ \t\n]*([ \t\n]*\""
187		       (regexp-quote (subr-name fun-or-var))
188		       "\""))
189	     nil t)
190      (error "Can't find source for %s" fun-or-var))
191    (cons (current-buffer) (match-beginning 0))))
192
193;;;###autoload
194(defun find-library (library)
195  "Find the elisp source of LIBRARY."
196  (interactive
197   (list
198    (completing-read "Library name: "
199		     'locate-file-completion
200		     (cons (or find-function-source-path load-path)
201			   (find-library-suffixes)))))
202  (let ((buf (find-file-noselect (find-library-name library))))
203    (condition-case nil (switch-to-buffer buf) (error (pop-to-buffer buf)))))
204
205;;;###autoload
206(defun find-function-search-for-symbol (symbol type library)
207  "Search for SYMBOL's definition of type TYPE in LIBRARY.
208Visit the library in a buffer, and return a cons cell (BUFFER . POSITION),
209or just (BUFFER . nil) if the definition can't be found in the file.
210
211If TYPE is nil, look for a function definition.
212Otherwise, TYPE specifies the kind of definition,
213and it is interpreted via `find-function-regexp-alist'.
214The search is done in the source for library LIBRARY."
215  (if (null library)
216      (error "Don't know where `%s' is defined" symbol))
217  ;; Some functions are defined as part of the construct
218  ;; that defines something else.
219  (while (and (symbolp symbol) (get symbol 'definition-name))
220    (setq symbol (get symbol 'definition-name)))
221  (if (string-match "\\`src/\\(.*\\.c\\)\\'" library)
222      (find-function-C-source symbol (match-string 1 library) type)
223    (if (string-match "\\.el\\(c\\)\\'" library)
224	(setq library (substring library 0 (match-beginning 1))))
225    (let* ((filename (find-library-name library))
226	   (regexp-symbol (cdr (assq type find-function-regexp-alist))))
227      (with-current-buffer (find-file-noselect filename)
228	(let ((regexp (format (symbol-value regexp-symbol)
229			      ;; Entry for ` (backquote) macro in loaddefs.el,
230			      ;; (defalias (quote \`)..., has a \ but
231			      ;; (symbol-name symbol) doesn't.  Add an
232			      ;; optional \ to catch this.
233			      (concat "\\\\?"
234				      (regexp-quote (symbol-name symbol)))))
235	      (case-fold-search))
236	  (with-syntax-table emacs-lisp-mode-syntax-table
237	    (goto-char (point-min))
238	    (if (or (re-search-forward regexp nil t)
239                    ;; `regexp' matches definitions using known forms like
240                    ;; `defun', or `defvar'.  But some functions/variables
241                    ;; are defined using special macros (or functions), so
242                    ;; if `regexp' can't find the definition, we look for
243                    ;; something of the form "(SOMETHING <symbol> ...)".
244                    ;; This fails to distinguish function definitions from
245                    ;; variable declarations (or even uses thereof), but is
246                    ;; a good pragmatic fallback.
247		    (re-search-forward
248		     (concat "^([^ ]+" find-function-space-re "['(]?"
249			     (regexp-quote (symbol-name symbol))
250			     "\\_>")
251		     nil t))
252		(progn
253		  (beginning-of-line)
254		  (cons (current-buffer) (point)))
255	      (cons (current-buffer) nil))))))))
256
257;;;###autoload
258(defun find-function-noselect (function)
259  "Return a pair (BUFFER . POINT) pointing to the definition of FUNCTION.
260
261Finds the source file containing the definition of FUNCTION
262in a buffer and the point of the definition.  The buffer is
263not selected.  If the function definition can't be found in
264the buffer, returns (BUFFER).
265
266If the file where FUNCTION is defined is not known, then it is
267searched for in `find-function-source-path' if non-nil, otherwise
268in `load-path'."
269  (if (not function)
270      (error "You didn't specify a function"))
271  (let ((def (symbol-function function))
272	aliases)
273    (while (symbolp def)
274      (or (eq def function)
275	  (if aliases
276	      (setq aliases (concat aliases
277				    (format ", which is an alias for `%s'"
278					    (symbol-name def))))
279	    (setq aliases (format "`%s' an alias for `%s'"
280				  function (symbol-name def)))))
281      (setq function (symbol-function function)
282	    def (symbol-function function)))
283    (if aliases
284	(message "%s" aliases))
285    (let ((library
286	   (cond ((eq (car-safe def) 'autoload)
287		  (nth 1 def))
288		 ((subrp def)
289		  (help-C-file-name def 'subr))
290		 ((symbol-file function 'defun)))))
291      (find-function-search-for-symbol function nil library))))
292
293(defun find-function-read (&optional type)
294  "Read and return an interned symbol, defaulting to the one near point.
295
296If TYPE is nil, insist on a symbol with a function definition.
297Otherwise TYPE should be `defvar' or `defface'.
298If TYPE is nil, defaults using `function-called-at-point',
299otherwise uses `variable-at-point'."
300  (let ((symb (if (null type)
301		  (function-called-at-point)
302		(if (eq type 'defvar)
303		    (variable-at-point)
304		  (variable-at-point t))))
305	(predicate (cdr (assq type '((nil . fboundp) (defvar . boundp)
306				     (defface . facep)))))
307	(prompt (cdr (assq type '((nil . "function") (defvar . "variable")
308				  (defface . "face")))))
309	(enable-recursive-minibuffers t)
310	val)
311    (if (equal symb 0)
312	(setq symb nil))
313    (setq val (completing-read
314	       (concat "Find "
315		       prompt
316		       (if symb
317			   (format " (default %s)" symb))
318		       ": ")
319	       obarray predicate t nil))
320    (list (if (equal val "")
321	      symb
322	    (intern val)))))
323
324(defun find-function-do-it (symbol type switch-fn)
325  "Find Emacs Lisp SYMBOL in a buffer and display it.
326TYPE is nil to search for a function definition,
327or else `defvar' or `defface'.
328
329The variable `find-function-recenter-line' controls how
330to recenter the display.  SWITCH-FN is the function to call
331to display and select the buffer.
332See also `find-function-after-hook'.
333
334Set mark before moving, if the buffer already existed."
335  (let* ((orig-point (point))
336	(orig-buf (window-buffer))
337	(orig-buffers (buffer-list))
338	(buffer-point (save-excursion
339			(find-definition-noselect symbol type)))
340	(new-buf (car buffer-point))
341	(new-point (cdr buffer-point)))
342    (when buffer-point
343      (when (memq new-buf orig-buffers)
344	(push-mark orig-point))
345      (funcall switch-fn new-buf)
346      (when new-point (goto-char new-point))
347      (recenter find-function-recenter-line)
348      (run-hooks 'find-function-after-hook))))
349
350;;;###autoload
351(defun find-function (function)
352  "Find the definition of the FUNCTION near point.
353
354Finds the source file containing the definition of the function
355near point (selected by `function-called-at-point') in a buffer and
356places point before the definition.
357Set mark before moving, if the buffer already existed.
358
359The library where FUNCTION is defined is searched for in
360`find-function-source-path', if non-nil, otherwise in `load-path'.
361See also `find-function-recenter-line' and `find-function-after-hook'."
362  (interactive (find-function-read))
363  (find-function-do-it function nil 'switch-to-buffer))
364
365;;;###autoload
366(defun find-function-other-window (function)
367  "Find, in another window, the definition of FUNCTION near point.
368
369See `find-function' for more details."
370  (interactive (find-function-read))
371  (find-function-do-it function nil 'switch-to-buffer-other-window))
372
373;;;###autoload
374(defun find-function-other-frame (function)
375  "Find, in another frame, the definition of FUNCTION near point.
376
377See `find-function' for more details."
378  (interactive (find-function-read))
379  (find-function-do-it function nil 'switch-to-buffer-other-frame))
380
381;;;###autoload
382(defun find-variable-noselect (variable &optional file)
383  "Return a pair `(BUFFER . POINT)' pointing to the definition of VARIABLE.
384
385Finds the library containing the definition of VARIABLE in a buffer and
386the point of the definition.  The buffer is not selected.
387If the variable's definition can't be found in the buffer, return (BUFFER).
388
389The library where VARIABLE is defined is searched for in FILE or
390`find-function-source-path', if non-nil, otherwise in `load-path'."
391  (if (not variable)
392      (error "You didn't specify a variable")
393    (let ((library (or file
394                       (symbol-file variable 'defvar)
395                       (help-C-file-name variable 'var))))
396      (find-function-search-for-symbol variable 'defvar library))))
397
398;;;###autoload
399(defun find-variable (variable)
400  "Find the definition of the VARIABLE at or before point.
401
402Finds the library containing the definition of the variable
403near point (selected by `variable-at-point') in a buffer and
404places point before the definition.
405
406Set mark before moving, if the buffer already existed.
407
408The library where VARIABLE is defined is searched for in
409`find-function-source-path', if non-nil, otherwise in `load-path'.
410See also `find-function-recenter-line' and `find-function-after-hook'."
411  (interactive (find-function-read 'defvar))
412  (find-function-do-it variable 'defvar 'switch-to-buffer))
413
414;;;###autoload
415(defun find-variable-other-window (variable)
416  "Find, in another window, the definition of VARIABLE near point.
417
418See `find-variable' for more details."
419  (interactive (find-function-read 'defvar))
420  (find-function-do-it variable 'defvar 'switch-to-buffer-other-window))
421
422;;;###autoload
423(defun find-variable-other-frame (variable)
424  "Find, in another frame, the definition of VARIABLE near point.
425
426See `find-variable' for more details."
427  (interactive (find-function-read 'defvar))
428  (find-function-do-it variable 'defvar 'switch-to-buffer-other-frame))
429
430;;;###autoload
431(defun find-definition-noselect (symbol type &optional file)
432  "Return a pair `(BUFFER . POINT)' pointing to the definition of SYMBOL.
433If the definition can't be found in the buffer, return (BUFFER).
434TYPE says what type of definition: nil for a function, `defvar' for a
435variable, `defface' for a face.  This function does not switch to the
436buffer nor display it.
437
438The library where SYMBOL is defined is searched for in FILE or
439`find-function-source-path', if non-nil, otherwise in `load-path'."
440  (cond
441   ((not symbol)
442    (error "You didn't specify a symbol"))
443   ((null type)
444    (find-function-noselect symbol))
445   ((eq type 'defvar)
446    (find-variable-noselect symbol file))
447   (t
448    (let ((library (or file (symbol-file symbol type))))
449      (find-function-search-for-symbol symbol type library)))))
450
451;; For symmetry, this should be called find-face; but some programs
452;; assume that, if that name is defined, it means something else.
453;;;###autoload
454(defun find-face-definition (face)
455  "Find the definition of FACE.  FACE defaults to the name near point.
456
457Finds the Emacs Lisp library containing the definition of the face
458near point (selected by `variable-at-point') in a buffer and
459places point before the definition.
460
461Set mark before moving, if the buffer already existed.
462
463The library where FACE is defined is searched for in
464`find-function-source-path', if non-nil, otherwise in `load-path'.
465See also `find-function-recenter-line' and `find-function-after-hook'."
466  (interactive (find-function-read 'defface))
467  (find-function-do-it face 'defface 'switch-to-buffer))
468
469;;;###autoload
470(defun find-function-on-key (key)
471  "Find the function that KEY invokes.  KEY is a string.
472Set mark before moving, if the buffer already existed."
473  (interactive "kFind function on key: ")
474  (let (defn)
475    (save-excursion
476      (let* ((event (and (eventp key) (aref key 0))) ; Null event OK below.
477	     (start (event-start event))
478	     (modifiers (event-modifiers event))
479	     (window (and (or (memq 'click modifiers) (memq 'down modifiers)
480			      (memq 'drag modifiers))
481			  (posn-window start))))
482	;; For a mouse button event, go to the button it applies to
483	;; to get the right key bindings.  And go to the right place
484	;; in case the keymap depends on where you clicked.
485	(when (windowp window)
486	  (set-buffer (window-buffer window))
487	  (goto-char (posn-point start)))
488	(setq defn (key-binding key))))
489    (let ((key-desc (key-description key)))
490      (if (or (null defn) (integerp defn))
491	  (message "%s is unbound" key-desc)
492	(if (consp defn)
493	    (message "%s runs %s" key-desc (prin1-to-string defn))
494	  (find-function-other-window defn))))))
495
496;;;###autoload
497(defun find-function-at-point ()
498  "Find directly the function at point in the other window."
499  (interactive)
500  (let ((symb (function-called-at-point)))
501    (when symb
502      (find-function-other-window symb))))
503
504;;;###autoload
505(defun find-variable-at-point ()
506  "Find directly the variable at point in the other window."
507  (interactive)
508  (let ((symb (variable-at-point)))
509    (when (and symb (not (equal symb 0)))
510      (find-variable-other-window symb))))
511
512;;;###autoload
513(defun find-function-setup-keys ()
514  "Define some key bindings for the find-function family of functions."
515  (define-key ctl-x-map "F" 'find-function)
516  (define-key ctl-x-4-map "F" 'find-function-other-window)
517  (define-key ctl-x-5-map "F" 'find-function-other-frame)
518  (define-key ctl-x-map "K" 'find-function-on-key)
519  (define-key ctl-x-map "V" 'find-variable)
520  (define-key ctl-x-4-map "V" 'find-variable-other-window)
521  (define-key ctl-x-5-map "V" 'find-variable-other-frame))
522
523(provide 'find-func)
524
525;; arch-tag: 43ecd81c-74dc-4d9a-8f63-a61e55670d64
526;;; find-func.el ends here
527