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))