* lisp/emacs-lisp/macroexp.el (macroexp-file-name): New function.

Yes, finally: a function that tells you the name of the file where
the code is located.  Finding this name is non-trivial in practice,
as evidenced by the "4 shift/reduce conflicts" warning when compiling
CEDET's python.el, because its `wisent-source` got it wrong in that
case, thinking the grammar came from `python.el` instead of
`python-wy.el`.

While at it, also made `macroexp-compiling-p` public, since it's
useful at various places.

(macroexp-compiling-p): Rename from `macroexp--compiling-p`.

* lisp/emacs-lisp/bytecomp.el (byte-compile-close-variables):
Bind `load-file-name` to nil so we can distinguish a load that calls
the byte compiler from a byte compilation which causes a load.

* lisp/cedet/semantic/wisent/python.el (wisent-python--expected-conflicts):
Remove; it was just a workaround.
* lisp/subr.el (do-after-load-evaluation): Avoid `byte-compile--` vars.
* lisp/cedet/semantic/fw.el (semantic-alias-obsolete):
Use `macroexp-compiling-p` and `macroexp-file-name`.
* lisp/cedet/semantic/wisent/comp.el (wisent-source): Use `macroexp-file-name`
(wisent-total-conflicts): Tighten regexp.
* lisp/emacs-lisp/cl-lib.el (cl--compiling-file): Delete function
and variable.  Use `macroexp-compiling-p` instead.
* lisp/progmodes/flymake.el (flymake-log):
* lisp/emacs-lisp/package.el (package-get-version):
* lisp/emacs-lisp/ert-x.el (ert-resource-directory):
Use `macroexp-file-name`.

etc/NEWS

@@ -369,6 +369,12 @@ the buffer cycles the whole buffer between "only top-level headings",
 
 * Changes in Specialized Modes and Packages in Emacs 28.1
 
+** Macroexp
+---
+*** New function 'macroexp-file-name' to know the name of the current file
+---
+*** New function 'macroexp-compiling-p' to know if we're compiling.
+
 ** 'blink-cursor-mode' is now enabled by default regardless of the UI.
 It used to be enabled when Emacs is started in GUI mode but not when started
 in text mode.  The cursor still only actually blinks in GUI frames.

lisp/cedet/semantic/fw.el

@@ -189,14 +189,13 @@ will throw a warning when it encounters this symbol."
   (when (and (mode-local--function-overload-p newfn)
              (not (mode-local--overload-obsoleted-by newfn))
              ;; Only throw this warning when byte compiling things.
-             (boundp 'byte-compile-current-file)
-             byte-compile-current-file
-	     (not (string-match "cedet" byte-compile-current-file))
+             (macroexp-compiling-p)
+	     (not (string-match "cedet" (macroexp-file-name)))
 	     )
     (make-obsolete-overload oldfnalias newfn when)
     (byte-compile-warn
      "%s: `%s' obsoletes overload `%s'"
-     byte-compile-current-file
+     (macroexp-file-name)
      newfn
      (with-suppressed-warnings ((obsolete semantic-overload-symbol-from-function))
        (semantic-overload-symbol-from-function oldfnalias)))))
@@ -211,8 +210,7 @@ will throw a warning when it encounters this symbol."
       (defvaralias oldvaralias newvar)
     (error
      ;; Only throw this warning when byte compiling things.
-     (when (and (boundp 'byte-compile-current-file)
-                byte-compile-current-file)
+     (when (macroexp-compiling-p)
        (byte-compile-warn
         "variable `%s' obsoletes, but isn't alias of `%s'"
         newvar oldvaralias)

lisp/cedet/semantic/wisent/comp.el

@@ -159,13 +159,9 @@ Its name is defined in constant `wisent-log-buffer-name'."
   '(with-current-buffer (wisent-log-buffer)
      (erase-buffer)))
 
-(defvar byte-compile-current-file)
-
 (defun wisent-source ()
   "Return the current source file name or nil."
-  (let ((source (or (and (boundp 'byte-compile-current-file)
-                         byte-compile-current-file)
-                    load-file-name (buffer-file-name))))
+  (let ((source (macroexp-file-name)))
     (if source
         (file-relative-name source))))
 
@@ -2241,7 +2237,7 @@ there are any reduce/reduce conflicts."
           ;; output warnings.
           (and src
                (intern (format "wisent-%s--expected-conflicts"
-                               (replace-regexp-in-string "\\.el$" "" src))))))
+                               (replace-regexp-in-string "\\.el\\'" "" src))))))
     (when (or (not (zerop rrc-total))
               (and (not (zerop src-total))
                    (not (= src-total (or wisent-expected-conflicts 0)))

lisp/cedet/semantic/wisent/python.el

@@ -33,11 +33,6 @@
 ;; for optional functionality
 (require 'python nil t)
 
-;; Tell wisent how many shift/reduce conflicts are to be expected by
-;; this grammar.
-(eval-and-compile
-  (defconst wisent-python--expected-conflicts 4))
-
 (require 'semantic/wisent)
 (require 'semantic/wisent/python-wy)
 (require 'semantic/find)

lisp/emacs-lisp/bytecomp.el

@@ -1727,6 +1727,11 @@ It is too wide if it has any lines longer than the largest of
          ;; 		(byte-compile-generate-emacs19-bytecodes
          ;; 		 byte-compile-generate-emacs19-bytecodes)
          (byte-compile-warnings byte-compile-warnings)
+         ;; Indicate that we're not currently loading some file.
+         ;; This is used in `macroexp-file-name' to make sure that
+         ;; loading file A which does (byte-compile-file B) won't
+         ;; cause macro calls in B to think they come from A.
+         (load-file-name nil)
          )
      ,@body))
 

lisp/emacs-lisp/cl-lib.el

@@ -232,13 +232,8 @@ one value.
 
 ;;; Declarations.
 
-(defvar cl--compiling-file nil)
-(defun cl--compiling-file ()
-  (or cl--compiling-file
-      (and (boundp 'byte-compile--outbuffer)
-           (bufferp (symbol-value 'byte-compile--outbuffer))
-	   (equal (buffer-name (symbol-value 'byte-compile--outbuffer))
-		  " *Compiler Output*"))))
+(define-obsolete-function-alias 'cl--compiling-file
+  #'macroexp-compiling-p "28.1")
 
 (defvar cl--proclaims-deferred nil)
 
@@ -253,7 +248,7 @@ one value.
 Puts `(cl-eval-when (compile load eval) ...)' around the declarations
 so that they are registered at compile-time as well as run-time."
   (let ((body (mapcar (lambda (x) `(cl-proclaim ',x)) specs)))
-    (if (cl--compiling-file) `(cl-eval-when (compile load eval) ,@body)
+    (if (macroexp-compiling-p) `(cl-eval-when (compile load eval) ,@body)
       `(progn ,@body))))           ; Avoid loading cl-macs.el for cl-eval-when.
 
 

lisp/emacs-lisp/cl-macs.el

@@ -545,7 +545,7 @@ its argument list allows full Common Lisp conventions."
     (let ((p (memq '&body args))) (if p (setcar p '&rest)))
     (if (memq '&environment args) (error "&environment used incorrectly"))
     (let ((restarg (memq '&rest args))
-	  (safety (if (cl--compiling-file) cl--optimize-safety 3))
+	  (safety (if (macroexp-compiling-p) cl--optimize-safety 3))
 	  (keys t)
 	  (laterarg nil) (exactarg nil) minarg)
       (or num (setq num 0))
@@ -709,7 +709,7 @@ If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level.
 
 \(fn (WHEN...) BODY...)"
   (declare (indent 1) (debug (sexp body)))
-  (if (and (fboundp 'cl--compiling-file) (cl--compiling-file)
+  (if (and (macroexp-compiling-p)
 	   (not cl--not-toplevel) (not (boundp 'for-effect))) ;Horrible kludge.
       (let ((comp (or (memq 'compile when) (memq :compile-toplevel when)))
 	    (cl--not-toplevel t))
@@ -738,7 +738,7 @@ If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level.
   "Like `progn', but evaluates the body at load time.
 The result of the body appears to the compiler as a quoted constant."
   (declare (debug (form &optional sexp)))
-  (if (cl--compiling-file)
+  (if (macroexp-compiling-p)
       (let* ((temp (cl-gentemp "--cl-load-time--"))
 	     (set `(setq ,temp ,form)))
 	(if (and (fboundp 'byte-compile-file-form-defmumble)
@@ -2455,7 +2455,7 @@ values.  For compatibility, (cl-values A B C) is a synonym for (list A B C).
 (defmacro cl-the (type form)
   "Return FORM.  If type-checking is enabled, assert that it is of TYPE."
   (declare (indent 1) (debug (cl-type-spec form)))
-  (if (not (or (not (cl--compiling-file))
+  (if (not (or (not (macroexp-compiling-p))
                (< cl--optimize-speed 3)
                (= cl--optimize-safety 3)))
       form
@@ -2522,7 +2522,7 @@ For instance
 
 will turn off byte-compile warnings in the function.
 See Info node `(cl)Declarations' for details."
-  (if (cl--compiling-file)
+  (if (macroexp-compiling-p)
       (while specs
 	(if (listp cl--declare-stack) (push (car specs) cl--declare-stack))
 	(cl--do-proclaim (pop specs) nil)))
@@ -2859,7 +2859,7 @@ Supported keywords for slots are:
 	 (copier (intern (format "copy-%s" name)))
 	 (predicate (intern (format "%s-p" name)))
 	 (print-func nil) (print-auto nil)
-	 (safety (if (cl--compiling-file) cl--optimize-safety 3))
+	 (safety (if (macroexp-compiling-p) cl--optimize-safety 3))
 	 (include nil)
          ;; There are 4 types of structs:
          ;; - `vector' type: means we should use a vector, which can come
@@ -3263,7 +3263,7 @@ does not contain SLOT-NAME."
   "Return non-nil if SYM will be bound when we run the code.
 Of course, we really can't know that for sure, so it's just a heuristic."
   (or (fboundp sym)
-      (and (cl--compiling-file)
+      (and (macroexp-compiling-p)
            (or (cdr (assq sym byte-compile-function-environment))
                (cdr (assq sym byte-compile-macro-environment))))))
 
@@ -3359,7 +3359,7 @@ Of course, we really can't know that for sure, so it's just a heuristic."
   "Verify that FORM is of type TYPE; signal an error if not.
 STRING is an optional description of the desired type."
   (declare (debug (place cl-type-spec &optional stringp)))
-  (and (or (not (cl--compiling-file))
+  (and (or (not (macroexp-compiling-p))
 	   (< cl--optimize-speed 3) (= cl--optimize-safety 3))
        (macroexp-let2 macroexp-copyable-p temp form
          `(progn (or (cl-typep ,temp ',type)
@@ -3379,7 +3379,7 @@ Other args STRING and ARGS... are arguments to be passed to `error'.
 They are not evaluated unless the assertion fails.  If STRING is
 omitted, a default message listing FORM itself is used."
   (declare (debug (form &rest form)))
-  (and (or (not (cl--compiling-file))
+  (and (or (not (macroexp-compiling-p))
 	   (< cl--optimize-speed 3) (= cl--optimize-safety 3))
        (let ((sargs (and show-args
                          (delq nil (mapcar (lambda (x)

lisp/emacs-lisp/eieio.el

@@ -233,7 +233,7 @@ This method is obsolete."
 
        ,@(when eieio-backward-compatibility
            (let ((f (intern (format "%s-child-p" name))))
-             `((defalias ',f ',testsym2)
+             `((defalias ',f #',testsym2)
                (make-obsolete
                 ',f ,(format "use (cl-typep ... \\='%s) instead" name)
                 "25.1"))))
@@ -288,8 +288,8 @@ created by the :initarg tag."
   (declare (debug (form symbolp)))
   `(eieio-oref ,obj (quote ,slot)))
 
-(defalias 'slot-value 'eieio-oref)
-(defalias 'set-slot-value 'eieio-oset)
+(defalias 'slot-value #'eieio-oref)
+(defalias 'set-slot-value #'eieio-oset)
 (make-obsolete 'set-slot-value "use (setf (slot-value ..) ..) instead" "25.1")
 
 (defmacro oref-default (obj slot)
@@ -418,7 +418,7 @@ If EXTRA, include that in the string returned to represent the symbol."
   (cl-check-type obj eieio-object)
   (eieio-class-name (eieio--object-class obj)))
 (define-obsolete-function-alias
-  'object-class-name 'eieio-object-class-name "24.4")
+  'object-class-name #'eieio-object-class-name "24.4")
 
 (defun eieio-class-parents (class)
   ;; FIXME: What does "(overload of variable)" mean here?
@@ -446,7 +446,7 @@ The CLOS function `class-direct-subclasses' is aliased to this function."
 (defmacro eieio-class-parent (class)
   "Return first parent class to CLASS.  (overload of variable)."
   `(car (eieio-class-parents ,class)))
-(define-obsolete-function-alias 'class-parent 'eieio-class-parent "24.4")
+(define-obsolete-function-alias 'class-parent #'eieio-class-parent "24.4")
 
 (defun same-class-p (obj class)
   "Return t if OBJ is of class-type CLASS."
@@ -461,7 +461,7 @@ The CLOS function `class-direct-subclasses' is aliased to this function."
   ;; class will be checked one layer down
   (child-of-class-p (eieio--object-class obj) class))
 ;; Backwards compatibility
-(defalias 'obj-of-class-p 'object-of-class-p)
+(defalias 'obj-of-class-p #'object-of-class-p)
 
 (defun child-of-class-p (child class)
   "Return non-nil if CHILD class is a subclass of CLASS."
@@ -665,7 +665,7 @@ This class is not stored in the `parent' slot of a class vector."
 (setq eieio-default-superclass (cl--find-class 'eieio-default-superclass))
 
 (define-obsolete-function-alias 'standard-class
-  'eieio-default-superclass "26.1")
+  #'eieio-default-superclass "26.1")
 
 (cl-defgeneric make-instance (class &rest initargs)
   "Make a new instance of CLASS based on INITARGS.
@@ -972,12 +972,12 @@ this object."
 This may create or delete slots, but does not affect the return value
 of `eq'."
   (error "EIEIO: `change-class' is unimplemented"))
-(define-obsolete-function-alias 'change-class 'eieio-change-class "26.1")
+(define-obsolete-function-alias 'change-class #'eieio-change-class "26.1")
 
 ;; Hook ourselves into help system for describing classes and methods.
 ;; FIXME: This is not actually needed any more since we can click on the
 ;; hyperlink from the constructor's docstring to see the type definition.
-(add-hook 'help-fns-describe-function-functions 'eieio-help-constructor)
+(add-hook 'help-fns-describe-function-functions #'eieio-help-constructor)
 
 (provide 'eieio)
 

lisp/emacs-lisp/ert-x.el

@@ -367,8 +367,7 @@ different resource directory naming scheme, set the variable
 name will be trimmed using `string-trim' with arguments
 `ert-resource-directory-trim-left-regexp' and
 `ert-resource-directory-trim-right-regexp'."
-  `(let* ((testfile ,(or (bound-and-true-p byte-compile-current-file)
-                         (and load-in-progress load-file-name)
+  `(let* ((testfile ,(or (macroexp-file-name)
                          buffer-file-name))
           (default-directory (file-name-directory testfile)))
      (file-truename

lisp/emacs-lisp/macroexp.el

@@ -112,7 +112,7 @@ and also to avoid outputting the warning during normal execution."
        (funcall (eval (cadr form)))
        (byte-compile-constant nil)))
 
-(defun macroexp--compiling-p ()
+(defun macroexp-compiling-p ()
   "Return non-nil if we're macroexpanding for the compiler."
   ;; FIXME: ¡¡Major Ugly Hack!! To determine whether the output of this
   ;; macro-expansion will be processed by the byte-compiler, we check
@@ -120,13 +120,22 @@ and also to avoid outputting the warning during normal execution."
   (member '(declare-function . byte-compile-macroexpand-declare-function)
           macroexpand-all-environment))
 
+(defun macroexp-file-name ()
+  "Return the name of the file from which the code comes.
+Returns nil when we do not know.
+A non-nil result is expected to be reliable when called from a macro in order
+to find the file in which the macro's call was found, and it should be
+reliable as well when used at the top-level of a file.
+Other uses risk returning non-nil value that point to the wrong file."
+  (or load-file-name (bound-and-true-p byte-compile-current-file)))
+
 (defvar macroexp--warned (make-hash-table :test #'equal :weakness 'key))
 
 (defun macroexp--warn-and-return (msg form &optional compile-only)
   (let ((when-compiled (lambda () (byte-compile-warn "%s" msg))))
     (cond
      ((null msg) form)
-     ((macroexp--compiling-p)
+     ((macroexp-compiling-p)
       (if (and (consp form) (gethash form macroexp--warned))
           ;; Already wrapped this exp with a warning: avoid inf-looping
           ;; where we keep adding the same warning onto `form' because

lisp/emacs-lisp/package.el

@@ -4024,10 +4024,7 @@ The return value is a string (or nil in case we can't find it)."
   ;; the version at compile time and hardcodes it into the .elc file!
   (declare (pure t))
   ;; Hack alert!
-  (let ((file
-         (or (if (boundp 'byte-compile-current-file) byte-compile-current-file)
-             load-file-name
-             buffer-file-name)))
+  (let ((file (or (macroexp-file-name) buffer-file-name)))
     (cond
      ((null file) nil)
      ;; Packages are normally installed into directories named "<pkg>-<vers>",

lisp/progmodes/flymake.el

@@ -287,8 +287,7 @@ LEVEL is passed to `display-warning', which is used to display
 the warning.  If this form is included in a byte-compiled file,
 the generated warning contains an indication of the file that
 generated it."
-  (let* ((compile-file (and (boundp 'byte-compile-current-file)
-                            (symbol-value 'byte-compile-current-file)))
+  (let* ((compile-file (macroexp-file-name))
          (sublog (if (and
                       compile-file
                       (not load-file-name))

lisp/subr.el

@@ -2097,7 +2097,7 @@ can do the job."
                      ,(if append
                           `(setq ,sym (append ,sym (list ,x)))
                         `(push ,x ,sym))))))
-          (if (not (macroexp--compiling-p))
+          (if (not (macroexp-compiling-p))
               code
             `(progn
                (macroexp--funcall-if-compiled ',warnfun)
@@ -3335,7 +3335,7 @@ to `accept-change-group' or `cancel-change-group'."
         ;; insertions are ever merged/combined, so we use such a "boundary"
         ;; only when the last change was an insertion and we use the position
         ;; of the last insertion.
-        (when (numberp (caar buffer-undo-list))
+        (when (numberp (car-safe (car buffer-undo-list)))
           (push (cons (caar buffer-undo-list) (caar buffer-undo-list))
                 buffer-undo-list))))))
 
@@ -5045,14 +5045,10 @@ This function is called directly from the C code."
                             obarray))
 	   (msg (format "Package %s is deprecated" package))
 	   (fun (lambda (msg) (message "%s" msg))))
-      ;; Cribbed from cl--compiling-file.
       (when (or (not (fboundp 'byte-compile-warning-enabled-p))
                 (byte-compile-warning-enabled-p 'obsolete package))
         (cond
-	 ((and (boundp 'byte-compile--outbuffer)
-	       (bufferp (symbol-value 'byte-compile--outbuffer))
-	       (equal (buffer-name (symbol-value 'byte-compile--outbuffer))
-		      " *Compiler Output*"))
+	 ((bound-and-true-p byte-compile-current-file)
 	  ;; Don't warn about obsolete files using other obsolete files.
 	  (unless (and (stringp byte-compile-current-file)
 		       (string-match-p "/obsolete/[^/]*\\'"