[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/android c045d5322c2 2/3: Merge remote-tracking branch 'origin/ma
|
From: |
Po Lu |
|
Subject: |
feature/android c045d5322c2 2/3: Merge remote-tracking branch 'origin/master' into feature/android |
|
Date: |
Sat, 18 Feb 2023 10:21:42 -0500 (EST) |
branch: feature/android
commit c045d5322c2c1658f215bf59d431fcc8f96ffc12
Merge: a61f9cb77ce 97f24924df6
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>
Merge remote-tracking branch 'origin/master' into feature/android
---
doc/lispref/compile.texi | 86 ++++++++++++++++++++------
doc/lispref/frames.texi | 40 ++++++++----
etc/NEWS | 3 +-
etc/NEWS.29 | 20 +++---
lisp/calc/calc.el | 9 +--
lisp/emacs-lisp/comp.el | 68 ++++++++++++--------
lisp/emacs-lisp/package.el | 7 +--
lisp/faces.el | 6 +-
lisp/files.el | 13 +++-
lisp/frame.el | 5 +-
lisp/hi-lock.el | 1 +
lisp/loadup.el | 15 +++--
lisp/progmodes/cc-engine.el | 2 +-
lisp/progmodes/elisp-mode.el | 4 +-
lisp/progmodes/project.el | 31 +++++++---
lisp/startup.el | 12 ++--
lisp/subr.el | 7 ++-
lisp/time.el | 4 +-
lisp/treesit.el | 9 ++-
src/comp.c | 98 +++++++++++++++--------------
src/data.c | 2 +-
src/treesit.c | 26 ++++++--
src/xdisp.c | 11 ++--
test/lisp/hi-lock-tests.el | 143 ++++++++++++++++++++++++-------------------
24 files changed, 383 insertions(+), 239 deletions(-)
diff --git a/doc/lispref/compile.texi b/doc/lispref/compile.texi
index be2125a9ab3..cdbf64036da 100644
--- a/doc/lispref/compile.texi
+++ b/doc/lispref/compile.texi
@@ -849,7 +849,12 @@ from writing its results, the @file{*.eln} files, into a
subdirectory
of @code{user-emacs-directory} (@pxref{Init File}). You can do that
by either changing the value of @code{native-comp-eln-load-path}
(@pxref{Native-Compilation Variables}) or by temporarily pointing the
-@env{HOME} environment variable to a non-existing directory.
+@env{HOME} environment variable to a non-existing directory. Note
+that the latter technique might still produce a small number of
+@file{*.eln} files if Emacs needs to generate @dfn{trampolines}, which
+are used if Lisp primitives are advised or redefined in your Lisp code
+that is being natively compiled. @xref{Native-Compilation Variables,
+trampolines}.
@menu
* Native-Compilation Functions:: Functions to natively-compile Lisp.
@@ -981,24 +986,6 @@ whether native-compilation is available should use this
predicate.
This section documents the variables that control
native-compilation.
-@defvar inhibit-automatic-native-compilation
-If your Emacs has support for native compilation, Emacs will (by
-default) compile the Lisp files you're loading in the background, and
-then install the native-compiled versions of the functions. If you
-wish to disable this, you can set this variable to non-@code{nil}. If
-you want to set it permanently, this should probably be done from the
-early init file, since setting it in the normal init file is probably
-too late.
-
-While setting this variable disables automatic compilation of Lisp
-files, the compiler may still be invoked to install @dfn{trampolines}
-if any built-in functions are redefined. However, these trampolines
-will not get written to your cache directory.
-
-You can also use the @samp{EMACS_INHIBIT_AUTOMATIC_NATIVE_COMPILATION}
-environment variable to disable native compilation.
-@end defvar
-
@defopt native-comp-speed
This variable specifies the optimization level for native compilation.
Its value should be a number between @minus{}1 and 3. Values between
@@ -1093,3 +1080,64 @@ The directories in this list are also used for writing
the
specifically, Emacs will write these files into the first writable
directory in the list. Thus, you can control where native-compilation
stores the results by changing the value of this variable.
+
+@cindex disable asynchronous native compilation
+@cindex inhibit asynchronous native compilation
+@cindex asynchronous native compilation, disable
+@defvar native-comp-jit-compilation
+This variable, if non-@code{nil}, enables asynchronous (a.k.a.@:
+@dfn{just-in-time}, or @acronym{JIT}) native compilation of the
+@file{*.elc} files loaded by Emacs for which the corresponding
+@file{*.eln} files do not already exist. This JIT compilation uses
+separate Emacs sub-processes running in batch mode, according to the
+value of @code{native-comp-async-jobs-number}. When the JIT
+compilation of a Lisp file finishes successfully, the resulting
+@file{.eln} file is loaded and its code replaces the definition of
+functions provided by the @file{.elc} file.
+@end defvar
+
+@cindex trampolines, in native compilation
+ Setting the value of @code{native-comp-jit-compilation} to@code{nil}
+disables JIT native compilation. However, even when JIT native
+compilation is disabled, Emacs might still need to start asynchronous
+native compilation subprocesses to produce @dfn{trampolines}. To
+control this, use a separate variable, described below.
+
+@defvar native-comp-enable-subr-trampolines
+This variable controls generation of trampolines. A trampoline is a
+small piece of native code required to allow calling Lisp primitives,
+which were advised or redefined, from Lisp code that was
+natively-compiled with @code{native-comp-speed} set to 2 or greater.
+Emacs stores the generated trampolines on separate @file{*.eln} files.
+By default, this variable's value is @code{t}, which enables the
+generation of trampoline files; setting it to @code{nil} disables the
+generation of trampolines. Note that if a trampoline needed for
+advising or redefining a primitive is not available and cannot be
+generated, calls to that primitive from natively-compiled Lisp will
+ignore redefinitions and advices, and will behave as if the primitive
+was called directly from C. Therefore, we don't recommend disabling
+the trampoline generation, unless you know that all the trampolines
+needed by your Lisp programs are already compiled and accessible to
+Emacs.
+
+The value of this variable can also be a string, in which case it is
+interpreted as the name of a directory in which to store the generated
+trampoline @file{*.eln} files, overriding the directories specified by
+@code{native-comp-eln-load-path}. This is useful if you want the
+trampolines to be generated as needed, but don't want to store them
+under the user's @env{HOME} directory or the other public directories
+where @file{*.eln} files are kept. However, unlike with directories
+in @code{native-comp-eln-load-path}, the trampolines will be stored in
+the directory given by the value of this variable, not in its
+version-specific subdirectory.
+
+If this variable is non-@code{nil}, and Emacs needs to produce a
+trampoline, but it cannot find any writable directory to store the
+trampoline, it will store it inside @code{temporary-file-directory}
+(@pxref{Unique File Names}).
+
+Trampolines produced when no writable directory is found to store
+them, or when this variable is a string, will only be available for
+the duration of the current Emacs session, because Emacs doesn't look
+for trampolines in either of these places.
+@end defvar
diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi
index 6ffefe8184f..3f51f55c7e1 100644
--- a/doc/lispref/frames.texi
+++ b/doc/lispref/frames.texi
@@ -1475,19 +1475,24 @@ in this frame. Its value is @code{color},
@code{grayscale} or
@vindex title@r{, a frame parameter}
@item title
-If a frame has a non-@code{nil} title, it appears in the window
+If a frame has a non-@code{nil} title, that title appears in the window
system's title bar at the top of the frame, and also in the mode line
of windows in that frame if @code{mode-line-frame-identification} uses
@samp{%F} (@pxref{%-Constructs}). This is normally the case when
Emacs is not using a window system, and can only display one frame at
-a time. @xref{Frame Titles}.
+a time. When Emacs is using a window system, this parameter, if
+non-@code{nil}, overrides the title determined by the @code{name}
+parameter and the implicit title calculated according to
+@code{frame-title-format}. It also overrides the title determined by
+@code{icon-title-format} for iconified frames. @xref{Frame Titles}.
@vindex name@r{, a frame parameter}
@item name
-The name of the frame. The frame name serves as a default for the frame
-title, if the @code{title} parameter is unspecified or @code{nil}. If
-you don't specify a name, Emacs sets the frame name automatically
-(@pxref{Frame Titles}).
+The name of the frame. If you don't specify a name via this
+parameter, Emacs sets the frame name automatically, as specified by
+@code{frame-title-format} and @code{icon-title-format}, and that is
+the frame's title that will appear on display when Emacs uses a window
+system (unless the @code{title} parameter overrides it).
If you specify the frame name explicitly when you create the frame, the
name is also used (instead of the name of the Emacs executable) when
@@ -2632,17 +2637,26 @@ frame name automatically based on a template stored in
the variable
frame is redisplayed.
@defvar frame-title-format
-This variable specifies how to compute a name for a frame when you have
-not explicitly specified one. The variable's value is actually a mode
+This variable specifies how to compute a name for a frame when you
+have not explicitly specified one (via the frame's parameters;
+@pxref{Basic Parameters}). The variable's value is actually a mode
line construct, just like @code{mode-line-format}, except that the
-@samp{%c}, @samp{%C}, and @samp{%l} constructs are ignored. @xref{Mode Line
-Data}.
+@samp{%c}, @samp{%C}, and @samp{%l} constructs are ignored.
+@xref{Mode Line Data}.
@end defvar
@defvar icon-title-format
-This variable specifies how to compute the name for an iconified frame,
-when you have not explicitly specified the frame title. This title
-appears in the icon itself.
+This variable specifies how to compute the name for an iconified frame
+when you have not explicitly specified the frame's name via the
+frame's parameters. The resulting title appears in the frame's icon
+itself. If the value is a string, is should be a mode line construct
+like that of @code{frame-title-format}. The value can also be
+@code{t}, which means to use @code{frame-title-format} instead; this
+avoids problems with some window managers and desktop environments,
+where a change in a frame's title (when a frame is iconified) is
+interpreted as a request to raise the frame and/or give it input
+focus. The default is a string identical to the default value of
+@code{frame-title-format}.
@end defvar
@defvar multiple-frames
diff --git a/etc/NEWS b/etc/NEWS
index 94e41df8f3c..af37633db83 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -63,7 +63,7 @@ This allows the user to customize the prompt that is appended
by
"(yes or no) ".
---
-** New face 'display-time-time-and-date-indicator'.
+** New face 'display-time-date-and-time'.
This is used for displaying the time and date components of
'display-time-mode'.
@@ -305,7 +305,6 @@ define "sexps" in tree-sitter enabled modes.
Tree-sitter conditionally sets 'forward-sexp-function' for major modes
that have defined 'treesit-sexp-type-regexp' to enable sexp-related
motion commands.
->>>>>>> origin/master
** New or changed byte-compilation warnings
diff --git a/etc/NEWS.29 b/etc/NEWS.29
index 35063678f58..b140d1dcbfd 100644
--- a/etc/NEWS.29
+++ b/etc/NEWS.29
@@ -199,13 +199,6 @@ load time.
** Native Compilation
+++
-*** New variable 'inhibit-automatic-native-compilation'.
-If set, Emacs will inhibit native compilation (and won't write
-anything to the eln cache automatically). The variable is initialized
-during Emacs startup from the environment variable
-'EMACS_INHIBIT_AUTOMATIC_NATIVE_COMPILATION'.
-
----
*** New command 'native-compile-prune-cache'.
This command deletes old subdirectories of the eln cache (but not the
ones for the current Emacs version). Note that subdirectories of the
@@ -1202,6 +1195,13 @@ the most recently deleted frame. With a numerical
prefix argument
between 1 and 16, where 1 is the most recently deleted frame, undelete
the corresponding deleted frame.
++++
+*** The variable 'icon-title-format' can now have the value t.
+That value means to use 'frame-title-format' for iconified frames.
+This is useful with some window managers and desktop environments
+which treat changes in frame's title as requests to raise the frame
+and/or give it input focus.
+
** Tab Bars and Tab Lines
---
@@ -3251,8 +3251,10 @@ for which a "built-in" mode would be turned on. For
example:
(add-to-list 'major-mode-remap-alist '(ruby-mode . ruby-ts-mode))
If you try these modes and don't like them, you can go back to the
-"built-in" modes by restarting Emacs. But please tell us why you
-didn't like the tree-sitter based modes, so that we could try
+"built-in" modes by restarting Emacs. (If you use desktop.el to save
+and restore Emacs sessions, make sure no buffer under these modes is
+recorded in the desktop file, before restarting.) But please tell us
+why you didn't like the tree-sitter based modes, so that we could try
improving them.
Each major mode based on tree-sitter needs a language grammar library,
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index 26556bf056a..1da4f9ad738 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -1286,16 +1286,17 @@ the trail buffer."
(defun calc-mode ()
"Calculator major mode.
-This is an RPN calculator featuring arbitrary-precision integer, rational,
-floating-point, complex, matrix, and symbolic arithmetic.
+This is a Reverse Polish notation (RPN) calculator featuring
+arbitrary-precision integer, rational, floating-point, complex,
+matrix, and symbolic arithmetic.
RPN calculation: 2 RET 3 + produces 5.
Algebraic style: \\=' 2+3 RET produces 5.
Basic operators are +, -, *, /, ^, & (reciprocal), % (modulo), n (change-sign).
-Press ? repeatedly for more complete help. Press `h i' to read the
-Calc manual on-line, `h s' to read the summary, or `h t' for the tutorial.
+Press \\`?' repeatedly for more complete help. Press \\`h i' to read the
+Calc manual, \\`h s' to read the summary, or \\`h t' for the tutorial.
Notations: 3.14e6 3.14 * 10^6
_23 negative number -23 (or type `23 n')
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index d2e7d933f4f..5e707d2d631 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -85,13 +85,17 @@ This is intended for debugging the compiler itself.
:type 'boolean
:version "28.1")
-(defcustom native-comp-deferred-compilation-deny-list
+(defcustom native-comp-jit-compilation-deny-list
'()
"List of regexps to exclude matching files from deferred native compilation.
Files whose names match any regexp are excluded from native compilation."
:type '(repeat regexp)
:version "28.1")
+(make-obsolete-variable 'native-comp-deferred-compilation-deny-list
+ 'native-comp-jit-compilation-deny-list
+ "29.1")
+
(defcustom native-comp-bootstrap-deny-list
'()
"List of regexps to exclude files from native compilation during bootstrap.
@@ -105,7 +109,11 @@ during bootstrap."
;; correctly (see comment in `advice--add-function'). DO NOT
;; REMOVE.
macroexpand rename-buffer)
- "Primitive functions to exclude from trampoline optimization."
+ "Primitive functions to exclude from trampoline optimization.
+
+Primitive functions included in this list will not be called
+directly by the natively-compiled code, which makes trampolines for
+those primitives unnecessary in case of function redefinition/advice."
:type '(repeat symbol)
:version "28.1")
@@ -695,7 +703,7 @@ Useful to hook into pass checkers.")
;;;###autoload
(defun comp-subr-trampoline-install (subr-name)
"Make SUBR-NAME effectively advice-able when called from native code."
- (unless (or (null comp-enable-subr-trampolines)
+ (unless (or (null native-comp-enable-subr-trampolines)
(memq subr-name native-comp-never-optimize-functions)
(gethash subr-name comp-installed-trampolines-h))
(cl-assert (subr-primitive-p (symbol-function subr-name)))
@@ -3782,6 +3790,32 @@ Return the trampoline if found or nil otherwise."
when (file-exists-p filename)
do (cl-return (native-elisp-load filename))))
+(defun comp--trampoline-abs-filename (subr-name)
+ "Return the absolute filename for a trampoline for SUBR-NAME."
+ (cl-loop
+ with dirs = (if (stringp native-comp-enable-subr-trampolines)
+ (list native-comp-enable-subr-trampolines)
+ (if native-compile-target-directory
+ (list (expand-file-name comp-native-version-dir
+ native-compile-target-directory))
+ (comp-eln-load-path-eff)))
+ with rel-filename = (comp-trampoline-filename subr-name)
+ for dir in dirs
+ for abs-filename = (expand-file-name rel-filename dir)
+ unless (file-exists-p dir)
+ do (ignore-errors
+ (make-directory dir t)
+ (cl-return abs-filename))
+ when (file-writable-p abs-filename)
+ do (cl-return abs-filename)
+ ;; Default to some temporary directory if no better option was
+ ;; found.
+ finally (cl-return
+ (expand-file-name
+ (make-temp-file-internal (file-name-sans-extension rel-filename)
+ 0 ".eln" nil)
+ temporary-file-directory))))
+
(defun comp-trampoline-compile (subr-name)
"Synthesize compile and return a trampoline for SUBR-NAME."
(let* ((lambda-list (comp-make-lambda-list-from-subr
@@ -3803,25 +3837,7 @@ Return the trampoline if found or nil otherwise."
(lexical-binding t))
(comp--native-compile
form nil
- ;; If we've disabled nativecomp, don't write the trampolines to
- ;; the eln cache (but create them).
- (unless inhibit-automatic-native-compilation
- (cl-loop
- for dir in (if native-compile-target-directory
- (list (expand-file-name comp-native-version-dir
-
native-compile-target-directory))
- (comp-eln-load-path-eff))
- for f = (expand-file-name
- (comp-trampoline-filename subr-name)
- dir)
- unless (file-exists-p dir)
- do (ignore-errors
- (make-directory dir t)
- (cl-return f))
- when (file-writable-p f)
- do (cl-return f)
- finally (error "Cannot find suitable directory for output in \
-`native-comp-eln-load-path'"))))))
+ (comp--trampoline-abs-filename subr-name))))
;; Some entry point support code.
@@ -4110,14 +4126,12 @@ the deferred compilation mechanism."
data
;; So we return the compiled function.
(native-elisp-load data)))
- ;; We may have created a temporary file when we're being
- ;; called with something other than a file as the argument.
- ;; Delete it if we can.
(when (and (not (stringp function-or-file))
(not output)
comp-ctxt
(comp-ctxt-output comp-ctxt)
(file-exists-p (comp-ctxt-output comp-ctxt)))
+ ;; NOTE: Not sure if we want to remove this or being cautious.
(cond ((eq 'windows-nt system-type)
;; We may still be using the temporary .eln file.
(ignore-errors (delete-file (comp-ctxt-output comp-ctxt))))
@@ -4137,11 +4151,11 @@ LOAD and SELECTOR work as described in
`native--compile-async'."
(t (error "SELECTOR must be a function a regexp or nil")))
;; Also exclude files from deferred compilation if
;; any of the regexps in
- ;; `native-comp-deferred-compilation-deny-list' matches.
+ ;; `native-comp-jit-compilation-deny-list' matches.
(and (eq load 'late)
(cl-some (lambda (re)
(string-match-p re file))
- native-comp-deferred-compilation-deny-list))))
+ native-comp-jit-compilation-deny-list))))
(defun native--compile-async (files &optional recursively load selector)
;; BEWARE, this function is also called directly from C.
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 09917cd29b1..a0bb5e75393 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -378,10 +378,8 @@ If so, and variable `package-check-signature' is
`allow-unsigned', return `allow-unsigned', otherwise return the
value of variable `package-check-signature'."
(if (eq package-check-signature 'allow-unsigned)
- (progn
- (require 'epg-config)
- (and (epg-find-configuration 'OpenPGP)
- 'allow-unsigned))
+ (and (epg-find-configuration 'OpenPGP)
+ 'allow-unsigned)
package-check-signature))
(defcustom package-unsigned-archives nil
@@ -958,7 +956,6 @@ Newer versions are always activated, regardless of FORCE."
"Untar the current buffer.
This uses `tar-untar-buffer' from Tar mode. All files should
untar into a directory named DIR; otherwise, signal an error."
- (require 'tar-mode)
(tar-mode)
;; Make sure everything extracts into DIR.
(let ((regexp (concat "\\`" (regexp-quote (expand-file-name dir)) "/"))
diff --git a/lisp/faces.el b/lisp/faces.el
index 7fe2cccba90..830d3b7a49a 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -191,7 +191,7 @@ For internal use only."
(let ((face-id (car (gethash face face--new-frame-defaults))))
(push `(,face-id ,face . ,spec) faces)))
(frame--face-hash-table frame))
- (mapcar #'cdr (sort faces (lambda (f1 f2) (< (car f1) (car f2)))))))
+ (mapcar #'cdr (sort faces (lambda (f1 f2) (> (car f1) (car f2)))))))
(defun face-list ()
"Return a list of all defined faces."
@@ -199,7 +199,7 @@ For internal use only."
(maphash (lambda (face spec)
(push `(,(car spec) . ,face) faces))
face--new-frame-defaults)
- (mapcar #'cdr (sort faces (lambda (f1 f2) (< (car f1) (car f2)))))))
+ (mapcar #'cdr (sort faces (lambda (f1 f2) (> (car f1) (car f2)))))))
(defun make-face (face)
"Define a new face with name FACE, a symbol.
@@ -2226,7 +2226,7 @@ the X resource \"reverseVideo\" is present, handle that."
(unwind-protect
(progn
(x-setup-function-keys frame)
- (dolist (face (nreverse (face-list)))
+ (dolist (face (face-list))
(face-spec-recalc face frame))
(x-handle-reverse-video frame parameters)
(frame-set-background-mode frame t)
diff --git a/lisp/files.el b/lisp/files.el
index b0ec6bb09d0..5b989902bc3 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -6360,7 +6360,18 @@ If FILE1 or FILE2 does not exist, the return value is
unspecified."
(let (f1-attr f2-attr)
(and (setq f1-attr (file-attributes (file-truename file1)))
(setq f2-attr (file-attributes (file-truename file2)))
- (equal f1-attr f2-attr))))))
+ (progn
+ ;; Haiku systems change the file's last access timestamp
+ ;; every time `stat' is called. Make sure to not compare
+ ;; the timestamps in that case.
+ (or (equal f1-attr f2-attr)
+ (when (and (eq system-type 'haiku)
+ (consp (nthcdr 4 f1-attr))
+ (consp (nthcdr 4 f2-attr)))
+ (ignore-errors
+ (setcar (nthcdr 4 f1-attr) nil)
+ (setcar (nthcdr 4 f2-attr) nil))
+ (equal f1-attr f2-attr)))))))))
(defun file-in-directory-p (file dir)
"Return non-nil if DIR is a parent directory of FILE.
diff --git a/lisp/frame.el b/lisp/frame.el
index d925a87153c..3fd8dbbdc36 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -2142,8 +2142,9 @@ frame's display)."
;; a toggle.
(featurep 't-mouse)
;; No way to check whether a w32 console has a mouse, assume
- ;; it always does.
- (boundp 'w32-use-full-screen-buffer))))))
+ ;; it always does, except in batch invocations.
+ (and (not noninteractive)
+ (boundp 'w32-use-full-screen-buffer)))))))
(defun display-popup-menus-p (&optional display)
"Return non-nil if popup menus are supported on DISPLAY.
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index 78fc5e6f716..5c536b190fb 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -611,6 +611,7 @@ then remove all hi-lock highlighting."
(cond
(current-prefix-arg (list t))
((and (display-popup-menus-p)
+ last-nonmenu-event
(listp last-nonmenu-event)
use-dialog-box)
(catch 'snafu
diff --git a/lisp/loadup.el b/lisp/loadup.el
index 3b30414b146..f6f48b3b735 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -594,7 +594,7 @@ lost after dumping")))
(equal dump-mode "pdump"))
;; Don't enable this before bootstrap is completed, as the
;; compiler infrastructure may not be usable yet.
- (setq comp-enable-subr-trampolines t))
+ (setq native-comp-enable-subr-trampolines t))
(message "Dumping under the name %s" output)
(condition-case ()
(delete-file output)
@@ -644,10 +644,17 @@ lost after dumping")))
(message "Adding name %s" (concat name ".pdmp"))
(add-name-to-file (expand-file-name "emacs.pdmp"
invocation-directory)
- (expand-file-name (concat name ".pdmp")
+ (expand-file-name (concat name exe)
invocation-directory)
- t))))
- (kill-emacs))))
+ t)
+ (when (equal dump-mode "pdump")
+ (message "Adding name %s" (concat name ".pdmp"))
+ (add-name-to-file (expand-file-name "emacs.pdmp"
+ invocation-directory)
+ (expand-file-name (concat name ".pdmp")
+ invocation-directory)
+ t))))
+ (kill-emacs)))))
;; This file must be loaded each time Emacs is run from scratch, e.g., temacs.
;; So run the startup code now. First, remove `-l loadup' from args.
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index f8ae49c42dd..037a53421a8 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -14951,7 +14951,7 @@ comment at the start of cc-engine.el for more info."
'case-label)
(1+ containing-sexp)))
(t (c-add-syntax (if (eq (char-before) ?:)
- 'case-label
+ 'case-label
'statement-case-intro)
(1+ containing-sexp))))))
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index be969b0c3e3..1c339d08148 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -220,8 +220,8 @@ All commands in `lisp-mode-shared-map' are inherited by
this map."
Load the compiled code when finished.
Use `emacs-lisp-byte-compile-and-load' in combination with
-`inhibit-automatic-native-compilation' set to nil to achieve
-asynchronous native compilation."
+`native-comp-jit-compilation' set to t to achieve asynchronous
+native compilation."
(interactive nil emacs-lisp-mode)
(emacs-lisp--before-compile-buffer)
(load (native-compile buffer-file-name)))
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 2343adf4698..1228c73fee8 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1,7 +1,7 @@
;;; project.el --- Operations on the current project -*- lexical-binding: t;
-*-
;; Copyright (C) 2015-2023 Free Software Foundation, Inc.
-;; Version: 0.9.6
+;; Version: 0.9.7
;; Package-Requires: ((emacs "26.1") (xref "1.4.0"))
;; This is a GNU ELPA :core package. Avoid using functionality that
@@ -494,6 +494,23 @@ files related to the current buffer.
The directory names should be absolute. Used in the VC-aware
project backend implementation of `project-external-roots'.")
+(defvar project-vc-backend-markers-alist
+ `((Git . ".git")
+ (Hg . ".hg")
+ (Bzr . ".bzr")
+ ;; See the comment above `vc-svn-admin-directory' for why we're
+ ;; duplicating the definition.
+ (SVN . ,(if (and (memq system-type '(cygwin windows-nt ms-dos))
+ (getenv "SVN_ASP_DOT_NET_HACK"))
+ "_svn"
+ ".svn"))
+ (DARCS . "_darcs")
+ (Fossil . ".fslckout")
+ (Got . ".got"))
+ "Associative list assigning root markers to VC backend symbols.
+
+See `project-vc-extra-root-markers' for the marker value format.")
+
(defun project-try-vc (dir)
(defvar vc-svn-admin-directory)
(require 'vc-svn)
@@ -501,17 +518,11 @@ project backend implementation of
`project-external-roots'.")
;; `project-vc-merge-submodules' or `project-vc-extra-root-markers'
;; changes.
(or (vc-file-getprop dir 'project-vc)
- (let* ((backend-markers-alist `((Git . ".git")
- (Hg . ".hg")
- (Bzr . ".bzr")
- (SVN . ,vc-svn-admin-directory)
- (DARCS . "_darcs")
- (Fossil . ".fslckout")))
- (backend-markers
+ (let* ((backend-markers
(delete
nil
(mapcar
- (lambda (b) (assoc-default b backend-markers-alist))
+ (lambda (b) (assoc-default b project-vc-backend-markers-alist))
vc-handled-backends)))
(marker-re
(concat
@@ -537,7 +548,7 @@ project backend implementation of
`project-external-roots'.")
(backend
(cl-find-if
(lambda (b)
- (member (assoc-default b backend-markers-alist)
+ (member (assoc-default b project-vc-backend-markers-alist)
last-matches))
vc-handled-backends))
project)
diff --git a/lisp/startup.el b/lisp/startup.el
index cfe20d4b720..fb14fbad17f 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -542,8 +542,8 @@ DIRS are relative."
(setq comp--compilable t))
(defvar native-comp-eln-load-path)
-(defvar inhibit-automatic-native-compilation)
-(defvar comp-enable-subr-trampolines)
+(defvar native-comp-jit-compilation)
+(defvar native-comp-enable-subr-trampolines)
(defvar startup--original-eln-load-path nil
"Original value of `native-comp-eln-load-path'.")
@@ -592,10 +592,6 @@ It is the default value of the variable `top-level'."
(funcall 'android-enumerate-fonts)
(setq android-fonts-enumerated t))
- ;; Allow disabling automatic .elc->.eln processing.
- (setq inhibit-automatic-native-compilation
- (getenv "EMACS_INHIBIT_AUTOMATIC_NATIVE_COMPILATION"))
-
(if command-line-processed
(message internal--top-level-message)
(setq command-line-processed t)
@@ -614,8 +610,8 @@ It is the default value of the variable `top-level'."
;; in this session. This is necessary if libgccjit is not
;; available on MS-Windows, but Emacs was built with
;; native-compilation support.
- (setq inhibit-automatic-native-compilation t
- comp-enable-subr-trampolines nil))
+ (setq native-comp-jit-compilation nil
+ native-comp-enable-subr-trampolines nil))
;; Form `native-comp-eln-load-path'.
(let ((path-env (getenv "EMACSNATIVELOADPATH")))
diff --git a/lisp/subr.el b/lisp/subr.el
index 439d6e3fbb5..33865aa326c 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1935,8 +1935,13 @@ activations. To prevent runaway recursion, use
`max-lisp-eval-depth'
instead; it will indirectly limit the specpdl stack size as well.")
(make-obsolete-variable 'max-specpdl-size nil "29.1")
+(make-obsolete-variable 'comp-enable-subr-trampolines
+ 'native-comp-enable-subr-trampolines
+ "29.1")
+
(make-obsolete-variable 'native-comp-deferred-compilation
- 'inhibit-automatic-native-compilation "29.1")
+ 'native-comp-jit-compilation
+ "29.1")
;;;; Alternate names for functions - these are not being phased out.
diff --git a/lisp/time.el b/lisp/time.el
index 030aef9d49b..522bec46ac6 100644
--- a/lisp/time.el
+++ b/lisp/time.el
@@ -139,7 +139,7 @@ make the mail indicator stand out on a color display."
:version "22.1"
:type '(choice (const :tag "None" nil) face))
-(defface display-time-time-and-date-indicator nil
+(defface display-time-date-and-time nil
"Face for `display-time-format'."
:group 'mode-line-faces
:version "30.1")
@@ -184,7 +184,7 @@ depend on `display-time-day-and-date' and
`display-time-24hr-format'."
(format-time-string (or display-time-format
(if display-time-24hr-format "%H:%M" "%-I:%M%p"))
now)
- 'face 'display-time-time-and-date-indicator
+ 'face 'display-time-date-and-time
'help-echo (format-time-string "%a %b %e, %Y" now))
load
(if mail
diff --git a/lisp/treesit.el b/lisp/treesit.el
index 749781894b8..d7f34146852 100644
--- a/lisp/treesit.el
+++ b/lisp/treesit.el
@@ -166,10 +166,13 @@ parser in `treesit-parser-list', or nil if there is no
parser."
A leaf node is a node that doesn't have any child nodes.
The returned node's span covers POS: the node's beginning is before
-or at POS, and the node's end is at or after POS.
+or at POS, and the node's end is after POS.
-If no leaf node's span covers POS (e.g., POS is on whitespace
-between two leaf nodes), return the first leaf node after POS.
+If no such node exists, but there's a leaf node which ends at POS,
+return that node.
+
+Otherwise (e.g., when POS is on whitespace between two leaf
+nodes), return the first leaf node after POS.
If there is no leaf node after POS, return the first leaf node
before POS.
diff --git a/src/comp.c b/src/comp.c
index 7d2987605d9..1b55226b0c3 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -5174,8 +5174,7 @@ maybe_defer_native_compilation (Lisp_Object function_name,
if (!load_gccjit_if_necessary (false))
return;
- if (!native_comp_deferred_compilation
- || !NILP (Vinhibit_automatic_native_compilation)
+ if (!native_comp_jit_compilation
|| noninteractive
|| !NILP (Vpurify_flag)
|| !COMPILEDP (definition)
@@ -5672,28 +5671,18 @@ syms_of_comp (void)
{
#ifdef HAVE_NATIVE_COMP
DEFVAR_LISP ("comp--delayed-sources", Vcomp__delayed_sources,
- doc: /* List of sources to be native-compiled when startup is
finished.
+ doc: /* List of sources to be native-compiled when startup is finished.
For internal use. */);
- DEFVAR_BOOL ("comp--compilable",
- comp__compilable,
- doc: /* Non-nil when comp.el can be native compiled.
+ DEFVAR_BOOL ("comp--compilable", comp__compilable,
+ doc: /* Non-nil when comp.el can be native compiled.
For internal use. */);
/* Compiler control customizes. */
- DEFVAR_LISP ("inhibit-automatic-native-compilation",
- Vinhibit_automatic_native_compilation,
- doc: /* If non-nil, inhibit automatic native compilation of
loaded .elc files.
+ DEFVAR_BOOL ("native-comp-jit-compilation", native_comp_jit_compilation,
+ doc: /* If non-nil, compile loaded .elc files asynchronously.
-After compilation, each function definition is updated to the native
-compiled one. */);
- Vinhibit_automatic_native_compilation = Qnil;
-
- DEFVAR_BOOL ("native-comp-deferred-compilation",
- native_comp_deferred_compilation,
- doc: /* If non-nil compile loaded .elc files asynchronously.
-
-After compilation, each function definition is updated to the native
-compiled one. */);
- native_comp_deferred_compilation = true;
+After compilation, each function definition is updated to use the
+natively-compiled one. */);
+ native_comp_jit_compilation = true;
DEFSYM (Qnative_comp_speed, "native-comp-speed");
DEFSYM (Qnative_comp_debug, "native-comp-debug");
@@ -5837,74 +5826,83 @@ compiled one. */);
/* FIXME should be initialized but not here... Plus this don't have
to be necessarily exposed to lisp but can easy debug for now. */
DEFVAR_LISP ("comp-subr-list", Vcomp_subr_list,
- doc: /* List of all defined subrs. */);
+ doc: /* List of all defined subrs. */);
DEFVAR_LISP ("comp-abi-hash", Vcomp_abi_hash,
- doc: /* String signing the .eln files ABI. */);
+ doc: /* String signing the .eln files ABI. */);
Vcomp_abi_hash = Qnil;
DEFVAR_LISP ("comp-native-version-dir", Vcomp_native_version_dir,
- doc: /* Directory in use to disambiguate eln compatibility. */);
+ doc: /* Directory in use to disambiguate eln compatibility. */);
Vcomp_native_version_dir = Qnil;
DEFVAR_LISP ("comp-deferred-pending-h", Vcomp_deferred_pending_h,
- doc: /* Hash table symbol-name -> function-value.
+ doc: /* Hash table symbol-name -> function-value.
For internal use. */);
Vcomp_deferred_pending_h = CALLN (Fmake_hash_table, QCtest, Qeq);
DEFVAR_LISP ("comp-eln-to-el-h", Vcomp_eln_to_el_h,
- doc: /* Hash table eln-filename -> el-filename. */);
+ doc: /* Hash table eln-filename -> el-filename. */);
Vcomp_eln_to_el_h = CALLN (Fmake_hash_table, QCtest, Qequal);
DEFVAR_LISP ("native-comp-eln-load-path", Vnative_comp_eln_load_path,
- doc: /* List of eln cache directories.
+ doc: /* List of directories to look for natively-compiled *.eln files.
-If a directory is non absolute it is assumed to be relative to
-`invocation-directory'.
-`comp-native-version-dir' value is used as a sub-folder name inside
-each eln cache directory.
-The last directory of this list is assumed to be the system one. */);
+The *.eln files are actually looked for in a version-specific
+subdirectory of each directory in this list. That subdirectory
+is determined by the value of `comp-native-version-dir'.
+If the name of a directory in this list is not absolute, it is
+assumed to be relative to `invocation-directory'.
+The last directory of this list is assumed to be the one holding
+the system *.eln files, which are the files produced when building
+Emacs. */);
/* Temporary value in use for bootstrap. We can't do better as
`invocation-directory' is still unset, will be fixed up during
dump reload. */
Vnative_comp_eln_load_path = Fcons (build_string ("../native-lisp/"), Qnil);
- DEFVAR_BOOL ("comp-enable-subr-trampolines", comp_enable_subr_trampolines,
- doc: /* If non-nil, enable primitive trampoline synthesis.
-This makes Emacs respect redefinition or advises of primitive functions
-when they are called from Lisp code natively-compiled at `native-comp-speed'
-of 2.
+ DEFVAR_LISP ("native-comp-enable-subr-trampolines",
+ Vnative_comp_enable_subr_trampolines,
+ doc: /* If non-nil, enable generation of trampolines for calling
primitives.
+Trampolines are needed so that Emacs respects redefinition or advice of
+primitive functions when they are called from Lisp code natively-compiled
+at `native-comp-speed' of 2.
-By default, this is enabled, and when Emacs sees a redefined or advised
+By default, the value is t, and when Emacs sees a redefined or advised
primitive called from natively-compiled Lisp, it generates a trampoline
for it on-the-fly.
-Disabling this, when a trampoline for a redefined or advised primitive is
-not available from previous compilations, means that such redefinition
-or advise will not have effect on calls from natively-compiled Lisp code.
-That is, calls to primitives without existing trampolines from
-natively-compiled Lisp will behave as if the primitive was called
-directly from C. */);
+If the value is a file name (a string), it specifies the directory in
+which to deposit the generated trampolines, overriding the directories
+in `native-comp-eln-load-path'.
+
+When this variable is nil, generation of trampolines is disabled.
+
+Disabling the generation of trampolines, when a trampoline for a redefined
+or advised primitive is not already available from previous compilations,
+means that such redefinition or advice will not have effect when calling
+primitives from natively-compiled Lisp code. That is, calls to primitives
+without existing trampolines from natively-compiled Lisp will behave as if
+the primitive was called directly from C, and will ignore its redefinition
+and advice. */);
DEFVAR_LISP ("comp-installed-trampolines-h", Vcomp_installed_trampolines_h,
- doc: /* Hash table subr-name -> installed trampoline.
-This is used to prevent double trampoline instantiation but also to
+ doc: /* Hash table subr-name -> installed trampoline.
+This is used to prevent double trampoline instantiation, and also to
protect the trampolines against GC. */);
Vcomp_installed_trampolines_h = CALLN (Fmake_hash_table);
DEFVAR_LISP ("comp-no-native-file-h", V_comp_no_native_file_h,
- doc: /* Files for which no deferred compilation has to be
performed.
+ doc: /* Files for which no deferred compilation should be performed.
These files' compilation should not be deferred because the bytecode
version was explicitly requested by the user during load.
For internal use. */);
V_comp_no_native_file_h = CALLN (Fmake_hash_table, QCtest, Qequal);
DEFVAR_BOOL ("comp-file-preloaded-p", comp_file_preloaded_p,
- doc: /* When non-nil assume the file being compiled to
-be preloaded. */);
+ doc: /* When non-nil, assume the file being compiled to be preloaded. */);
DEFVAR_LISP ("comp-loaded-comp-units-h", Vcomp_loaded_comp_units_h,
- doc: /* Hash table recording all loaded compilation units.
-file -> CU. */);
+ doc: /* Hash table recording all loaded compilation units, file -> CU.
*/);
Vcomp_loaded_comp_units_h =
CALLN (Fmake_hash_table, QCweakness, Qvalue, QCtest, Qequal);
diff --git a/src/data.c b/src/data.c
index 04ac2b09ac3..1fa8b0358b5 100644
--- a/src/data.c
+++ b/src/data.c
@@ -855,7 +855,7 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
#ifdef HAVE_NATIVE_COMP
register Lisp_Object function = XSYMBOL (symbol)->u.s.function;
- if (comp_enable_subr_trampolines
+ if (!NILP (Vnative_comp_enable_subr_trampolines)
&& SUBRP (function)
&& !SUBR_NATIVE_COMPILEDP (function))
CALLN (Ffuncall, Qcomp_subr_trampoline_install, symbol);
diff --git a/src/treesit.c b/src/treesit.c
index cab2f0d5354..e1d6f1ef79f 100644
--- a/src/treesit.c
+++ b/src/treesit.c
@@ -720,6 +720,7 @@ Return nil if a grammar library for LANGUAGE is not
available. */)
}
}
+
/*** Parsing functions */
static void
@@ -770,7 +771,8 @@ treesit_record_change (ptrdiff_t start_byte, ptrdiff_t
old_end_byte,
treesit_check_parser (lisp_parser);
TSTree *tree = XTS_PARSER (lisp_parser)->tree;
/* See comment (ref:visible-beg-null) if you wonder why we don't
- update visible_beg/end when tree is NULL. */
+ update visible_beg/end when tree is NULL. */
+
if (tree != NULL)
{
eassert (start_byte <= old_end_byte);
@@ -794,8 +796,14 @@ treesit_record_change (ptrdiff_t start_byte, ptrdiff_t
old_end_byte,
ptrdiff_t old_end_offset = (min (visible_end,
max (visible_beg, old_end_byte))
- visible_beg);
- ptrdiff_t new_end_offset = (min (visible_end,
- max (visible_beg, new_end_byte))
+ /* We don't clip new_end_offset under visible_end, because
+ inserting in narrowed region always extends the visible
+ region. If we clip new_end_offset here, and re-add the
+ clipped "tail" in treesit_sync_visible_region later,
+ while it is technically equivalent, tree-sitter's
+ incremental parsing algorithm doesn't seem to like it
+ (bug#61369). */
+ ptrdiff_t new_end_offset = (max (visible_beg, new_end_byte)
- visible_beg);
eassert (start_offset <= old_end_offset);
eassert (start_offset <= new_end_offset);
@@ -817,11 +825,13 @@ treesit_record_change (ptrdiff_t start_byte, ptrdiff_t
old_end_byte,
/* Move forward. */
visi_beg_delta = (old_end_byte < visible_beg
? new_end_byte - old_end_byte : 0);
+
XTS_PARSER (lisp_parser)->visible_beg = visible_beg + visi_beg_delta;
XTS_PARSER (lisp_parser)->visible_end = (visible_end
+ visi_beg_delta
+ (new_end_offset
- old_end_offset));
+
eassert (XTS_PARSER (lisp_parser)->visible_beg >= 0);
eassert (XTS_PARSER (lisp_parser)->visible_beg
<= XTS_PARSER (lisp_parser)->visible_end);
@@ -1104,6 +1114,7 @@ treesit_read_buffer (void *parser, uint32_t byte_index,
return beg;
}
+
/*** Functions for parser and node object */
/* Wrap the parser in a Lisp_Object to be used in the Lisp
@@ -1266,6 +1277,9 @@ treesit_ensure_query_compiled (Lisp_Object query,
Lisp_Object *signal_symbol,
return treesit_query;
}
+
+/* Lisp definitions. */
+
DEFUN ("treesit-parser-p",
Ftreesit_parser_p, Streesit_parser_p, 1, 1, 0,
doc: /* Return t if OBJECT is a tree-sitter parser. */)
@@ -1484,6 +1498,7 @@ treesit_parser_live_p (Lisp_Object parser)
(!NILP (Fbuffer_live_p (XTS_PARSER (parser)->buffer))));
}
+
/*** Parser API */
DEFUN ("treesit-parser-root-node",
@@ -1730,6 +1745,7 @@ positions. PARSER is the parser issuing the
notification. */)
return Qnil;
}
+
/*** Node API */
/* Check that OBJ is a positive integer and signal an error if
@@ -2252,6 +2268,7 @@ produced by tree-sitter. */)
return same_node ? Qt : Qnil;
}
+
/*** Query functions */
DEFUN ("treesit-pattern-expand",
@@ -2826,6 +2843,7 @@ the query. */)
return Fnreverse (result);
}
+
/*** Navigation */
static inline void
@@ -3446,7 +3464,7 @@ DEFUN ("treesit-available-p", Ftreesit_available_p,
#endif
}
-
+
/*** Initialization */
/* Initialize the tree-sitter routines. */
diff --git a/src/xdisp.c b/src/xdisp.c
index d3dae205037..21362d0b9d8 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -13424,7 +13424,8 @@ gui_consider_frame_title (Lisp_Object frame)
Fselect_window (f->selected_window, Qt);
set_buffer_internal_1 (XBUFFER (XWINDOW (f->selected_window)->contents));
- fmt = FRAME_ICONIFIED_P (f) ? Vicon_title_format : Vframe_title_format;
+ fmt = (FRAME_ICONIFIED_P (f) && !EQ (Vicon_title_format, Qt)
+ ? Vicon_title_format : Vframe_title_format);
mode_line_target = MODE_LINE_TITLE;
title_start = MODE_LINE_NOPROP_LEN (0);
@@ -36762,9 +36763,11 @@ which no explicit name has been set (see
`modify-frame-parameters'). */);
DEFVAR_LISP ("icon-title-format", Vicon_title_format,
doc: /* Template for displaying the title bar of an iconified frame.
\(Assuming the window manager supports this feature.)
-This variable has the same structure as `mode-line-format' (which see),
-and is used only on frames for which no explicit name has been set
-\(see `modify-frame-parameters'). */);
+If the value is a string, it should have the same structure
+as `mode-line-format' (which see), and is used only on frames
+for which no explicit name has been set \(see `modify-frame-parameters').
+If the value is t, that means use `frame-title-format' for
+iconified frames. */);
/* Do not nest calls to pure_list. This works around a bug in
Oracle Developer Studio 12.6. */
Lisp_Object icon_title_name_format
diff --git a/test/lisp/hi-lock-tests.el b/test/lisp/hi-lock-tests.el
index aeb08ecbb29..794a3b1d0c2 100644
--- a/test/lisp/hi-lock-tests.el
+++ b/test/lisp/hi-lock-tests.el
@@ -86,13 +86,18 @@
(unhighlight-regexp "a a")
(should (= (length (overlays-in (point-min) (point-max))) 0))
- (let ((search-spaces-regexp search-whitespace-regexp)) (highlight-regexp
"a a"))
+ (let ((search-spaces-regexp search-whitespace-regexp))
+ (highlight-regexp "a a"))
(should (= (length (overlays-in (point-min) (point-max))) 1))
- (cl-letf (((symbol-function 'completing-read)
- (lambda (_prompt _coll
- &optional _x _y _z _hist defaults _inherit)
- (car defaults))))
- (call-interactively 'unhighlight-regexp))
+ ;; We bind use-dialog-box to nil to prevent unhighlight-regexp
+ ;; from using popup menus, since the replacement for
+ ;; completing-read below is not ready for that calamity
+ (let ((use-dialog-box nil))
+ (cl-letf (((symbol-function 'completing-read)
+ (lambda (_prompt _coll
+ &optional _x _y _z _hist defaults _inherit)
+ (car defaults))))
+ (call-interactively 'unhighlight-regexp)))
(should (= (length (overlays-in (point-min) (point-max))) 0))
(emacs-lisp-mode)
@@ -142,12 +147,16 @@
(let ((search-spaces-regexp search-whitespace-regexp)) (highlight-regexp
"a a"))
(font-lock-ensure)
(should (memq 'hi-yellow (get-text-property 1 'face)))
- (cl-letf (((symbol-function 'completing-read)
- (lambda (_prompt _coll
- &optional _x _y _z _hist defaults _inherit)
- (car defaults)))
- (font-lock-fontified t))
- (call-interactively 'unhighlight-regexp))
+ ;; We bind use-dialog-box to nil to prevent unhighlight-regexp
+ ;; from using popup menus, since the replacement for
+ ;; completing-read below is not ready for that calamity
+ (let ((use-dialog-box nil))
+ (cl-letf (((symbol-function 'completing-read)
+ (lambda (_prompt _coll
+ &optional _x _y _z _hist defaults _inherit)
+ (car defaults)))
+ (font-lock-fontified t))
+ (call-interactively 'unhighlight-regexp)))
(should (null (get-text-property 1 'face))))))
(ert-deftest hi-lock-unhighlight ()
@@ -156,58 +165,64 @@
(with-temp-buffer
(insert "aAbB\n")
- (cl-letf (((symbol-function 'completing-read)
- (lambda (_prompt _coll
- &optional _x _y _z _hist defaults _inherit)
- (car defaults))))
-
- (highlight-regexp "a")
- (highlight-regexp "b")
- (should (= (length (overlays-in (point-min) (point-max))) 4))
- ;; `hi-lock--regexps-at-point' should take regexp "a" at point 1,
- ;; not the last regexp "b"
- (goto-char 1)
- (call-interactively 'unhighlight-regexp)
- (should (= (length (overlays-in 1 3)) 0))
- (should (= (length (overlays-in 3 5)) 2))
- ;; Next call should unhighlight remaining regepxs
- (call-interactively 'unhighlight-regexp)
- (should (= (length (overlays-in 3 5)) 0))
-
- ;; Test unhighlight all
- (highlight-regexp "a")
- (highlight-regexp "b")
- (should (= (length (overlays-in (point-min) (point-max))) 4))
- (unhighlight-regexp t)
- (should (= (length (overlays-in (point-min) (point-max))) 0))
-
- (emacs-lisp-mode)
- (setq font-lock-mode t)
-
- (highlight-regexp "a")
- (highlight-regexp "b")
- (font-lock-ensure)
- (should (memq 'hi-yellow (get-text-property 1 'face)))
- (should (memq 'hi-yellow (get-text-property 3 'face)))
- ;; `hi-lock--regexps-at-point' should take regexp "a" at point 1,
- ;; not the last regexp "b"
- (goto-char 1)
- (let ((font-lock-fontified t)) (call-interactively
'unhighlight-regexp))
- (should (null (get-text-property 1 'face)))
- (should (memq 'hi-yellow (get-text-property 3 'face)))
- ;; Next call should unhighlight remaining regepxs
- (let ((font-lock-fontified t)) (call-interactively
'unhighlight-regexp))
- (should (null (get-text-property 3 'face)))
-
- ;; Test unhighlight all
- (highlight-regexp "a")
- (highlight-regexp "b")
- (font-lock-ensure)
- (should (memq 'hi-yellow (get-text-property 1 'face)))
- (should (memq 'hi-yellow (get-text-property 3 'face)))
- (let ((font-lock-fontified t)) (unhighlight-regexp t))
- (should (null (get-text-property 1 'face)))
- (should (null (get-text-property 3 'face)))))))
+ ;; We bind use-dialog-box to nil to prevent unhighlight-regexp
+ ;; from using popup menus, since the replacement for
+ ;; completing-read below is not ready for that calamity
+ (let ((use-dialog-box nil))
+ (cl-letf (((symbol-function 'completing-read)
+ (lambda (_prompt _coll
+ &optional _x _y _z _hist defaults _inherit)
+ (car defaults))))
+ (highlight-regexp "a")
+ (highlight-regexp "b")
+ (should (= (length (overlays-in (point-min) (point-max))) 4))
+ ;; `hi-lock--regexps-at-point' should take regexp "a" at point 1,
+ ;; not the last regexp "b"
+ (goto-char 1)
+ (call-interactively 'unhighlight-regexp)
+ (should (= (length (overlays-in 1 3)) 0))
+ (should (= (length (overlays-in 3 5)) 2))
+ ;; Next call should unhighlight remaining regepxs
+ (call-interactively 'unhighlight-regexp)
+ (should (= (length (overlays-in 3 5)) 0))
+
+ ;; Test unhighlight all
+ (highlight-regexp "a")
+ (highlight-regexp "b")
+ (should (= (length (overlays-in (point-min) (point-max))) 4))
+ (unhighlight-regexp t)
+ (should (= (length (overlays-in (point-min) (point-max))) 0))
+
+ (emacs-lisp-mode)
+ (setq font-lock-mode t)
+
+ (highlight-regexp "a")
+ (highlight-regexp "b")
+ (font-lock-ensure)
+ (should (memq 'hi-yellow (get-text-property 1 'face)))
+ (should (memq 'hi-yellow (get-text-property 3 'face)))
+ ;; `hi-lock--regexps-at-point' should take regexp "a" at point 1,
+ ;; not the last regexp "b"
+ (goto-char 1)
+ (let ((font-lock-fontified t))
+ (call-interactively 'unhighlight-regexp))
+ (should (null (get-text-property 1 'face)))
+ (should (memq 'hi-yellow (get-text-property 3 'face)))
+ ;; Next call should unhighlight remaining regepxs
+ (let ((font-lock-fontified t))
+ (call-interactively 'unhighlight-regexp))
+ (should (null (get-text-property 3 'face)))
+
+ ;; Test unhighlight all
+ (highlight-regexp "a")
+ (highlight-regexp "b")
+ (font-lock-ensure)
+ (should (memq 'hi-yellow (get-text-property 1 'face)))
+ (should (memq 'hi-yellow (get-text-property 3 'face)))
+ (let ((font-lock-fontified t))
+ (unhighlight-regexp t))
+ (should (null (get-text-property 1 'face)))
+ (should (null (get-text-property 3 'face))))))))
(provide 'hi-lock-tests)
;;; hi-lock-tests.el ends here