1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00

Styled quotes in compiler warnings

* lisp/emacs-lisp/byte-run.el (byte-run--parse-body)
(byte-run--unescaped-character-literals-warning):
* lisp/emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment)
(byte-compile-form, bytecomp--warn-dodgy-eq-arg):
* lisp/emacs-lisp/cconv.el (cconv--warn-unused-msg):
* lisp/emacs-lisp/cl-macs.el (cl-defstruct):
* lisp/emacs-lisp/easy-mmode.el (define-minor-mode):
* lisp/emacs-lisp/eieio.el (defclass):
* lisp/emacs-lisp/macroexp.el (macroexp--unfold-lambda)
(macroexp--expand-all):
* lisp/emacs-lisp/pcase.el (pcase--u1):
* lisp/subr.el (when, unless, ignore-error, lsh, sit-for)
(with-demoted-errors):
Use format-message to ensure properly styled quotes in compiler
warning messages.
This commit is contained in:
Mattias Engdegård 2023-01-03 15:58:14 +01:00
parent cfc0e1cc02
commit 0e1b03bbb8
9 changed files with 46 additions and 37 deletions

View file

@ -262,7 +262,8 @@ This is used by `declare'.")
(interactive-form nil)
(warnings nil)
(warn #'(lambda (msg form)
(push (macroexp-warn-and-return msg nil nil t form)
(push (macroexp-warn-and-return
(format-message msg) nil nil t form)
warnings))))
(while
(and body
@ -679,11 +680,11 @@ Otherwise, return nil. For internal use only."
;; This is called from lread.c and therefore needs to be preloaded.
(if lread--unescaped-character-literals
(let ((sorted (sort lread--unescaped-character-literals #'<)))
(format-message "unescaped character literals %s detected, %s expected!"
(mapconcat (lambda (char) (format "`?%c'" char))
sorted ", ")
(mapconcat (lambda (char) (format "`?\\%c'" char))
sorted ", ")))))
(format "unescaped character literals %s detected, %s expected!"
(mapconcat (lambda (char) (format-message "`?%c'" char))
sorted ", ")
(mapconcat (lambda (char) (format-message "`?\\%c'" char))
sorted ", ")))))
(defun byte-compile-info (string &optional message type)
"Format STRING in a way that looks pleasing in the compilation output.

View file

@ -554,7 +554,7 @@ Return the compile-time value of FORM."
,(macroexpand-all `(progn ,@body)
macroexpand-all-environment)))
(macroexp-warn-and-return
"`with-suppressed-warnings' with empty body"
(format-message "`with-suppressed-warnings' with empty body")
nil '(empty-body with-suppressed-warnings) t warnings)))))
"The default macro-environment passed to macroexpand by the compiler.
Placing a macro here will cause a macro to have different semantics when
@ -3445,7 +3445,7 @@ lambda-expression."
(t "."))))
(if (eq (car-safe (symbol-function (car form))) 'macro)
(byte-compile-report-error
(format "`%s' defined after use in %S (missing `require' of a library file?)"
(format-message "`%s' defined after use in %S (missing `require' of a library file?)"
(car form) form)))
(if (and handler
;; Make sure that function exists.
@ -5524,8 +5524,8 @@ and corresponding effects."
(defun bytecomp--warn-dodgy-eq-arg (form type parenthesis)
(macroexp-warn-and-return
(format "`%s' called with literal %s that may never match (%s)"
(car form) type parenthesis)
(format-message "`%s' called with literal %s that may never match (%s)"
(car form) type parenthesis)
form (list 'suspicious (car form)) t))
(defun bytecomp--check-eq-args (form &optional a b &rest _ignore)

View file

@ -236,9 +236,9 @@ Returns a form where all lambdas don't have any free variables."
(not (intern-soft var))
(eq ?_ (aref (symbol-name var) 0)))
(let ((suggestions (help-uni-confusable-suggestions (symbol-name var))))
(format "Unused lexical %s `%S'%s"
varkind (bare-symbol var)
(if suggestions (concat "\n " suggestions) "")))))
(format-message "Unused lexical %s `%S'%s"
varkind (bare-symbol var)
(if suggestions (concat "\n " suggestions) "")))))
(define-inline cconv--var-classification (binder form)
(inline-quote

View file

@ -3176,8 +3176,9 @@ To see the documentation for a defined struct type, use
(when (cl-oddp (length desc))
(push
(macroexp-warn-and-return
(format "Missing value for option `%S' of slot `%s' in struct %s!"
(car (last desc)) slot name)
(format-message
"Missing value for option `%S' of slot `%s' in struct %s!"
(car (last desc)) slot name)
nil nil nil (car (last desc)))
forms)
(when (and (keywordp (car defaults))
@ -3185,8 +3186,9 @@ To see the documentation for a defined struct type, use
(let ((kw (car defaults)))
(push
(macroexp-warn-and-return
(format " I'll take `%s' to be an option rather than a default value."
kw)
(format-message
" I'll take `%s' to be an option rather than a default value."
kw)
nil nil nil kw)
forms)
(push kw desc)

View file

@ -250,7 +250,8 @@ INIT-VALUE LIGHTER KEYMAP.
(warnwrap (if (or (null body) (keywordp (car body))) #'identity
(lambda (exp)
(macroexp-warn-and-return
"Use keywords rather than deprecated positional arguments to `define-minor-mode'"
(format-message
"Use keywords rather than deprecated positional arguments to `define-minor-mode'")
exp))))
keyw keymap-sym tmp)

View file

@ -184,8 +184,9 @@ and reference them using the function `class-option'."
(when (and initarg (eq alloc :class))
(push
(cons sname
(format "Meaningless :initarg for class allocated slot '%S'"
sname))
(format-message
"Meaningless :initarg for class allocated slot `%S'"
sname))
warnings))
(let ((init (plist-get soptions :initform)))

View file

@ -291,10 +291,11 @@ It should normally be a symbol with position and it defaults to FORM."
(setq arglist (cdr arglist)))
(if values
(macroexp-warn-and-return
(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)
(format-message
(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 nil nil arglist)
;; The following leads to infinite recursion when loading a
@ -367,14 +368,14 @@ Assumes the caller has bound `macroexpand-all-environment'."
(if (null body)
(macroexp-unprogn
(macroexp-warn-and-return
(format "`%s' with empty body" fun)
(format-message "`%s' with empty body" fun)
nil (list 'empty-body fun) 'compile-only fun))
(macroexp--all-forms body))
(cdr form))
form)))
(`(while)
(macroexp-warn-and-return
"missing `while' condition"
(format-message "missing `while' condition")
`(signal 'wrong-number-of-arguments '(while 0))
nil 'compile-only form))
(`(setq ,(and var (pred symbolp)
@ -392,7 +393,7 @@ Assumes the caller has bound `macroexpand-all-environment'."
(let ((nargs (length args)))
(if (/= (logand nargs 1) 0)
(macroexp-warn-and-return
"odd number of arguments in `setq' form"
(format-message "odd number of arguments in `setq' form")
`(signal 'wrong-number-of-arguments '(setq ,nargs))
nil 'compile-only fn)
(let ((assignments nil))

View file

@ -947,7 +947,7 @@ Otherwise, it defers to REST which is a list of branches of the form
(let ((code (pcase--u1 matches code vars rest)))
(if (eq upat '_) code
(macroexp-warn-and-return
"Pattern t is deprecated. Use `_' instead"
(format-message "Pattern t is deprecated. Use `_' instead")
code nil nil upat))))
((eq upat 'pcase--dontcare) :pcase--dontcare)
((memq (car-safe upat) '(guard pred))

View file

@ -282,7 +282,7 @@ value of last one, or nil if there are none."
(declare (indent 1) (debug t))
(if body
(list 'if cond (cons 'progn body))
(macroexp-warn-and-return "`when' with empty body"
(macroexp-warn-and-return (format-message "`when' with empty body")
cond '(empty-body when) t)))
(defmacro unless (cond &rest body)
@ -292,7 +292,7 @@ value of last one, or nil if there are none."
(declare (indent 1) (debug t))
(if body
(cons 'if (cons cond (cons nil body)))
(macroexp-warn-and-return "`unless' with empty body"
(macroexp-warn-and-return (format-message "`unless' with empty body")
cond '(empty-body unless) t)))
(defsubst subr-primitive-p (object)
@ -393,14 +393,15 @@ The CONDITION argument is not evaluated. Do not quote it."
((and (eq (car-safe condition) 'quote)
(cdr condition) (null (cddr condition)))
(macroexp-warn-and-return
(format "`ignore-error' condition argument should not be quoted: %S"
condition)
(format-message
"`ignore-error' condition argument should not be quoted: %S"
condition)
`(condition-case nil (progn ,@body) (,(cadr condition) nil))
nil t condition))
(body
`(condition-case nil (progn ,@body) (,condition nil)))
(t
(macroexp-warn-and-return "`ignore-error' with empty body"
(macroexp-warn-and-return (format-message "`ignore-error' with empty body")
nil '(empty-body ignore-error) t condition))))
@ -530,8 +531,9 @@ This function is provided for compatibility. In new code, use `ash'
instead."
(declare (compiler-macro
(lambda (form)
(macroexp-warn-and-return "avoid `lsh'; use `ash' instead"
form '(suspicious lsh) t form))))
(macroexp-warn-and-return
(format-message "avoid `lsh'; use `ash' instead")
form '(suspicious lsh) t form))))
(when (and (< value 0) (< count 0))
(when (< value most-negative-fixnum)
(signal 'args-out-of-range (list value count)))
@ -3300,7 +3302,7 @@ floating point support."
(lambda (form)
(if (not (or (numberp nodisp) obsolete)) form
(macroexp-warn-and-return
"Obsolete calling convention for 'sit-for'"
(format-message "Obsolete calling convention for `sit-for'")
`(,(car form) (+ ,seconds (/ (or ,nodisp 0) 1000.0)) ,obsolete)
'(obsolete sit-for))))))
;; This used to be implemented in C until the following discussion:
@ -4882,7 +4884,8 @@ but that should be robust in the unexpected case that an error is signaled."
;; The use without `format' is obsolete, let's warn when we bump
;; into any such remaining uses.
(macroexp-warn-and-return
"Missing format argument in `with-demote-errors'" exp nil nil
(format-message "Missing format argument in `with-demote-errors'")
exp nil nil
orig-format))))
(defmacro combine-after-change-calls (&rest body)