Several amendments to scratch/correct-warning-pos.

The position return by read-positioning-symbols is now the position in the
buffer, rather than the offset from the start of a form, enabling warning
positions in other parts of the buffer to be output.

* src/lisp.h (lisp_h_EQ): Add XLI casts so that it compiles cleanly.

* src/data.c (Fremove_pos_from_symbol): New DEFUN.

* src/lread.c (readchar_count): renamed to readchar_offset.
(read_internal_start) Initialize readchar_offset to the buffer's point when
STREAM is a buffer.

* lisp/emacs-lisp/bytecomp.el (byte-compile-warning-prefix): Amend to use
OFFSET as a buffer position, not an offset from the start of a form.
(byte-compile-warn): Remove symbol positions from any shape of ARGS, not just
a symbol with position.

* lisp/emacs-lisp/cconv.c (cconv-convert): In the :unused case, position the
new IGNORE symbol with the VAR it has replaced.

* lisp/emacs-lisp/macroexp.el (macroexp--warn-wrap, macroexp-warn-and-return):
Add an extra position parameter to each.

* lisp/emacs-lisp/bindat.el (bindat-type), lisp/emacs-lisp/byte-run.el
(defmacro, defun), lisp/emacs-lisp/cconv.el (cconv--convert-func-body)
(cconv-convert), lisp/emacs-lisp/cl-generic.el (cl-defmethod),
lisp/emacs-lisp/cl-macs.el (cl-symbol-macrolet, cl-defstruct),
lisp/emacs-lisp/easy-mmode.el (define-minor-mode),
lisp/emacs-lisp/eieio-core.el (eieio-oref, eieio-oref-default)
(eieio-oset-default), lisp/emacs-lisp/eieio.el (defclass),
lisp/emacs-lisp/gv.el (gv-ref), lisp/emacs-lisp/macroexp.el
(macroexp-macroexpand, macroexp--unfold-lambda, macroexp--expand-all),
lisp/emacs-lisp/pcase.el (pcase-compile-patterns, pcase--u1): Add an extra
position argument to each call of macroexp-warn-and-return.

12 files changed, 41 insertions, 33 deletions

diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 76c2e80fda8..17a55c7dbaa 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -804,6 +804,7 @@ is the name of a variable that will hold the value we need to pack.")
               (if (or (eq label '_) (not (assq label labels)))
                   code
                 (macroexp-warn-and-return
+                 code
                  (format "Duplicate label: %S" label)
                  code))))
            (`(,_ ,val)
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index d82d9454e84..813ff53ea73 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -253,7 +253,8 @@ The return value is undefined.
 		  #'(lambda (x)
 		      (let ((f (cdr (assq (car x) macro-declarations-alist))))
 			(if f (apply (car f) name arglist (cdr x))
-			  (macroexp-warn-and-return
+                          (macroexp-warn-and-return
+			   (car x)
 			   (format-message
 			    "Unknown macro property %S in %S"
 			    (car x) name)
@@ -327,6 +328,7 @@ The return value is undefined.
                     nil)
                    (t
                     (macroexp-warn-and-return
+                     (car x)
                      (format-message "Unknown defun property `%S' in %S"
                                      (car x) name)
                      nil)))))
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 869b6c01b8a..2f23fe743ec 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1326,7 +1326,7 @@ Return nil if such is not found."
                         (goto-char byte-compile-last-position)
                         (setq old-l (1+ (count-lines (point-min) (point-at-bol)))
                               old-c (1+ (current-column)))
-                        (goto-char (+ byte-compile-read-position offset))
+                        (goto-char offset)
                         (setq new-l (1+ (count-lines (point-min) (point-at-bol)))
                               new-c (1+ (current-column)))
                         (format "%d:%d:%d:%d:" old-l old-c new-l new-c)))
@@ -1435,12 +1435,7 @@ function directly; use `byte-compile-warn' or
 
 (defun byte-compile-warn (format &rest args)
   "Issue a byte compiler warning; use (format-message FORMAT ARGS...) for message."
-  (setq args
-        (mapcar (lambda (arg)
-                  (if (symbolp arg)
-                      (bare-symbol arg)
-                    arg))
-                args))
+  (setq args (mapcar #'byte-compile-strip-symbol-positions args))
   (setq format (apply #'format-message format args))
   (if byte-compile-error-on-warn
       (error "%s" format)		; byte-compile-file catches and logs it
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 9c9ebe15d5d..e12f0a1753b 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -258,11 +258,11 @@ Returns a form where all lambdas don't have any free variables."
               ;; unused vars.
               (not (intern-soft var))
               (eq ?_ (aref (symbol-name var) 0))
-	      ;; As a special exception, ignore "ignore".
+	      ;; As a special exception, ignore "ignored".
 	      (eq var 'ignored))
        (let ((suggestions (help-uni-confusable-suggestions (symbol-name var))))
          (format "Unused lexical %s `%S'%s"
-                 varkind var
+                 varkind (bare-symbol var)
                  (if suggestions (concat "\n  " suggestions) "")))))
 
 (define-inline cconv--var-classification (binder form)
@@ -286,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 'lexical)) wrappers))
+         (push (lambda (body) (macroexp--warn-wrap body msg body 'lexical)) wrappers))
         (_
          (if (assq arg env) (push `(,arg . nil) env)))))
     (setq funcbody (mapcar (lambda (form)
@@ -414,11 +414,14 @@ places where they originally did not directly appear."
                        ;; Declared variable is unused.
                        (if (assq var new-env)
                            (push `(,var) new-env)) ;FIXME:Needed?
-                       (let ((newval
-                              `(ignore ,(cconv-convert value env extend)))
-                             (msg (cconv--warn-unused-msg var "variable")))
+                       (let* ((Ignore (if (symbol-with-pos-p var)
+                                          (position-symbol 'ignore var)
+                                        'ignore))
+                              (newval `(,Ignore
+                                        ,(cconv-convert value env extend)))
+                              (msg (cconv--warn-unused-msg var "variable")))
                          (if (null msg) newval
-                           (macroexp--warn-wrap msg newval 'lexical))))
+                           (macroexp--warn-wrap var msg newval 'lexical))))
 
                       ;; Normal default case.
                       (_
@@ -517,7 +520,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 'lexical)
+                 (macroexp--warn-wrap var msg newprotform 'lexical)
                newprotform)
           ,@(mapcar
              (lambda (handler)
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index b94737e0fee..43214aab30c 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -512,7 +512,7 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
                    (byte-compile-warning-enabled-p 'obsolete name))
                (let* ((obsolete (get name 'byte-obsolete-info)))
                  (macroexp-warn-and-return
-                  ;; org-name
+                  org-name
                   (macroexp--obsolete-warning name obsolete "generic function")
                   nil)))
          ;; You could argue that `defmethod' modifies rather than defines the
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index dbe0eb1b0e2..3659a0c95a2 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2449,7 +2449,7 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...).
             (if malformed-bindings
                 (let ((rev-malformed-bindings (nreverse malformed-bindings)))
                   (macroexp-warn-and-return
-                   ;; rev-malformed-bindings
+                   rev-malformed-bindings
                    (format-message "Malformed `cl-symbol-macrolet' binding(s): %S"
                                    rev-malformed-bindings)
                    expansion))
@@ -3136,7 +3136,7 @@ To see the documentation for a defined struct type, use
               (when (cl-oddp (length desc))
                 (push
                  (macroexp-warn-and-return
-                  ;; (car (last desc))
+                  (car (last desc))
                   (format "Missing value for option `%S' of slot `%s' in struct %s!"
                           (car (last desc)) slot name)
                   'nil)
@@ -3146,7 +3146,7 @@ To see the documentation for a defined struct type, use
                   (let ((kw (car defaults)))
                     (push
                      (macroexp-warn-and-return
-                      ;; kw
+                      kw
                       (format "  I'll take `%s' to be an option rather than a default value."
                               kw)
                       'nil)
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index db86e0e0292..59038f6e9b2 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -230,6 +230,7 @@ INIT-VALUE LIGHTER KEYMAP.
          (warnwrap (if (or (null body) (keywordp (car body))) #'identity
                      (lambda (exp)
                        (macroexp-warn-and-return
+                        exp
                         "Use keywords rather than deprecated positional arguments to `define-minor-mode'"
                         exp))))
 	 keyw keymap-sym tmp)
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index 4e9357c2ada..b17ecd34d4d 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -744,7 +744,7 @@ 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
-                  ;; name
+                  name
                   (format-message "Unknown slot `%S'" name)
                   exp nil 'compile-only))
                 (_ exp))))
@@ -781,11 +781,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
+                  name
                   (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
+                  name
                   (format-message "Slot `%S' is not class-allocated" name)
                   exp nil 'compile-only))
                 (_ exp)))))
@@ -843,11 +845,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
+                  name
                   (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
+                  name
                   (format-message "Slot `%S' is not class-allocated" name)
                   exp nil 'compile-only))
                 (_ exp)))))
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 76f7b661a62..0d0dff6d68e 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -242,7 +242,8 @@ This method is obsolete."
 
     `(progn
        ,@(mapcar (lambda (w)
-                   (macroexp-warn-and-return w `(progn ',w) nil 'compile-only))
+                   (macroexp-warn-and-return w ; W is probably a poor choice for a position.
+                    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
@@ -292,7 +293,7 @@ This method is obsolete."
                          (if (not (stringp (car slots)))
                              whole
                            (macroexp-warn-and-return
-                            ;; (car slots)
+                            (car slots)
                             (format "Obsolete name arg %S to constructor %S"
                                     (car slots) (car whole))
                             ;; Keep the name arg, for backward compatibility,
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index ed33524f2dc..eb65e5f1046 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -595,7 +595,7 @@ binding mode."
             (eq (car-safe code) 'cons))
         code
       (macroexp-warn-and-return
-       ;; org-place
+       org-place
        "Use of gv-ref probably requires lexical-binding"
        code))))
 
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 6d114a8a547..60fac981308 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -135,18 +135,17 @@ 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 category)
+(defun macroexp--warn-wrap (arg msg form category)
   (let ((when-compiled (lambda ()
                          (when (byte-compile-warning-enabled-p category)
-                           (byte-compile-warn-x form "%s" msg)))))
+                           (byte-compile-warn-x arg "%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 (;; _arg
-                                 msg form &optional category compile-only)
+(defun macroexp-warn-and-return (arg msg form &optional category compile-only)
   "Return code equivalent to FORM labeled with warning MSG.
 CATEGORY is the category of the warning, like the categories that
 can appear in `byte-compile-warnings'.
@@ -161,7 +160,7 @@ is executed without being compiled first."
         ;; macroexpand-all gets right back to macroexpanding `form'.
         form
       (puthash form form macroexp--warned)
-      (macroexp--warn-wrap msg form category)))
+      (macroexp--warn-wrap arg msg form category)))
    (t
     (unless compile-only
       (message "%sWarning: %s"
@@ -217,7 +216,7 @@ is executed without being compiled first."
         (let* ((fun (car form))
                (obsolete (get fun 'byte-obsolete-info)))
           (macroexp-warn-and-return
-           ;; fun
+           fun
            (macroexp--obsolete-warning
             fun obsolete
             (if (symbolp (symbol-function fun))
@@ -273,6 +272,7 @@ is executed without being compiled first."
       (setq arglist (cdr arglist)))
     (if values
         (macroexp-warn-and-return
+         name
          (format (if (eq values 'too-few)
                      "attempt to open-code `%s' with too few arguments"
                    "attempt to open-code `%s' with too many arguments")
@@ -332,7 +332,7 @@ Assumes the caller has bound `macroexpand-all-environment'."
          (if (null body)
              (macroexp-unprogn
               (macroexp-warn-and-return
-               ;; fun
+               fun
                (format "Empty %s body" fun)
                nil nil 'compile-only))
            (macroexp--all-forms body))
@@ -370,7 +370,7 @@ Assumes the caller has bound `macroexpand-all-environment'."
                         (eq 'lambda (car-safe (cadr arg))))
                (setcar (nthcdr funarg form)
                        (macroexp-warn-and-return
-                        ;; (nth 1 f)
+                        (cadr arg)
                         (format "%S quoted with ' rather than with #'"
                                 (let ((f (cadr arg)))
                                   (if (symbolp f) f `(lambda ,(nth 1 f) ...))))
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 430ae97078c..81280d4e041 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -433,6 +433,7 @@ how many time this CODEGEN is called."
                     (memq (car case) pcase--dontwarn-upats))
           (setq main
                 (macroexp-warn-and-return
+                 (car case)
                  (format "pcase pattern %S shadowed by previous pcase pattern"
                          (car case))
                  main))))
@@ -940,7 +941,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
-             ;; upat
+             upat
              "Pattern t is deprecated.  Use `_' instead"
              code))))
        ((eq upat 'pcase--dontcare) :pcase--dontcare)