pestctrl/emacs
1
0
Fork 0
forked from Github/emacs
Code Issues Pull requests Projects Releases Packages Wiki Activity

Merge from origin/emacs-29

Browse source 
1769a58830 Fix some uses of 'use-dialog-box'
deef41a825 Fix hi-lock-tests when 'use-dialog-box' is non-nil
5093a53496 Fix regression due to change in face sort order by 'face-...
3e74763099 * lisp/files.el (file-equal-p): Work around Haiku stat bug.
13fd7667f9 ; * src/treesit.c: Improve sectioning.
a40b1745d4 (project-vc-backend-markers-alist): Add entry for vc-got
18e96ed7c8 project.el: Extract backend->marker association for a defvar
0a5615669a Don't completely clip into visible range in treesit_recor...
5b34fc0708 * lisp/treesit.el (treesit-node-at): Update docstring (bu...
1c7d762378 ; Minor copyedit of NEWS wrt *-ts-modes
09fad246de * lisp/calc/calc.el (calc-mode): Improve docstring.
8aad8d75aa ; Improve and update documentation of native compilation
d6e4f24372 Merge 'emacs-29' into 'feature/inhibit-native-comp-cleanup'
a555abc56d Fix order of faces in 'face-list'
b44a7ff85d Allow 'icon-title-format' to have the value t
f1f571e72a Add electric indent for preproc directives
83af806ab7 Rename 'emacs-news-toggle-tag' to 'emacs-news-cycle-tag'
5bc88b3b17 Add menu to news-mode
40f4bc4e0a ; Avoid installing VC package dependencies multiple times
1c9d81a2b4 Attempt to recognise if a VC package has no Elisp files
2550e8bb0b Fix mule-tests under en_US.UTF-8 locale
3279530993 Move block closer above declaration_list rule (bug#61531)
b18754bb17 Minor improvements in c-ts-mode and docs
3c6b726a7b Add super node as a keyword
1917c51fe6 ; Prevent ERC-induced false positive in JUnit report
b16965ef7e Delete perplexing paragraph from Gnus manual
43c62a4732 ; Fix typo
fdac69b45e ; Auto-commit of loaddefs files.
7678b7e46f Eglot: check server capability before sending didSave (bu...
a3a1ef7bd5 Fix rust-ts-mode type and module highlighting (Bug#61302)
477aa047ee rust-ts-mode: Highlight variable reassignments
5206a551c1 Improve backward compatibility of save-restriction
accd88d554 Don't indent template_string contents (bug#61503)
d97a383996 csharp-ts-mode: fontify compiler directives (bug#61512)
420d2cae84 Update to Transient v0.3.7-209-gdab1dfa
a3751b5d0c ; Raise an error if a VC package checkout is empty
6a32ba8b69 ; Fix the installation of dependencies for VC packages
4eac80fcc3 ; Prepare to update ERC version to 5.5
4f099a7217 ; Remove failing erc-reuse-buffers test
ce4a066ed1 * Generate trampolines in a temporary directory if no oth...
4bb27a5ca9 ; Minor docs copyedits
13bcff3da5 Merge branch 'emacs-29' of git.savannah.gnu.org:/srv/git/...
3d572ae0d5 Rename with/without-narrowing to with/without-restriction
d806b0e33c * lisp/repeat.el: Rename internal function and variable (...
1a64f326e0 * Fix previous change
95692f6754 Rename native-comp-deferred-compilation-deny-list
8d8464bd5a Rename native-comp-deferred-compilation into native-comp-...
5d0912f144 Rename comp-enable-subr-trampolines into native-comp-enab...
dd8b720ee7 ; * etc/NEWS: Fix typos.
909bd04cf5 ; * lisp/calendar/lunar.el: Add comments. (bug#61460)
10f2aedea9 ; * lisp/progmodes/c-ts-mode.el (c-ts-base-mode): delete ...
abfd00e5c0 * lisp/emacs-lisp/comp.el (native-comp-never-optimize-fun...
1795839bab Support `comp-enable-subr-trampolines' as string value
865758130a ; * admin/git-bisect-start: Update failing commits
b948d0d7ef Merge branch 'scratch/fix-locked-narrowing'
b6e2799aa1 * Some more `inhibit-native-compile' clean-up
dcb2379a46 Minor improvements to labeled narrowing
c0681cd347 Revert "Add new variable 'inhibit-native-compilation'"
3969a34fa1 Revert "Rename to inhibit-automatic-native-compilation"
4297039bd1 Save and restore the absence of narrowing locks
2956e54b1d Add an extensive test for labeled (locked) narrowing
79ce185ad1 Update the documentation about labeled (locked) narrowing
a6cd4553d4 Rename two long line optimizations variables
0d73e4aa26 Add specific symbols for narrowings
d8438e2bb4 Add 'without-narrowing' macro
97314447e6 Make 'narrowing-lock' and 'narrowing-unlock' internal
a4aa32bdff Fix 'save-restriction' for narrowing locks
This commit is contained in:
Stefan Kangas 2023-02-18 10:45:46 +01:00
commit 0be5f7ab63
21 changed files with 364 additions and 223 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

86
doc/lispref/compile.texi
View file

@ -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 of @code{user-emacs-directory} (@pxref{Init File}). You can do that
by either changing the value of @code{native-comp-eln-load-path} by either changing the value of @code{native-comp-eln-load-path}
(@pxref{Native-Compilation Variables}) or by temporarily pointing the (@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 @menu
* Native-Compilation Functions:: Functions to natively-compile Lisp. * 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 This section documents the variables that control
native-compilation. 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 @defopt native-comp-speed
This variable specifies the optimization level for native compilation. This variable specifies the optimization level for native compilation.
Its value should be a number between @minus{}1 and 3. Values between 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 specifically, Emacs will write these files into the first writable
directory in the list. Thus, you can control where native-compilation directory in the list. Thus, you can control where native-compilation
stores the results by changing the value of this variable. 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

40
doc/lispref/frames.texi
View file

@ -1474,19 +1474,24 @@ in this frame. Its value is @code{color}, @code{grayscale} or
@vindex title@r{, a frame parameter} @vindex title@r{, a frame parameter}
@item title @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 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 of windows in that frame if @code{mode-line-frame-identification} uses
@samp{%F} (@pxref{%-Constructs}). This is normally the case when @samp{%F} (@pxref{%-Constructs}). This is normally the case when
Emacs is not using a window system, and can only display one frame at 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} @vindex name@r{, a frame parameter}
@item name @item name
The name of the frame. The frame name serves as a default for the frame The name of the frame. If you don't specify a name via this
title, if the @code{title} parameter is unspecified or @code{nil}. If parameter, Emacs sets the frame name automatically, as specified by
you don't specify a name, Emacs sets the frame name automatically @code{frame-title-format} and @code{icon-title-format}, and that is
(@pxref{Frame Titles}). 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 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 name is also used (instead of the name of the Emacs executable) when
@ -2630,17 +2635,26 @@ frame name automatically based on a template stored in the variable
frame is redisplayed. frame is redisplayed.
@defvar frame-title-format @defvar frame-title-format
This variable specifies how to compute a name for a frame when you have This variable specifies how to compute a name for a frame when you
not explicitly specified one. The variable's value is actually a mode 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 line construct, just like @code{mode-line-format}, except that the
@samp{%c}, @samp{%C}, and @samp{%l} constructs are ignored. @xref{Mode Line @samp{%c}, @samp{%C}, and @samp{%l} constructs are ignored.
Data}. @xref{Mode Line Data}.
@end defvar @end defvar
@defvar icon-title-format @defvar icon-title-format
This variable specifies how to compute the name for an iconified frame, This variable specifies how to compute the name for an iconified frame
when you have not explicitly specified the frame title. This title when you have not explicitly specified the frame's name via the
appears in the icon itself. 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 @end defvar
@defvar multiple-frames @defvar multiple-frames

20
etc/NEWS.29
View file

@ -199,13 +199,6 @@ load time.
** Native Compilation ** 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'. *** New command 'native-compile-prune-cache'.
This command deletes old subdirectories of the eln cache (but not the This command deletes old subdirectories of the eln cache (but not the
ones for the current Emacs version). Note that subdirectories of 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 between 1 and 16, where 1 is the most recently deleted frame, undelete
the corresponding deleted frame. 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 ** 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)) (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 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 "built-in" modes by restarting Emacs. (If you use desktop.el to save
didn't like the tree-sitter based modes, so that we could try 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. improving them.
Each major mode based on tree-sitter needs a language grammar library, Each major mode based on tree-sitter needs a language grammar library,

9
lisp/calc/calc.el
View file

@ -1286,16 +1286,17 @@ the trail buffer."
(defun calc-mode () (defun calc-mode ()
"Calculator major mode. "Calculator major mode.
This is an RPN calculator featuring arbitrary-precision integer, rational, This is a Reverse Polish notation (RPN) calculator featuring
floating-point, complex, matrix, and symbolic arithmetic. arbitrary-precision integer, rational, floating-point, complex,
matrix, and symbolic arithmetic.
RPN calculation: 2 RET 3 + produces 5. RPN calculation: 2 RET 3 + produces 5.
Algebraic style: \\=' 2+3 RET produces 5. Algebraic style: \\=' 2+3 RET produces 5.
Basic operators are +, -, *, /, ^, & (reciprocal), % (modulo), n (change-sign). Basic operators are +, -, *, /, ^, & (reciprocal), % (modulo), n (change-sign).
Press ? repeatedly for more complete help. Press `h i' to read the 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. Calc manual, \\`h s' to read the summary, or \\`h t' for the tutorial.
Notations: 3.14e6 3.14 * 10^6 Notations: 3.14e6 3.14 * 10^6
_23 negative number -23 (or type `23 n') _23 negative number -23 (or type `23 n')

68
lisp/emacs-lisp/comp.el
View file

@ -85,13 +85,17 @@ This is intended for debugging the compiler itself.
:type 'boolean :type 'boolean
:version "28.1") :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. "List of regexps to exclude matching files from deferred native compilation.
Files whose names match any regexp are excluded from native compilation." Files whose names match any regexp are excluded from native compilation."
:type '(repeat regexp) :type '(repeat regexp)
:version "28.1") :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 (defcustom native-comp-bootstrap-deny-list
'() '()
"List of regexps to exclude files from native compilation during bootstrap. "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 ;; correctly (see comment in `advice--add-function'). DO NOT
;; REMOVE. ;; REMOVE.
macroexpand rename-buffer) 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) :type '(repeat symbol)
:version "28.1") :version "28.1")
@ -695,7 +703,7 @@ Useful to hook into pass checkers.")
;;;###autoload ;;;###autoload
(defun comp-subr-trampoline-install (subr-name) (defun comp-subr-trampoline-install (subr-name)
"Make SUBR-NAME effectively advice-able when called from native code." "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) (memq subr-name native-comp-never-optimize-functions)
(gethash subr-name comp-installed-trampolines-h)) (gethash subr-name comp-installed-trampolines-h))
(cl-assert (subr-primitive-p (symbol-function subr-name))) (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) when (file-exists-p filename)
do (cl-return (native-elisp-load 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) (defun comp-trampoline-compile (subr-name)
"Synthesize compile and return a trampoline for SUBR-NAME." "Synthesize compile and return a trampoline for SUBR-NAME."
(let* ((lambda-list (comp-make-lambda-list-from-subr (let* ((lambda-list (comp-make-lambda-list-from-subr
@ -3803,25 +3837,7 @@ Return the trampoline if found or nil otherwise."
(lexical-binding t)) (lexical-binding t))
(comp--native-compile (comp--native-compile
form nil form nil
;; If we've disabled nativecomp, don't write the trampolines to (comp--trampoline-abs-filename subr-name))))
;; 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'"))))))
;; Some entry point support code. ;; Some entry point support code.
@ -4110,14 +4126,12 @@ the deferred compilation mechanism."
data data
;; So we return the compiled function. ;; So we return the compiled function.
(native-elisp-load data))) (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)) (when (and (not (stringp function-or-file))
(not output) (not output)
comp-ctxt comp-ctxt
(comp-ctxt-output comp-ctxt) (comp-ctxt-output comp-ctxt)
(file-exists-p (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) (cond ((eq 'windows-nt system-type)
;; We may still be using the temporary .eln file. ;; We may still be using the temporary .eln file.
(ignore-errors (delete-file (comp-ctxt-output comp-ctxt)))) (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"))) (t (error "SELECTOR must be a function a regexp or nil")))
;; Also exclude files from deferred compilation if ;; Also exclude files from deferred compilation if
;; any of the regexps in ;; any of the regexps in
;; `native-comp-deferred-compilation-deny-list' matches. ;; `native-comp-jit-compilation-deny-list' matches.
(and (eq load 'late) (and (eq load 'late)
(cl-some (lambda (re) (cl-some (lambda (re)
(string-match-p re file)) (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) (defun native--compile-async (files &optional recursively load selector)
;; BEWARE, this function is also called directly from C. ;; BEWARE, this function is also called directly from C.

6
lisp/faces.el
View file

@ -191,7 +191,7 @@ For internal use only."
(let ((face-id (car (gethash face face--new-frame-defaults)))) (let ((face-id (car (gethash face face--new-frame-defaults))))
(push `(,face-id ,face . ,spec) faces))) (push `(,face-id ,face . ,spec) faces)))
(frame--face-hash-table frame)) (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 () (defun face-list ()
"Return a list of all defined faces." "Return a list of all defined faces."
@ -199,7 +199,7 @@ For internal use only."
(maphash (lambda (face spec) (maphash (lambda (face spec)
(push `(,(car spec) . ,face) faces)) (push `(,(car spec) . ,face) faces))
face--new-frame-defaults) 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) (defun make-face (face)
"Define a new face with name FACE, a symbol. "Define a new face with name FACE, a symbol.
@ -2226,7 +2226,7 @@ the X resource \"reverseVideo\" is present, handle that."
(unwind-protect (unwind-protect
(progn (progn
(x-setup-function-keys frame) (x-setup-function-keys frame)
(dolist (face (nreverse (face-list))) (dolist (face (face-list))
(face-spec-recalc face frame)) (face-spec-recalc face frame))
(x-handle-reverse-video frame parameters) (x-handle-reverse-video frame parameters)
(frame-set-background-mode frame t) (frame-set-background-mode frame t)

13
lisp/files.el
View file

@ -6360,7 +6360,18 @@ If FILE1 or FILE2 does not exist, the return value is unspecified."
(let (f1-attr f2-attr) (let (f1-attr f2-attr)
(and (setq f1-attr (file-attributes (file-truename file1))) (and (setq f1-attr (file-attributes (file-truename file1)))
(setq f2-attr (file-attributes (file-truename file2))) (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) (defun file-in-directory-p (file dir)
"Return non-nil if DIR is a parent directory of FILE. "Return non-nil if DIR is a parent directory of FILE.

5
lisp/frame.el
View file

@ -2120,8 +2120,9 @@ frame's display)."
;; a toggle. ;; a toggle.
(featurep 't-mouse) (featurep 't-mouse)
;; No way to check whether a w32 console has a mouse, assume ;; No way to check whether a w32 console has a mouse, assume
;; it always does. ;; it always does, except in batch invocations.
(boundp 'w32-use-full-screen-buffer)))))) (and (not noninteractive)
(boundp 'w32-use-full-screen-buffer)))))))
(defun display-popup-menus-p (&optional display) (defun display-popup-menus-p (&optional display)
"Return non-nil if popup menus are supported on DISPLAY. "Return non-nil if popup menus are supported on DISPLAY.

1
lisp/hi-lock.el
View file

@ -611,6 +611,7 @@ then remove all hi-lock highlighting."
(cond (cond
(current-prefix-arg (list t)) (current-prefix-arg (list t))
((and (display-popup-menus-p) ((and (display-popup-menus-p)
last-nonmenu-event
(listp last-nonmenu-event) (listp last-nonmenu-event)
use-dialog-box) use-dialog-box)
(catch 'snafu (catch 'snafu

2
lisp/loadup.el
View file

@ -550,7 +550,7 @@ lost after dumping")))
(equal dump-mode "pdump")) (equal dump-mode "pdump"))
;; Don't enable this before bootstrap is completed, as the ;; Don't enable this before bootstrap is completed, as the
;; compiler infrastructure may not be usable yet. ;; 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) (message "Dumping under the name %s" output)
(condition-case () (condition-case ()
(delete-file output) (delete-file output)

2
lisp/progmodes/cc-engine.el
View file

@ -14951,7 +14951,7 @@ comment at the start of cc-engine.el for more info."
'case-label) 'case-label)
(1+ containing-sexp))) (1+ containing-sexp)))
(t (c-add-syntax (if (eq (char-before) ?:) (t (c-add-syntax (if (eq (char-before) ?:)
'case-label 'case-label
'statement-case-intro) 'statement-case-intro)
(1+ containing-sexp)))))) (1+ containing-sexp))))))

4
lisp/progmodes/elisp-mode.el
View file

@ -220,8 +220,8 @@ All commands in `lisp-mode-shared-map' are inherited by this map."
Load the compiled code when finished. Load the compiled code when finished.
Use `emacs-lisp-byte-compile-and-load' in combination with Use `emacs-lisp-byte-compile-and-load' in combination with
`inhibit-automatic-native-compilation' set to nil to achieve `native-comp-jit-compilation' set to t to achieve asynchronous
asynchronous native compilation." native compilation."
(interactive nil emacs-lisp-mode) (interactive nil emacs-lisp-mode)
(emacs-lisp--before-compile-buffer) (emacs-lisp--before-compile-buffer)
(load (native-compile buffer-file-name))) (load (native-compile buffer-file-name)))

31
lisp/progmodes/project.el
View file

@ -1,7 +1,7 @@
;;; project.el --- Operations on the current project -*- lexical-binding: t; -*- ;;; project.el --- Operations on the current project -*- lexical-binding: t; -*-
;; Copyright (C) 2015-2023 Free Software Foundation, Inc. ;; 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")) ;; Package-Requires: ((emacs "26.1") (xref "1.4.0"))
;; This is a GNU ELPA :core package. Avoid using functionality that ;; 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 The directory names should be absolute. Used in the VC-aware
project backend implementation of `project-external-roots'.") 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) (defun project-try-vc (dir)
(defvar vc-svn-admin-directory) (defvar vc-svn-admin-directory)
(require 'vc-svn) (require 'vc-svn)
@ -501,17 +518,11 @@ project backend implementation of `project-external-roots'.")
;; `project-vc-merge-submodules' or `project-vc-extra-root-markers' ;; `project-vc-merge-submodules' or `project-vc-extra-root-markers'
;; changes. ;; changes.
(or (vc-file-getprop dir 'project-vc) (or (vc-file-getprop dir 'project-vc)
(let* ((backend-markers-alist `((Git . ".git") (let* ((backend-markers
(Hg . ".hg")
(Bzr . ".bzr")
(SVN . ,vc-svn-admin-directory)
(DARCS . "_darcs")
(Fossil . ".fslckout")))
(backend-markers
(delete (delete
nil nil
(mapcar (mapcar
(lambda (b) (assoc-default b backend-markers-alist)) (lambda (b) (assoc-default b project-vc-backend-markers-alist))
vc-handled-backends))) vc-handled-backends)))
(marker-re (marker-re
(concat (concat
@ -537,7 +548,7 @@ project backend implementation of `project-external-roots'.")
(backend (backend
(cl-find-if (cl-find-if
(lambda (b) (lambda (b)
(member (assoc-default b backend-markers-alist) (member (assoc-default b project-vc-backend-markers-alist)
last-matches)) last-matches))
vc-handled-backends)) vc-handled-backends))
project) project)

12
lisp/startup.el
View file

@ -542,8 +542,8 @@ DIRS are relative."
(setq comp--compilable t)) (setq comp--compilable t))
(defvar native-comp-eln-load-path) (defvar native-comp-eln-load-path)
(defvar inhibit-automatic-native-compilation) (defvar native-comp-jit-compilation)
(defvar comp-enable-subr-trampolines) (defvar native-comp-enable-subr-trampolines)
(defvar startup--original-eln-load-path nil (defvar startup--original-eln-load-path nil
"Original value of `native-comp-eln-load-path'.") "Original value of `native-comp-eln-load-path'.")
@ -579,10 +579,6 @@ the updated value."
It sets `command-line-processed', processes the command-line, It sets `command-line-processed', processes the command-line,
reads the initialization files, etc. reads the initialization files, etc.
It is the default value of the variable `top-level'." It is the default value of the variable `top-level'."
;; Allow disabling automatic .elc->.eln processing.
(setq inhibit-automatic-native-compilation
(getenv "EMACS_INHIBIT_AUTOMATIC_NATIVE_COMPILATION"))
(if command-line-processed (if command-line-processed
(message internal--top-level-message) (message internal--top-level-message)
(setq command-line-processed t) (setq command-line-processed t)
@ -601,8 +597,8 @@ It is the default value of the variable `top-level'."
;; in this session. This is necessary if libgccjit is not ;; in this session. This is necessary if libgccjit is not
;; available on MS-Windows, but Emacs was built with ;; available on MS-Windows, but Emacs was built with
;; native-compilation support. ;; native-compilation support.
(setq inhibit-automatic-native-compilation t (setq native-comp-jit-compilation nil
comp-enable-subr-trampolines nil)) native-comp-enable-subr-trampolines nil))
;; Form `native-comp-eln-load-path'. ;; Form `native-comp-eln-load-path'.
(let ((path-env (getenv "EMACSNATIVELOADPATH"))) (let ((path-env (getenv "EMACSNATIVELOADPATH")))

7
lisp/subr.el
View file

@ -1925,8 +1925,13 @@ activations. To prevent runaway recursion, use `max-lisp-eval-depth'
instead; it will indirectly limit the specpdl stack size as well.") instead; it will indirectly limit the specpdl stack size as well.")
(make-obsolete-variable 'max-specpdl-size nil "29.1") (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 (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. ;;;; Alternate names for functions - these are not being phased out.

9
lisp/treesit.el
View file

@ -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. 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 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 If no such node exists, but there's a leaf node which ends at POS,
between two leaf nodes), return the first leaf node after 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 If there is no leaf node after POS, return the first leaf node
before POS. before POS.

98
src/comp.c
View file

@ -5174,8 +5174,7 @@ maybe_defer_native_compilation (Lisp_Object function_name,
if (!load_gccjit_if_necessary (false)) if (!load_gccjit_if_necessary (false))
return; return;
if (!native_comp_deferred_compilation if (!native_comp_jit_compilation
|| !NILP (Vinhibit_automatic_native_compilation)
|| noninteractive || noninteractive
|| !NILP (Vpurify_flag) || !NILP (Vpurify_flag)
|| !COMPILEDP (definition) || !COMPILEDP (definition)
@ -5672,28 +5671,18 @@ syms_of_comp (void)
{ {
#ifdef HAVE_NATIVE_COMP #ifdef HAVE_NATIVE_COMP
DEFVAR_LISP ("comp--delayed-sources", Vcomp__delayed_sources, 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. */); For internal use. */);
DEFVAR_BOOL ("comp--compilable", DEFVAR_BOOL ("comp--compilable", comp__compilable,
comp__compilable, doc: /* Non-nil when comp.el can be native compiled.
doc: /* Non-nil when comp.el can be native compiled.
For internal use. */); For internal use. */);
/* Compiler control customizes. */ /* Compiler control customizes. */
DEFVAR_LISP ("inhibit-automatic-native-compilation", DEFVAR_BOOL ("native-comp-jit-compilation", native_comp_jit_compilation,
Vinhibit_automatic_native_compilation, doc: /* If non-nil, compile loaded .elc files asynchronously.
doc: /* If non-nil, inhibit automatic native compilation of loaded .elc files.
After compilation, each function definition is updated to the native After compilation, each function definition is updated to use the
compiled one. */); natively-compiled one. */);
Vinhibit_automatic_native_compilation = Qnil; native_comp_jit_compilation = true;
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;
DEFSYM (Qnative_comp_speed, "native-comp-speed"); DEFSYM (Qnative_comp_speed, "native-comp-speed");
DEFSYM (Qnative_comp_debug, "native-comp-debug"); 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 /* FIXME should be initialized but not here... Plus this don't have
to be necessarily exposed to lisp but can easy debug for now. */ to be necessarily exposed to lisp but can easy debug for now. */
DEFVAR_LISP ("comp-subr-list", Vcomp_subr_list, 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, 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; Vcomp_abi_hash = Qnil;
DEFVAR_LISP ("comp-native-version-dir", Vcomp_native_version_dir, 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; Vcomp_native_version_dir = Qnil;
DEFVAR_LISP ("comp-deferred-pending-h", Vcomp_deferred_pending_h, 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. */); For internal use. */);
Vcomp_deferred_pending_h = CALLN (Fmake_hash_table, QCtest, Qeq); Vcomp_deferred_pending_h = CALLN (Fmake_hash_table, QCtest, Qeq);
DEFVAR_LISP ("comp-eln-to-el-h", Vcomp_eln_to_el_h, 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); Vcomp_eln_to_el_h = CALLN (Fmake_hash_table, QCtest, Qequal);
DEFVAR_LISP ("native-comp-eln-load-path", Vnative_comp_eln_load_path, 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 The *.eln files are actually looked for in a version-specific
`invocation-directory'. subdirectory of each directory in this list. That subdirectory
`comp-native-version-dir' value is used as a sub-folder name inside is determined by the value of `comp-native-version-dir'.
each eln cache directory. If the name of a directory in this list is not absolute, it is
The last directory of this list is assumed to be the system one. */); 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 /* Temporary value in use for bootstrap. We can't do better as
`invocation-directory' is still unset, will be fixed up during `invocation-directory' is still unset, will be fixed up during
dump reload. */ dump reload. */
Vnative_comp_eln_load_path = Fcons (build_string ("../native-lisp/"), Qnil); Vnative_comp_eln_load_path = Fcons (build_string ("../native-lisp/"), Qnil);
DEFVAR_BOOL ("comp-enable-subr-trampolines", comp_enable_subr_trampolines, DEFVAR_LISP ("native-comp-enable-subr-trampolines",
doc: /* If non-nil, enable primitive trampoline synthesis. Vnative_comp_enable_subr_trampolines,
This makes Emacs respect redefinition or advises of primitive functions doc: /* If non-nil, enable generation of trampolines for calling primitives.
when they are called from Lisp code natively-compiled at `native-comp-speed' Trampolines are needed so that Emacs respects redefinition or advice of
of 2. 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 primitive called from natively-compiled Lisp, it generates a trampoline
for it on-the-fly. for it on-the-fly.
Disabling this, when a trampoline for a redefined or advised primitive is If the value is a file name (a string), it specifies the directory in
not available from previous compilations, means that such redefinition which to deposit the generated trampolines, overriding the directories
or advise will not have effect on calls from natively-compiled Lisp code. in `native-comp-eln-load-path'.
That is, calls to primitives without existing trampolines from
natively-compiled Lisp will behave as if the primitive was called When this variable is nil, generation of trampolines is disabled.
directly from C. */);
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, DEFVAR_LISP ("comp-installed-trampolines-h", Vcomp_installed_trampolines_h,
doc: /* Hash table subr-name -> installed trampoline. doc: /* Hash table subr-name -> installed trampoline.
This is used to prevent double trampoline instantiation but also to This is used to prevent double trampoline instantiation, and also to
protect the trampolines against GC. */); protect the trampolines against GC. */);
Vcomp_installed_trampolines_h = CALLN (Fmake_hash_table); Vcomp_installed_trampolines_h = CALLN (Fmake_hash_table);
DEFVAR_LISP ("comp-no-native-file-h", V_comp_no_native_file_h, 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 These files' compilation should not be deferred because the bytecode
version was explicitly requested by the user during load. version was explicitly requested by the user during load.
For internal use. */); For internal use. */);
V_comp_no_native_file_h = CALLN (Fmake_hash_table, QCtest, Qequal); V_comp_no_native_file_h = CALLN (Fmake_hash_table, QCtest, Qequal);
DEFVAR_BOOL ("comp-file-preloaded-p", comp_file_preloaded_p, DEFVAR_BOOL ("comp-file-preloaded-p", comp_file_preloaded_p,
doc: /* When non-nil assume the file being compiled to doc: /* When non-nil, assume the file being compiled to be preloaded. */);
be preloaded. */);
DEFVAR_LISP ("comp-loaded-comp-units-h", Vcomp_loaded_comp_units_h, DEFVAR_LISP ("comp-loaded-comp-units-h", Vcomp_loaded_comp_units_h,
doc: /* Hash table recording all loaded compilation units. doc: /* Hash table recording all loaded compilation units, file -> CU. */);
file -> CU. */);
Vcomp_loaded_comp_units_h = Vcomp_loaded_comp_units_h =
CALLN (Fmake_hash_table, QCweakness, Qvalue, QCtest, Qequal); CALLN (Fmake_hash_table, QCweakness, Qvalue, QCtest, Qequal);

2
src/data.c
View file

@ -855,7 +855,7 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
#ifdef HAVE_NATIVE_COMP #ifdef HAVE_NATIVE_COMP
register Lisp_Object function = XSYMBOL (symbol)->u.s.function; register Lisp_Object function = XSYMBOL (symbol)->u.s.function;
if (comp_enable_subr_trampolines if (!NILP (Vnative_comp_enable_subr_trampolines)
&& SUBRP (function) && SUBRP (function)
&& !SUBR_NATIVE_COMPILEDP (function)) && !SUBR_NATIVE_COMPILEDP (function))
CALLN (Ffuncall, Qcomp_subr_trampoline_install, symbol); CALLN (Ffuncall, Qcomp_subr_trampoline_install, symbol);

26
src/treesit.c
View file

@ -720,6 +720,7 @@ Return nil if a grammar library for LANGUAGE is not available. */)
} }
} }
/*** Parsing functions */ /*** Parsing functions */
static void static void
@ -770,7 +771,8 @@ treesit_record_change (ptrdiff_t start_byte, ptrdiff_t old_end_byte,
treesit_check_parser (lisp_parser); treesit_check_parser (lisp_parser);
TSTree *tree = XTS_PARSER (lisp_parser)->tree; TSTree *tree = XTS_PARSER (lisp_parser)->tree;
/* See comment (ref:visible-beg-null) if you wonder why we don't /* 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) if (tree != NULL)
{ {
eassert (start_byte <= old_end_byte); 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, ptrdiff_t old_end_offset = (min (visible_end,
max (visible_beg, old_end_byte)) max (visible_beg, old_end_byte))
- visible_beg); - visible_beg);
ptrdiff_t new_end_offset = (min (visible_end, /* We don't clip new_end_offset under visible_end, because
max (visible_beg, new_end_byte)) 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); - visible_beg);
eassert (start_offset <= old_end_offset); eassert (start_offset <= old_end_offset);
eassert (start_offset <= new_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. */ /* Move forward. */
visi_beg_delta = (old_end_byte < visible_beg visi_beg_delta = (old_end_byte < visible_beg
? new_end_byte - old_end_byte : 0); ? new_end_byte - old_end_byte : 0);
XTS_PARSER (lisp_parser)->visible_beg = visible_beg + visi_beg_delta; XTS_PARSER (lisp_parser)->visible_beg = visible_beg + visi_beg_delta;
XTS_PARSER (lisp_parser)->visible_end = (visible_end XTS_PARSER (lisp_parser)->visible_end = (visible_end
+ visi_beg_delta + visi_beg_delta
+ (new_end_offset + (new_end_offset
- old_end_offset)); - old_end_offset));
eassert (XTS_PARSER (lisp_parser)->visible_beg >= 0); eassert (XTS_PARSER (lisp_parser)->visible_beg >= 0);
eassert (XTS_PARSER (lisp_parser)->visible_beg eassert (XTS_PARSER (lisp_parser)->visible_beg
<= XTS_PARSER (lisp_parser)->visible_end); <= XTS_PARSER (lisp_parser)->visible_end);
@ -1104,6 +1114,7 @@ treesit_read_buffer (void *parser, uint32_t byte_index,
return beg; return beg;
} }
/*** Functions for parser and node object */ /*** Functions for parser and node object */
/* Wrap the parser in a Lisp_Object to be used in the Lisp /* 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; return treesit_query;
} }
/* Lisp definitions. */
DEFUN ("treesit-parser-p", DEFUN ("treesit-parser-p",
Ftreesit_parser_p, Streesit_parser_p, 1, 1, 0, Ftreesit_parser_p, Streesit_parser_p, 1, 1, 0,
doc: /* Return t if OBJECT is a tree-sitter parser. */) 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)))); (!NILP (Fbuffer_live_p (XTS_PARSER (parser)->buffer))));
} }
/*** Parser API */ /*** Parser API */
DEFUN ("treesit-parser-root-node", DEFUN ("treesit-parser-root-node",
@ -1730,6 +1745,7 @@ positions. PARSER is the parser issuing the notification. */)
return Qnil; return Qnil;
} }
/*** Node API */ /*** Node API */
/* Check that OBJ is a positive integer and signal an error if /* 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; return same_node ? Qt : Qnil;
} }
/*** Query functions */ /*** Query functions */
DEFUN ("treesit-pattern-expand", DEFUN ("treesit-pattern-expand",
@ -2826,6 +2843,7 @@ the query. */)
return Fnreverse (result); return Fnreverse (result);
} }
/*** Navigation */ /*** Navigation */
static inline void static inline void
@ -3446,7 +3464,7 @@ DEFUN ("treesit-available-p", Ftreesit_available_p,
#endif #endif
} }
/*** Initialization */ /*** Initialization */
/* Initialize the tree-sitter routines. */ /* Initialize the tree-sitter routines. */

11
src/xdisp.c
View file

@ -13424,7 +13424,8 @@ gui_consider_frame_title (Lisp_Object frame)
Fselect_window (f->selected_window, Qt); Fselect_window (f->selected_window, Qt);
set_buffer_internal_1 (XBUFFER (XWINDOW (f->selected_window)->contents)); 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; mode_line_target = MODE_LINE_TITLE;
title_start = MODE_LINE_NOPROP_LEN (0); title_start = MODE_LINE_NOPROP_LEN (0);
@ -36655,9 +36656,11 @@ which no explicit name has been set (see `modify-frame-parameters'). */);
DEFVAR_LISP ("icon-title-format", Vicon_title_format, DEFVAR_LISP ("icon-title-format", Vicon_title_format,
doc: /* Template for displaying the title bar of an iconified frame. doc: /* Template for displaying the title bar of an iconified frame.
\(Assuming the window manager supports this feature.) \(Assuming the window manager supports this feature.)
This variable has the same structure as `mode-line-format' (which see), If the value is a string, it should have the same structure
and is used only on frames for which no explicit name has been set as `mode-line-format' (which see), and is used only on frames
\(see `modify-frame-parameters'). */); 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 /* Do not nest calls to pure_list. This works around a bug in
Oracle Developer Studio 12.6. */ Oracle Developer Studio 12.6. */
Lisp_Object icon_title_name_format Lisp_Object icon_title_name_format

135
test/lisp/hi-lock-tests.el
View file

@ -86,13 +86,18 @@
(unhighlight-regexp "a a") (unhighlight-regexp "a a")
(should (= (length (overlays-in (point-min) (point-max))) 0)) (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)) (should (= (length (overlays-in (point-min) (point-max))) 1))
(cl-letf (((symbol-function 'completing-read) ;; We bind use-dialog-box to nil to prevent unhighlight-regexp
(lambda (_prompt _coll ;; from using popup menus, since the replacement for
&optional _x _y _z _hist defaults _inherit) ;; completing-read below is not ready for that calamity
(car defaults)))) (let ((use-dialog-box nil))
(call-interactively 'unhighlight-regexp)) (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)) (should (= (length (overlays-in (point-min) (point-max))) 0))
(emacs-lisp-mode) (emacs-lisp-mode)
@ -142,12 +147,16 @@
(let ((search-spaces-regexp search-whitespace-regexp)) (highlight-regexp "a a")) (let ((search-spaces-regexp search-whitespace-regexp)) (highlight-regexp "a a"))
(font-lock-ensure) (font-lock-ensure)
(should (memq 'hi-yellow (get-text-property 1 'face))) (should (memq 'hi-yellow (get-text-property 1 'face)))
(cl-letf (((symbol-function 'completing-read) ;; We bind use-dialog-box to nil to prevent unhighlight-regexp
(lambda (_prompt _coll ;; from using popup menus, since the replacement for
&optional _x _y _z _hist defaults _inherit) ;; completing-read below is not ready for that calamity
(car defaults))) (let ((use-dialog-box nil))
(font-lock-fontified t)) (cl-letf (((symbol-function 'completing-read)
(call-interactively 'unhighlight-regexp)) (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)))))) (should (null (get-text-property 1 'face))))))
(ert-deftest hi-lock-unhighlight () (ert-deftest hi-lock-unhighlight ()
@ -156,58 +165,64 @@
(with-temp-buffer (with-temp-buffer
(insert "aAbB\n") (insert "aAbB\n")
(cl-letf (((symbol-function 'completing-read) ;; We bind use-dialog-box to nil to prevent unhighlight-regexp
(lambda (_prompt _coll ;; from using popup menus, since the replacement for
&optional _x _y _z _hist defaults _inherit) ;; completing-read below is not ready for that calamity
(car defaults)))) (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))
(highlight-regexp "a") ;; Test unhighlight all
(highlight-regexp "b") (highlight-regexp "a")
(should (= (length (overlays-in (point-min) (point-max))) 4)) (highlight-regexp "b")
;; `hi-lock--regexps-at-point' should take regexp "a" at point 1, (should (= (length (overlays-in (point-min) (point-max))) 4))
;; not the last regexp "b" (unhighlight-regexp t)
(goto-char 1) (should (= (length (overlays-in (point-min) (point-max))) 0))
(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 (emacs-lisp-mode)
(highlight-regexp "a") (setq font-lock-mode t)
(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) (highlight-regexp "a")
(setq font-lock-mode t) (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)))
(highlight-regexp "a") ;; Test unhighlight all
(highlight-regexp "b") (highlight-regexp "a")
(font-lock-ensure) (highlight-regexp "b")
(should (memq 'hi-yellow (get-text-property 1 'face))) (font-lock-ensure)
(should (memq 'hi-yellow (get-text-property 3 'face))) (should (memq 'hi-yellow (get-text-property 1 'face)))
;; `hi-lock--regexps-at-point' should take regexp "a" at point 1, (should (memq 'hi-yellow (get-text-property 3 'face)))
;; not the last regexp "b" (let ((font-lock-fontified t))
(goto-char 1) (unhighlight-regexp t))
(let ((font-lock-fontified t)) (call-interactively 'unhighlight-regexp)) (should (null (get-text-property 1 'face)))
(should (null (get-text-property 1 'face))) (should (null (get-text-property 3 '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) (provide 'hi-lock-tests)
;;; hi-lock-tests.el ends here ;;; hi-lock-tests.el ends here