summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/cconv.el15
-rw-r--r--lisp/emacs-lisp/eieio-core.el13
-rw-r--r--lisp/emacs-lisp/eieio.el5
-rw-r--r--lisp/emacs-lisp/macroexp.el27
4 files changed, 34 insertions, 26 deletions
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index f1579cda8bd..ea0b09805ea 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -259,8 +259,7 @@ Returns a form where all lambdas don't have any free variables."
(not (intern-soft var))
(eq ?_ (aref (symbol-name var) 0))
;; As a special exception, ignore "ignore".
- (eq var 'ignored)
- (not (byte-compile-warning-enabled-p 'unbound var)))
+ (eq var 'ignored))
(let ((suggestions (help-uni-confusable-suggestions (symbol-name var))))
(format "Unused lexical %s `%S'%s"
varkind var
@@ -287,7 +286,7 @@ of converted forms."
(let (and (pred stringp) msg)
(cconv--warn-unused-msg arg "argument")))
(if (assq arg env) (push `(,arg . nil) env)) ;FIXME: Is it needed?
- (push (lambda (body) (macroexp--warn-wrap msg body)) wrappers))
+ (push (lambda (body) (macroexp--warn-wrap msg body 'lexical)) wrappers))
(_
(if (assq arg env) (push `(,arg . nil) env)))))
(setq funcbody (mapcar (lambda (form)
@@ -408,7 +407,7 @@ places where they originally did not directly appear."
`(ignore ,(cconv-convert value env extend)))
(msg (cconv--warn-unused-msg var "variable")))
(if (null msg) newval
- (macroexp--warn-wrap msg newval))))
+ (macroexp--warn-wrap msg newval 'lexical))))
;; Normal default case.
(_
@@ -507,7 +506,7 @@ places where they originally did not directly appear."
(newprotform (cconv-convert protected-form env extend)))
`(condition-case ,var
,(if msg
- (macroexp--warn-wrap msg newprotform)
+ (macroexp--warn-wrap msg newprotform 'lexical)
newprotform)
,@(mapcar
(lambda (handler)
@@ -599,14 +598,16 @@ FORM is the parent form that binds this var."
(`((,(and var (guard (eq ?_ (aref (symbol-name var) 0)))) . ,_)
,_ ,_ ,_ ,_)
;; FIXME: Convert this warning to use `macroexp--warn-wrap'
- ;; so as to give better position information.
+ ;; so as to give better position information and obey
+ ;; `byte-compile-warnings'.
(byte-compile-warn
"%s `%S' not left unused" varkind var))
((and (let (or 'let* 'let) (car form))
`((,var) ;; (or `(,var nil) : Too many false positives: bug#47080
t nil ,_ ,_))
;; FIXME: Convert this warning to use `macroexp--warn-wrap'
- ;; so as to give better position information.
+ ;; so as to give better position information and obey
+ ;; `byte-compile-warnings'.
(unless (not (intern-soft var))
(byte-compile-warn "Variable `%S' left uninitialized" var))))
(pcase vardata
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index 8f1e38b613b..b11ed3333f0 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -742,7 +742,8 @@ Argument FN is the function calling this verifier."
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-slot-names))))
(macroexp-warn-and-return
- (format-message "Unknown slot `%S'" name) exp 'compile-only))
+ (format-message "Unknown slot `%S'" name)
+ exp nil 'compile-only))
(_ exp))))
(gv-setter eieio-oset))
(cl-check-type slot symbol)
@@ -777,12 +778,13 @@ Fills in CLASS's SLOT with its default value."
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-slot-names))))
(macroexp-warn-and-return
- (format-message "Unknown slot `%S'" name) exp 'compile-only))
+ (format-message "Unknown slot `%S'" name)
+ exp nil 'compile-only))
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-class-slot-names))))
(macroexp-warn-and-return
(format-message "Slot `%S' is not class-allocated" name)
- exp 'compile-only))
+ exp nil 'compile-only))
(_ exp)))))
(cl-check-type class (or eieio-object class))
(cl-check-type slot symbol)
@@ -838,12 +840,13 @@ Fills in the default value in CLASS' in SLOT with VALUE."
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-slot-names))))
(macroexp-warn-and-return
- (format-message "Unknown slot `%S'" name) exp 'compile-only))
+ (format-message "Unknown slot `%S'" name)
+ exp nil 'compile-only))
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-class-slot-names))))
(macroexp-warn-and-return
(format-message "Slot `%S' is not class-allocated" name)
- exp 'compile-only))
+ exp nil 'compile-only))
(_ 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 b31ea42a99b..c16d8e110ec 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -241,7 +241,8 @@ This method is obsolete."
))
`(progn
- ,@(mapcar (lambda (w) (macroexp-warn-and-return w `(progn ',w) 'compile-only))
+ ,@(mapcar (lambda (w)
+ (macroexp-warn-and-return w `(progn ',w) nil 'compile-only))
warnings)
;; This test must be created right away so we can have self-
;; referencing classes. ei, a class whose slot can contain only
@@ -742,7 +743,7 @@ Called from the constructor routine."
(cl-defmethod initialize-instance ((this eieio-default-superclass)
&optional args)
- "Construct the new object THIS based on SLOTS.
+ "Construct the new object THIS based on ARGS.
ARGS is a property list where odd numbered elements are tags, and
even numbered elements are the values to store in the tagged slot.
If you overload the `initialize-instance', there you will need to
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index f4bab9c3456..48311f56de2 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -135,15 +135,22 @@ Other uses risk returning non-nil value that point to the wrong file."
(defvar macroexp--warned (make-hash-table :test #'equal :weakness 'key))
-(defun macroexp--warn-wrap (msg form)
- (let ((when-compiled (lambda () (byte-compile-warn "%s" msg))))
+(defun macroexp--warn-wrap (msg form category)
+ (let ((when-compiled (lambda ()
+ (when (byte-compile-warning-enabled-p category)
+ (byte-compile-warn "%s" msg)))))
`(progn
(macroexp--funcall-if-compiled ',when-compiled)
,form)))
(define-obsolete-function-alias 'macroexp--warn-and-return
#'macroexp-warn-and-return "28.1")
-(defun macroexp-warn-and-return (msg form &optional compile-only)
+(defun macroexp-warn-and-return (msg form &optional category compile-only)
+ "Return code equivalent to FORM by labeled with warning MSG.
+CATEGORY is the category of the warning, like the categories that
+can appear in `byte-compile-warnings'.
+COMPILE-ONLY if non-nil indicates that no warning should be emitted if
+the code is executed without being compiled first."
(cond
((null msg) form)
((macroexp-compiling-p)
@@ -153,7 +160,7 @@ Other uses risk returning non-nil value that point to the wrong file."
;; macroexpand-all gets right back to macroexpanding `form'.
form
(puthash form form macroexp--warned)
- (macroexp--warn-wrap msg form)))
+ (macroexp--warn-wrap msg form category)))
(t
(unless compile-only
(message "%sWarning: %s"
@@ -205,9 +212,7 @@ Other uses risk returning non-nil value that point to the wrong file."
(if (and (not (eq form new-form)) ;It was a macro call.
(car-safe form)
(symbolp (car form))
- (get (car form) 'byte-obsolete-info)
- (or (not (fboundp 'byte-compile-warning-enabled-p))
- (byte-compile-warning-enabled-p 'obsolete (car form))))
+ (get (car form) 'byte-obsolete-info))
(let* ((fun (car form))
(obsolete (get fun 'byte-obsolete-info)))
(macroexp-warn-and-return
@@ -215,7 +220,7 @@ Other uses risk returning non-nil value that point to the wrong file."
fun obsolete
(if (symbolp (symbol-function fun))
"alias" "macro"))
- new-form))
+ new-form 'obsolete))
new-form)))
(defun macroexp--unfold-lambda (form &optional name)
@@ -325,10 +330,8 @@ Assumes the caller has bound `macroexpand-all-environment'."
(if (null body)
(macroexp-unprogn
(macroexp-warn-and-return
- (and (or (not (fboundp 'byte-compile-warning-enabled-p))
- (byte-compile-warning-enabled-p t))
- (format "Empty %s body" fun))
- nil t))
+ (format "Empty %s body" fun)
+ nil nil 'compile-only))
(macroexp--all-forms body))
(cdr form))
form))