]> code.delx.au - gnu-emacs/blobdiff - lisp/emacs-lisp/find-func.el
Update copyright year to 2016
[gnu-emacs] / lisp / emacs-lisp / find-func.el
index e1586a96716dd248b4bd1ac12e8b05f164773eb5..0575ce49f80330a468566cc96c1bae8f22c68aea 100644 (file)
@@ -1,6 +1,6 @@
-;;; find-func.el --- find the definition of the Emacs Lisp function near point
+;;; find-func.el --- find the definition of the Emacs Lisp function near point  -*- lexical-binding:t -*-
 
-;; Copyright (C) 1997, 1999, 2001-2014 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999, 2001-2016 Free Software Foundation, Inc.
 
 ;; Author: Jens Petersen <petersen@kurims.kyoto-u.ac.jp>
 ;; Maintainer: petersen@kurims.kyoto-u.ac.jp
   (concat
    "^\\s-*(\\(def\\(ine-skeleton\\|ine-generic-mode\\|ine-derived-mode\\|\
 ine\\(?:-global\\)?-minor-mode\\|ine-compilation-mode\\|un-cvs-mode\\|\
-foo\\|[^icfgv]\\(\\w\\|\\s_\\)+\\*?\\)\\|easy-mmode-define-[a-z-]+\\|easy-menu-define\\|\
+foo\\|\\(?:[^icfgv]\\|g[^r]\\)\\(\\w\\|\\s_\\)+\\*?\\)\\|easy-mmode-define-[a-z-]+\\|easy-menu-define\\|\
 menu-bar-make-toggle\\)"
    find-function-space-re
-   "\\('\\|\(quote \\)?%s\\(\\s-\\|$\\|\(\\|\)\\)")
+   "\\('\\|(quote \\)?%s\\(\\s-\\|$\\|[()]\\)")
   "The regexp used by `find-function' to search for a function definition.
 Note it must contain a `%s' at the place where `format'
 should insert the function name.  The default value avoids `defconst',
@@ -100,13 +100,40 @@ Please send improvements and fixes to the maintainer."
   :group 'find-function
   :version "22.1")
 
+(defcustom find-feature-regexp
+  (concat ";;; Code:")
+  "The regexp used by `xref-find-definitions' when searching for a feature definition.
+Note it must contain a `%s' at the place where `format'
+should insert the feature name."
+  ;; We search for ";;; Code" rather than (feature '%s) because the
+  ;; former is near the start of the code, and the latter is very
+  ;; uninteresting. If the regexp is not found, just goes to
+  ;; (point-min), which is acceptable in this case.
+  :type 'regexp
+  :group 'xref
+  :version "25.0")
+
+(defcustom find-alias-regexp
+  "(defalias +'%s"
+  "The regexp used by `xref-find-definitions' to search for an alias definition.
+Note it must contain a `%s' at the place where `format'
+should insert the feature name."
+  :type 'regexp
+  :group 'xref
+  :version "25.0")
+
 (defvar find-function-regexp-alist
   '((nil . find-function-regexp)
     (defvar . find-variable-regexp)
-    (defface . find-face-regexp))
+    (defface . find-face-regexp)
+    (feature . find-feature-regexp)
+    (defalias . find-alias-regexp))
   "Alist mapping definition types into regexp variables.
 Each regexp variable's value should actually be a format string
-to be used to substitute the desired symbol name into the regexp.")
+to be used to substitute the desired symbol name into the regexp.
+Instead of regexp variable, types can be mapped to functions as well,
+in which case the function is called with one argument (the object
+we're looking for) and it should search for it.")
 (put 'find-function-regexp-alist 'risky-local-variable t)
 
 (defcustom find-function-source-path nil
@@ -186,12 +213,15 @@ 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."
+  "Return the original function definition of an advised function FUNC.
+If FUNC is not a symbol, return it.  Else, if it's not advised,
+return the symbol's function definition."
   (or (and (symbolp func)
-          (featurep 'advice)
-          (let ((ofunc (cdr (assq 'origname (ad-get-advice-info func)))))
-            (and (fboundp ofunc) ofunc)))
+           (featurep 'nadvice)
+           (let ((ofunc (advice--symbol-function func)))
+             (if (advice--p ofunc)
+                 (advice--cd*r ofunc)
+               ofunc)))
       func))
 
 (defun find-function-C-source (fun-or-var file type)
@@ -282,67 +312,78 @@ The search is done in the source for library LIBRARY."
     (let* ((filename (find-library-name library))
           (regexp-symbol (cdr (assq type find-function-regexp-alist))))
       (with-current-buffer (find-file-noselect filename)
-       (let ((regexp (format (symbol-value regexp-symbol)
-                             ;; Entry for ` (backquote) macro in loaddefs.el,
-                             ;; (defalias (quote \`)..., has a \ but
-                             ;; (symbol-name symbol) doesn't.  Add an
-                             ;; optional \ to catch this.
-                             (concat "\\\\?"
-                                     (regexp-quote (symbol-name symbol)))))
+       (let ((regexp (if (functionp regexp-symbol) regexp-symbol
+                        (format (symbol-value regexp-symbol)
+                                ;; Entry for ` (backquote) macro in loaddefs.el,
+                                ;; (defalias (quote \`)..., has a \ but
+                                ;; (symbol-name symbol) doesn't.  Add an
+                                ;; optional \ to catch this.
+                                (concat "\\\\?"
+                                        (regexp-quote (symbol-name symbol))))))
              (case-fold-search))
          (with-syntax-table emacs-lisp-mode-syntax-table
            (goto-char (point-min))
-           (if (or (re-search-forward regexp nil t)
-                    ;; `regexp' matches definitions using known forms like
-                    ;; `defun', or `defvar'.  But some functions/variables
-                    ;; are defined using special macros (or functions), so
-                    ;; if `regexp' can't find the definition, we look for
-                    ;; something of the form "(SOMETHING <symbol> ...)".
-                    ;; This fails to distinguish function definitions from
-                    ;; variable declarations (or even uses thereof), but is
-                    ;; a good pragmatic fallback.
-                   (re-search-forward
-                    (concat "^([^ ]+" find-function-space-re "['(]?"
-                            (regexp-quote (symbol-name symbol))
-                            "\\_>")
-                    nil t))
+           (if (if (functionp regexp)
+                    (funcall regexp symbol)
+                  (or (re-search-forward regexp nil t)
+                      ;; `regexp' matches definitions using known forms like
+                      ;; `defun', or `defvar'.  But some functions/variables
+                      ;; are defined using special macros (or functions), so
+                      ;; if `regexp' can't find the definition, we look for
+                      ;; something of the form "(SOMETHING <symbol> ...)".
+                      ;; This fails to distinguish function definitions from
+                      ;; variable declarations (or even uses thereof), but is
+                      ;; a good pragmatic fallback.
+                      (re-search-forward
+                       (concat "^([^ ]+" find-function-space-re "['(]?"
+                               (regexp-quote (symbol-name symbol))
+                               "\\_>")
+                       nil t)))
                (progn
                  (beginning-of-line)
                  (cons (current-buffer) (point)))
              (cons (current-buffer) nil))))))))
 
 (defun find-function-library (function &optional lisp-only verbose)
-  "Return the library FUNCTION is defined in.
+  "Return the pair (ORIG-FUNCTION . LIBRARY) for FUNCTION.
+
+ORIG-FUNCTION is the original name, after removing all advice and
+resolving aliases.  LIBRARY is an absolute file name, a relative
+file name inside the C sources directory, or a name of an
+autoloaded feature.
 
-If FUNCTION is a built-in function and LISP-ONLY is non-nil,
+If ORIG-FUNCTION is a built-in function and LISP-ONLY is non-nil,
 signal an error.
 
 If VERBOSE is non-nil, and FUNCTION is an alias, display a
 message about the whole chain of aliases."
-  (let ((def (symbol-function (find-function-advised-original function)))
+  (let ((def (if (symbolp 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)
+    (while (and def (symbolp def))
       (or (eq def function)
           (not verbose)
-          (if aliases
-              (setq aliases (concat aliases
-                                    (format ", which is an alias for `%s'"
-                                            (symbol-name def))))
-            (setq aliases (format "`%s' is an alias for `%s'"
-                                  function (symbol-name def)))))
-      (setq function (symbol-function (find-function-advised-original function))
-            def (symbol-function (find-function-advised-original function))))
+          (setq aliases (if aliases
+                            (concat aliases
+                                    (format-message
+                                     ", which is an alias for `%s'"
+                                     (symbol-name def)))
+                          (format-message "`%s' is an alias for `%s'"
+                                          function (symbol-name def)))))
+      (setq function (find-function-advised-original function)
+            def (find-function-advised-original function)))
     (if aliases
         (message "%s" aliases))
-    (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)))))
+    (cons function
+          (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))))))
 
 ;;;###autoload
 (defun find-function-noselect (function &optional lisp-only)
@@ -362,8 +403,8 @@ 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 ((library (find-function-library function lisp-only t)))
-    (find-function-search-for-symbol function nil library)))
+  (let ((func-lib (find-function-library function lisp-only t)))
+    (find-function-search-for-symbol (car func-lib) nil (cdr func-lib))))
 
 (defun find-function-read (&optional type)
   "Read and return an interned symbol, defaulting to the one near point.
@@ -402,7 +443,6 @@ See also `find-function-after-hook'.
 
 Set mark before moving, if the buffer already existed."
   (let* ((orig-point (point))
-       (orig-buf (window-buffer))
        (orig-buffers (buffer-list))
        (buffer-point (save-excursion
                        (find-definition-noselect symbol type)))
@@ -535,11 +575,11 @@ See also `find-function-recenter-line' and `find-function-after-hook'."
   (interactive (find-function-read 'defface))
   (find-function-do-it face 'defface 'switch-to-buffer))
 
-;;;###autoload
-(defun find-function-on-key (key)
+(defun find-function-on-key-do-it (key find-fn)
   "Find the function that KEY invokes.  KEY is a string.
-Set mark before moving, if the buffer already existed."
-  (interactive "kFind function on key: ")
+Set mark before moving, if the buffer already existed.
+
+FIND-FN is the function to call to navigate to the function."
   (let (defn)
     (save-excursion
       (let* ((event (and (eventp key) (aref key 0))) ; Null event OK below.
@@ -560,7 +600,28 @@ Set mark before moving, if the buffer already existed."
          (message "%s is unbound" key-desc)
        (if (consp defn)
            (message "%s runs %s" key-desc (prin1-to-string defn))
-         (find-function-other-window defn))))))
+         (funcall find-fn defn))))))
+
+;;;###autoload
+(defun find-function-on-key (key)
+  "Find the function that KEY invokes.  KEY is a string.
+Set mark before moving, if the buffer already existed."
+  (interactive "kFind function on key: ")
+  (find-function-on-key-do-it key #'find-function))
+
+;;;###autoload
+(defun find-function-on-key-other-window (key)
+  "Find, in the other window, the function that KEY invokes.
+See `find-function-on-key'."
+  (interactive "kFind function on key: ")
+  (find-function-on-key-do-it key #'find-function-other-window))
+
+;;;###autoload
+(defun find-function-on-key-other-frame (key)
+  "Find, in the other frame, the function that KEY invokes.
+See `find-function-on-key'."
+  (interactive "kFind function on key: ")
+  (find-function-on-key-do-it key #'find-function-other-frame))
 
 ;;;###autoload
 (defun find-function-at-point ()
@@ -585,6 +646,8 @@ Set mark before moving, if the buffer already existed."
   (define-key ctl-x-4-map "F" 'find-function-other-window)
   (define-key ctl-x-5-map "F" 'find-function-other-frame)
   (define-key ctl-x-map "K" 'find-function-on-key)
+  (define-key ctl-x-4-map "K" 'find-function-on-key-other-window)
+  (define-key ctl-x-5-map "K" 'find-function-on-key-other-frame)
   (define-key ctl-x-map "V" 'find-variable)
   (define-key ctl-x-4-map "V" 'find-variable-other-window)
   (define-key ctl-x-5-map "V" 'find-variable-other-frame))