diff options
| author | Stefan Monnier | 2022-04-01 10:02:32 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2022-04-01 10:02:32 -0400 |
| commit | 6cb688684065ca74b14263fcc22036cededa2bbe (patch) | |
| tree | ebf2606b01bc9d33d9542d71622710bbca3f88b2 | |
| parent | 2b564f504bbf7c050355840b40a9897f12ed91f9 (diff) | |
| download | emacs-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`.
| -rw-r--r-- | lisp/emacs-lisp/cl-generic.el | 18 | ||||
| -rw-r--r-- | lisp/emacs-lisp/seq.el | 15 |
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. | ||
| 409 | Equality is defined by TESTFN if non-nil or by `equal' if nil." | 408 | Equality 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. |