* 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`.

diff --git a/etc/NEWS b/etc/NEWS
index 2bad41f5ee9190d87124e8aff4af5ca592e68386..caa366aaef8a29715d1527f0180554863d24ee48 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -369,6 +369,12 @@ the buffer cycles the whole buffer between "only top-level headings",
 \f
 * 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.

diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el
index 91944c44f5e06f2b3144dcfa27ea42b173fab263..3c36c6cb9f8aa0e80b6582bf57a319424cfa5126 100644 (file)
--- a/lisp/cedet/semantic/fw.el
+++ b/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)

diff --git a/lisp/cedet/semantic/wisent/comp.el b/lisp/cedet/semantic/wisent/comp.el
index 755d30a371b4803fd6c85507c861907c56c08284..7a64fe2fec392ae58d1e477a114a8334c9647fa2 100644 (file)
--- a/lisp/cedet/semantic/wisent/comp.el
+++ b/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)))

diff --git a/lisp/cedet/semantic/wisent/python.el b/lisp/cedet/semantic/wisent/python.el
index 74f190c08606ba569bc7c453032564676d8e5143..7769ad1961b06d373127a41be4b6a0fbffb8a32c 100644 (file)
--- a/lisp/cedet/semantic/wisent/python.el
+++ b/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)

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index c0683babcf977e2d2079fc4abd62b543246dc7b6..26fab31b961d77473222894f074176a1c89ff9a2 100644 (file)
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/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))
 

diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index f06452ea174a8fa77be0b0d144c3c431e969c64b..7f7eb96342357233d9a37dcf1a68472276c34221 100644 (file)
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/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.
 
 

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index b9a8a3f112585340095fcbc6d0e05ed27727141a..b852d825c761cacfba12a1e720a9c3f228180258 100644 (file)
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/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)

diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index a095ad0f6db63416c432b686f4a5e668aeb22d70..d3e5d03edb58333e8b6a97a7aa6484d4757c02dc 100644 (file)
--- a/lisp/emacs-lisp/eieio.el
+++ b/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)
 

diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el
index bf9aff67a694b32c1be23aa29903d3270f0c138d..1191fb8f8dea7a9735f8e2a4e0a9d542cb4ef7e4 100644 (file)
--- a/lisp/emacs-lisp/ert-x.el
+++ b/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

diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 0934e43e66a8c59b11683721cb2f3d40ed6939b3..a6b0985e6c7e52e7bb33a69b3cff07ce41c0d709 100644 (file)
--- a/lisp/emacs-lisp/macroexp.el
+++ b/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

diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 092befa1f2e1698d32f70eda6a76df75e6f52dfe..c81992145db469ad16f1c04a53aaa7054a3ba895 100644 (file)
--- a/lisp/emacs-lisp/package.el
+++ b/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>",

diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index d01803282aa9b9a028cf0fd2fe97094d888a85fb..bd308e02203ed4d45f77cab007c88228d33cefc4 100644 (file)
--- a/lisp/progmodes/flymake.el
+++ b/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))

diff --git a/lisp/subr.el b/lisp/subr.el
index 2ad31b656eae50b87952b3b64032ced0031147b3..cc8b85b1d39401334cb7b23663cb648a8f92064f 100644 (file)
--- a/lisp/subr.el
+++ b/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/[^/]*\\'"