master 5218701: * lisp/emacs-lisp/macroexp.el (macroexp-warn-and-return): Add arg `category`

[Stefan Monnier]

branch: master
commit 52187012f1772bc9ccbe3376991bb35732a76501
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    * lisp/emacs-lisp/macroexp.el (macroexp-warn-and-return): Add arg `category`
    
    Use it to obey `byte-compile-warnings`.
    
    (macroexp--warn-wrap): Add arg `category`.
    (macroexp-macroexpand, macroexp--expand-all): Use it.
    
    * lisp/emacs-lisp/cconv.el (cconv--convert-funcbody, cconv-convert):
    Mark the warnings as `lexical`.
    
    * lisp/emacs-lisp/eieio-core.el (eieio-oref, eieio-oref-default)
    (eieio-oset-default):
    * lisp/emacs-lisp/eieio.el (defclass): Adjust to new calling convention.
---
 lisp/emacs-lisp/cconv.el      | 15 ++++++++-------
 lisp/emacs-lisp/eieio-core.el | 13 ++++++++-----
 lisp/emacs-lisp/eieio.el      |  5 +++--
 lisp/emacs-lisp/macroexp.el   | 27 +++++++++++++++------------
 4 files changed, 34 insertions(+), 26 deletions(-)

diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index f1579cd..ea0b098 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 8f1e38b..b11ed33 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 b31ea42a..c16d8e1 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 f4bab9c..48311f5 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))