mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-18 18:05:07 +00:00
Code Issues Releases Activity

Merge from origin/emacs-29

Browse Source 
c36fe3df17 Fix c-ts-mode imenu defun name (bug#60296)
a24e350170 Fix treesit--children-covering-range-recurse (bug#60301)
fbb4eb919b Support treesit-defun-name in tree-sitter major modes
6253184afc ; * lisp/treesit.el (treesit-defun-at-point): Guard again...
f8e219ebfa Add treesit-defun-name and friends
35c2ca2ca6 Make treesit-node-at/on guess language at point
7f7def2ae6 ; Add treesit-no-parser error
b6a2e1ddf6 * nt/INSTALL.W64: update instructions for setting up W64 ...
265b91d891 Revert "; Bump minimum supported Windows version for MinG...
75155e4586 ; Bump minimum supported Windows version for MinGW64 to W...
677f6c79eb ; Update minimum requirements of MinGW-w64
7723af5e4a ; * lisp/progmodes/c-ts-mode.el: quote literal string in ...
38866510c7 ; * src/xdisp.c (redisplay_internal): Reinstate the FRAME...
a825aa0b13 Fix definition of CNS 11643-15 charset
a42b20dd95 ; * lisp/progmodes/c-ts-mode.el: Add outline section head...
e4e3634539 Improve c-ts-mode block comment indent (bug#60270)
e30621caa2 ; Add treesit_recursion_limit
6a43af5880 Fix block comment indent and filling for c-ts-mode (bug#5...
e492c21e81 Fix treesit_cursor_helper (bug#60267)
4437dbedf7 Fix restart-emacs alarms (Bug#60220)
121a9ff9f6 Fix alternate stack test in configure
84888080ee Add more functions to "string" shortdoc
c90f97d4e5 Make the Contour terminal an alias of xterm-256color
c3fac9465f ; Fix punctuation in last change.
756bb422a4 Correct wrong info in (info)Go to node
a8c3424d28 Fix typo in TUTORIAL.fr (bug#60261)
24cd2f0daf Add some diff-fixup-modifs tests
d32091199a Fix quoted argument in emacsclient-mail.desktop Exec key
286c48137f ert-x: Move window selection logic to its own macro
823c49cea8 ; ert-x: Simplify `ert-with-test-buffer-selected'
38c6abe4d0 ; ert-x: Add test for buffer read-only state
0e39ad6fa5 Fix crash after X error
This commit is contained in:
Stefan Kangas 2022-12-25 06:30:21 +01:00
commit 48db8b68a8
29 changed files with 754 additions and 283 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
configure.ac
View File

@ -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;

8
doc/lispref/modes.texi
View File

@ -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

70
doc/lispref/parsing.texi
View File

@ -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

5
doc/misc/info.texi
View File

@ -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

12
etc/PROBLEMS
View File

@ -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:

4
etc/emacsclient-mail.desktop
View File

@ -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

2
etc/emacsclient.desktop
View File

@ -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

2
etc/tutorials/TUTORIAL.fr
View File

@ -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>.

53
lisp/emacs-lisp/ert-x.el
View File

@ -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.
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
If BUFFER-OR-NAME is nil, the current buffer is used.
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 ()

9
lisp/emacs-lisp/shortdoc.el
View File

@ -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")

3
lisp/faces.el
View File

@ -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."

2
lisp/international/characters.el
View File

@ -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)

2
lisp/international/mule-conf.el
View File

@ -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)

202
lisp/progmodes/c-ts-mode.el
View File

@ -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)))))
;;; 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")
(c-ts-mode--declarator-identifier (treesit-node-child node 0 t)))
("pointer_declarator"
(c-ts-mode--declarator-identifier (treesit-node-child node -1)))
((or "function_declarator" "array_declarator" "init_declarator")
(c-ts-mode--declarator-identifier
(treesit-node-child-by-field-name node "declarator")))
;; Terminal case.
((or "identifier" "field_identifier")
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'."
(pcase (treesit-node-type node)
((or "attributed_declarator" "parenthesized_declarator")
(apply #'c-ts-mode--fontify-declarator
(treesit-node-child node 0 t) override start end args))
("pointer_declarator"
(apply #'c-ts-mode--fontify-declarator
(treesit-node-child node -1) override start end args))
((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))
((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))))
(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))

22
lisp/progmodes/csharp-mode.el
View File

@ -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)

22
lisp/progmodes/java-ts-mode.el
View File

@ -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)

42
lisp/progmodes/js.el
View File

@ -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

17
lisp/progmodes/json-ts-mode.el
View File

@ -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)

17
lisp/progmodes/python.el
View File

@ -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

55
lisp/progmodes/rust-ts-mode.el
View File

@ -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)))

25
lisp/textmodes/css-mode.el
View File

@ -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)

16
lisp/textmodes/toml-ts-mode.el
View File

@ -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)

156
lisp/treesit.el
View File

@ -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

25
nt/INSTALL.W64
View File

@ -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

1
src/emacs.c
View File

@ -2910,6 +2910,7 @@ killed. */
if (!NILP (restart))
{
turn_on_atimers (false);
#ifdef WINDOWSNT
if (w32_reexec_emacs (initial_cmdline, initial_wd) < 0)
#else

138
src/treesit.c
View File

@ -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);

8
src/xdisp.c
View File

@ -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

39
test/lisp/emacs-lisp/ert-x-tests.el
View File

@ -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")))

79
test/lisp/vc/diff-mode-tests.el
View File

@ -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