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:
parent
cfc0e1cc02
commit
0e1b03bbb8
9 changed files with 46 additions and 37 deletions
|
@ -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.
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
||||
|
|
|
@ -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)))
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue