From: Stephen Leake <stephen_leake@stephe-leake.org>
Date: Thu, 13 Aug 2015 17:54:39 +0000 (-0500)
Subject: xref-find-definitions: Exclude more generic function items.
X-Git-Tag: emacs-25.0.90~1373^2~46
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=0382fd42c6979bbedc9230b789503258a5e963eb;p=emacs.git

xref-find-definitions: Exclude more generic function items.

* lisp/emacs-lisp/cl-generic.el (cl--generic-search-method): Add doc string.
(cl--generic-find-defgeneric-regexp): New.
(find-function-regexp-alist): Add it.

* lisp/emacs-lisp/find-func.el (find-feature-regexp): Move here from
elisp-mode.el, change to search for ";;; Code:"
(find-alias-regexp): Move here from elisp-mode.el, cleaned up.
(find-function-regexp-alist): Add them.

* lisp/progmodes/elisp-mode.el:
(elisp--xref-format, elisp--xref-format-extra): Change back to defvar due
to bug#21237.
(elisp--xref-find-definitions): Exclude co-located default methods for
generic functions. Also exclude implicitly declared defgeneric.
(elisp--xref-find-definitions): Handle C source properly. Exclude minor
mode variables defined by 'define-minor-mode'.

* test/automated/elisp-mode-tests.el: Declare generic functions, add
tests for them.
(xref-elisp-test-run): Fix bug.
(emacs-test-dir): Improve initial value.
(find-defs-defun-defvar-el): Don't expect defvar.
(find-defs-feature-el): Match change to find-feature-regexp.
---

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 63cd9108410..a138697a18b 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -791,6 +791,8 @@ Can only be used from within the lexical body of a primary or around method."
 ;;; Add support for describe-function
 
 (defun cl--generic-search-method (met-name)
+  "For `find-function-regexp-alist'. Searches for a cl-defmethod.
+MET-NAME is a cons (SYMBOL . SPECIALIZERS)."
   (let ((base-re (concat "(\\(?:cl-\\)?defmethod[ \t]+"
                          (regexp-quote (format "%s" (car met-name)))
 			 "\\_>")))
@@ -806,11 +808,15 @@ Can only be used from within the lexical body of a primary or around method."
       nil t)
      (re-search-forward base-re nil t))))
 
+;; WORKAROUND: This can't be a defconst due to bug#21237.
+(defvar cl--generic-find-defgeneric-regexp "(\\(?:cl-\\)?defgeneric[ \t]+%s\\>")
 
 (with-eval-after-load 'find-func
   (defvar find-function-regexp-alist)
   (add-to-list 'find-function-regexp-alist
-               `(cl-defmethod . ,#'cl--generic-search-method)))
+               `(cl-defmethod . ,#'cl--generic-search-method))
+  (add-to-list 'find-function-regexp-alist
+               `(cl-defgeneric . cl--generic-find-defgeneric-regexp)))
 
 (defun cl--generic-method-info (method)
   (let* ((specializers (cl--generic-method-specializers method))
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index cd23cd77f4a..4dc0596de66 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -100,10 +100,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.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.
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 7ac5a5cb778..81314574672 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -604,40 +604,23 @@ It can be quoted, or be inside a quoted form."
     (`apropos
      (elisp--xref-find-apropos id))))
 
-(defconst elisp--xref-format
+;; WORKAROUND: This is nominally a constant, but the text properities
+;; are not preserved thru dump if use defconst. See bug#21237
+(defvar elisp--xref-format
   (let ((str "(%s %s)"))
     (put-text-property 1 3 'face 'font-lock-keyword-face str)
     (put-text-property 4 6 'face 'font-lock-function-name-face str)
     str))
 
-(defconst elisp--xref-format-extra
+;; WORKAROUND: This is nominally a constant, but the text properities
+;; are not preserved thru dump if use defconst. See bug#21237
+(defvar elisp--xref-format-extra
   (let ((str "(%s %s %s)"))
     (put-text-property 1 3 'face 'font-lock-keyword-face str)
     (put-text-property 4 6 'face 'font-lock-function-name-face str)
     str))
 
-(defcustom find-feature-regexp
-  (concat "(provide +'%s)")
-  "The regexp used by `xref-find-definitions' to search for a feature definition.
-Note it must contain a `%s' at the place where `format'
-should insert the feature name."
-  :type 'regexp
-  :group 'xref
-  :version "25.0")
-
-(defcustom find-alias-regexp
-  "(\\(defalias +'\\|def\\(const\\|face\\) +\\)%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")
-
-(with-eval-after-load 'find-func
-  (defvar find-function-regexp-alist)
-  (add-to-list 'find-function-regexp-alist (cons 'feature 'find-feature-regexp))
-  (add-to-list 'find-function-regexp-alist (cons 'defalias 'find-alias-regexp)))
+(defvar find-feature-regexp)
 
 (defun elisp--xref-make-xref (type symbol file &optional summary)
   "Return an xref for TYPE SYMBOL in FILE.
@@ -683,9 +666,10 @@ otherwise build the summary from TYPE and SYMBOL."
 	(when file
 	  (cond
 	   ((eq file 'C-source)
-            ;; First call to find-lisp-object-file-name (for this
-            ;; symbol?); C-source has not been cached yet.
-            ;; Second call will return "src/*.c" in file; handled by 't' case below.
+            ;; First call to find-lisp-object-file-name for an object
+            ;; defined in C; the doc strings from the C source have
+            ;; not been loaded yet.  Second call will return "src/*.c"
+            ;; in file; handled by 't' case below.
 	    (push (elisp--xref-make-xref nil symbol (help-C-file-name (symbol-function symbol) 'subr)) xrefs))
 
            ((and (setq doc (documentation symbol t))
@@ -704,17 +688,42 @@ otherwise build the summary from TYPE and SYMBOL."
               ))
 
 	   ((setq generic (cl--generic symbol))
+            ;; A generic function. If there is a default method, it
+            ;; will appear in the method table, with no
+            ;; specializers.
+            ;;
+            ;; If the default method is declared by the cl-defgeneric
+            ;; declaration, it will have the same location as teh
+            ;; cl-defgeneric, so we want to exclude it from the
+            ;; result. In this case, it will have a null doc
+            ;; string. User declarations of default methods may also
+            ;; have null doc strings, but we hope that is
+            ;; rare. Perhaps this hueristic will discourage that.
 	    (dolist (method (cl--generic-method-table generic))
-	      (let* ((info (cl--generic-method-info method))
-		     (met-name (cons symbol (cl--generic-method-specializers method)))
-		     (descr (format elisp--xref-format-extra 'cl-defmethod symbol (nth 1 info)))
+	      (let* ((info (cl--generic-method-info method));; qual-string combined-args doconly
+                     (specializers (cl--generic-method-specializers method))
+		     (met-name (cons symbol specializers))
 		     (file (find-lisp-object-file-name met-name 'cl-defmethod)))
-		(when file
-		  (push (elisp--xref-make-xref 'cl-defmethod met-name file descr) xrefs))
+		(when (and file
+                           (or specializers   ;; default method has null specializers
+                               (nth 2 info))) ;; assuming only co-located default has null doc string
+                  (if specializers
+                      (let ((summary (format elisp--xref-format-extra 'cl-defmethod symbol (nth 1 info))))
+                        (push (elisp--xref-make-xref 'cl-defmethod met-name file summary) xrefs))
+
+                    (let ((summary (format elisp--xref-format-extra 'cl-defmethod symbol "()")))
+                      (push (elisp--xref-make-xref 'cl-defmethod met-name file summary) xrefs))))
 		))
 
-	    (let ((descr (format elisp--xref-format 'cl-defgeneric symbol)))
-	      (push (elisp--xref-make-xref nil symbol file descr) xrefs))
+            (if (and (setq doc (documentation symbol t))
+                     ;; This doc string is created somewhere in
+                     ;; cl--generic-make-function for an implicit
+                     ;; defgeneric.
+                     (string-match "\n\n(fn ARG &rest ARGS)" doc))
+                ;; This symbol is an implicitly defined defgeneric, so
+                ;; don't return it.
+                nil
+              (push (elisp--xref-make-xref 'cl-defgeneric symbol file) xrefs))
 	    )
 
 	   (t
@@ -722,11 +731,43 @@ otherwise build the summary from TYPE and SYMBOL."
 	   ))))
 
     (when (boundp symbol)
+      ;; A variable
       (let ((file (find-lisp-object-file-name symbol 'defvar)))
 	(when file
-	  (when (eq file 'C-source)
-	    (setq file (help-C-file-name symbol 'var)))
-	  (push (elisp--xref-make-xref 'defvar symbol file) xrefs))))
+          (cond
+           ((eq file 'C-source)
+            ;; The doc strings from the C source have not been loaded
+            ;; yet; help-C-file-name does that.  Second call will
+            ;; return "src/*.c" in file; handled below.
+            (push (elisp--xref-make-xref 'defvar symbol (help-C-file-name symbol 'var)) xrefs))
+
+           ((string= "src/" (substring file 0 4))
+            ;; The variable is defined in a C source file; don't check
+            ;; for define-minor-mode.
+            (push (elisp--xref-make-xref 'defvar symbol file) xrefs))
+
+           ((memq symbol minor-mode-list)
+            ;; The symbol is a minor mode. These should be defined by
+            ;; "define-minor-mode", which means the variable and the
+            ;; function are declared in the same place. So we return only
+            ;; the function, arbitrarily.
+            ;;
+            ;; There is an exception, when the variable is defined in C
+            ;; code, as for abbrev-mode.
+            ;;
+            ;; IMPROVEME: If the user is searching for the identifier at
+            ;; point, we can determine whether it is a variable or
+            ;; function by looking at the source code near point.
+            ;;
+            ;; IMPROVEME: The user may actually be asking "do any
+            ;; variables by this name exist"; we need a way to specify
+            ;; that.
+            nil)
+
+           (t
+            (push (elisp--xref-make-xref 'defvar symbol file) xrefs))
+
+           ))))
 
     (when (featurep symbol)
       (let ((file (ignore-errors
diff --git a/test/automated/elisp-mode-tests.el b/test/automated/elisp-mode-tests.el
index 9b4014a8a55..47212e919c6 100644
--- a/test/automated/elisp-mode-tests.el
+++ b/test/automated/elisp-mode-tests.el
@@ -177,8 +177,8 @@
 
 
 (defun xref-elisp-test-run (xrefs expecteds)
+  (should (= (length xrefs) (length expecteds)))
   (while xrefs
-    (should (= (length xrefs) (length expecteds)))
     (let ((xref (pop xrefs))
           (expected (pop expecteds)))
 
@@ -204,8 +204,9 @@ to (xref-elisp-test-descr-to-target xref)."
 
 ;; When tests are run from the Makefile, 'default-directory' is $HOME,
 ;; so we must provide this dir to expand-file-name in the expected
-;; results. The Makefile sets EMACS_TEST_DIRECTORY.
-(defconst emacs-test-dir (getenv "EMACS_TEST_DIRECTORY"))
+;; results. This also allows running these tests from other
+;; directories.
+(defconst emacs-test-dir (file-name-directory (or load-file-name (buffer-file-name))))
 
 ;; alphabetical by test name
 
@@ -244,12 +245,144 @@ to (xref-elisp-test-descr-to-target xref)."
 
 ;; FIXME: defconst
 
+;; FIXME: eieio defclass
+
+;; Possible ways of defining the default method implementation for a
+;; generic function. We declare these here, so we know we cover all
+;; cases, and we don't rely on other code not changing.
+;;
+;; When the generic and default method are declared in the same place,
+;; elisp--xref-find-definitions only returns one.
+
+(cl-defstruct (xref-elisp-root-type)
+  slot-1)
+
+(cl-defgeneric xref-elisp-generic-no-methods ()
+  "doc string no-methods"
+  ;; No default implementation, no methods, but fboundp is true for
+  ;; this symbol; it calls cl-no-applicable-method
+  )
+
+(cl-defmethod xref-elisp-generic-no-default ((this xref-elisp-root-type))
+  "doc string no-default xref-elisp-root-type"
+  "non-default for no-default")
+
+;; defgeneric after defmethod in file to ensure the fallback search
+;; method of just looking for the function name will fail.
+(cl-defgeneric xref-elisp-generic-no-default ()
+  "doc string no-default generic"
+  ;; No default implementation; this function calls the cl-generic
+  ;; dispatching code.
+  )
+
+(cl-defgeneric xref-elisp-generic-co-located-default ()
+  "doc string co-located-default generic"
+  "co-located default")
+
+(cl-defmethod xref-elisp-generic-co-located-default ((this xref-elisp-root-type))
+  "doc string co-located-default xref-elisp-root-type"
+  "non-default for co-located-default")
+
+(cl-defgeneric xref-elisp-generic-separate-default ()
+  "doc string separate-default generic"
+  ;; default implementation provided separately
+  )
+
+(cl-defmethod xref-elisp-generic-separate-default ()
+  "doc string separate-default default"
+  "separate default")
+
+(cl-defmethod xref-elisp-generic-separate-default ((this xref-elisp-root-type))
+  "doc string separate-default xref-elisp-root-type"
+  "non-default for separate-default")
+
+(cl-defmethod xref-elisp-generic-implicit-generic ()
+  "doc string implict-generic default"
+  "default for implicit generic")
+
+(cl-defmethod xref-elisp-generic-implicit-generic ((this xref-elisp-root-type))
+  "doc string implict-generic xref-elisp-root-type"
+  "non-default for implicit generic")
+
+
+(xref-elisp-deftest find-defs-defgeneric-no-methods
+  (elisp--xref-find-definitions 'xref-elisp-generic-no-methods)
+  (list
+   (xref-make "(cl-defgeneric xref-elisp-generic-no-methods)"
+	      (xref-make-elisp-location
+	       'xref-elisp-generic-no-methods 'cl-defgeneric
+	       (expand-file-name "elisp-mode-tests.el" emacs-test-dir)))
+   ))
+
+(xref-elisp-deftest find-defs-defgeneric-no-default
+  (elisp--xref-find-definitions 'xref-elisp-generic-no-default)
+  (list
+   (xref-make "(cl-defgeneric xref-elisp-generic-no-default)"
+	      (xref-make-elisp-location
+	       'xref-elisp-generic-no-default 'cl-defgeneric
+	       (expand-file-name "elisp-mode-tests.el" emacs-test-dir)))
+   (xref-make "(cl-defmethod xref-elisp-generic-no-default ((this xref-elisp-root-type)))"
+	      (xref-make-elisp-location
+	       '(xref-elisp-generic-no-default xref-elisp-root-type) 'cl-defmethod
+	       (expand-file-name "elisp-mode-tests.el" emacs-test-dir)))
+   ))
+
+(xref-elisp-deftest find-defs-defgeneric-co-located-default
+  (elisp--xref-find-definitions 'xref-elisp-generic-co-located-default)
+  (list
+   (xref-make "(cl-defgeneric xref-elisp-generic-co-located-default)"
+	      (xref-make-elisp-location
+	       'xref-elisp-generic-co-located-default 'cl-defgeneric
+	       (expand-file-name "elisp-mode-tests.el" emacs-test-dir)))
+   (xref-make "(cl-defmethod xref-elisp-generic-co-located-default ((this xref-elisp-root-type)))"
+	      (xref-make-elisp-location
+	       '(xref-elisp-generic-co-located-default xref-elisp-root-type) 'cl-defmethod
+	       (expand-file-name "elisp-mode-tests.el" emacs-test-dir)))
+   ))
+
+(xref-elisp-deftest find-defs-defgeneric-separate-default
+  (elisp--xref-find-definitions 'xref-elisp-generic-separate-default)
+  (list
+   (xref-make "(cl-defgeneric xref-elisp-generic-separate-default)"
+	      (xref-make-elisp-location
+	       'xref-elisp-generic-separate-default 'cl-defgeneric
+	       (expand-file-name "elisp-mode-tests.el" emacs-test-dir)))
+   (xref-make "(cl-defmethod xref-elisp-generic-separate-default ())"
+              (xref-make-elisp-location
+               '(xref-elisp-generic-separate-default) 'cl-defmethod
+               (expand-file-name "elisp-mode-tests.el" emacs-test-dir)))
+
+   (xref-make "(cl-defmethod xref-elisp-generic-separate-default ((this xref-elisp-root-type)))"
+	      (xref-make-elisp-location
+	       '(xref-elisp-generic-separate-default xref-elisp-root-type) 'cl-defmethod
+	       (expand-file-name "elisp-mode-tests.el" emacs-test-dir)))
+   ))
+
+(xref-elisp-deftest find-defs-defgeneric-implicit-generic
+  (elisp--xref-find-definitions 'xref-elisp-generic-implicit-generic)
+  (list
+   (xref-make "(cl-defmethod xref-elisp-generic-implicit-generic ())"
+	      (xref-make-elisp-location
+	       '(xref-elisp-generic-implicit-generic) 'cl-defmethod
+	       (expand-file-name "elisp-mode-tests.el" emacs-test-dir)))
+   (xref-make "(cl-defmethod xref-elisp-generic-implicit-generic ((this xref-elisp-root-type)))"
+	      (xref-make-elisp-location
+	       '(xref-elisp-generic-implicit-generic xref-elisp-root-type) 'cl-defmethod
+	       (expand-file-name "elisp-mode-tests.el" emacs-test-dir)))
+   ))
+
+;; Test that we handle more than one method
+
+;; When run from the Makefile, etags is not loaded at compile time,
+;; but it is by the time this test is run.  interactively; don't fail
+;; for that.
+(require 'etags)
 (xref-elisp-deftest find-defs-defgeneric-el
   (elisp--xref-find-definitions 'xref-location-marker)
   (list
    (xref-make "(cl-defgeneric xref-location-marker)"
 	      (xref-make-elisp-location
-	       'xref-location-marker nil
+	       'xref-location-marker 'cl-defgeneric
 	       (expand-file-name "../../lisp/progmodes/xref.el" emacs-test-dir)))
    (xref-make "(cl-defmethod xref-location-marker ((l xref-elisp-location)))"
 	      (xref-make-elisp-location
@@ -267,7 +400,10 @@ to (xref-elisp-test-descr-to-target xref)."
 	      (xref-make-elisp-location
 	       '(xref-location-marker xref-bogus-location) 'cl-defmethod
 	       (expand-file-name "../../lisp/progmodes/xref.el" emacs-test-dir)))
-   ;; etags is not loaded at test time
+   (xref-make "(cl-defmethod xref-location-marker ((l xref-etags-location)))"
+              (xref-make-elisp-location
+               '(xref-location-marker xref-etags-location) 'cl-defmethod
+               (expand-file-name "../../lisp/progmodes/etags.el" emacs-test-dir)))
    ))
 
 (xref-elisp-deftest find-defs-defgeneric-eval
@@ -318,19 +454,18 @@ to (xref-elisp-test-descr-to-target xref)."
   )
 
 ;; Source for both variable and defun is "(define-minor-mode
-;; compilation-minor-mode". There is no way to tell that from the
-;; symbol.  find-function-regexp-alist uses find-function-regexp for
-;; this, but that matches too many things for use in this test.
+;; compilation-minor-mode". There is no way to tell that directly from
+;; the symbol, but we can use (memq sym minor-mode-list) to detect
+;; that the symbol is a minor mode. See `elisp--xref-find-definitions'
+;; for more comments.
+;;
+;; IMPROVEME: return defvar instead of defun if source near starting
+;; point indicates the user is searching for a varible, not a
+;; function.
 (require 'compile) ;; not loaded by default at test time
 (xref-elisp-deftest find-defs-defun-defvar-el
   (elisp--xref-find-definitions 'compilation-minor-mode)
   (list
-   (cons
-    (xref-make "(defvar compilation-minor-mode)"
-	      (xref-make-elisp-location
-	       'compilation-minor-mode 'defvar
-	       (expand-file-name "../../lisp/progmodes/compile.el" emacs-test-dir)))
-    "(define-minor-mode compilation-minor-mode")
    (cons
     (xref-make "(defun compilation-minor-mode)"
                (xref-make-elisp-location
@@ -382,10 +517,13 @@ to (xref-elisp-test-descr-to-target xref)."
 (xref-elisp-deftest find-defs-feature-el
   (elisp--xref-find-definitions 'xref)
   (list
-   (xref-make "(feature xref)"
+   (cons
+    (xref-make "(feature xref)"
 	      (xref-make-elisp-location
 	       'xref 'feature
-	       (expand-file-name "../../lisp/progmodes/xref.el" emacs-test-dir)))))
+	       (expand-file-name "../../lisp/progmodes/xref.el" emacs-test-dir)))
+    ";;; Code:")
+   ))
 
 (xref-elisp-deftest find-defs-feature-eval
   (elisp--xref-find-definitions (eval '(provide 'stephe-leake-feature)))