[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 48db8b68a8: Merge from origin/emacs-29
|
From: |
Stefan Kangas |
|
Subject: |
master 48db8b68a8: Merge from origin/emacs-29 |
|
Date: |
Sun, 25 Dec 2022 00:45:43 -0500 (EST) |
branch: master
commit 48db8b68a8eb5c12d5682f2eb31cadc53186f5d7
Merge: 4dc5bee98d c36fe3df17
Author: Stefan Kangas <stefankangas@gmail.com>
Commit: Stefan Kangas <stefankangas@gmail.com>
Merge from origin/emacs-29
c36fe3df17b Fix c-ts-mode imenu defun name (bug#60296)
a24e350170e Fix treesit--children-covering-range-recurse (bug#60301)
fbb4eb919b4 Support treesit-defun-name in tree-sitter major modes
6253184afc2 ; * lisp/treesit.el (treesit-defun-at-point): Guard again...
f8e219ebfaa Add treesit-defun-name and friends
35c2ca2ca64 Make treesit-node-at/on guess language at point
7f7def2ae62 ; Add treesit-no-parser error
b6a2e1ddf66 * nt/INSTALL.W64: update instructions for setting up W64 ...
265b91d891a Revert "; Bump minimum supported Windows version for MinG...
75155e45860 ; Bump minimum supported Windows version for MinGW64 to W...
677f6c79eb9 ; Update minimum requirements of MinGW-w64
7723af5e4aa ; * lisp/progmodes/c-ts-mode.el: quote literal string in ...
38866510c7c ; * src/xdisp.c (redisplay_internal): Reinstate the FRAME...
a825aa0b135 Fix definition of CNS 11643-15 charset
a42b20dd95e ; * lisp/progmodes/c-ts-mode.el: Add outline section head...
e4e36345399 Improve c-ts-mode block comment indent (bug#60270)
e30621caa2c ; Add treesit_recursion_limit
6a43af58802 Fix block comment indent and filling for c-ts-mode (bug#5...
e492c21e810 Fix treesit_cursor_helper (bug#60267)
4437dbedf7b Fix restart-emacs alarms (Bug#60220)
121a9ff9f6f Fix alternate stack test in configure
84888080eea Add more functions to "string" shortdoc
c90f97d4e5d Make the Contour terminal an alias of xterm-256color
c3fac9465fa ; Fix punctuation in last change.
756bb422a49 Correct wrong info in (info)Go to node
a8c3424d28b Fix typo in TUTORIAL.fr (bug#60261)
24cd2f0daf1 Add some diff-fixup-modifs tests
d32091199ae Fix quoted argument in emacsclient-mail.desktop Exec key
286c48137f6 ert-x: Move window selection logic to its own macro
823c49cea85 ; ert-x: Simplify `ert-with-test-buffer-selected'
38c6abe4d0b ; ert-x: Add test for buffer read-only state
0e39ad6fa56 Fix crash after X error
---
configure.ac | 1 +
doc/lispref/modes.texi | 8 ++
doc/lispref/parsing.texi | 70 ++++++++++---
doc/misc/info.texi | 5 +-
etc/PROBLEMS | 12 +++
etc/emacsclient-mail.desktop | 4 +-
etc/emacsclient.desktop | 2 +-
etc/tutorials/TUTORIAL.fr | 2 +-
lisp/emacs-lisp/ert-x.el | 53 +++++-----
lisp/emacs-lisp/shortdoc.el | 9 ++
lisp/faces.el | 3 +-
lisp/international/characters.el | 2 +-
lisp/international/mule-conf.el | 2 +-
lisp/progmodes/c-ts-mode.el | 200 ++++++++++++++++++++++++++++++------
lisp/progmodes/csharp-mode.el | 22 +++-
lisp/progmodes/java-ts-mode.el | 22 +++-
lisp/progmodes/js.el | 42 +++-----
lisp/progmodes/json-ts-mode.el | 17 ++-
lisp/progmodes/python.el | 17 ++-
lisp/progmodes/rust-ts-mode.el | 55 +++++-----
lisp/textmodes/css-mode.el | 25 +++--
lisp/textmodes/toml-ts-mode.el | 16 +--
lisp/treesit.el | 156 +++++++++++++++++++++-------
nt/INSTALL.W64 | 25 ++---
src/emacs.c | 1 +
src/treesit.c | 138 +++++++++++++++----------
src/xdisp.c | 8 +-
test/lisp/emacs-lisp/ert-x-tests.el | 39 +++++++
test/lisp/vc/diff-mode-tests.el | 79 ++++++++++++++
29 files changed, 753 insertions(+), 282 deletions(-)
diff --git a/configure.ac b/configure.ac
index 47a9065e54..d0217bdcf4 100644
--- a/configure.ac
+++ b/configure.ac
@@ -5209,6 +5209,7 @@ AC_CACHE_CHECK([whether signals can be handled on
alternate stack],
[emacs_cv_alternate_stack],
[AC_COMPILE_IFELSE(
[AC_LANG_PROGRAM([[#include <signal.h>
+ #include <stdlib.h>
]],
[[stack_t ss;
struct sigaction sa;
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index c44938f392..736c2d6841 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -5024,6 +5024,14 @@ comment-start token. Comment-start tokens are defined
by regular
expression @code{comment-start-skip}. This function assumes
@var{parent} is the comment node.
+@item prev-adaptive-prefix
+This anchor is a function that is called with 3 arguments: @var{node},
+@var{parent}, and @var{bol}. It tries to go to the beginning of the
+previous non-empty line, and matches @code{adaptive-fill-regexp}. If
+there is a match, this function returns the end of the match,
+otherwise it returns nil. This anchor is useful for a
+@code{indent-relative}-like indent behavior for block comments.
+
@end ftable
@end defvar
diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi
index adb4c5e6e0..918e197676 100644
--- a/doc/lispref/parsing.texi
+++ b/doc/lispref/parsing.texi
@@ -576,12 +576,12 @@ leaf node after @var{pos}.
Finally, if there is no leaf node after @var{pos}, return the first
leaf node before @var{pos}.
-When @var{parser-or-lang} is @code{nil} or omitted, this function uses
-the first parser in @code{(treesit-parser-list)} of the current
-buffer. If @var{parser-or-lang} is a parser object, it uses that
-parser; if @var{parser-or-lang} is a language, it finds the first
-parser using that language in @code{(treesit-parser-list)}, and uses
-that.
+If @var{parser-or-lang} is a parser object, this function uses that
+parser; if @var{parser-or-lang} is a language, this function uses the
+first parser for that language in the current buffer, or creates one
+if none exists; if @var{parser-or-lang} is @code{nil}, this function
+tries to guess the language at @var{pos} by
+@code{treesit-language-at}.
If this function cannot find a suitable node to return, it returns
@code{nil}.
@@ -610,13 +610,14 @@ is at or after @var{end}.
inside any top-level construct (function definition, etc.) most
probably will give you the root node, because the root node is the
smallest node that covers that empty line. Most of the time, you want
-to use @code{treesit-node-at}, described above, instead.
+to use @code{treesit-node-at} instead.
-When @var{parser-or-lang} is @code{nil}, this function uses the first
-parser in @code{(treesit-parser-list)} of the current buffer. If
-@var{parser-or-lang} is a parser object, it uses that parser; if
-@var{parser-or-lang} is a language, it finds the first parser using
-that language in @code{(treesit-parser-list)}, and uses that.
+If @var{parser-or-lang} is a parser object, this function uses that
+parser; if @var{parser-or-lang} is a language, this function uses the
+first parser for that language in the current buffer, or creates one
+if none exists; if @var{parser-or-lang} is @code{nil}, this function
+tries to guess the language at @var{beg} by
+@code{treesit-language-at}.
If @var{named} is non-@code{nil}, this function looks for a named node
only (@pxref{tree-sitter named node, named node}).
@@ -628,9 +629,10 @@ This function returns the root node of the syntax tree
generated by
@end defun
@defun treesit-buffer-root-node &optional language
-This function finds the first parser that uses @var{language} in
-@code{(treesit-parser-list)} of the current buffer, and returns the
-root node generated by that parser. If it cannot find an appropriate
+This function finds the first parser for @var{language} in the current
+buffer, or creates one if none exists, and returns the root node
+generated by that parser. If @var{language} is omitted, it uses the
+first parser in the parser list. If it cannot find an appropriate
parser, it returns @code{nil}.
@end defun
@@ -1725,6 +1727,9 @@ indentation.
If @code{treesit-defun-type-regexp} is non-@code{nil}, it sets up
navigation functions for @code{beginning-of-defun} and
@code{end-of-defun}.
+@item
+If @code{treesit-defun-name-function} is non-@code{nil}, it sets up
+add-log functions used by @code{add-log-current-defun}.
@end itemize
@end defun
@@ -1735,6 +1740,41 @@ For more information of these built-in tree-sitter
features,
For supporting mixing of multiple languages in a major mode,
@pxref{Multiple Languages}.
+Besides @code{beginning-of-defun} and @code{end-of-defun}, Emacs
+provides some additional functions for working with defuns:
+@code{treesit-defun-at-point} returns the defun node at point, and
+@code{treesit-defun-name} returns the name of a defun node.
+
+@defun treesit-defun-at-point
+This function returns the defun node at point, or @code{nil} if none
+is found. It respects @code{treesit-defun-tactic}: it returns the
+top-level defun if the value is @code{top-level}, and returns the
+immediate enclosing defun if the value is @code{nested}.
+
+This function requires @code{treesit-defun-type-regexp} to work. If
+it is @code{nil}, this function simply returns @code{nil}.
+@end defun
+
+@defun treesit-defun-name node
+This function returns the defun name of @var{node}. It returns
+@code{nil} if there is no defun name for @var{node}, or if @var{node}
+is not a defun node, or if @var{node} is @code{nil}.
+
+The defun name is names like function name, class name, struct name,
+etc.
+
+If @code{treesit-defun-name-function} is @code{nil}, this function
+always returns @code{nil}.
+@end defun
+
+@defvar treesit-defun-name-function
+If non-@code{nil}, this variable should store a function that is
+called with a node and returns the defun name of it. The function
+should have the same semantic as @code{treesit-defun-name}: if the
+node is not a defun node, or the node is a defun node but doesn't have
+a name, or the node is @code{nil}, return @code{nil}.
+@end defvar
+
@node Tree-sitter C API
@section Tree-sitter C API Correspondence
diff --git a/doc/misc/info.texi b/doc/misc/info.texi
index 4db35ebf0f..84c4eeba4b 100644
--- a/doc/misc/info.texi
+++ b/doc/misc/info.texi
@@ -1098,9 +1098,8 @@ name, and @key{RET}. Thus, @kbd{gTop@key{RET}} would go
to the node
called @samp{Top} in this file. (This is equivalent to @kbd{t}, see
@ref{Help-Int}.) @kbd{gGo to node@key{RET}} would come back here.
- Unlike @kbd{m}, @kbd{g} does not allow the use of abbreviations.
-But it does allow completion, so you can type @key{TAB} to complete a
-partial node name.
+ Like @kbd{m}, @kbd{g} allows the use of abbreviations. It also allows
+completion, so you can type @key{TAB} to complete a partial node name.
@cindex go to another Info file
To go to a node in another file, you can include the file name in the
diff --git a/etc/PROBLEMS b/etc/PROBLEMS
index 1b449b7009..1e45887b86 100644
--- a/etc/PROBLEMS
+++ b/etc/PROBLEMS
@@ -3499,6 +3499,18 @@ with development builds, since the .elc files are
pre-compiled in releases.
** Dumping
+*** temacs.exe fails to run when invoked by the build for dumping
+
+The error message might be something like
+
+ make[2]: *** [Makefile:915: bootstrap-emacs.pdmp] Error 127
+
+This happens if you try to build Emacs on versions of MS-Windows older
+than the minimum version supported by MinGW-w64. As of Dec 2022, the
+minimum supported Windows version is 8.1, and the computer hardware
+(CPU, memory, disk) should also match the minimum Windows 8.1
+requirements.
+
*** Segfault during 'make'
If Emacs segfaults when 'make' executes one of these commands:
diff --git a/etc/emacsclient-mail.desktop b/etc/emacsclient-mail.desktop
index b575a41758..91df122c59 100644
--- a/etc/emacsclient-mail.desktop
+++ b/etc/emacsclient-mail.desktop
@@ -1,7 +1,7 @@
[Desktop Entry]
Categories=Network;Email;
Comment=GNU Emacs is an extensible, customizable text editor - and more
-Exec=sh -c "exec emacsclient --alternate-editor= --display=\\"\\$DISPLAY\\"
--eval \\\\(message-mailto\\\\ \\\\\\"%u\\\\\\"\\\\)"
+Exec=sh -c "exec emacsclient --alternate-editor= --display=\\"\\$DISPLAY\\"
--eval \\"(message-mailto \\\\\\"\\$1\\\\\\")\\"" sh %u
Icon=emacs
Name=Emacs (Mail, Client)
MimeType=x-scheme-handler/mailto;
@@ -13,7 +13,7 @@ Actions=new-window;new-instance;
[Desktop Action new-window]
Name=New Window
-Exec=emacsclient --alternate-editor= --create-frame --eval "(message-mailto
\\"%u\\")"
+Exec=sh -c "exec emacsclient --alternate-editor= --create-frame --eval
\\"(message-mailto \\\\\\"\\$1\\\\\\")\\"" sh %u
[Desktop Action new-instance]
Name=New Instance
diff --git a/etc/emacsclient.desktop b/etc/emacsclient.desktop
index 1ecdecffaf..a9f840c703 100644
--- a/etc/emacsclient.desktop
+++ b/etc/emacsclient.desktop
@@ -3,7 +3,7 @@ Name=Emacs (Client)
GenericName=Text Editor
Comment=Edit text
MimeType=text/english;text/plain;text/x-makefile;text/x-c++hdr;text/x-c++src;text/x-chdr;text/x-csrc;text/x-java;text/x-moc;text/x-pascal;text/x-tcl;text/x-tex;application/x-shellscript;text/x-c;text/x-c++;
-Exec=sh -c "if [ -n \\"\\$*\\" ]; then exec emacsclient --alternate-editor=
--display=\\"\\$DISPLAY\\" \\"\\$@\\"; else exec emacsclient
--alternate-editor= --create-frame; fi" placeholder %F
+Exec=sh -c "if [ -n \\"\\$*\\" ]; then exec emacsclient --alternate-editor=
--display=\\"\\$DISPLAY\\" \\"\\$@\\"; else exec emacsclient
--alternate-editor= --create-frame; fi" sh %F
Icon=emacs
Type=Application
Terminal=false
diff --git a/etc/tutorials/TUTORIAL.fr b/etc/tutorials/TUTORIAL.fr
index 5b080645e4..70d60fcae7 100644
--- a/etc/tutorials/TUTORIAL.fr
+++ b/etc/tutorials/TUTORIAL.fr
@@ -1219,7 +1219,7 @@ Les conditions de copie d'Emacs lui-même sont plus
complexes, mais
dans le même esprit. Lisez le fichier COPYING et donnez ensuite des
copies de GNU Emacs à vos amis. Participez à l'éradication de
l'obstructionnisme du logiciel (sa « propriétarisation ») en
-utilisant, écrivant et partagent des logiciels libres !
+utilisant, écrivant et partageant des logiciels libres !
Cette traduction française a été effectuée par Éric Jacoboni
<jaco@teaser.fr> et complétée par Bastien Guerry <bzg@gnu.org>.
diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el
index 49f2a1d696..0614313809 100644
--- a/lisp/emacs-lisp/ert-x.el
+++ b/lisp/emacs-lisp/ert-x.el
@@ -102,42 +102,35 @@ the name of the test and the result of NAME-FORM."
(indent 1))
`(ert--call-with-test-buffer ,name-form (lambda () ,@body)))
-(cl-defmacro ert-with-test-buffer-selected ((&key name)
- &body body)
- "Create a test buffer, switch to it, and run BODY.
+(cl-defmacro ert-with-buffer-selected (buffer-or-name &body body)
+ "Display a buffer in a temporary selected window and run BODY.
+
+If BUFFER-OR-NAME is nil, the current buffer is used.
-This extends `ert-with-test-buffer' by displaying the test
-buffer (whose name is derived from NAME) in a temporary window.
-The temporary window becomes the `selected-window' before BODY is
-evaluated. The modification hooks `before-change-functions' and
+The buffer is made the current buffer, and the temporary window
+becomes the `selected-window', before BODY is evaluated. The
+modification hooks `before-change-functions' and
`after-change-functions' are not inhibited during the evaluation
of BODY, which makes it easier to use `execute-kbd-macro' to
simulate user interaction. The window configuration is restored
before returning, even if BODY exits nonlocally. The return
value is the last form in BODY."
- (declare (debug ((":name" form) def-body))
- (indent 1))
- (let ((ret (make-symbol "ert--with-test-buffer-selected-ret")))
- `(save-window-excursion
- (let (,ret)
- (ert-with-test-buffer (:name ,name)
- (with-current-buffer-window (current-buffer)
- `(display-buffer-below-selected
- (body-function
- . ,(lambda (window)
- (select-window window t)
- ;; body-function is intended to initialize the
- ;; contents of a temporary read-only buffer, so
- ;; it is executed with some convenience
- ;; changes. Undo those changes so that the
- ;; test buffer behaves more like an ordinary
- ;; buffer while the body executes.
- (let ((inhibit-modification-hooks nil)
- (inhibit-read-only nil)
- (buffer-read-only nil))
- (setq ,ret (progn ,@body))))))
- nil))
- ,ret))))
+ (declare (debug (form body)) (indent 1))
+ `(save-window-excursion
+ (with-current-buffer (or ,buffer-or-name (current-buffer))
+ (with-selected-window (display-buffer (current-buffer))
+ ,@body))))
+
+(cl-defmacro ert-with-test-buffer-selected ((&key name) &body body)
+ "Create a test buffer, switch to it, and run BODY.
+
+This combines `ert-with-test-buffer' and
+`ert-with-buffer-selected'. The return value is the last form in
+BODY."
+ (declare (debug ((":name" form) body)) (indent 1))
+ `(ert-with-test-buffer (:name ,name)
+ (ert-with-buffer-selected (current-buffer)
+ ,@body)))
;;;###autoload
(defun ert-kill-all-test-buffers ()
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index 6704db3cc5..90f81d740f 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -263,6 +263,12 @@ A FUNC form can have any number of `:no-eval' (or
`:no-value'),
:eval (stringp "a")
:eval (stringp 'a)
:eval "(stringp ?a)")
+ (string-or-null-p
+ :eval (string-or-null-p "a")
+ :eval (string-or-null-p nil))
+ (char-or-string-p
+ :eval "(char-or-string-p ?a)"
+ :eval (char-or-string-p "a"))
(string-empty-p
:no-manual t
:eval (string-empty-p ""))
@@ -300,6 +306,9 @@ A FUNC form can have any number of `:no-eval' (or
`:no-value'),
:eval (string-to-number "2.5e+03"))
(number-to-string
:eval (number-to-string 42))
+ (char-uppercase-p
+ :eval "(char-uppercase-p ?A)"
+ :eval "(char-uppercase-p ?a)")
"Data About Strings"
(length
:eval (length "foo")
diff --git a/lisp/faces.el b/lisp/faces.el
index c69339e2fd..29e26e4c65 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -47,7 +47,8 @@ the terminal-initialization file to be loaded."
("vt400" . "vt200")
("vt420" . "vt200")
("alacritty" . "xterm")
- ("foot" . "xterm"))
+ ("foot" . "xterm")
+ ("contour" . "xterm"))
"Alist of terminal type aliases.
Entries are of the form (TYPE . ALIAS), where both elements are strings.
This means to treat a terminal of type TYPE as if it were of type ALIAS."
diff --git a/lisp/international/characters.el b/lisp/international/characters.el
index 9dcae187f2..42344d499c 100644
--- a/lisp/international/characters.el
+++ b/lisp/international/characters.el
@@ -184,7 +184,7 @@ with L, LRE, or LRO Unicode bidi character type.")
(dolist (c '(chinese-cns11643-1 chinese-cns11643-2 chinese-cns11643-3
chinese-cns11643-4 chinese-cns11643-5 chinese-cns11643-6
- chinese-cns11643-7))
+ chinese-cns11643-7 chinese-cns11643-15))
(map-charset-chars #'modify-category-entry c ?c)
(if (eq c 'chinese-cns11643-1)
(map-charset-chars #'modify-category-entry c ?C #x4421 #x7E7E)
diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el
index 3f3ac6064a..65ba2370fc 100644
--- a/lisp/international/mule-conf.el
+++ b/lisp/international/mule-conf.el
@@ -1268,7 +1268,7 @@
:short-name "CNS11643-15"
:long-name "CNS11643-15 (Chinese traditional)"
:code-space [33 126 33 126]
- :code-offset #x27A000
+ :code-offset #x28083A ; Right after 'big5-hkscs.
:unify-map "CNS-F")
(unify-charset 'chinese-gb2312)
diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el
index 6f7056864f..edd81b8bf7 100644
--- a/lisp/progmodes/c-ts-mode.el
+++ b/lisp/progmodes/c-ts-mode.el
@@ -39,6 +39,8 @@
(declare-function treesit-node-child-by-field-name "treesit.c")
(declare-function treesit-node-type "treesit.c")
+;;; Custom variables
+
(defcustom c-ts-mode-indent-offset 2
"Number of spaces for each indentation step in `c-ts-mode'."
:version "29.1"
@@ -91,6 +93,8 @@ follows the form of `treesit-simple-indent-rules'."
table)
"Syntax table for `c++-ts-mode'.")
+;;; Indent
+
(defun c-ts-mode--indent-styles (mode)
"Indent rules supported by `c-ts-mode'.
MODE is either `c' or `cpp'."
@@ -102,7 +106,9 @@ MODE is either `c' or `cpp'."
((node-is "else") parent-bol 0)
((node-is "case") parent-bol 0)
((node-is "preproc_arg") no-indent)
- ((and (parent-is "comment") comment-end) comment-start -1)
+ ((and (parent-is "comment") c-ts-mode--looking-at-star)
+ c-ts-mode--comment-start-after-first-star -1)
+ ((parent-is "comment") prev-adaptive-prefix 0)
((node-is "labeled_statement") parent-bol 0)
((parent-is "labeled_statement") parent-bol c-ts-mode-indent-offset)
((match "preproc_ifdef" "compound_statement") point-min 0)
@@ -167,6 +173,24 @@ MODE is either `c' or `cpp'."
('linux (alist-get 'linux (c-ts-mode--indent-styles mode)))))))
`((,mode ,@style))))
+(defun c-ts-mode--looking-at-star (&rest _)
+ "A tree-sitter simple indent matcher.
+Matches if there is a \"*\" after point (ignoring whitespace in
+between)."
+ (looking-at (rx (* (syntax whitespace)) "*")))
+
+(defun c-ts-mode--comment-start-after-first-star (_n parent &rest _)
+ "A tree-sitter simple indent anchor.
+Finds the \"/*\" and returns the point after the \"*\".
+Assumes PARENT is a comment node."
+ (save-excursion
+ (goto-char (treesit-node-start parent))
+ (if (looking-at (rx "/*"))
+ (match-end 0)
+ (point))))
+
+;;; Font-lock
+
(defvar c-ts-mode--preproc-keywords
'("#define" "#if" "#ifdef" "#ifndef"
"#else" "#elif" "#endif" "#include")
@@ -361,28 +385,34 @@ MODE is either `c' or `cpp'."
@c-ts-mode--fontify-defun)
(:match "^DEFUN$" @fn)))))
-(defun c-ts-mode--fontify-declarator (node override start end &rest args)
- "Fontify a declarator (whatever under the \"declarator\" field).
-For NODE, OVERRIDE, START, END, and ARGS, see
-`treesit-font-lock-rules'."
+;;; Font-lock helpers
+
+(defun c-ts-mode--declarator-identifier (node)
+ "Return the identifier of the declarator node NODE."
(pcase (treesit-node-type node)
+ ;; Recurse.
((or "attributed_declarator" "parenthesized_declarator")
- (apply #'c-ts-mode--fontify-declarator
- (treesit-node-child node 0 t) override start end args))
+ (c-ts-mode--declarator-identifier (treesit-node-child node 0 t)))
("pointer_declarator"
- (apply #'c-ts-mode--fontify-declarator
- (treesit-node-child node -1) override start end args))
+ (c-ts-mode--declarator-identifier (treesit-node-child node -1)))
((or "function_declarator" "array_declarator" "init_declarator")
- (apply #'c-ts-mode--fontify-declarator
- (treesit-node-child-by-field-name node "declarator")
- override start end args))
+ (c-ts-mode--declarator-identifier
+ (treesit-node-child-by-field-name node "declarator")))
+ ;; Terminal case.
((or "identifier" "field_identifier")
- (treesit-fontify-with-override
- (treesit-node-start node) (treesit-node-end node)
- (pcase (treesit-node-type (treesit-node-parent node))
- ("function_declarator" 'font-lock-function-name-face)
- (_ 'font-lock-variable-name-face))
- override start end))))
+ node)))
+
+(defun c-ts-mode--fontify-declarator (node override start end &rest args)
+ "Fontify a declarator (whatever under the \"declarator\" field).
+For NODE, OVERRIDE, START, END, and ARGS, see
+`treesit-font-lock-rules'."
+ (let* ((identifier (c-ts-mode--declarator-identifier node))
+ (face (pcase (treesit-node-type (treesit-node-parent identifier))
+ ("function_declarator" 'font-lock-function-name-face)
+ (_ 'font-lock-variable-name-face))))
+ (treesit-fontify-with-override
+ (treesit-node-start identifier) (treesit-node-end identifier)
+ face override start end)))
(defun c-ts-mode--fontify-variable (node override start end &rest _)
"Fontify an identifier node if it is a variable.
@@ -453,6 +483,21 @@ For NODE, OVERRIDE, START, and END, see
(t 'font-lock-warning-face))
override start end)))
+;;; Imenu
+
+(defun c-ts-mode--defun-name (node)
+ "Return the name of the defun NODE.
+Return nil if NODE is not a defun node, return an empty string if
+NODE doesn't have a name."
+ (treesit-node-text
+ (pcase (treesit-node-type node)
+ ((or "function_definition" "declaration")
+ (c-ts-mode--declarator-identifier
+ (treesit-node-child-by-field-name node "declarator")))
+ ("struct_specifier"
+ (treesit-node-child-by-field-name node "name")))
+ t))
+
(defun c-ts-mode--imenu-1 (node)
"Helper for `c-ts-mode--imenu'.
Find string representation for NODE and set marker, then recurse
@@ -460,22 +505,7 @@ the subtrees."
(let* ((ts-node (car node))
(subtrees (mapcan #'c-ts-mode--imenu-1 (cdr node)))
(name (when ts-node
- (treesit-node-text
- (pcase (treesit-node-type ts-node)
- ("function_definition"
- (treesit-node-child-by-field-name
- (treesit-node-child-by-field-name
- ts-node "declarator")
- "declarator"))
- ("declaration"
- (let ((child (treesit-node-child ts-node -1 t)))
- (pcase (treesit-node-type child)
- ("identifier" child)
- (_ (treesit-node-child-by-field-name
- child "declarator")))))
- ("struct_specifier"
- (treesit-node-child-by-field-name
- ts-node "name"))))))
+ (treesit-defun-name ts-node)))
(marker (when ts-node
(set-marker (make-marker)
(treesit-node-start ts-node)))))
@@ -517,6 +547,8 @@ the subtrees."
(when var-index `(("Variable" . ,var-index)))
(when func-index `(("Function" . ,func-index))))))
+;;; Defun navigation
+
(defun c-ts-mode--end-of-defun ()
"`end-of-defun-function' of `c-ts-mode'."
;; A struct/enum/union_specifier node doesn't include the ; at the
@@ -562,6 +594,74 @@ the semicolon. This function skips the semicolon."
(treesit-node-end node))
(goto-char orig-point)))
+;;; Filling
+
+(defun c-ts-mode--fill-paragraph (&optional arg)
+ "Fillling function for `c-ts-mode'.
+ARG is passed to `fill-paragraph'."
+ (interactive "*P")
+ (save-restriction
+ (widen)
+ (let* ((node (treesit-node-at (point)))
+ (start (treesit-node-start node))
+ (end (treesit-node-end node))
+ ;; Bind to nil to avoid infinite recursion.
+ (fill-paragraph-function nil)
+ (orig-point (point-marker))
+ (start-marker nil)
+ (end-marker nil)
+ (end-len 0))
+ (when (equal (treesit-node-type node) "comment")
+ ;; We mask "/*" and the space before "*/" like
+ ;; `c-fill-paragraph' does.
+ (atomic-change-group
+ ;; Mask "/*".
+ (goto-char start)
+ (when (looking-at (rx (* (syntax whitespace))
+ (group "/") "*"))
+ (goto-char (match-beginning 1))
+ (setq start-marker (point-marker))
+ (replace-match " " nil nil nil 1))
+ ;; Mask spaces before "*/" if it is attached at the end
+ ;; of a sentence rather than on its own line.
+ (goto-char end)
+ (when (looking-back (rx (not (syntax whitespace))
+ (group (+ (syntax whitespace)))
+ "*/")
+ (line-beginning-position))
+ (goto-char (match-beginning 1))
+ (setq end-marker (point-marker))
+ (setq end-len (- (match-end 1) (match-beginning 1)))
+ (replace-match (make-string end-len ?x)
+ nil nil nil 1))
+ ;; If "*/" is on its own line, don't included it in the
+ ;; filling region.
+ (when (not end-marker)
+ (goto-char end)
+ (when (looking-back (rx "*/") 2)
+ (backward-char 2)
+ (skip-syntax-backward "-")
+ (setq end (point))))
+ ;; Let `fill-paragraph' do its thing.
+ (goto-char orig-point)
+ (narrow-to-region start end)
+ (funcall #'fill-paragraph arg)
+ ;; Unmask.
+ (when start-marker
+ (goto-char start-marker)
+ (delete-char 1)
+ (insert "/"))
+ (when end-marker
+ (goto-char end-marker)
+ (delete-region (point) (+ end-len (point)))
+ (insert (make-string end-len ?\s))))
+ (goto-char orig-point))
+ ;; Return t so `fill-paragraph' doesn't attempt to fill by
+ ;; itself.
+ t)))
+
+;;; Modes
+
(defvar-keymap c-ts-mode-map
:doc "Keymap for the C language with tree-sitter"
:parent prog-mode-map
@@ -584,6 +684,7 @@ the semicolon. This function skips the semicolon."
"class_specifier"))
#'c-ts-mode--defun-valid-p))
(setq-local treesit-defun-skipper #'c-ts-mode--defun-skipper)
+ (setq-local treesit-defun-name-function #'c-ts-mode--defun-name)
;; Nodes like struct/enum/union_specifier can appear in
;; function_definitions, so we need to find the top-level node.
@@ -593,6 +694,37 @@ the semicolon. This function skips the semicolon."
(when (eq c-ts-mode-indent-style 'linux)
(setq-local indent-tabs-mode t))
+ (setq-local adaptive-fill-mode t)
+ ;; This matches (1) empty spaces (the default), (2) "//", (3) "*",
+ ;; but do not match "/*", because we don't want to use "/*" as
+ ;; prefix when filling. (Actually, it doesn't matter, because
+ ;; `comment-start-skip' matches "/*" which will cause
+ ;; `fill-context-prefix' to use "/*" as a prefix for filling, that's
+ ;; why we mask the "/*" in `c-ts-mode--fill-paragraph'.)
+ (setq-local adaptive-fill-regexp
+ (concat (rx (* (syntax whitespace))
+ (group (or (seq "/" (+ "/")) (* "*"))))
+ adaptive-fill-regexp))
+ ;; Same as `adaptive-fill-regexp'.
+ (setq-local adaptive-fill-first-line-regexp
+ (rx bos
+ (seq (* (syntax whitespace))
+ (group (or (seq "/" (+ "/")) (* "*")))
+ (* (syntax whitespace)))
+ eos))
+ ;; Same as `adaptive-fill-regexp'.
+ (setq-local paragraph-start
+ (rx (or (seq (* (syntax whitespace))
+ (group (or (seq "/" (+ "/")) (* "*")))
+ (* (syntax whitespace))
+ ;; Add this eol so that in
+ ;; `fill-context-prefix', `paragraph-start'
+ ;; doesn't match the prefix.
+ eol)
+ "\f")))
+ (setq-local paragraph-separate paragraph-start)
+ (setq-local fill-paragraph-function #'c-ts-mode--fill-paragraph)
+
;; Electric
(setq-local electric-indent-chars
(append "{}():;," electric-indent-chars))
diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el
index 9e8b22c6ab..dd2d877c96 100644
--- a/lisp/progmodes/csharp-mode.el
+++ b/lisp/progmodes/csharp-mode.el
@@ -837,6 +837,22 @@ compilation and evaluation time conflicts."
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.cs\\'" . csharp-mode))
+(defun csharp-ts-mode--defun-name (node)
+ "Return the defun name of NODE.
+Return nil if there is no name or if NODE is not a defun node."
+ (pcase (treesit-node-type node)
+ ((or "method_declaration"
+ "record_declaration"
+ "struct_declaration"
+ "enum_declaration"
+ "interface_declaration"
+ "class_declaration"
+ "class_declaration")
+ (treesit-node-text
+ (treesit-node-child-by-field-name
+ node "name")
+ t))))
+
(defun csharp-ts-mode--imenu-1 (node)
"Helper for `csharp-ts-mode--imenu'.
Find string representation for NODE and set marker, then recurse
@@ -844,10 +860,7 @@ the subtrees."
(let* ((ts-node (car node))
(subtrees (mapcan #'csharp-ts-mode--imenu-1 (cdr node)))
(name (when ts-node
- (or (treesit-node-text
- (or (treesit-node-child-by-field-name
- ts-node "name"))
- t)
+ (or (treesit-defun-name ts-node)
"Unnamed node")))
(marker (when ts-node
(set-marker (make-marker)
@@ -940,6 +953,7 @@ Key bindings:
;; Navigation.
(setq-local treesit-defun-type-regexp "declaration")
+ (setq-local treesit-defun-name-function #'csharp-ts-mode--defun-name)
;; Font-lock.
(setq-local treesit-font-lock-settings csharp-ts-mode--font-lock-settings)
diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el
index bd6a8aa474..b6f747cf1c 100644
--- a/lisp/progmodes/java-ts-mode.el
+++ b/lisp/progmodes/java-ts-mode.el
@@ -248,6 +248,22 @@
'((["," ":" ";"]) @font-lock-delimiter-face))
"Tree-sitter font-lock settings for `java-ts-mode'.")
+(defun java-ts-mode--defun-name (node)
+ "Return the defun name of NODE.
+Return nil if there is no name or if NODE is not a defun node."
+ (pcase (treesit-node-type node)
+ ((or "method_declaration"
+ "class_declaration"
+ "record_declaration"
+ "interface_declaration"
+ "enum_declaration"
+ "import_declaration"
+ "package_declaration"
+ "module_declaration")
+ (treesit-node-text
+ (treesit-node-child-by-field-name node "name")
+ t))))
+
(defun java-ts-mode--imenu-1 (node)
"Helper for `java-ts-mode--imenu'.
Find string representation for NODE and set marker, then recurse
@@ -255,10 +271,7 @@ the subtrees."
(let* ((ts-node (car node))
(subtrees (mapcan #'java-ts-mode--imenu-1 (cdr node)))
(name (when ts-node
- (or (treesit-node-text
- (or (treesit-node-child-by-field-name
- ts-node "name"))
- t)
+ (or (treesit-defun-name ts-node)
"Unnamed node")))
(marker (when ts-node
(set-marker (make-marker)
@@ -339,6 +352,7 @@ the subtrees."
"import_declaration"
"package_declaration"
"module_declaration")))
+ (setq-local treesit-defun-name-function #'java-ts-mode--defun-name)
;; Font-lock.
(setq-local treesit-font-lock-settings java-ts-mode--font-lock-settings)
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index 15272dcc00..229bd53e1e 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -3656,24 +3656,18 @@ OVERRIDE is the override flag described in
(setq font-beg (treesit-node-end child)
child (treesit-node-next-sibling child)))))
-(defun js-treesit-current-defun ()
- "Return name of surrounding function.
-This function can be used as a value in `which-func-functions'"
- (let ((node (treesit-node-at (point)))
- (name-list ()))
- (cl-loop while node
- if (pcase (treesit-node-type node)
- ("function_declaration" t)
- ("method_definition" t)
- ("class_declaration" t)
- ("variable_declarator" t)
- (_ nil))
- do (push (treesit-node-text
- (treesit-node-child-by-field-name node "name")
- t)
- name-list)
- do (setq node (treesit-node-parent node))
- finally return (string-join name-list "."))))
+(defun js--treesit-defun-name (node)
+ "Return the defun name of NODE.
+Return nil if there is no name or if NODE is not a defun node."
+ (treesit-node-text
+ (treesit-node-child-by-field-name
+ (pcase (treesit-node-type node)
+ ("lexical_declaration"
+ (treesit-search-subtree node "variable_declarator" nil nil 1))
+ ((or "function_declaration" "method_definition" "class_declaration")
+ node))
+ "name")
+ t))
(defun js--treesit-imenu-1 (node)
"Given a sparse tree, create an imenu alist.
@@ -3702,15 +3696,8 @@ definition*\"."
("function_declaration" 'function)))
;; The root of the tree could have a nil ts-node.
(name (when ts-node
- (let ((ts-node-1
- (if (eq type 'variable)
- (treesit-search-subtree
- ts-node "variable_declarator" nil nil 1)
- ts-node)))
- (treesit-node-text
- (treesit-node-child-by-field-name
- ts-node-1 "name")
- t))))
+ (or (treesit-defun-name ts-node)
+ "Anonymous")))
(marker (when ts-node
(set-marker (make-marker)
(treesit-node-start ts-node)))))
@@ -3890,6 +3877,7 @@ Currently there are `js-mode' and `js-ts-mode'."
"method_definition"
"function_declaration"
"lexical_declaration")))
+ (setq-local treesit-defun-name-function #'js--treesit-defun-name)
;; Fontification.
(setq-local treesit-font-lock-settings js--treesit-font-lock-settings)
(setq-local treesit-font-lock-feature-list
diff --git a/lisp/progmodes/json-ts-mode.el b/lisp/progmodes/json-ts-mode.el
index 6c2f380587..6725c5f227 100644
--- a/lisp/progmodes/json-ts-mode.el
+++ b/lisp/progmodes/json-ts-mode.el
@@ -107,6 +107,16 @@
'((ERROR) @font-lock-warning-face))
"Font-lock settings for JSON.")
+(defun json-ts-mode--defun-name (node)
+ "Return the defun name of NODE.
+Return nil if there is no name or if NODE is not a defun node."
+ (pcase (treesit-node-type node)
+ ((or "pair" "object")
+ (treesit-node-text
+ (treesit-node-child-by-field-name
+ node "key")
+ t))))
+
(defun json-ts-mode--imenu-1 (node)
"Helper for `json-ts-mode--imenu'.
Find string representation for NODE and set marker, then recurse
@@ -114,10 +124,8 @@ the subtrees."
(let* ((ts-node (car node))
(subtrees (mapcan #'json-ts-mode--imenu-1 (cdr node)))
(name (when ts-node
- (treesit-node-text
- (treesit-node-child-by-field-name
- ts-node "key")
- t)))
+ (or (treesit-defun-name ts-node)
+ "Anonymous")))
(marker (when ts-node
(set-marker (make-marker)
(treesit-node-start ts-node)))))
@@ -161,6 +169,7 @@ the subtrees."
;; Navigation.
(setq-local treesit-defun-type-regexp
(rx (or "pair" "object")))
+ (setq-local treesit-defun-name-function #'json-ts-mode--defun-name)
;; Font-lock.
(setq-local treesit-font-lock-settings json-ts-mode--font-lock-settings)
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 86bfafe271..0cd0c6c225 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -5448,6 +5448,16 @@ To this:
;;; Tree-sitter imenu
+(defun python--treesit-defun-name (node)
+ "Return the defun name of NODE.
+Return nil if there is no name or if NODE is not a defun node."
+ (pcase (treesit-node-type node)
+ ((or "function_definition" "class_definition")
+ (treesit-node-text
+ (treesit-node-child-by-field-name
+ node "name")
+ t))))
+
(defun python--imenu-treesit-create-index-1 (node)
"Given a sparse tree, create an imenu alist.
@@ -5473,9 +5483,8 @@ definition*\"."
("class_definition" 'class)))
;; The root of the tree could have a nil ts-node.
(name (when ts-node
- (treesit-node-text
- (treesit-node-child-by-field-name
- ts-node "name") t)))
+ (or (treesit-defun-name ts-node)
+ "Anonymous")))
(marker (when ts-node
(set-marker (make-marker)
(treesit-node-start ts-node)))))
@@ -6643,6 +6652,8 @@ implementations: `python-mode' and `python-ts-mode'."
#'python-imenu-treesit-create-index)
(setq-local treesit-defun-type-regexp (rx (or "function" "class")
"_definition"))
+ (setq-local treesit-defun-name-function
+ #'python--treesit-defun-name)
(treesit-major-mode-setup)
(when python-indent-guess-indent-offset
diff --git a/lisp/progmodes/rust-ts-mode.el b/lisp/progmodes/rust-ts-mode.el
index 8b2ed19101..81f5b8765f 100644
--- a/lisp/progmodes/rust-ts-mode.el
+++ b/lisp/progmodes/rust-ts-mode.el
@@ -273,6 +273,33 @@
(when struct-index `(("Struct" . ,struct-index)))
(when func-index `(("Fn" . ,func-index))))))
+(defun rust-ts-mode--defun-name (node)
+ "Return the defun name of NODE.
+Return nil if there is no name or if NODE is not a defun node."
+ (pcase (treesit-node-type node)
+ ("enum_item"
+ (treesit-node-text
+ (treesit-node-child-by-field-name node "name") t))
+ ("function_item"
+ (treesit-node-text
+ (treesit-node-child-by-field-name node "name") t))
+ ("impl_item"
+ (let ((trait-node (treesit-node-child-by-field-name node "trait")))
+ (concat
+ (treesit-node-text trait-node t)
+ (when trait-node " for ")
+ (treesit-node-text
+ (treesit-node-child-by-field-name node "type") t))))
+ ("mod_item"
+ (treesit-node-text
+ (treesit-node-child-by-field-name node "name") t))
+ ("struct_item"
+ (treesit-node-text
+ (treesit-node-child-by-field-name node "name") t))
+ ("type_item"
+ (treesit-node-text
+ (treesit-node-child-by-field-name node "name") t))))
+
(defun rust-ts-mode--imenu-1 (node)
"Helper for `rust-ts-mode--imenu'.
Find string representation for NODE and set marker, then recurse
@@ -282,31 +309,8 @@ the subtrees."
(subtrees (mapcan #'rust-ts-mode--imenu-1
children))
(name (when ts-node
- (pcase (treesit-node-type ts-node)
- ("enum_item"
- (treesit-node-text
- (treesit-node-child-by-field-name ts-node "name") t))
- ("function_item"
- (treesit-node-text
- (treesit-node-child-by-field-name ts-node "name") t))
- ("impl_item"
- (let ((trait-node (treesit-node-child-by-field-name
ts-node "trait")))
- (concat
- (treesit-node-text
- trait-node t)
- (when trait-node
- " for ")
- (treesit-node-text
- (treesit-node-child-by-field-name ts-node "type") t))))
- ("mod_item"
- (treesit-node-text
- (treesit-node-child-by-field-name ts-node "name") t))
- ("struct_item"
- (treesit-node-text
- (treesit-node-child-by-field-name ts-node "name") t))
- ("type_item"
- (treesit-node-text
- (treesit-node-child-by-field-name ts-node "name") t)))))
+ (or (treesit-defun-name ts-node)
+ "Anonymous")))
(marker (when ts-node
(set-marker (make-marker)
(treesit-node-start ts-node)))))
@@ -363,6 +367,7 @@ the subtrees."
"function_item"
"impl_item"
"struct_item")))
+ (setq-local treesit-defun-name-function #'rust-ts-mode--defun-name)
(treesit-major-mode-setup)))
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index 822097a86d..99ef4f10a0 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -1412,6 +1412,19 @@ for determining whether point is within a selector."
'((ERROR) @error))
"Tree-sitter font-lock settings for `css-ts-mode'.")
+(defun css--treesit-defun-name (node)
+ "Return the defun name of NODE.
+Return nil if there is no name or if NODE is not a defun node."
+ (pcase (treesit-node-type node)
+ ("rule_set" (treesit-node-text
+ (treesit-node-child node 0) t))
+ ("media_statement"
+ (let ((block (treesit-node-child node -1)))
+ (string-trim
+ (buffer-substring-no-properties
+ (treesit-node-start node)
+ (treesit-node-start block)))))))
+
(defun css--treesit-imenu-1 (node)
"Helper for `css--treesit-imenu'.
Find string representation for NODE and set marker, then recurse
@@ -1419,15 +1432,8 @@ the subtrees."
(let* ((ts-node (car node))
(subtrees (mapcan #'css--treesit-imenu-1 (cdr node)))
(name (when ts-node
- (pcase (treesit-node-type ts-node)
- ("rule_set" (treesit-node-text
- (treesit-node-child ts-node 0) t))
- ("media_statement"
- (let ((block (treesit-node-child ts-node -1)))
- (string-trim
- (buffer-substring-no-properties
- (treesit-node-start ts-node)
- (treesit-node-start block))))))))
+ (or (treesit-defun-name ts-node)
+ "Anonymous")))
(marker (when ts-node
(set-marker (make-marker)
(treesit-node-start ts-node)))))
@@ -1835,6 +1841,7 @@ can also be used to fill comments.
(treesit-parser-create 'css)
(setq-local treesit-simple-indent-rules css--treesit-indent-rules)
(setq-local treesit-defun-type-regexp "rule_set")
+ (setq-local treesit-defun-name-function #'css--treesit-defun-name)
(setq-local treesit-font-lock-settings css--treesit-settings)
(setq-local treesit-font-lock-feature-list
'((selector comment query keyword)
diff --git a/lisp/textmodes/toml-ts-mode.el b/lisp/textmodes/toml-ts-mode.el
index bca6a5e81a..790de2133e 100644
--- a/lisp/textmodes/toml-ts-mode.el
+++ b/lisp/textmodes/toml-ts-mode.el
@@ -107,12 +107,12 @@
'((ERROR) @font-lock-warning-face))
"Font-lock settings for TOML.")
-(defun toml-ts-mode--get-table-name (node)
- "Obtains the header-name for the associated tree-sitter `NODE'."
- (if node
- (treesit-node-text
- (car (cdr (treesit-node-children node))))
- "Root table"))
+(defun toml-ts-mode--defun-name (node)
+ "Return the defun name of NODE.
+Return nil if there is no name or if NODE is not a defun node."
+ (pcase (treesit-node-type node)
+ ((or "table" "table_array_element")
+ (car (cdr (treesit-node-children node))))))
(defun toml-ts-mode--imenu-1 (node)
"Helper for `toml-ts-mode--imenu'.
@@ -120,7 +120,8 @@ Find string representation for NODE and set marker, then
recurse
the subtrees."
(let* ((ts-node (car node))
(subtrees (mapcan #'toml-ts-mode--imenu-1 (cdr node)))
- (name (toml-ts-mode--get-table-name ts-node))
+ (name (or (treesit-defun-name ts-node)
+ "Root table"))
(marker (when ts-node
(set-marker (make-marker)
(treesit-node-start ts-node)))))
@@ -167,6 +168,7 @@ the subtrees."
;; Navigation.
(setq-local treesit-defun-type-regexp
(rx (or "table" "table_array_element")))
+ (setq-local treesit-defun-name-function #'toml-ts-mode--defun-name)
;; Font-lock.
(setq-local treesit-font-lock-settings toml-ts-mode--font-lock-settings)
diff --git a/lisp/treesit.el b/lisp/treesit.el
index 75330ac121..1de0da19c2 100644
--- a/lisp/treesit.el
+++ b/lisp/treesit.el
@@ -141,6 +141,9 @@ parser in `treesit-parser-list', or nil if there is no
parser."
;;; Node API supplement
+(define-error 'treesit-no-parser "No available parser for this buffer"
+ 'treesit-error)
+
(defun treesit-node-buffer (node)
"Return the buffer in which NODE belongs."
(treesit-parser-buffer
@@ -168,13 +171,15 @@ before POS.
Return nil if no leaf node can be returned. If NAMED is non-nil,
only look for named nodes.
-If PARSER-OR-LANG is nil, use the first parser in
-`treesit-parser-list'; if PARSER-OR-LANG is a parser, use
-that parser; if PARSER-OR-LANG is a language, find a parser using
-that language in the current buffer, and use that."
+If PARSER-OR-LANG is a parser, use that parser; if PARSER-OR-LANG
+is a language, find the first parser for that language in the
+current buffer, or create one if none exists; If PARSER-OR-LANG
+is nil, try to guess the language at POS by
+`treesit-language-at'."
(let* ((root (if (treesit-parser-p parser-or-lang)
(treesit-parser-root-node parser-or-lang)
- (treesit-buffer-root-node parser-or-lang)))
+ (treesit-buffer-root-node
+ (or parser-or-lang (treesit-language-at pos)))))
(node root)
(node-before root)
(pos-1 (max (1- pos) (point-min)))
@@ -216,13 +221,15 @@ to use `treesit-node-at' instead.
Return nil if none was found. If NAMED is non-nil, only look for
named node.
-If PARSER-OR-LANG is nil, use the first parser in
-`treesit-parser-list'; if PARSER-OR-LANG is a parser, use
-that parser; if PARSER-OR-LANG is a language, find a parser using
-that language in the current buffer, and use that."
+If PARSER-OR-LANG is a parser, use that parser; if PARSER-OR-LANG
+is a language, find the first parser for that language in the
+current buffer, or create one if none exists; If PARSER-OR-LANG
+is nil, try to guess the language at BEG by
+`treesit-language-at'."
(let ((root (if (treesit-parser-p parser-or-lang)
(treesit-parser-root-node parser-or-lang)
- (treesit-buffer-root-node parser-or-lang))))
+ (treesit-buffer-root-node
+ (or parser-or-lang (treesit-language-at beg))))))
(treesit-node-descendant-for-range root beg (or end beg) named)))
(defun treesit-node-top-level (node &optional type)
@@ -243,16 +250,15 @@ regexp, rather than using NODE's type."
(defun treesit-buffer-root-node (&optional language)
"Return the root node of the current buffer.
-Use the first parser in `treesit-parser-list'.
-If optional argument LANGUAGE is non-nil, use the first parser
-for LANGUAGE."
+Use the first parser in the parser list if LANGUAGE is omitted.
+If LANGUAGE is non-nil, use the first parser for LANGUAGE in the
+parser list, or create one if none exists."
(if-let ((parser
- (or (if language
- (treesit-parser-create language)
- (or (car (treesit-parser-list))
- (signal 'treesit-error
- '("Buffer has no parser")))))))
+ (if language
+ (treesit-parser-create language)
+ (or (car (treesit-parser-list))
+ (signal 'treesit-no-parser (list (current-buffer)))))))
(treesit-parser-root-node parser)))
(defun treesit-filter-child (node pred &optional named)
@@ -859,7 +865,7 @@ LIMIT is the recursion limit, which defaults to 100."
(push child result))
(setq child (treesit-node-next-sibling child)))
;; If NODE has no child, keep NODE.
- (or result node)))
+ (or result (list node))))
(defsubst treesit--node-length (node)
"Return the length of the text of NODE."
@@ -1107,6 +1113,22 @@ See `treesit-simple-indent-presets'.")
(re-search-forward comment-start-skip)
(skip-syntax-backward "-")
(point))))
+ (cons 'prev-adaptive-prefix
+ (lambda (_n parent &rest _)
+ (save-excursion
+ (re-search-backward
+ (rx (not (or " " "\t" "\n"))) nil t)
+ (beginning-of-line)
+ (and (>= (point) (treesit-node-start parent))
+ ;; `adaptive-fill-regexp' will not match "/*",
+ ;; so we need to also try `comment-start-skip'.
+ (or (and adaptive-fill-regexp
+ (looking-at adaptive-fill-regexp)
+ (> (- (match-end 0) (match-beginning 0)) 0)
+ (match-end 0))
+ (and comment-start-skip
+ (looking-at comment-start-skip)
+ (match-end 0)))))))
;; TODO: Document.
(cons 'grand-parent
(lambda (_n parent &rest _)
@@ -1229,7 +1251,14 @@ comment-start
Goes to the position that `comment-start-skip' would return,
skips whitespace backwards, and returns the resulting
- position. Assumes PARENT is a comment node.")
+ position. Assumes PARENT is a comment node.
+
+prev-adaptive-prefix
+
+ Goes to the beginning of previous non-empty line, and tries
+ to match `adaptive-fill-regexp'. If it matches, return the
+ end of the match, otherwise return nil. This is useful for a
+ `indent-relative'-like indent behavior for block comments.")
(defun treesit--simple-indent-eval (exp)
"Evaluate EXP.
@@ -1583,6 +1612,17 @@ newline after a defun, or the beginning of a defun.
If the value is nil, no skipping is performed.")
+(defvar-local treesit-defun-name-function nil
+ "A function called with a node and returns the name of it.
+If the node is a defun node, return the defun name. E.g., the
+function name of a function. If the node is not a defun node, or
+the defun node doesn't have a name, or the node is nil, return
+nil.")
+
+(defvar-local treesit-add-log-defun-delimiter "."
+ "The delimiter used to connect several defun names.
+This is used in `treesit-add-log-current-defun'.")
+
(defun treesit-beginning-of-defun (&optional arg)
"Move backward to the beginning of a defun.
@@ -1659,7 +1699,9 @@ previous and next sibling defuns around POS, and PARENT
is the
parent defun surrounding POS. All of three could be nil if no
sound defun exists.
-REGEXP and PRED are the same as in `treesit-defun-type-regexp'."
+REGEXP and PRED are the same as in `treesit-defun-type-regexp'.
+
+Assumes `treesit-defun-type-regexp' is set."
(let* ((node (treesit-node-at pos))
;; NODE-BEFORE/AFTER = NODE when POS is completely in NODE,
;; but if not, that means point could be in between two
@@ -1845,26 +1887,58 @@ function is called recursively."
;; TODO: In corporate into thing-at-point.
(defun treesit-defun-at-point ()
- "Return the defun at point or nil if none is found.
+ "Return the defun node at point or nil if none is found.
Respects `treesit-defun-tactic': return the top-level defun if it
is `top-level', return the immediate parent defun if it is
-`nested'."
- (pcase-let* ((`(,regexp . ,pred)
- (if (consp treesit-defun-type-regexp)
- treesit-defun-type-regexp
- (cons treesit-defun-type-regexp nil)))
- (`(,_ ,next ,parent)
- (treesit--defuns-around (point) regexp pred))
- ;; If point is at the beginning of a defun, we
- ;; prioritize that defun over the parent in nested
- ;; mode.
- (node (or (and (eq (treesit-node-start next) (point))
- next)
- parent)))
- (if (eq treesit-defun-tactic 'top-level)
- (treesit--top-level-defun node regexp pred)
- node)))
+`nested'.
+
+Return nil if `treesit-defun-type-regexp' is not set."
+ (when treesit-defun-type-regexp
+ (pcase-let* ((`(,regexp . ,pred)
+ (if (consp treesit-defun-type-regexp)
+ treesit-defun-type-regexp
+ (cons treesit-defun-type-regexp nil)))
+ (`(,_ ,next ,parent)
+ (treesit--defuns-around (point) regexp pred))
+ ;; If point is at the beginning of a defun, we
+ ;; prioritize that defun over the parent in nested
+ ;; mode.
+ (node (or (and (eq (treesit-node-start next) (point))
+ next)
+ parent)))
+ (if (eq treesit-defun-tactic 'top-level)
+ (treesit--top-level-defun node regexp pred)
+ node))))
+
+(defun treesit-defun-name (node)
+ "Return the defun name of NODE.
+
+Return nil if there is no name, or if NODE is not a defun node,
+or if NODE is nil.
+
+If `treesit-defun-name-function' is nil, always return nil."
+ (when treesit-defun-name-function
+ (funcall treesit-defun-name-function node)))
+
+(defun treesit-add-log-current-defun ()
+ "Return the name of the defun at point.
+
+Used for `add-log-current-defun-function'.
+
+The delimiter between nested defun names is controlled by
+`treesit-add-log-defun-delimiter'."
+ (let ((node (treesit-defun-at-point))
+ (name nil))
+ (while node
+ (when-let ((new-name (treesit-defun-name node)))
+ (if name
+ (setq name (concat new-name
+ treesit-add-log-defun-delimiter
+ name))
+ (setq name new-name)))
+ (setq node (treesit-node-parent node)))
+ name))
;;; Activating tree-sitter
@@ -1959,7 +2033,11 @@ before calling this function."
;; the variables. In future we should update `end-of-defun' to
;; work with nested defuns.
(setq-local beginning-of-defun-function #'treesit-beginning-of-defun)
- (setq-local end-of-defun-function #'treesit-end-of-defun)))
+ (setq-local end-of-defun-function #'treesit-end-of-defun))
+ ;; Defun name.
+ (when treesit-defun-name-function
+ (setq-local add-log-current-defun-function
+ #'treesit-add-log-current-defun)))
;;; Debugging
diff --git a/nt/INSTALL.W64 b/nt/INSTALL.W64
index 9261c82db1..b1f5dabaaf 100644
--- a/nt/INSTALL.W64
+++ b/nt/INSTALL.W64
@@ -6,7 +6,7 @@
This document describes how to compile a 64-bit GNU Emacs using MSYS2
and MinGW-w64. For instructions for building a 32-bit Emacs using
-MSYS and MinGW, see the file INSTALL in this directory.
+MSYS and mingw.org's MinGW, see the file INSTALL in this directory.
Do not use this recipe with Cygwin. For building on Cygwin, use the normal
installation instructions in ../INSTALL.
@@ -16,28 +16,27 @@ installation instructions in ../INSTALL.
The total space required is 3GB: 1.8GB for MSYS2 / MinGW-w64 and 1.2GB for
Emacs with the full repository, or less if you're using a release tarball.
+As of December 2022, the minimum supported system, both for building
+Emacs with the MSYS2/MinGW-w64 toolchain and for running the produced
+binary, is Windows 8.1. The computer hardware should also match the
+Microsoft requirements for Windows 8.1.
+
* Set up the MinGW-w64 / MSYS2 build environment
MinGW-w64 provides a complete runtime for projects built with GCC for 64-bit
Windows -- it's located at https://mingw-w64.org/.
MSYS2 is a Cygwin-derived software distribution for Windows which provides
-build tools for MinGW-w64 -- see https://msys2.github.io/.
+build tools for MinGW-w64 -- see https://msys2.org/.
** Download and install MinGW-w64 and MSYS2
-You can download the x86_64 version of MSYS2 (i.e. msys2-x86_64-<date>.exe)
-from
-
- https://sourceforge.net/projects/msys2/files/Base/x86_64
-
-Run this file to install MSYS2 in your preferred directory, e.g. the default
-C:\msys64 -- this will install MinGW-w64 also. Note that directory names
-containing spaces may cause problems.
+Go to https://msys2.org and follow the instructions. It is not
+necessary to install the packages suggested on those instructions.
** Download and install the necessary packages
-Run c:/msys64/msys2.exe in your MSYS2 directory and you will see a BASH window
+Run mingw64.exe in your MSYS2 directory and you will see a BASH window
opened.
In the BASH prompt, use the following command to install the necessary
@@ -117,10 +116,6 @@ put the Emacs source into C:\emacs\emacs-26:
Now you're ready to build and install Emacs with autogen, configure, make,
and make install.
-First we need to switch to the MinGW-w64 environment. Exit the MSYS2 BASH
-console and run mingw64.exe in the C:\msys64 folder, then cd back to
-your Emacs source directory, e.g.:
-
cd /c/emacs/emacs-26
** Run autogen
diff --git a/src/emacs.c b/src/emacs.c
index d8a2863fd9..a2ba4b50f0 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -2910,6 +2910,7 @@ killed. */
if (!NILP (restart))
{
+ turn_on_atimers (false);
#ifdef WINDOWSNT
if (w32_reexec_emacs (initial_cmdline, initial_wd) < 0)
#else
diff --git a/src/treesit.c b/src/treesit.c
index c882d45513..ce8a280443 100644
--- a/src/treesit.c
+++ b/src/treesit.c
@@ -404,6 +404,10 @@ init_treesit_functions (void)
/*** Initialization */
+/* This is the limit on recursion levels for some tree-sitter
+ functions. Remember to update docstrings when changing this
+ value. */
+const ptrdiff_t treesit_recursion_limit = 1000;
bool treesit_initialized = false;
static bool
@@ -1762,7 +1766,7 @@ If NODE is nil, return nil. */)
return build_string (string);
}
-static TSTreeCursor treesit_cursor_helper (TSNode, Lisp_Object);
+static bool treesit_cursor_helper (TSTreeCursor *, TSNode, Lisp_Object);
DEFUN ("treesit-node-parent",
Ftreesit_node_parent, Streesit_node_parent, 1, 1, 0,
@@ -1778,7 +1782,10 @@ Return nil if NODE has no parent. If NODE is nil,
return nil. */)
TSNode treesit_node = XTS_NODE (node)->node;
Lisp_Object parser = XTS_NODE (node)->parser;
- TSTreeCursor cursor = treesit_cursor_helper (treesit_node, parser);
+ TSTreeCursor cursor;
+ if (!treesit_cursor_helper (&cursor, treesit_node, parser))
+ return return_value;
+
if (ts_tree_cursor_goto_parent (&cursor))
{
TSNode parent = ts_tree_cursor_current_node (&cursor);
@@ -2637,8 +2644,59 @@ treesit_assume_true (bool val)
eassert (val == true);
}
+/* Tries to move CURSOR to point to TARGET. END_POS is the end of
+ TARGET. If success, return true, otherwise move CURSOR back to
+ starting position and return false. LIMIT is the recursion
+ limit. */
+static bool
+treesit_cursor_helper_1 (TSTreeCursor *cursor, TSNode *target,
+ uint32_t end_pos, ptrdiff_t limit)
+{
+ if (limit <= 0)
+ return false;
+
+ TSNode cursor_node = ts_tree_cursor_current_node (cursor);
+ if (ts_node_eq (cursor_node, *target))
+ return true;
+
+ if (!ts_tree_cursor_goto_first_child (cursor))
+ return false;
+
+ /* Skip nodes that definitely don't contain TARGET. */
+ while (ts_node_end_byte (cursor_node) < end_pos)
+ {
+ if (!ts_tree_cursor_goto_next_sibling (cursor))
+ break;
+ cursor_node = ts_tree_cursor_current_node (cursor);
+ }
+
+ /* Go through each sibling that could contain TARGET. Because of
+ missing nodes (their width is 0), there could be multiple
+ siblings that could contain TARGET. */
+ while (ts_node_start_byte (cursor_node) <= end_pos)
+ {
+ if (treesit_cursor_helper_1 (cursor, target, end_pos, limit - 1))
+ return true;
+
+ if (!ts_tree_cursor_goto_next_sibling (cursor))
+ break;
+ cursor_node = ts_tree_cursor_current_node (cursor);
+ }
+
+ /* Couldn't find TARGET, must be not in this subtree, move cursor
+ back and pray that other brothers and sisters can succeed. */
+ treesit_assume_true (ts_tree_cursor_goto_parent (cursor));
+ return false;
+}
+
/* Create a TSTreeCursor pointing at NODE. PARSER is the lisp parser
- that produced NODE.
+ that produced NODE. If success, return true, otherwise return
+ false. This function should almost always succeed, but if the parse
+ tree is strangely too deep and exceeds the recursion limit, this
+ function will fail and return false.
+
+ If this function returns true, caller needs to free CURSOR; if
+ returns false, caller don't need to free CURSOR.
The reason we need this instead of simply using ts_tree_cursor_new
is that we have to create the cursor on the root node and traverse
@@ -2646,56 +2704,17 @@ treesit_assume_true (bool val)
Otherwise going to sibling or parent of NODE wouldn't work.
(Wow perfect filling.) */
-static TSTreeCursor
-treesit_cursor_helper (TSNode node, Lisp_Object parser)
+static bool
+treesit_cursor_helper (TSTreeCursor *cursor, TSNode node, Lisp_Object parser)
{
uint32_t end_pos = ts_node_end_byte (node);
TSNode root = ts_tree_root_node (XTS_PARSER (parser)->tree);
- TSTreeCursor cursor = ts_tree_cursor_new (root);
- TSNode cursor_node = ts_tree_cursor_current_node (&cursor);
- /* This is like treesit-node-at. We go down from the root node,
- either to first child or next sibling, repeatedly, and finally
- arrive at NODE. */
- while (!ts_node_eq (node, cursor_node))
- {
- treesit_assume_true (ts_tree_cursor_goto_first_child (&cursor));
- cursor_node = ts_tree_cursor_current_node (&cursor);
- /* ts_tree_cursor_goto_first_child_for_byte is not reliable, so
- we just go through each sibling. */
- while (ts_node_is_missing (cursor_node)
- || ts_node_end_byte (cursor_node) < end_pos)
- {
- /* A "missing" node has zero width, so it's possible that
- its end = NODE.end but it's not NODE, so we skip them.
- But we need to make sure this missing node is not the
- node we are looking for before skipping it. */
- if (ts_node_is_missing (cursor_node)
- && ts_node_eq (node, cursor_node))
- return cursor;
- treesit_assume_true (ts_tree_cursor_goto_next_sibling (&cursor));
- cursor_node = ts_tree_cursor_current_node (&cursor);
- }
- /* Right now CURSOR.end >= NODE.end. But what if CURSOR.end =
- NODE.end, and there are missing nodes after CURSOR, and the
- missing node after CURSOR is the NODE we are looking for??
- Well, create a probe and look ahead. (This is tested by
- treesit-cursor-helper-with-missing-node.) */
- TSTreeCursor probe = ts_tree_cursor_copy (&cursor);
- TSNode probe_node;
- while (ts_tree_cursor_goto_next_sibling (&probe))
- {
- probe_node = ts_tree_cursor_current_node (&probe);
- if (!ts_node_is_missing (probe_node))
- break;
- if (ts_node_eq (probe_node, node))
- {
- ts_tree_cursor_delete (&cursor);
- return probe;
- }
- }
- ts_tree_cursor_delete (&probe);
- }
- return cursor;
+ *cursor = ts_tree_cursor_new (root);
+ bool success = treesit_cursor_helper_1 (cursor, &node, end_pos,
+ treesit_recursion_limit);
+ if (!success)
+ ts_tree_cursor_delete (cursor);
+ return success;
}
/* Move CURSOR to the next/previous sibling. FORWARD controls the
@@ -2957,7 +2976,7 @@ Return the first matched node, or nil if none matches.
*/)
/* We use a default limit of 1000. See bug#59426 for the
discussion. */
- ptrdiff_t the_limit = 1000;
+ ptrdiff_t the_limit = treesit_recursion_limit;
if (!NILP (limit))
{
CHECK_FIXNUM (limit);
@@ -2968,7 +2987,10 @@ Return the first matched node, or nil if none matches.
*/)
Lisp_Object parser = XTS_NODE (node)->parser;
Lisp_Object return_value = Qnil;
- TSTreeCursor cursor = treesit_cursor_helper (XTS_NODE (node)->node, parser);
+ TSTreeCursor cursor;
+ if (!treesit_cursor_helper (&cursor, XTS_NODE (node)->node, parser))
+ return return_value;
+
if (treesit_search_dfs (&cursor, predicate, parser, NILP (backward),
NILP (all), the_limit, false))
{
@@ -3022,7 +3044,10 @@ always traverse leaf nodes first, then upwards. */)
Lisp_Object parser = XTS_NODE (start)->parser;
Lisp_Object return_value = Qnil;
- TSTreeCursor cursor = treesit_cursor_helper (XTS_NODE (start)->node, parser);
+ TSTreeCursor cursor;
+ if (!treesit_cursor_helper (&cursor, XTS_NODE (start)->node, parser))
+ return return_value;
+
if (treesit_search_forward (&cursor, predicate, parser,
NILP (backward), NILP (all)))
{
@@ -3130,7 +3155,7 @@ a regexp. */)
/* We use a default limit of 1000. See bug#59426 for the
discussion. */
- ptrdiff_t the_limit = 1000;
+ ptrdiff_t the_limit = treesit_recursion_limit;
if (!NILP (limit))
{
CHECK_FIXNUM (limit);
@@ -3141,7 +3166,10 @@ a regexp. */)
Lisp_Object parser = XTS_NODE (root)->parser;
Lisp_Object parent = Fcons (Qnil, Qnil);
- TSTreeCursor cursor = treesit_cursor_helper (XTS_NODE (root)->node, parser);
+ TSTreeCursor cursor;
+ if (!treesit_cursor_helper (&cursor, XTS_NODE (root)->node, parser))
+ return Qnil;
+
treesit_build_sparse_tree (&cursor, parent, predicate, process_fn,
the_limit, parser);
ts_tree_cursor_delete (&cursor);
diff --git a/src/xdisp.c b/src/xdisp.c
index e8df230ef8..08565d5532 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -16838,6 +16838,13 @@ redisplay_internal (void)
/* Only GC scrollbars when we redisplay the whole frame. */
= f->redisplay || !REDISPLAY_SOME_P ();
bool f_redisplay_flag = f->redisplay;
+
+ /* The X error handler may have deleted that frame
+ before we went back to retry_frame. This must come
+ before any accesses to f->terminal. */
+ if (!FRAME_LIVE_P (f))
+ continue;
+
/* Mark all the scroll bars to be removed; we'll redeem
the ones we want when we redisplay their windows. */
if (gcscrollbars && FRAME_TERMINAL (f)->condemn_scroll_bars_hook)
@@ -16845,7 +16852,6 @@ redisplay_internal (void)
if (FRAME_VISIBLE_P (f) && !FRAME_OBSCURED_P (f))
{
-
/* Don't allow freeing images and faces for this
frame as long as the frame's update wasn't
completed. This prevents crashes when some Lisp
diff --git a/test/lisp/emacs-lisp/ert-x-tests.el
b/test/lisp/emacs-lisp/ert-x-tests.el
index 63e7cd7608..1cfd218592 100644
--- a/test/lisp/emacs-lisp/ert-x-tests.el
+++ b/test/lisp/emacs-lisp/ert-x-tests.el
@@ -82,6 +82,40 @@
(should-not (buffer-live-p buffer-1))
(should (buffer-live-p buffer-2))))))
+(ert-deftest ert-test-with-buffer-selected/current ()
+ (let ((origbuf (current-buffer)))
+ (ert-with-test-buffer ()
+ (let ((buf (current-buffer)))
+ (should (not (eq buf origbuf)))
+ (with-current-buffer origbuf
+ (ert-with-buffer-selected buf
+ (should (eq (current-buffer) buf))))))))
+
+(ert-deftest ert-test-with-buffer-selected/selected ()
+ (ert-with-test-buffer ()
+ (ert-with-buffer-selected (current-buffer)
+ (should (eq (window-buffer) (current-buffer))))))
+
+(ert-deftest ert-test-with-buffer-selected/nil-buffer ()
+ (ert-with-test-buffer ()
+ (let ((buf (current-buffer)))
+ (ert-with-buffer-selected nil
+ (should (eq (window-buffer) buf))))))
+
+(ert-deftest ert-test-with-buffer-selected/modification-hooks ()
+ (ert-with-test-buffer ()
+ (ert-with-buffer-selected (current-buffer)
+ (should (null inhibit-modification-hooks)))))
+
+(ert-deftest ert-test-with-buffer-selected/read-only ()
+ (ert-with-test-buffer ()
+ (ert-with-buffer-selected (current-buffer)
+ (should (null inhibit-read-only))
+ (should (null buffer-read-only)))))
+
+(ert-deftest ert-test-with-buffer-selected/return-value ()
+ (should (equal (ert-with-buffer-selected nil "foo") "foo")))
+
(ert-deftest ert-test-with-test-buffer-selected/selected ()
(ert-with-test-buffer-selected ()
(should (eq (window-buffer) (current-buffer)))))
@@ -90,6 +124,11 @@
(ert-with-test-buffer-selected ()
(should (null inhibit-modification-hooks))))
+(ert-deftest ert-test-with-test-buffer-selected/read-only ()
+ (ert-with-test-buffer-selected ()
+ (should (null inhibit-read-only))
+ (should (null buffer-read-only))))
+
(ert-deftest ert-test-with-test-buffer-selected/return-value ()
(should (equal (ert-with-test-buffer-selected () "foo") "foo")))
diff --git a/test/lisp/vc/diff-mode-tests.el b/test/lisp/vc/diff-mode-tests.el
index 19e3dbb42a..b67ccd4fe0 100644
--- a/test/lisp/vc/diff-mode-tests.el
+++ b/test/lisp/vc/diff-mode-tests.el
@@ -478,5 +478,84 @@ baz"))))
(should (equal (diff-hunk-file-names)
'("/tmp/ange-ftp1351895K.el" "/tmp/ange-ftp13518wvE.el")))))
+(ert-deftest diff-mode-test-fixups-added-lines ()
+ "Check that `diff-fixup-modifs' works well with hunks with added lines."
+ (let ((patch "--- file
++++ file
+@@ -0,0 +1,15 @@
++1
++2
++3
++4
+"))
+ (with-temp-buffer
+ (insert patch)
+ (diff-fixup-modifs (point-min) (point-max))
+ (should (equal (buffer-string) "--- file
++++ file
+@@ -0,0 +1,4 @@
++1
++2
++3
++4
+"))))
+ (let ((patch "--- file
++++ file
+@@ -389,5 +398,6 @@
+ while (1)
+ ;
++ # not needed
+ # at all
+ # stop
+"))
+ (with-temp-buffer
+ (insert patch)
+ (diff-fixup-modifs (point-min) (point-max))
+ (should (equal (buffer-string) "--- file
++++ file
+@@ -389,4 +398,5 @@
+ while (1)
+ ;
++ # not needed
+ # at all
+ # stop
+")))))
+
+(ert-deftest diff-mode-test-fixups-empty-hunks ()
+ "Check that `diff-fixup-modifs' works well with empty hunks."
+ (let ((patch "--- file
++++ file
+@@ -1 +1 @@
+-1
+@@ -10 +10 @@
+-1
++1
+--- otherfile
++++ otherfile
+@@ -1 +1 @@
++2
+@@ -10 +10 @@
+-1
++1
+"))
+ (with-temp-buffer
+ (insert patch)
+ (diff-fixup-modifs (point-min) (point-max))
+ (should (equal (buffer-string) "--- file
++++ file
+@@ -1,1 +1,0 @@
+-1
+@@ -10,1 +10,1 @@
+-1
++1
+--- otherfile
++++ otherfile
+@@ -1,0 +1,1 @@
++2
+@@ -10,1 +10,1 @@
+-1
++1
+")))))
+
(provide 'diff-mode-tests)
;;; diff-mode-tests.el ends here