[Emacs-diffs] master b2225a3: * lisp/subr.el (method-files): Move function to cl-generic.el

[Stefan Monnier]

branch: master
commit b2225a374f24f1ee1a881bfd5d3c1f7b57447e47
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>

    * lisp/subr.el (method-files): Move function to cl-generic.el
    
    * lisp/emacs-lisp/cl-generic.el (cl-generic-p): New function.
    (cl--generic-method-files): New function, moved from subr.el.
    * lisp/emacs-lisp/edebug.el (edebug-instrument-function): Use them.
    * test/lisp/emacs-lisp/cl-generic-tests.el:
    * test/lisp/subr-tests.el: Move and adjust method-files tests accordingly.
---
 etc/NEWS                                 |  2 ++
 lisp/emacs-lisp/cl-generic.el            | 18 ++++++++++++++++++
 lisp/emacs-lisp/edebug.el                |  4 ++--
 lisp/subr.el                             | 19 -------------------
 test/lisp/emacs-lisp/cl-generic-tests.el | 24 ++++++++++++++++++++++++
 test/lisp/subr-tests.el                  | 25 -------------------------
 6 files changed, 46 insertions(+), 46 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index a7800fe..2b7c93f 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -604,6 +604,8 @@ paragraphs, for the purposes of bidirectional display.
 
 * Changes in Specialized Modes and Packages in Emacs 26.1
 
+** New function `cl-generic-p'.
+
 ** Dired
 
 +++
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 1144682..1a3f8e1 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -166,6 +166,10 @@ SPECIALIZERS-FUNCTION takes as first argument a tag value 
TAG
 (defmacro cl--generic (name)
   `(get ,name 'cl--generic))
 
+(defun cl-generic-p (f)
+  "Return non-nil if F is a generic function."
+  (and (symbolp f) (cl--generic f)))
+
 (defun cl-generic-ensure-function (name &optional noerror)
   (let (generic
         (origname name))
@@ -1023,6 +1027,20 @@ The value returned is a list of elements of the form
           (push (cl--generic-method-info method) docs))))
     docs))
 
+(defun cl--generic-method-files (method)
+  "Return a list of files where METHOD is defined by `cl-defmethod'.
+The list will have entries of the form (FILE . (METHOD ...))
+where (METHOD ...) contains the qualifiers and specializers of
+the method and is a suitable argument for
+`find-function-search-for-symbol'.  Filenames are absolute."
+  (let (result)
+    (pcase-dolist (`(,file . ,defs) load-history)
+      (dolist (def defs)
+        (when (and (eq (car-safe def) 'cl-defmethod)
+                   (eq (cadr def) method))
+          (push (cons file (cdr def)) result))))
+    result))
+
 ;;; Support for (head <val>) specializers.
 
 ;; For both the `eql' and the `head' specializers, the dispatch
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 1494ed1..c6ef8d7 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -3213,8 +3213,8 @@ instrument cannot be found, signal an error."
      ((consp func-marker)
       (message "%s is already instrumented." func)
       (list func))
-     ((get func 'cl--generic)
-      (let ((method-defs (method-files func))
+     ((cl-generic-p func)
+      (let ((method-defs (cl--generic-method-files func))
             symbols)
         (unless method-defs
           (error "Could not find any method definitions for %s" func))
diff --git a/lisp/subr.el b/lisp/subr.el
index 79a28d3..90a78cf 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2031,25 +2031,6 @@ definition, variable definition, or face definition 
only."
        (setq files (cdr files)))
       file)))
 
-(defun method-files (method)
-  "Return a list of files where METHOD is defined by `cl-defmethod'.
-The list will have entries of the form (FILE . (METHOD ...))
-where (METHOD ...) contains the qualifiers and specializers of
-the method and is a suitable argument for
-`find-function-search-for-symbol'.  Filenames are absolute."
-  (let ((files load-history)
-        result)
-    (while files
-      (let ((defs (cdr (car files))))
-        (while defs
-          (let ((def (car defs)))
-            (if (and (eq (car-safe def) 'cl-defmethod)
-                     (eq (cadr def) method))
-                (push (cons (car (car files)) (cdr def)) result)))
-          (setq defs (cdr defs))))
-      (setq files (cdr files)))
-    result))
-
 (defun locate-library (library &optional nosuffix path interactive-call)
   "Show the precise file name of Emacs library LIBRARY.
 LIBRARY should be a relative file name of the library, a string.
diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el 
b/test/lisp/emacs-lisp/cl-generic-tests.el
index 0768e31..31f6541 100644
--- a/test/lisp/emacs-lisp/cl-generic-tests.el
+++ b/test/lisp/emacs-lisp/cl-generic-tests.el
@@ -219,5 +219,29 @@
   (should (equal (cl--generic-1 '(5) nil) '("cinq" (5))))
   (should (equal (cl--generic-1 '(6) nil) '("six" a))))
 
+(cl-defgeneric cl-generic-tests--generic (x))
+(cl-defmethod cl-generic-tests--generic ((x string))
+  (message "%s is a string" x))
+(cl-defmethod cl-generic-tests--generic ((x integer))
+  (message "%s is a number" x))
+(cl-defgeneric cl-generic-tests--generic-without-methods (x y))
+(defvar cl-generic-tests--this-file
+  (file-truename (or load-file-name buffer-file-name)))
+
+(ert-deftest cl-generic-tests--method-files--finds-methods ()
+  "`method-files' returns a list of files and methods for a generic function."
+  (let ((retval (cl--generic-method-files 'cl-generic-tests--generic)))
+    (should (equal (length retval) 2))
+    (mapc (lambda (x)
+            (should (equal (car x) cl-generic-tests--this-file))
+            (should (equal (cadr x) 'cl-generic-tests--generic)))
+          retval)
+    (should-not (equal (nth 0 retval) (nth 1 retval)))))
+
+(ert-deftest cl-generic-tests--method-files--nonexistent-methods ()
+  "`method-files' returns nil if asked to find a method which doesn't exist."
+  (should-not (cl--generic-method-files 'cl-generic-tests--undefined-generic))
+  (should-not (cl--generic-method-files 
'cl-generic-tests--generic-without-methods)))
+
 (provide 'cl-generic-tests)
 ;;; cl-generic-tests.el ends here
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 7e50429..a59f0ca 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -292,31 +292,6 @@ cf. Bug#25477."
   (should-error (eval '(dolist "foo") t)
                 :type 'wrong-type-argument))
 
-(require 'cl-generic)
-(cl-defgeneric subr-tests--generic (x))
-(cl-defmethod subr-tests--generic ((x string))
-  (message "%s is a string" x))
-(cl-defmethod subr-tests--generic ((x integer))
-  (message "%s is a number" x))
-(cl-defgeneric subr-tests--generic-without-methods (x y))
-(defvar subr-tests--this-file
-  (file-truename (or load-file-name buffer-file-name)))
-
-(ert-deftest subr-tests--method-files--finds-methods ()
-  "`method-files' returns a list of files and methods for a generic function."
-  (let ((retval (method-files 'subr-tests--generic)))
-    (should (equal (length retval) 2))
-    (mapc (lambda (x)
-            (should (equal (car x) subr-tests--this-file))
-            (should (equal (cadr x) 'subr-tests--generic)))
-          retval)
-    (should-not (equal (nth 0 retval) (nth 1 retval)))))
-
-(ert-deftest subr-tests--method-files--nonexistent-methods ()
-  "`method-files' returns nil if asked to find a method which doesn't exist."
-  (should-not (method-files 'subr-tests--undefined-generic))
-  (should-not (method-files 'subr-tests--generic-without-methods)))
-
 (ert-deftest subr-tests-bug22027 ()
   "Test for http://debbugs.gnu.org/22027 ."
   (let ((default "foo") res)