[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 2766f9f: * lisp/emacs-lisp/macroexp.el (macroexp-file-name): New
|
From: |
Stefan Monnier |
|
Subject: |
master 2766f9f: * lisp/emacs-lisp/macroexp.el (macroexp-file-name): New function. |
|
Date: |
Wed, 24 Feb 2021 13:52:52 -0500 (EST) |
branch: master
commit 2766f9fdb95a1a4418020d32ce3f0cbd262f7cee
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
* 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 2bad41f..caa366a 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 91944c4..3c36c6c 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 755d30a..7a64fe2 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 74f190c..7769ad19 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 c0683ba..26fab31 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 f06452e..7f7eb96 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 b9a8a3f..b852d82 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 a095ad0..d3e5d03 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 bf9aff6..1191fb8 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 0934e43..a6b0985 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 092befa..c819921 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 "<pkg>-<vers>",
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index d018032..bd308e0 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 2ad31b6..cc8b85b 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/[^/]*\\'"
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 2766f9f: * lisp/emacs-lisp/macroexp.el (macroexp-file-name): New function.,
Stefan Monnier <=