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

(cl-defstruct): Improve handling of unknown options

Until now `cl-defstruct` signaled an error when encountering an
unknown option.  It's easy to code and it does the job, but it
doesn't give good location info in the compiler's output,
and it makes it more painful to use not-yet-supported options.
So just signal a warning instead.

* lisp/emacs-lisp/cl-macs.el (cl-defstruct): Warn about unknown
options, instead of signaling an error.
This commit is contained in:
Stefan Monnier 2024-04-16 21:17:47 -04:00
parent 2141caca30
commit 484b097909

View file

@ -3010,6 +3010,7 @@ To see the documentation for a defined struct type, use
;; All the above is for the following def-form. ;; All the above is for the following def-form.
&rest &or symbolp (symbolp &optional def-form &rest sexp)))) &rest &or symbolp (symbolp &optional def-form &rest sexp))))
(let* ((name (if (consp struct) (car struct) struct)) (let* ((name (if (consp struct) (car struct) struct))
(warning nil)
(opts (cdr-safe struct)) (opts (cdr-safe struct))
(slots nil) (slots nil)
(defaults nil) (defaults nil)
@ -3094,7 +3095,10 @@ To see the documentation for a defined struct type, use
(setq descs (nconc (make-list (car args) '(cl-skip-slot)) (setq descs (nconc (make-list (car args) '(cl-skip-slot))
descs))) descs)))
(t (t
(error "Structure option %s unrecognized" opt))))) (setq warning
(macroexp-warn-and-return
(format "Structure option %S unrecognized" opt)
warning nil nil (list opt struct)))))))
(unless (or include-name type (unless (or include-name type
;; Don't create a bogus parent to `cl-structure-object' ;; Don't create a bogus parent to `cl-structure-object'
;; while compiling the (cl-defstruct cl-structure-object ..) ;; while compiling the (cl-defstruct cl-structure-object ..)
@ -3333,6 +3337,7 @@ To see the documentation for a defined struct type, use
(cl-struct-define ',name ,docstring ',include-name (cl-struct-define ',name ,docstring ',include-name
',(or type 'record) ,(eq named t) ',descs ',(or type 'record) ,(eq named t) ',descs
',tag-symbol ',tag ',print-auto)) ',tag-symbol ',tag ',print-auto))
,warning
',name))) ',name)))
;;; Add cl-struct support to pcase ;;; Add cl-struct support to pcase