;;; find-func.el --- find the definition of the Emacs Lisp function near point
-;; Copyright (C) 1997, 1999, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999, 2001-2012 Free Software Foundation, Inc.
;; Author: Jens Petersen <petersen@kurims.kyoto-u.ac.jp>
;; Maintainer: petersen@kurims.kyoto-u.ac.jp
(dolist (suffix (get-load-suffixes) (nreverse suffixes))
(unless (string-match "elc" suffix) (push suffix suffixes)))))
+(defun find-library--load-name (library)
+ (let ((name library))
+ (dolist (dir load-path)
+ (let ((rel (file-relative-name library dir)))
+ (if (and (not (string-match "\\`\\.\\./" rel))
+ (< (length rel) (length name)))
+ (setq name rel))))
+ (unless (equal name library) name)))
+
(defun find-library-name (library)
- "Return the absolute file name of the Lisp source of LIBRARY."
+ "Return the absolute file name of the Emacs Lisp source of LIBRARY.
+LIBRARY should be a string (the name of the library)."
;; If the library is byte-compiled, try to find a source library by
;; the same name.
(if (string-match "\\.el\\(c\\(\\..*\\)?\\)\\'" library)
(setq library (replace-match "" t t library)))
- (or
+ (or
(locate-file library
(or find-function-source-path load-path)
(find-library-suffixes))
(locate-file library
(or find-function-source-path load-path)
load-file-rep-suffixes)
+ (when (file-name-absolute-p library)
+ (let ((rel (find-library--load-name library)))
+ (when rel
+ (or
+ (locate-file rel
+ (or find-function-source-path load-path)
+ (find-library-suffixes))
+ (locate-file rel
+ (or find-function-source-path load-path)
+ load-file-rep-suffixes)))))
(error "Can't find library %s" library)))
(defvar find-function-C-source-directory
If nil, do not try to find the source code of functions and variables
defined in C.")
+(declare-function ad-get-advice-info "advice" (function))
+
+(defun find-function-advised-original (func)
+ "Return the original function symbol of an advised function FUNC.
+If FUNC is not the symbol of an advised function, just returns FUNC."
+ (or (and (symbolp func)
+ (featurep 'advice)
+ (let ((ofunc (cdr (assq 'origname (ad-get-advice-info func)))))
+ (and (fboundp ofunc) ofunc)))
+ func))
+
(defun find-function-C-source (fun-or-var file type)
"Find the source location where FUN-OR-VAR is defined in FILE.
TYPE should be nil to find a function, or `defvar' to find a variable."
- (unless find-function-C-source-directory
- (setq find-function-C-source-directory
- (read-directory-name "Emacs C source dir: " nil nil t)))
- (setq file (expand-file-name file find-function-C-source-directory))
- (unless (file-readable-p file)
- (error "The C source file %s is not available"
- (file-name-nondirectory file)))
+ (let ((dir (or find-function-C-source-directory
+ (read-directory-name "Emacs C source dir: " nil nil t))))
+ (setq file (expand-file-name file dir))
+ (if (file-readable-p file)
+ (if (null find-function-C-source-directory)
+ (setq find-function-C-source-directory dir))
+ (error "The C source file %s is not available"
+ (file-name-nondirectory file))))
(unless type
- (setq fun-or-var (indirect-function fun-or-var)))
+ ;; Either or both an alias and its target might be advised.
+ (setq fun-or-var (find-function-advised-original
+ (indirect-function
+ (find-function-advised-original fun-or-var)))))
(with-current-buffer (find-file-noselect file)
(goto-char (point-min))
(unless (re-search-forward
;;;###autoload
(defun find-library (library)
- "Find the elisp source of LIBRARY."
+ "Find the Emacs Lisp source of LIBRARY.
+LIBRARY should be a string (the name of the library)."
(interactive
(let* ((dirs (or find-function-source-path load-path))
(suffixes (find-library-suffixes))
+ (table (apply-partially 'locate-file-completion-table
+ dirs suffixes))
(def (if (eq (function-called-at-point) 'require)
;; `function-called-at-point' may return 'require
;; with `point' anywhere on this line. So wrap the
(thing-at-point 'symbol))
(error nil))
(thing-at-point 'symbol))))
- (when def
- (setq def (and (locate-file-completion-table
- dirs suffixes def nil 'lambda)
- def)))
+ (when (and def (not (test-completion def table)))
+ (setq def nil))
(list
(completing-read (if def (format "Library name (default %s): " def)
"Library name: ")
- (apply-partially 'locate-file-completion-table
- dirs suffixes)
- nil nil nil nil def))))
+ table nil nil nil nil def))))
(let ((buf (find-file-noselect (find-library-name library))))
(condition-case nil (switch-to-buffer buf) (error (pop-to-buffer buf)))))
(cons (current-buffer) nil))))))))
;;;###autoload
-(defun find-function-noselect (function)
+(defun find-function-noselect (function &optional lisp-only)
"Return a pair (BUFFER . POINT) pointing to the definition of FUNCTION.
Finds the source file containing the definition of FUNCTION
not selected. If the function definition can't be found in
the buffer, returns (BUFFER).
+If FUNCTION is a built-in function, this function normally
+attempts to find it in the Emacs C sources; however, if LISP-ONLY
+is non-nil, signal an error instead.
+
If the file where FUNCTION is defined is not known, then it is
searched for in `find-function-source-path' if non-nil, otherwise
in `load-path'."
(if (not function)
- (error "You didn't specify a function"))
- (let ((def (symbol-function function))
+ (error "You didn't specify a function"))
+ (let ((def (symbol-function (find-function-advised-original function)))
aliases)
+ ;; FIXME for completeness, it might be nice to print something like:
+ ;; foo (which is advised), which is an alias for bar (which is advised).
(while (symbolp def)
(or (eq def function)
(if aliases
(setq aliases (concat aliases
(format ", which is an alias for `%s'"
(symbol-name def))))
- (setq aliases (format "`%s' an alias for `%s'"
+ (setq aliases (format "`%s' is an alias for `%s'"
function (symbol-name def)))))
- (setq function (symbol-function function)
- def (symbol-function function)))
+ (setq function (symbol-function (find-function-advised-original function))
+ def (symbol-function (find-function-advised-original function))))
(if aliases
(message "%s" aliases))
(let ((library
- (cond ((eq (car-safe def) 'autoload)
- (nth 1 def))
+ (cond ((autoloadp def) (nth 1 def))
((subrp def)
+ (if lisp-only
+ (error "%s is a built-in function" function))
(help-C-file-name def 'subr))
((symbol-file function 'defun)))))
(find-function-search-for-symbol function nil library))))
Otherwise TYPE should be `defvar' or `defface'.
If TYPE is nil, defaults using `function-called-at-point',
otherwise uses `variable-at-point'."
- (let ((symb (if (null type)
- (function-called-at-point)
- (if (eq type 'defvar)
- (variable-at-point)
- (variable-at-point t))))
- (predicate (cdr (assq type '((nil . fboundp) (defvar . boundp)
- (defface . facep)))))
- (prompt (cdr (assq type '((nil . "function") (defvar . "variable")
- (defface . "face")))))
- (enable-recursive-minibuffers t)
- val)
- (if (equal symb 0)
- (setq symb nil))
- (setq val (completing-read
- (concat "Find "
- prompt
- (if symb
- (format " (default %s)" symb))
- ": ")
- obarray predicate t nil))
- (list (if (equal val "")
- symb
- (intern val)))))
+ (let* ((symb1 (cond ((null type) (function-called-at-point))
+ ((eq type 'defvar) (variable-at-point))
+ (t (variable-at-point t))))
+ (symb (unless (eq symb1 0) symb1))
+ (predicate (cdr (assq type '((nil . fboundp)
+ (defvar . boundp)
+ (defface . facep)))))
+ (prompt-type (cdr (assq type '((nil . "function")
+ (defvar . "variable")
+ (defface . "face")))))
+ (prompt (concat "Find " prompt-type
+ (and symb (format " (default %s)" symb))
+ ": "))
+ (enable-recursive-minibuffers t))
+ (list (intern (completing-read
+ prompt obarray predicate
+ t nil nil (and symb (symbol-name symb)))))))
(defun find-function-do-it (symbol type switch-fn)
"Find Emacs Lisp SYMBOL in a buffer and display it.
(provide 'find-func)
-;; arch-tag: 43ecd81c-74dc-4d9a-8f63-a61e55670d64
;;; find-func.el ends here
HCoop / bpt / emacs.git / blobdiff