]> git.eshelyaron.com Git - emacs.git/commitdiff
cl-generic: Rework obsolescence checks for defmethod
authorStefan Monnier <monnier@iro.umontreal.ca>
Fri, 1 Apr 2022 14:02:32 +0000 (10:02 -0400)
committerStefan Monnier <monnier@iro.umontreal.ca>
Fri, 1 Apr 2022 14:02:32 +0000 (10:02 -0400)
* lisp/emacs-lisp/cl-generic.el (cl-defgeneric): Silence obsolescence
warnings in the included methods.
(cl-defmethod): Reuse standard obsolescence checks.

* lisp/emacs-lisp/seq.el (seq-contains): Remove redundant
`with-suppressed-warnings`.

lisp/emacs-lisp/cl-generic.el
lisp/emacs-lisp/seq.el

index 32a5fe5e54b1590816ede4027afd98ae8b0845b4..1e820adaff6479c910a2358de8acd34b42b97b81 100644 (file)
@@ -308,8 +308,10 @@ DEFAULT-BODY, if present, is used as the body of a default method.
                   `(help-add-fundoc-usage ,doc ',args)
                 (help-add-fundoc-usage doc args)))
            :autoload-end
-           ,@(mapcar (lambda (method) `(cl-defmethod ,name ,@method))
-                     (nreverse methods)))
+           ,(when methods
+              `(with-suppressed-warnings ((obsolete ,name))
+                 ,@(mapcar (lambda (method) `(cl-defmethod ,name ,@method))
+                           (nreverse methods)))))
        ,@(mapcar (lambda (declaration)
                    (let ((f (cdr (assq (car declaration)
                                        defun-declarations-alist))))
@@ -552,8 +554,7 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
                     cl--generic-edebug-make-name nil]
              lambda-doc                 ; documentation string
              def-body)))                ; part to be debugged
-  (let ((qualifiers nil)
-        (orig-name name))
+  (let ((qualifiers nil))
     (while (cl-generic--method-qualifier-p args)
       (push args qualifiers)
       (setq args (pop body)))
@@ -563,18 +564,15 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
       (setq name (gv-setter (cadr name))))
     (pcase-let* ((`(,call-con . ,fun) (cl--generic-lambda args body)))
       `(progn
-         ,(and (get name 'byte-obsolete-info)
-               (let* ((obsolete (get name 'byte-obsolete-info)))
-                 (macroexp-warn-and-return
-                  (macroexp--obsolete-warning name obsolete "generic function")
-                  nil (list 'obsolete name) nil orig-name)))
          ;; You could argue that `defmethod' modifies rather than defines the
          ;; function, so warnings like "not known to be defined" are fair game.
          ;; But in practice, it's common to use `cl-defmethod'
          ;; without a previous `cl-defgeneric'.
          ;; The ",'" is a no-op that pacifies check-declare.
          (,'declare-function ,name "")
-         (cl-generic-define-method ',name ',(nreverse qualifiers) ',args
+         ;; We use #' to quote `name' so as to trigger an
+         ;; obsolescence warning when applicable.
+         (cl-generic-define-method #',name ',(nreverse qualifiers) ',args
                                    ',call-con ,fun)))))
 
 (defun cl--generic-member-method (specializers qualifiers methods)
index 1bcb844d8e9abef714d0a46e1a918f953639d42c..133d3c9e118abcbc2e0c4a83878ae49a87dc8bf2 100644 (file)
@@ -403,15 +403,14 @@ found or not."
         (setq count (+ 1 count))))
     count))
 
-(with-suppressed-warnings ((obsolete seq-contains))
-  (cl-defgeneric seq-contains (sequence elt &optional testfn)
-    "Return the first element in SEQUENCE that is equal to ELT.
+(cl-defgeneric seq-contains (sequence elt &optional testfn)
+  "Return the first element in SEQUENCE that is equal to ELT.
 Equality is defined by TESTFN if non-nil or by `equal' if nil."
-    (declare (obsolete seq-contains-p "27.1"))
-    (seq-some (lambda (e)
-                (when (funcall (or testfn #'equal) elt e)
-                  e))
-              sequence)))
+  (declare (obsolete seq-contains-p "27.1"))
+  (seq-some (lambda (e)
+              (when (funcall (or testfn #'equal) elt e)
+                e))
+            sequence))
 
 (cl-defgeneric seq-contains-p (sequence elt &optional testfn)
   "Return non-nil if SEQUENCE contains an element equal to ELT.