summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorStefan Monnier <monnier@iro.umontreal.ca>2022-04-01 10:02:32 -0400
committerStefan Monnier <monnier@iro.umontreal.ca>2022-04-01 10:02:32 -0400
commit6cb688684065ca74b14263fcc22036cededa2bbe (patch)
treeebf2606b01bc9d33d9542d71622710bbca3f88b2
parent2b564f504bbf7c050355840b40a9897f12ed91f9 (diff)
downloademacs-6cb688684065ca74b14263fcc22036cededa2bbe.tar.gz
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`.
-rw-r--r--lisp/emacs-lisp/cl-generic.el18
-rw-r--r--lisp/emacs-lisp/seq.el15
2 files changed, 15 insertions, 18 deletions
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 32a5fe5e54b..1e820adaff6 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -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)
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index 1bcb844d8e9..133d3c9e118 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -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.