aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorStefan Monnier2022-04-01 10:02:32 -0400
committerStefan Monnier2022-04-01 10:02:32 -0400
commit6cb688684065ca74b14263fcc22036cededa2bbe (patch)
treeebf2606b01bc9d33d9542d71622710bbca3f88b2 /lisp
parent2b564f504bbf7c050355840b40a9897f12ed91f9 (diff)
downloademacs-6cb688684065ca74b14263fcc22036cededa2bbe.tar.gz
emacs-6cb688684065ca74b14263fcc22036cededa2bbe.zip
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`.
Diffstat (limited to 'lisp')
-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.
308 `(help-add-fundoc-usage ,doc ',args) 308 `(help-add-fundoc-usage ,doc ',args)
309 (help-add-fundoc-usage doc args))) 309 (help-add-fundoc-usage doc args)))
310 :autoload-end 310 :autoload-end
311 ,@(mapcar (lambda (method) `(cl-defmethod ,name ,@method)) 311 ,(when methods
312 (nreverse methods))) 312 `(with-suppressed-warnings ((obsolete ,name))
313 ,@(mapcar (lambda (method) `(cl-defmethod ,name ,@method))
314 (nreverse methods)))))
313 ,@(mapcar (lambda (declaration) 315 ,@(mapcar (lambda (declaration)
314 (let ((f (cdr (assq (car declaration) 316 (let ((f (cdr (assq (car declaration)
315 defun-declarations-alist)))) 317 defun-declarations-alist))))
@@ -552,8 +554,7 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
552 cl--generic-edebug-make-name nil] 554 cl--generic-edebug-make-name nil]
553 lambda-doc ; documentation string 555 lambda-doc ; documentation string
554 def-body))) ; part to be debugged 556 def-body))) ; part to be debugged
555 (let ((qualifiers nil) 557 (let ((qualifiers nil))
556 (orig-name name))
557 (while (cl-generic--method-qualifier-p args) 558 (while (cl-generic--method-qualifier-p args)
558 (push args qualifiers) 559 (push args qualifiers)
559 (setq args (pop body))) 560 (setq args (pop body)))
@@ -563,18 +564,15 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
563 (setq name (gv-setter (cadr name)))) 564 (setq name (gv-setter (cadr name))))
564 (pcase-let* ((`(,call-con . ,fun) (cl--generic-lambda args body))) 565 (pcase-let* ((`(,call-con . ,fun) (cl--generic-lambda args body)))
565 `(progn 566 `(progn
566 ,(and (get name 'byte-obsolete-info)
567 (let* ((obsolete (get name 'byte-obsolete-info)))
568 (macroexp-warn-and-return
569 (macroexp--obsolete-warning name obsolete "generic function")
570 nil (list 'obsolete name) nil orig-name)))
571 ;; You could argue that `defmethod' modifies rather than defines the 567 ;; You could argue that `defmethod' modifies rather than defines the
572 ;; function, so warnings like "not known to be defined" are fair game. 568 ;; function, so warnings like "not known to be defined" are fair game.
573 ;; But in practice, it's common to use `cl-defmethod' 569 ;; But in practice, it's common to use `cl-defmethod'
574 ;; without a previous `cl-defgeneric'. 570 ;; without a previous `cl-defgeneric'.
575 ;; The ",'" is a no-op that pacifies check-declare. 571 ;; The ",'" is a no-op that pacifies check-declare.
576 (,'declare-function ,name "") 572 (,'declare-function ,name "")
577 (cl-generic-define-method ',name ',(nreverse qualifiers) ',args 573 ;; We use #' to quote `name' so as to trigger an
574 ;; obsolescence warning when applicable.
575 (cl-generic-define-method #',name ',(nreverse qualifiers) ',args
578 ',call-con ,fun))))) 576 ',call-con ,fun)))))
579 577
580(defun cl--generic-member-method (specializers qualifiers methods) 578(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."
403 (setq count (+ 1 count)))) 403 (setq count (+ 1 count))))
404 count)) 404 count))
405 405
406(with-suppressed-warnings ((obsolete seq-contains)) 406(cl-defgeneric seq-contains (sequence elt &optional testfn)
407 (cl-defgeneric seq-contains (sequence elt &optional testfn) 407 "Return the first element in SEQUENCE that is equal to ELT.
408 "Return the first element in SEQUENCE that is equal to ELT.
409Equality is defined by TESTFN if non-nil or by `equal' if nil." 408Equality is defined by TESTFN if non-nil or by `equal' if nil."
410 (declare (obsolete seq-contains-p "27.1")) 409 (declare (obsolete seq-contains-p "27.1"))
411 (seq-some (lambda (e) 410 (seq-some (lambda (e)
412 (when (funcall (or testfn #'equal) elt e) 411 (when (funcall (or testfn #'equal) elt e)
413 e)) 412 e))
414 sequence))) 413 sequence))
415 414
416(cl-defgeneric seq-contains-p (sequence elt &optional testfn) 415(cl-defgeneric seq-contains-p (sequence elt &optional testfn)
417 "Return non-nil if SEQUENCE contains an element equal to ELT. 416 "Return non-nil if SEQUENCE contains an element equal to ELT.