1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-05 22:20:24 -08:00

cl-generic: Rework obsolescence checks for defmethod

* 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`.
This commit is contained in:
Stefan Monnier 2022-04-01 10:02:32 -04:00
parent 2b564f504b
commit 6cb6886840
2 changed files with 15 additions and 18 deletions

View 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)

View 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.