From 2766f9fdb95a1a4418020d32ce3f0cbd262f7cee Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 24 Feb 2021 13:52:45 -0500 Subject: [PATCH] * 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 | 6 ++++++ lisp/cedet/semantic/fw.el | 10 ++++------ lisp/cedet/semantic/wisent/comp.el | 8 ++------ lisp/cedet/semantic/wisent/python.el | 5 ----- lisp/emacs-lisp/bytecomp.el | 5 +++++ lisp/emacs-lisp/cl-lib.el | 11 +++-------- lisp/emacs-lisp/cl-macs.el | 18 +++++++++--------- lisp/emacs-lisp/eieio.el | 18 +++++++++--------- lisp/emacs-lisp/ert-x.el | 3 +-- lisp/emacs-lisp/macroexp.el | 13 +++++++++++-- lisp/emacs-lisp/package.el | 5 +---- lisp/progmodes/flymake.el | 3 +-- lisp/subr.el | 10 +++------- 13 files changed, 55 insertions(+), 60 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 2bad41f5ee9..caa366aaef8 100644 --- a/etc/NEWS +++ b/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. diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el index 91944c44f5e..3c36c6cb9f8 100644 --- 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 755d30a371b..7a64fe2fec3 100644 --- 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 74f190c0860..7769ad1961b 100644 --- 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 c0683babcf9..26fab31b961 100644 --- 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 f06452ea174..7f7eb963423 100644 --- 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 b9a8a3f1125..b852d825c76 100644 --- 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 a095ad0f6db..d3e5d03edb5 100644 --- 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 bf9aff67a69..1191fb8f8de 100644 --- 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 0934e43e66a..a6b0985e6c7 100644 --- 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 092befa1f2e..c81992145db 100644 --- 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 "-", diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index d01803282aa..bd308e02203 100644 --- 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 2ad31b656ea..cc8b85b1d39 100644 --- 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/[^/]*\\'" -- 2.39.2