[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#53618: 29.0.50; macroexp-warn-and-return incompatible change
|
From: |
Stefan Monnier |
|
Subject: |
bug#53618: 29.0.50; macroexp-warn-and-return incompatible change |
|
Date: |
Fri, 28 Jan 2022 19:37:01 -0500 |
Package: Emacs
Version: 29.0.50
Alan's symbols-with-pos has introduced a backward incompatible change to
`macroexp-warn-and-return` by adding a new *first* argument `arg`.
The patch below changes that so the new argument comes last (and is
optional). Alan argued it's preferable for this arg to come first and
the function was new in Emacs-28 so it's OK to break compatibility.
The patch below shows that indeed the arg is almost always
desirable/needed to get the right position information (the default
behavior when the arg is absent is not as good), so it's kind of pain
having it as last arg. And I'm not super happy with the long list of
args of this function.
But these arguments don't seem strong enough to justify
breaking compatibility, hence the patch below.
Any objection?
Stefan
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 04c5b9f080..c6d64975ec 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -804,7 +804,6 @@ bindat--type
(if (or (eq label '_) (not (assq label labels)))
code
(macroexp-warn-and-return
- code
(format "Duplicate label: %S" label)
code))))
(`(,_ ,val)
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index fedc10cea4..159832c536 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -334,11 +334,10 @@ 'defmacro
(let ((f (cdr (assq (car x) macro-declarations-alist))))
(if f (apply (car f) name arglist (cdr x))
(macroexp-warn-and-return
- (car x)
(format-message
"Unknown macro property %S in %S"
(car x) name)
- nil))))
+ nil nil nil (car x)))))
decls)))
;; Refresh font-lock if this is a new macro, or it is an
;; existing macro whose 'no-font-lock-keyword declaration
@@ -408,10 +407,9 @@ defun
nil)
(t
(macroexp-warn-and-return
- (car x)
(format-message "Unknown defun property `%S' in %S"
(car x) name)
- nil)))))
+ nil nil nil (car x))))))
decls))
(def (list 'defalias
(list 'quote name)
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 5e0e0834ff..b44dda6f9d 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -499,7 +499,7 @@ cl-defmethod
lambda-doc ; documentation string
def-body))) ; part to be debugged
(let ((qualifiers nil)
- (org-name name))
+ (orig-name name))
(while (cl-generic--method-qualifier-p args)
(push args qualifiers)
(setq args (pop body)))
@@ -514,9 +514,8 @@ cl-defmethod
(byte-compile-warning-enabled-p 'obsolete name))
(let* ((obsolete (get name 'byte-obsolete-info)))
(macroexp-warn-and-return
- org-name
(macroexp--obsolete-warning name obsolete "generic function")
- nil)))
+ nil nil 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'
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 470168177c..5085217250 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2431,10 +2431,9 @@ cl-symbol-macrolet
(if malformed-bindings
(let ((rev-malformed-bindings (nreverse malformed-bindings)))
(macroexp-warn-and-return
- rev-malformed-bindings
(format-message "Malformed `cl-symbol-macrolet' binding(s):
%S"
rev-malformed-bindings)
- expansion))
+ expansion nil nil rev-malformed-bindings))
expansion)))
(unless advised
(advice-remove 'macroexpand #'cl--sm-macroexpand)))))
@@ -3118,20 +3117,18 @@ cl-defstruct
(when (cl-oddp (length desc))
(push
(macroexp-warn-and-return
- (car (last desc))
(format "Missing value for option `%S' of slot `%s' in
struct %s!"
(car (last desc)) slot name)
- 'nil)
+ nil nil nil (car (last desc)))
forms)
(when (and (keywordp (car defaults))
(not (keywordp (car desc))))
(let ((kw (car defaults)))
(push
(macroexp-warn-and-return
- kw
(format " I'll take `%s' to be an option rather than a
default value."
kw)
- 'nil)
+ nil nil nil kw)
forms)
(push kw desc)
(setcar defaults nil))))
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index 7bcb2f2936..688c76e0c5 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -230,7 +230,6 @@ define-minor-mode
(warnwrap (if (or (null body) (keywordp (car body))) #'identity
(lambda (exp)
(macroexp-warn-and-return
- exp
"Use keywords rather than deprecated positional
arguments to `define-minor-mode'"
exp))))
keyw keymap-sym tmp)
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index 33aabf4a48..e063aaec37 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -748,9 +748,8 @@ eieio-oref
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-slot-names))))
(macroexp-warn-and-return
- name
(format-message "Unknown slot `%S'" name)
- exp nil 'compile-only))
+ exp nil 'compile-only name))
(_ exp))))
(gv-setter eieio-oset))
(cl-check-type slot symbol)
@@ -785,15 +784,13 @@ eieio-oref-default
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-slot-names))))
(macroexp-warn-and-return
- name
(format-message "Unknown slot `%S'" name)
- exp nil 'compile-only))
+ exp nil 'compile-only name))
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-class-slot-names))))
(macroexp-warn-and-return
- name
(format-message "Slot `%S' is not class-allocated" name)
- exp nil 'compile-only))
+ exp nil 'compile-only name))
(_ exp)))))
(cl-check-type class (or eieio-object class))
(cl-check-type slot symbol)
@@ -849,15 +846,13 @@ eieio-oset-default
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-slot-names))))
(macroexp-warn-and-return
- name
(format-message "Unknown slot `%S'" name)
- exp nil 'compile-only))
+ exp nil 'compile-only name))
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-class-slot-names))))
(macroexp-warn-and-return
- name
(format-message "Slot `%S' is not class-allocated" name)
- exp nil 'compile-only))
+ exp nil 'compile-only name))
(_ exp)))))
(setq class (eieio--class-object class))
(cl-check-type class eieio--class)
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 820e8383d8..ee41c45d44 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -246,7 +246,7 @@ defclass
`(progn
,@(mapcar (lambda (w)
(macroexp-warn-and-return
- (car w) (cdr w) `(progn ',(cdr w)) nil 'compile-only))
+ (cdr w) `(progn ',(cdr w)) nil 'compile-only (car w)))
warnings)
;; This test must be created right away so we can have self-
;; referencing classes. ei, a class whose slot can contain only
@@ -296,13 +296,13 @@ defclass
(if (not (stringp (car slots)))
whole
(macroexp-warn-and-return
- (car slots)
(format "Obsolete name arg %S to constructor %S"
(car slots) (car whole))
;; Keep the name arg, for backward compatibility,
;; but hide it so we don't trigger indefinitely.
`(,(car whole) (identity ,(car slots))
- ,@(cdr slots)))))))
+ ,@(cdr slots))
+ nil nil (car slots))))))
(apply #'make-instance ',name slots))))))
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index 91538d1f06..7cfa1f2dad 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -581,9 +581,7 @@ gv-ref
Note: this only works reliably with lexical binding mode, except for very
simple PLACEs such as (symbol-function \\='foo) which will also work in dynamic
binding mode."
- (let ((org-place place) ; It's too difficult to determine by inspection
whether
- ; the functions modify place.
- (code
+ (let ((code
(gv-letplace (getter setter) place
`(cons (lambda () ,getter)
(lambda (gv--val) ,(funcall setter 'gv--val))))))
@@ -595,9 +593,8 @@ gv-ref
(eq (car-safe code) 'cons))
code
(macroexp-warn-and-return
- org-place
"Use of gv-ref probably requires lexical-binding"
- code))))
+ code nil nil place))))
(defsubst gv-deref (ref)
"Dereference REF, returning the referenced value.
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 256092599b..e91b302af1 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -160,14 +160,14 @@ macroexp--warn-wrap
(define-obsolete-function-alias 'macroexp--warn-and-return
#'macroexp-warn-and-return "28.1")
-(defun macroexp-warn-and-return (arg msg form &optional category compile-only)
+(defun macroexp-warn-and-return (msg form &optional category compile-only arg)
"Return code equivalent to FORM labeled with warning MSG.
-ARG is a symbol (or a form) giving the source code position of FORM
-for the message. It should normally be a symbol with position.
CATEGORY is the category of the warning, like the categories that
can appear in `byte-compile-warnings'.
COMPILE-ONLY non-nil means no warning should be emitted if the code
-is executed without being compiled first."
+is executed without being compiled first.
+ARG is a symbol (or a form) giving the source code position for the message.
+It should normally be a symbol with position and it defaults to FORM."
(cond
((null msg) form)
((macroexp-compiling-p)
@@ -177,7 +177,7 @@ macroexp-warn-and-return
;; macroexpand-all gets right back to macroexpanding `form'.
form
(puthash form form macroexp--warned)
- (macroexp--warn-wrap arg msg form category)))
+ (macroexp--warn-wrap (or arg form) msg form category)))
(t
(unless compile-only
(message "%sWarning: %s"
@@ -233,12 +233,11 @@ macroexp-macroexpand
(let* ((fun (car form))
(obsolete (get fun 'byte-obsolete-info)))
(macroexp-warn-and-return
- fun
(macroexp--obsolete-warning
fun obsolete
(if (symbolp (symbol-function fun))
"alias" "macro"))
- new-form (list 'obsolete fun)))
+ new-form (list 'obsolete fun) nil fun))
new-form)))
(defun macroexp--unfold-lambda (form &optional name)
@@ -289,12 +288,11 @@ macroexp--unfold-lambda
(setq arglist (cdr arglist)))
(if values
(macroexp-warn-and-return
- arglist
(format (if (eq values 'too-few)
"attempt to open-code `%s' with too few arguments"
"attempt to open-code `%s' with too many arguments")
name)
- form)
+ form nil nil arglist)
;; The following leads to infinite recursion when loading a
;; file containing `(defsubst f () (f))', and then trying to
@@ -365,9 +363,8 @@ macroexp--expand-all
(if (null body)
(macroexp-unprogn
(macroexp-warn-and-return
- fun
(format "Empty %s body" fun)
- nil nil 'compile-only))
+ nil nil 'compile-only fun))
(macroexp--all-forms body))
(cdr form))
form)))
@@ -405,11 +402,10 @@ macroexp--expand-all
(eq 'lambda (car-safe (cadr arg))))
(setcar (nthcdr funarg form)
(macroexp-warn-and-return
- (cadr arg)
(format "%S quoted with ' rather than with #'"
(let ((f (cadr arg)))
(if (symbolp f) f `(lambda ,(nth 1 f)
...))))
- arg)))))
+ arg nil nil (cadr arg))))))
;; Macro expand compiler macros. This cannot be delayed to
;; byte-optimize-form because the output of the compiler-macro can
;; use macros.
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index c3dbfe2947..0330a2a0ab 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -433,10 +433,9 @@ pcase-compile-patterns
(memq (car case) pcase--dontwarn-upats))
(setq main
(macroexp-warn-and-return
- (car case)
(format "pcase pattern %S shadowed by previous pcase pattern"
(car case))
- main))))
+ main nil nil (car case)))))
main)))
(defun pcase--expand (exp cases)
@@ -941,9 +940,8 @@ pcase--u1
(let ((code (pcase--u1 matches code vars rest)))
(if (eq upat '_) code
(macroexp-warn-and-return
- upat
"Pattern t is deprecated. Use `_' instead"
- code))))
+ code nil nil upat))))
((eq upat 'pcase--dontcare) :pcase--dontcare)
((memq (car-safe upat) '(guard pred))
(if (eq (car upat) 'pred) (pcase--mark-used sym))
- bug#53618: 29.0.50; macroexp-warn-and-return incompatible change,
Stefan Monnier <=