X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/821b6002127fba1e5b57d39e63eabd0ae189f6af..25cc0f2aada3e321e5f1c6d1e492a93d16da45b2:/lisp/emacs-lisp/find-func.el

diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index 7ea13d4637..4a7b710910 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -1,6 +1,6 @@
 ;;; find-func.el --- find the definition of the Emacs Lisp function near point  -*- lexical-binding:t -*-
 
-;; Copyright (C) 1997, 1999, 2001-2015 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
@@ -43,6 +43,8 @@
 
 ;;; Code:
 
+(require 'seq)
+
 ;;; User variables:
 
 (defgroup find-function nil
@@ -62,7 +64,7 @@ ine\\(?:-global\\)?-minor-mode\\|ine-compilation-mode\\|un-cvs-mode\\|\
 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,10 +102,34 @@ 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.1")
+
+(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.1")
+
 (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.
@@ -158,15 +184,15 @@ See the functions `find-function' and `find-variable'."
 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)))
+  (when (string-match "\\.el\\(c\\(\\..*\\)?\\)\\'" library)
+    (setq library (replace-match "" t t library)))
   (or
    (locate-file library
-		(or find-function-source-path load-path)
-		(find-library-suffixes))
+                (or find-function-source-path load-path)
+                (find-library-suffixes))
    (locate-file library
-		(or find-function-source-path load-path)
-		load-file-rep-suffixes)
+                (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
@@ -177,8 +203,44 @@ LIBRARY should be a string (the name of the library)."
           (locate-file rel
                        (or find-function-source-path load-path)
                        load-file-rep-suffixes)))))
+   (find-library--from-load-path library)
    (error "Can't find library %s" library)))
 
+(defun find-library--from-load-path (library)
+  ;; In `load-history', the file may be ".elc", ".el", ".el.gz", and
+  ;; LIBRARY may be "foo.el" or "foo", so make sure that we get all
+  ;; potential matches, and then see whether any of them lead us to an
+  ;; ".el" or an ".el.gz" file.
+  (let* ((elc-regexp "\\.el\\(c\\(\\..*\\)?\\)\\'")
+         (suffix-regexp
+          (concat "\\("
+                  (mapconcat 'regexp-quote (find-library-suffixes) "\\'\\|")
+                  "\\|" elc-regexp "\\)\\'"))
+         (potentials
+          (mapcar
+           (lambda (entry)
+             (if (string-match suffix-regexp (car entry))
+                 (replace-match "" t t (car entry))
+               (car entry)))
+           (seq-filter
+            (lambda (entry)
+              (string-match
+               (concat "\\`"
+                       (regexp-quote
+                        (replace-regexp-in-string suffix-regexp "" library))
+                       suffix-regexp)
+               (file-name-nondirectory (car entry))))
+            load-history)))
+         result)
+    (dolist (file potentials)
+      (dolist (suffix (find-library-suffixes))
+        (when (not result)
+          (cond ((file-exists-p file)
+                 (setq result file))
+                ((file-exists-p (concat file suffix))
+                 (setq result (concat file suffix)))))))
+    result))
+
 (defvar find-function-C-source-directory
   (let ((dir (expand-file-name "src" source-directory)))
     (if (file-accessible-directory-p dir) dir))
@@ -189,12 +251,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)
@@ -228,9 +293,12 @@ TYPE should be nil to find a function, or `defvar' to find a variable."
     (cons (current-buffer) (match-beginning 0))))
 
 ;;;###autoload
-(defun find-library (library)
+(defun find-library (library &optional other-window)
   "Find the Emacs Lisp source of LIBRARY.
-LIBRARY should be a string (the name of the library)."
+LIBRARY should be a string (the name of the library).  If the
+optional OTHER-WINDOW argument (i.e., the command argument) is
+specified, pop to a different window before displaying the
+buffer."
   (interactive
    (let* ((dirs (or find-function-source-path load-path))
           (suffixes (find-library-suffixes))
@@ -252,11 +320,17 @@ LIBRARY should be a string (the name of the library)."
      (when (and def (not (test-completion def table)))
        (setq def nil))
      (list
-      (completing-read (if def (format "Library name (default %s): " def)
+      (completing-read (if def
+                           (format "Library name (default %s): " def)
 			 "Library name: ")
-		       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)))))
+		       table nil nil nil nil def)
+      current-prefix-arg)))
+  (prog1
+      (funcall (if other-window
+                   'pop-to-buffer
+                 'pop-to-buffer-same-window)
+               (find-file-noselect (find-library-name library)))
+    (run-hooks 'find-function-after-hook)))
 
 ;;;###autoload
 (defun find-function-search-for-symbol (symbol type library)
@@ -330,8 +404,10 @@ signal an error.
 
 If VERBOSE is non-nil, and FUNCTION is an alias, display a
 message about the whole chain of aliases."
-  (let ((def (if (symbolp function)
-                 (symbol-function (find-function-advised-original function))))
+  (let ((def (when (symbolp function)
+               (or (fboundp function)
+                   (signal 'void-function (list 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).
@@ -340,12 +416,13 @@ message about the whole chain of aliases."
           (not verbose)
           (setq aliases (if aliases
                             (concat aliases
-                                    (format ", which is an alias for `%s'"
-                                            (symbol-name def)))
-                          (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))))
+                                    (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
@@ -547,11 +624,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.
@@ -572,7 +649,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 ()
@@ -597,6 +695,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))