]> 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 3131be09eb1c0925e0bb921eba7e2430fedb858d..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,30 +312,33 @@ 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)))
@@ -324,21 +357,23 @@ 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))
     (cons function
@@ -408,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)))
@@ -541,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.
@@ -566,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 ()
@@ -591,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))