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

Merge from origin/emacs-29

Browse Source 
db96b1282f * lisp/help.el: Use 'C-h C-q' to toggle 'help-quick' wind...
489865c21e ; Improve markup of long key sequences
d42c2668cf ; * etc/NEWS: Fix wording of a recently edited entry.
7a0eaee198 * lisp/isearch.el: Small fixes.
b69bffeec0 * lisp/vc/diff-mode.el (diff-minor-mode-prefix): Replace ...
9263847ab7 ; * etc/NEWS: Move the paragraph with 'C-u RET' closer to...
62fb2dc37d * doc/emacs/display.texi (Text Scale): Improve section ab...
70480d3b6b * lisp/repeat.el (repeat-echo-function): Suggest 'add-fun...
fd48201ffe * lisp/tab-line.el (tab-line-cache-key-default): More cac...
b164660260 * etc/package-keyring.gpg: Update with new key
c0be51389e ; Yet another declare-function to avoid treesit-related w...
8676bec51d ; * lisp/treesit.el (treesit--simple-imenu-1): Doc fix; w...
2ddc480f44 Warn of absent networks module in ERC
19d00fab9a Avoid "already compiled" warning in erc-compat
2d8f7b66bc ; Fix one more treesit byte-compilation warning.
2d0a921486 ; Avoid treesit-related byte-compiler warnings
8503b370be (python--treesit-settings): Remove duplicate matcher
b464e6c490 Make last change of w32 GUI dialogs conditional and rever...
eedc9d79ae Fix tree-sitter typos
248c13dcfe Update tree-sitter major modes to use the new Imenu facility
b39dc7ab27 Add tree-sitter helper functions for Imenu
ba1ddea9da Fix treesit--things-around (bug#60355)
7512b9025a ; * lisp/treesit.el (treesit-traverse-parent): Remove alias.
5326b04198 Improve treesit-node-top-level and treesit-parent-until
637f5b164f ; Add "src" to the heuristic sub-directory heuristic
8ab6df0c9f ; * lisp/epa-ks.el (epa-ks-do-key-to-fetch): Fix 'when' u...
2b55a48d3e * src/w32menu.c (simple_dialog_show): Use MB_YESNOCANCEL ...
8b8b791567 ; Improve documentation of TAB/SPC indentation
624e382211 ; Improve doc strings of some new faces
41f12e1019 ; * lisp/elide-head.el (elide-head): Doc fix to silence c...
e3b4cd0ac1 ; * lisp/htmlfontify.el (hfy-text-p): Fix whitespace.
1b4dc4691c Fix htmlfontify.el command injection vulnerability.
1fe4b98b4d Improve support for Scheme R6RS and R7RS libraries (bug#5...
2347f37f67 ; * test/src/treesit-tests.el: remove dead store (bytecom...
a6d961ae2f Add a new tree-sitter query predicate 'pred'
835a80dcc4 ; Fix tree-sitter defun tests
a14821d615 Improve gnutls-min-prime-bits docstring
b14bbd108e Improve handling of tab-bar height.
669160d47b ; * nt/INSTALL.W64: More fixes and updates.
26b2ec7cb8 Simplify last change (bug#60311)
082fc6e308 Fix 'json-available-p' on MS-Windows
6c86faec29 loaddefs-gen: Group results by absolute file name
d90d7d15f2 ; Fix vindexes in parsing.texi
eb26872837 Fix imenu for c-ts-mode (bug#60296)
8f68b6497e Clean up python-ts-mode font-lock features
28f26b11a1 Add comment indent and filling to other tree-sitter major...
c6b0282645 ; Remove unused function in c-ts-mode
6e52a9fcad ; * doc/lispref/modes.texi (Parser-based Font Lock): Mino...
2bcd1e9a99 ; * doc/lispref/parsing.texi (Retrieving Nodes): Add notice.
7c7950fe00 Add maintainer stub for tree-sitter files
cf32776622 ; * doc/lispref/parsing.texi (Using Parser): Remove delet...

# Conflicts:
#	etc/NEWS
#	lisp/progmodes/c-ts-mode.el
#	lisp/progmodes/typescript-ts-mode.el
#	lisp/treesit.el
This commit is contained in:
Stefan Kangas 2022-12-28 21:40:59 +01:00
commit dce6791e99
50 changed files with 945 additions and 813 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
doc/emacs/display.texi
View File

@ -920,12 +920,12 @@ decrease the font size of the affected faces, depending on the
direction of the scrolling.
The final key of these commands may be repeated without the leading
@kbd{C-x}. For instance, @kbd{C-x C-= C-= C-=} increases the face
height by three steps. Each step scales the text height by a factor
of 1.2; to change this factor, customize the variable
@code{text-scale-mode-step}. A numeric argument of 0
to the @code{text-scale-adjust} command restores the default height,
the same as typing @kbd{C-x C-0}.
@kbd{C-x} and without the modifiers. For instance, @w{@kbd{C-x C-= C-= C-=}}
and @w{@kbd{C-x C-= = =}} increase the face height by three steps. Each
step scales the text height by a factor of 1.2; to change this factor,
customize the variable @code{text-scale-mode-step}. A numeric
argument of 0 to the @code{text-scale-adjust} command restores the
default height, the same as typing @kbd{C-x C-0}.
@cindex adjust global font size
@findex global-text-scale-adjust

35
doc/lispref/modes.texi
View File

@ -2841,6 +2841,35 @@ function uses @code{imenu-generic-expression} instead.
Setting this variable makes it buffer-local in the current buffer.
@end defvar
If built with tree-sitter, Emacs can automatically generate an Imenu
index if the major mode sets relevant variables.
@defvar treesit-simple-imenu-settings
This variable instructs Emacs how to generate Imenu indexes. It
should be a list of @w{(@var{category} @var{regexp} @var{pred}
@var{name-fn})}.
@var{category} should be the name of a category, like "Function",
"Class", etc. @var{regexp} should be a regexp matching the type of
nodes that belong to @var{category}. @var{pred} should be either
@code{nil} or a function that takes a node as the argument. It should
return non-@code{nil} if the node is a valid node for @var{category},
or @code{nil} if not.
@var{category} could also be @code{nil}. In which case the entries
matched by @var{regexp} and @var{pred} are not grouped under
@var{category}.
@var{name-fn} should be either @var{nil} or a function that takes a
defun node and returns the name of that defun, e.g., the function name
for a function definition. If @var{name-fn} is @var{nil},
@code{treesit-defun-name} (@pxref{Tree-sitter major modes}) is used
instead.
@code{treesit-major-mode-setup} (@pxref{Tree-sitter major modes})
automatically sets up Imenu if this variable is non-@code{nil}.
@end defvar
@node Font Lock Mode
@section Font Lock Mode
@cindex Font Lock mode
@ -4023,11 +4052,12 @@ This function takes a series of @var{query-spec}s, where each
@var{:keyword}/@var{value} pairs. Each @var{query} is a
tree-sitter query in either the string, s-expression or compiled form.
@c FIXME: Cross-ref treesit-font-lock-level to user manual.
For each @var{query}, the @var{:keyword}/@var{value} pairs that
precede it add meta information to it. The @code{:lang} keyword
declares @var{query}'s language. The @code{:feature} keyword sets the
feature name of @var{query}. Users can control which features are
enabled with @code{font-lock-maximum-decoration} and
enabled with @code{treesit-font-lock-level} and
@code{treesit-font-lock-feature-list} (described below). These two
keywords are mandatory.
@ -4067,10 +4097,11 @@ priority. If a capture name is neither a face nor a function, it is
ignored.
@end defun
@c FIXME: Cross-ref treesit-font-lock-level to user manual.
@defvar treesit-font-lock-feature-list
This is a list of lists of feature symbols. Each element of the list
is a list that represents a decoration level.
@code{font-lock-maximum-decoration} controls which levels are
@code{treesit-font-lock-level} controls which levels are
activated.
Each element of the list is a list of the form @w{@code{(@var{feature}

50
doc/lispref/parsing.texi
View File

@ -393,12 +393,6 @@ tree-sitter can be activated. Major modes should check this value
when deciding whether to enable tree-sitter features.
@end defvar
@defun treesit-can-enable-p
This function checks whether the current buffer is suitable for
activating tree-sitter features. It basically checks
@code{treesit-available-p} and @code{treesit-max-buffer-size}.
@end defun
@cindex creating tree-sitter parsers
@cindex tree-sitter parser, creating
@defun treesit-parser-create language &optional buffer no-reuse
@ -649,6 +643,10 @@ it, or query for information about this node.
@defun treesit-node-parent node
This function returns the immediate parent of @var{node}.
If @var{node} is more than 1000 levels deep in a parse tree, the
return value is undefined. Currently it returns @var{nil}, but that
could change in the future.
@end defun
@defun treesit-node-child node n &optional named
@ -1268,10 +1266,11 @@ example, with the following pattern:
@end example
@noindent
tree-sitter only matches arrays where the first element equals to
the last element. To attach a predicate to a pattern, we need to
group them together. A predicate always starts with a @samp{#}.
Currently there are two predicates, @code{#equal} and @code{#match}.
tree-sitter only matches arrays where the first element equals to the
last element. To attach a predicate to a pattern, we need to group
them together. A predicate always starts with a @samp{#}. Currently
there are three predicates, @code{#equal}, @code{#match}, and
@code{#pred}.
@deffn Predicate equal arg1 arg2
Matches if @var{arg1} equals to @var{arg2}. Arguments can be either
@ -1284,6 +1283,11 @@ Matches if the text that @var{capture-name}'s node spans in the buffer
matches regular expression @var{regexp}. Matching is case-sensitive.
@end deffn
@deffn Predicate pred fn &rest nodes
Matches if function @var{fn} returns non-@code{nil} when passed each
node in @var{nodes} as arguments.
@end deffn
Note that a predicate can only refer to capture names that appear in
the same pattern. Indeed, it makes little sense to refer to capture
names in other patterns.
@ -1717,17 +1721,14 @@ This function activates some tree-sitter features for a major mode.
Currently, it sets up the following features:
@itemize
@vindex treesit-font-lock-settings
@item
If @code{treesit-font-lock-settings} is non-@code{nil}, it sets up
fontification.
If @code{treesit-font-lock-settings} (@pxref{Parser-based Font Lock})
is non-@code{nil}, it sets up fontification.
@vindex treesit-simple-indent-rules
@item
If @code{treesit-simple-indent-rules} is non-@code{nil}, it sets up
indentation.
If @code{treesit-simple-indent-rules} (@pxref{Parser-based Font Lock})
is non-@code{nil}, it sets up indentation.
@vindex treesit-defun-type-regexp
@item
If @code{treesit-defun-type-regexp} is non-@code{nil}, it sets up
navigation functions for @code{beginning-of-defun} and
@ -1736,6 +1737,10 @@ navigation functions for @code{beginning-of-defun} and
@item
If @code{treesit-defun-name-function} is non-@code{nil}, it sets up
add-log functions used by @code{add-log-current-defun}.
@item
If @code{treesit-simple-imenu-settings} (@pxref{Imenu}) is
non-@code{nil}, it sets up Imenu.
@end itemize
@end defun
@ -1784,6 +1789,17 @@ node is a defun node but doesn't have a name, or the node is
@code{nil}, it should return @code{nil}.
@end defvar
@defvar treesit-defun-type-regexp
This variable determines which nodes are considered defuns by Emacs.
It can be a regexp that matches the type of defun nodes.
Sometimes not all nodes matched by the regexp are valid defuns.
Therefore, this variable can also be a cons cell of the form
@w{(@var{regexp} . @var{pred})}, where @var{pred} should be a function
that takes a node as its argument, and returns @code{t} if the node is
valid defun, or @code{nil} if it is not valid.
@end defvar
@node Tree-sitter C API
@section Tree-sitter C API Correspondence

12
doc/misc/erc.texi
View File

@ -529,6 +529,16 @@ Translate morse code in messages
@end table
@anchor{Required Modules}
@subheading Required Modules
@cindex required modules
Note that some modules are essential to core IRC operations and thus
not listed above. You can nevertheless still remove these, but doing
so demands special precautions to avoid degrading the user experience.
At present, the only such module is @code{networks}, whose library ERC
always loads anyway.
@subheading Local Modules
@cindex local modules
@ -1290,7 +1300,7 @@ When preparing entries for your backend, it may help to get a feel for
how ERC and its modules conduct searches, especially when exploring a
new context, such as channel keys. (Hint: in such situations, try
temporarily setting the variable @code{auth-source-debug} to @code{t}
and checking @samp{*Messages*} periodically for insights into how
and checking @file{*Messages*} periodically for insights into how
auth-source is operating.) Overall, though, ERC tries to be
consistent in performing queries across various authentication
contexts. Here's what to expect with respect to the @samp{host}

11
etc/ERC-NEWS
View File

@ -39,6 +39,14 @@ anew. The pre-5.4 "disabled" behavior has been restored and will
remain accessible for the foreseeable future, warts and all (e.g.,
with its often superfluous "/DIALED-HOST" suffixing always present).
** The 'networks' module is now quasi-required.
The 'networks' module is now all but required for everyday interactive
use. A default member of 'erc-modules' since ERC 5.3, 'networks' has
grown increasingly integral to core client operations over the years.
From now on, only the most essential operations will be officially
supported in its absence, and users will see a warning upon
entry-point invocation when it's not present.
** Tighter auth-source integration with bigger changes on the horizon.
The days of hit-and-miss auth-source queries are hopefully behind us.
With the overhaul of the services module temporarily shelved and the
@ -111,7 +119,8 @@ and 'erc-backend'.
The function 'erc-network' always returns non-nil in server and target
buffers belonging to a successfully established IRC connection, even
after that connection has been closed.
after that connection has been closed. (Also see the note in the
section above about the 'networks' module basically being mandatory.)
In 5.4, support for network symbols as keys was added for
'erc-autojoin-channels-alist'. This has been extended to include

38
etc/NEWS.29
View File

@ -1077,7 +1077,7 @@ the default candidate.
*** New command 'help-quick' displays an overview of common commands.
The command pops up a buffer at the bottom of the screen with a few
helpful commands for various tasks. You can toggle the display using
'C-h q'.
'C-h C-q'.
** Emacs now comes with Org v9.6.
See the file ORG-NEWS for user-visible changes in Org.
@ -1103,7 +1103,7 @@ in addition to the ellipsis. The default is nil, but in 'help-mode'
it has the value 'insert' that inserts the buttons directly into the
buffer, and you can use 'RET' to cycle outline visibility. When
the value is 'in-margins', Outline Minor Mode uses the window margins
to hide/show buttons.
for buttons that hide/show outlines.
** Windows
@ -1874,6 +1874,12 @@ exit the minibuffer. These keys are also available for in-buffer
completion, but they don't insert candidates automatically, you need
to type 'M-RET' to insert the selected candidate to the buffer.
+++
*** Choosing a completion with a prefix argument doesn't exit the minibuffer.
This means that typing 'C-u RET' on a completion candidate in the
"*Completions*" buffer inserts the completion into the minibuffer,
but doesn't exit the minibuffer.
+++
*** The "*Completions*" buffer can now be automatically selected.
To enable this behavior, customize the user option
@ -1932,12 +1938,6 @@ candidate in the "*Completions*" buffer is highlighted with that face.
The nil value disables this highlighting. The default is to highlight
using the 'completions-highlight' face.
+++
*** Choosing a completion with a prefix argument doesn't exit the minibuffer.
This means that typing 'C-u RET' on a completion candidate in the
"*Completions*" buffer inserts the completion to the minibuffer,
but doesn't exit the minibuffer.
+++
*** You can now define abbrevs for the minibuffer modes.
'minibuffer-mode-abbrev-table' and
@ -3055,6 +3055,19 @@ name.
This key is now bound to 'Buffer-menu-view-other-window', which will
view this line's buffer in View mode in another window.
** Scheme mode
---
*** Auto-detection of Scheme library files.
Emacs now automatically enables the Scheme mode when opening R6RS
Scheme Library Source ('.sls') files and R7RS Scheme Library
Definition ('.sld') files.
---
*** Imenu members for R6RS and R7RS library members.
Imenu now lists the members directly nested in R6RS Scheme libraries
('library') and R7RS libraries ('define-library').
* New Modes and Packages in Emacs 29.1
@ -4688,6 +4701,15 @@ where those APIs are available.
When 'w32-use-native-image-API' is non-nil, Emacs on MS-Windows now
has built-in support for displaying BMP images.
---
*** GUI Yes/No dialogs now include a "Cancel" button.
The "Cancel" button is in addition to "Yes" and "No", and is intended
to allow users to quit the dialog, as an equivalent of C-g when Emacs
asks a yes/no question via the echo area. This is controlled by the
new variable 'w32-yes-no-dialog-show-cancel', by default t. Set it to
nil to get back the old behavior of showing a modal dialog with only
two buttons: "Yes" and "No".
** Cygwin
---

BIN
etc/package-keyring.gpg
View File

Binary file not shown.

7
lisp/elide-head.el
View File

@ -164,10 +164,11 @@ mode hooks."
(defun elide-head (&optional arg)
"Hide header material in buffer according to `elide-head-headers-to-hide'.
The header is made invisible with an overlay. With a prefix arg, show
an elided material again.
The header is made invisible with an overlay. With a prefix
argument ARG, show an elided material again.
This is suitable as an entry on `find-file-hook' or appropriate mode hooks."
This is suitable as an entry on `find-file-hook' or appropriate
mode hooks."
(declare (obsolete elide-head-mode "29.1"))
(interactive "P")
(if arg

3
lisp/emacs-lisp/loaddefs-gen.el
View File

@ -608,7 +608,8 @@ instead of just updating them with the new/changed autoloads."
(write-region (point-min) (point-max) output-file nil 'silent))
;; We have some data, so generate the loaddef files. First
;; group per output file.
(dolist (fdefs (seq-group-by #'car defs))
(dolist (fdefs (seq-group-by (lambda (x) (expand-file-name (car x)))
defs))
(let ((loaddefs-file (car fdefs))
hash)
(with-temp-buffer

27
lisp/emacs-lisp/package-vc.el
View File

@ -613,18 +613,21 @@ checkout. This overrides the `:branch' attribute in PKG-SPEC."
;; When nothing is specified about a `lisp-dir', then should
;; heuristically check if there is a sub-directory with lisp
;; files. These are conventionally just called "lisp". If this
;; directory exists and contains non-zero number of lisp files, we
;; will use that instead of `pkg-dir'.
(when-let* (((null lisp-dir))
(dir (expand-file-name "lisp" pkg-dir))
((file-directory-p dir))
((directory-files dir nil "\\`[^.].+\\.el\\'" t 1)))
;; We won't use `dir', since dir is an absolute path and we
;; don't want `lisp-dir' to depend on the current location of
;; the package installation, ie. to break if moved around the
;; file system or between installations.
(setq lisp-dir "lisp"))
;; files. These are conventionally just called "lisp" or "src".
;; If this directory exists and contains non-zero number of lisp
;; files, we will use that instead of `pkg-dir'.
(catch 'done
(dolist (name '("lisp" "src"))
(when-let* (((null lisp-dir))
(dir (expand-file-name name pkg-dir))
((file-directory-p dir))
((directory-files dir nil "\\`[^.].+\\.el\\'" t 1)))
;; We won't use `dir', since dir is an absolute path and we
;; don't want `lisp-dir' to depend on the current location of
;; the package installation, ie. to break if moved around the
;; file system or between installations.
(throw 'done (setq lisp-dir name)))))
(when lisp-dir
(push (cons :lisp-dir lisp-dir)
(package-desc-extras pkg-desc)))

6
lisp/epa-ks.el
View File

@ -135,9 +135,9 @@ Keys are marked using `epa-ks-mark-key-to-fetch'."
keys))
(forward-line))
(when (yes-or-no-p (format "Proceed with fetching all %d key(s)? "
(length keys))))
(dolist (id keys)
(epa-ks--fetch-key id))))
(length keys)))
(dolist (id keys)
(epa-ks--fetch-key id)))))
(tabulated-list-clear-all-tags))
(defun epa-ks--query-url (query exact)

10
lisp/erc/erc-backend.el
View File

@ -320,6 +320,15 @@ session when reconnecting. Once `erc-reuse-buffers' is retired
and fully removed, modules can switch to leveraging the
`permanent-local' property instead.")
(defvar erc--server-post-connect-hook '(erc-networks--warn-on-connect)
"Functions to run when a network connection is successfully opened.
Though internal, this complements `erc-connect-pre-hook' in that
it bookends the process rather than the logical connection, which
is the domain of `erc-before-connect' and `erc-after-connect'.
Note that unlike `erc-connect-pre-hook', this only runs in server
buffers, and it does so immediately before the first protocol
exchange.")
(defvar-local erc-server-timed-out nil
"Non-nil if the IRC server failed to respond to a ping.")
@ -646,6 +655,7 @@ The current buffer is given by BUFFER."
(cl-defmethod erc--register-connection ()
"Perform opening IRC protocol exchange with server."
(run-hooks 'erc--server-post-connect-hook)
(erc-login))
(defvar erc--server-connect-dumb-ipv6-regexp

2
lisp/erc/erc-compat.el
View File

@ -261,7 +261,7 @@ If START or END is negative, it counts from the end."
(when-let* ((s (plist-get e :secret))
(v (auth-source--obfuscate s)))
(setf (plist-get e :secret)
(byte-compile (lambda () (auth-source--deobfuscate v)))))
(apply-partially #'auth-source--deobfuscate v)))
(push e out)))
rv)))

26
lisp/erc/erc-networks.el
View File

@ -1472,14 +1472,16 @@ to be a false alarm. If `erc-reuse-buffers' is nil, let
(t (rename-buffer (generate-new-buffer-name name)))))
nil)
;; Soju v0.4.0 only sends ISUPPORT on upstream reconnect, so this
;; doesn't apply. ZNC 1.8.2, however, still sends the entire burst.
(defconst erc-networks--bouncer-targets '(*status bouncerserv)
"Case-mapped symbols matching known bouncer service-bot targets.")
;; Soju v0.4.0 sends ISUPPORT and nothing else on upstream reconnect,
;; so this actually doesn't apply. ZNC 1.8.2, however, still sends
;; the entire burst.
(defvar erc-networks--bouncer-targets '(*status bouncerserv)
"Symbols matching proxy-bot targets.")
(defun erc-networks-on-MOTD-end (proc parsed)
"Call on-connect functions with server PROC and PARSED message.
This must run before `erc-server-connected' is set."
"Call on-connect functions with server PROC and PARSED message."
;; This should normally run before `erc-server-connected' is set.
;; However, bouncers and other proxies may interfere with that.
(when erc-server-connected
(unless (erc-buffer-filter (lambda ()
(and erc--target
@ -1502,6 +1504,18 @@ This must run before `erc-server-connected' is set."
((remove-hook 'erc-server-376-functions #'erc-networks-on-MOTD-end)
(remove-hook 'erc-server-422-functions #'erc-networks-on-MOTD-end)))
(defun erc-networks--warn-on-connect ()
"Emit warning when the `networks' module hasn't been loaded.
Ideally, do so upon opening the network process."
(unless (or erc--target erc-networks-mode)
(require 'info nil t)
(let ((m (concat "Required module `networks' not loaded. If this "
" was unexpected, please add it to `erc-modules'.")))
;; Assume the server buffer has been marked as active.
(erc-display-error-notice
nil (concat m " See Info:\"(erc) Required Modules\" for more."))
(lwarn 'erc :warning m))))
(defun erc-ports-list (ports)
"Return a list of PORTS.

2
lisp/erc/erc-sasl.el
View File

@ -435,7 +435,7 @@ Otherwise, expect it to disappear in subsequent versions.")
(if (eq :user (alist-get 'user erc-sasl--options))
(erc-current-nick)
erc-session-username)))
(erc-login))
(cl-call-next-method))
(when erc-sasl--send-cap-ls
(erc-server-send "CAP REQ :sasl"))
(erc-server-send (format "AUTHENTICATE %s" m)))

6
lisp/erc/erc.el
View File

@ -1607,7 +1607,8 @@ same manner."
(when target ; compat
(setq tgt-info (erc--target-from-string target)))
(if tgt-info
(let* ((esid (erc-networks--id-symbol erc-networks--id))
(let* ((esid (and erc-networks--id
(erc-networks--id-symbol erc-networks--id)))
(name (if esid
(erc-networks--reconcile-buffer-names tgt-info
erc-networks--id)
@ -6760,7 +6761,8 @@ This should be a string with substitution variables recognized by
If the name of the network is not available, then use the
shortened server name instead."
(if-let ((erc--target)
(name (if-let ((esid (erc-networks--id-symbol erc-networks--id)))
(name (if-let ((erc-networks--id)
(esid (erc-networks--id-symbol erc-networks--id)))
(symbol-name esid)
(erc-shorten-server-name (or erc-server-announced-name
erc-session-server)))))

2
lisp/files.el
View File

@ -2850,7 +2850,7 @@ since only a single case-insensitive search through the alist is made."
("\\.emacs-places\\'" . lisp-data-mode)
("\\.el\\'" . emacs-lisp-mode)
("Project\\.ede\\'" . emacs-lisp-mode)
("\\.\\(scm\\|stk\\|ss\\|sch\\)\\'" . scheme-mode)
("\\.\\(scm\\|sls\\|sld\\|stk\\|ss\\|sch\\)\\'" . scheme-mode)
("\\.l\\'" . lisp-mode)
("\\.li?sp\\'" . lisp-mode)
("\\.[fF]\\'" . fortran-mode)

6
lisp/font-lock.el
View File

@ -2110,7 +2110,7 @@ For example, the declaration and use of fields in a struct."
(defface font-lock-punctuation-face
'((t nil))
"Font Lock mode face used to highlight punctuation."
"Font Lock mode face used to highlight punctuation characters."
:group 'font-lock-faces
:version "29.1")
@ -2122,7 +2122,9 @@ For example, the declaration and use of fields in a struct."
(defface font-lock-delimiter-face
'((t :inherit font-lock-punctuation-face))
"Font Lock mode face used to highlight delimiters."
"Font Lock mode face used to highlight delimiters.
What exactly is a delimiter depends on the major mode, but usually
these are characters like comma, colon, and semi-colon."
:group 'font-lock-faces
:version "29.1")

32
lisp/help.el
View File

@ -76,6 +76,7 @@ buffer.")
"C-n" #'view-emacs-news
"C-o" #'describe-distribution
"C-p" #'view-emacs-problems
"C-q" #'help-quick-toggle
"C-s" #'search-forward-help-for-help
"C-t" #'view-emacs-todo
"C-w" #'describe-no-warranty
@ -116,7 +117,7 @@ buffer.")
"v" #'describe-variable
"w" #'where-is
"x" #'describe-command
"q" #'help-quit-or-quick)
"q" #'help-quit)
(define-key global-map (char-to-string help-char) 'help-command)
(define-key global-map [help] 'help-command)
@ -243,7 +244,17 @@ buffer.")
;; ... and shrink it immediately.
(fit-window-to-buffer))
(message
(substitute-command-keys "Toggle the quick help buffer using \\[help-quit-or-quick]."))))
(substitute-command-keys "Toggle the quick help buffer using \\[help-quick-toggle]."))))
(defun help-quick-toggle ()
"Toggle the quick-help window."
(interactive)
(if (and-let* ((window (get-buffer-window "*Quick Help*")))
(quit-window t window))
;; Clear the message we may have gotten from `C-h' and then
;; waiting before hitting `q'.
(message "")
(help-quick)))
(defalias 'cheat-sheet #'help-quick)
@ -252,21 +263,6 @@ buffer.")
(interactive)
nil)
(defun help-quit-or-quick ()
"Call `help-quit' or `help-quick' depending on the context."
(interactive)
(cond
(help-buffer-under-preparation
;; FIXME: There should be a better way to detect if we are in the
;; help command loop.
(help-quit))
((and-let* ((window (get-buffer-window "*Quick Help*")))
(quit-window t window)
;; Clear the message we may have gotten from `C-h' and then
;; waiting before hitting `q'.
(message "")))
((help-quick))))
(defvar help-return-method nil
"What to do to \"exit\" the help buffer.
This is a list
@ -416,7 +412,7 @@ Do not call this in the scope of `with-help-window'."
("describe-package" "Describe a specific Emacs package")
""
("help-with-tutorial" "Start the Emacs tutorial")
("help-quick-or-quit" "Display the quick help buffer.")
("help-quick-toggle" "Display the quick help buffer.")
("view-echo-area-messages"
"Show recent messages (from echo area)")
("view-lossage" ,(format "Show last %d input keystrokes (lossage)"

5
lisp/htmlfontify.el
View File

@ -1850,8 +1850,9 @@ Hardly bombproof, but good enough in the context in which it is being used."
(defun hfy-text-p (srcdir file)
"Is SRCDIR/FILE text? Use `hfy-istext-command' to determine this."
(let* ((cmd (format hfy-istext-command (expand-file-name file srcdir)))
(rsp (shell-command-to-string cmd)))
(let* ((cmd (format hfy-istext-command
(shell-quote-argument (expand-file-name file srcdir))))
(rsp (shell-command-to-string cmd)))
(string-match "text" rsp)))
;; open a file, check fontification, if fontified, write a fontified copy

3
lisp/indent.el
View File

@ -784,7 +784,8 @@ If PREV is non-nil, return the previous one instead."
(defun tab-to-tab-stop ()
"Insert spaces or tabs to next defined tab-stop column.
The variable `tab-stop-list' is a list of columns at which there are tab stops.
Use \\[edit-tab-stops] to edit them interactively."
Use \\[edit-tab-stops] to edit them interactively.
Whether this inserts tabs or spaces depends on `indent-tabs-mode'."
(interactive)
(and abbrev-mode (= (char-syntax (preceding-char)) ?w)
(expand-abbrev))

13
lisp/isearch.el
View File

@ -181,7 +181,9 @@ When t (by default), signal an error when no more matches are found.
Then after repeating the search, wrap with `isearch-wrap-function'.
When `no', wrap immediately after reaching the last match.
When `no-ding', wrap immediately without flashing the screen.
When nil, never wrap, just stop at the last match."
When nil, never wrap, just stop at the last match.
With the values `no' and `no-ding' the search will try
to wrap around also on typing a character."
:type '(choice (const :tag "Pause before wrapping" t)
(const :tag "No pause before wrapping" no)
(const :tag "No pause and no flashing" no-ding)
@ -880,6 +882,7 @@ matches literally, against one space. You can toggle the value of this
variable by the command `isearch-toggle-lax-whitespace', usually bound to
`M-s SPC' during isearch."
:type 'boolean
:group 'isearch
:version "25.1")
(defvar isearch-regexp-lax-whitespace nil
@ -1179,6 +1182,7 @@ Each element of the list should be one of the symbols supported by
`isearch-forward-thing-at-point' to yank the initial \"thing\"
as text to the search string."
:type '(repeat (symbol :tag "Thing symbol"))
:group 'isearch
:version "28.1")
(defun isearch-forward-thing-at-point ()
@ -2525,10 +2529,11 @@ If no input items have been entered yet, just beep."
(ding)
(isearch-pop-state))
;; When going back to the hidden match, reopen it and close other overlays.
(when (and (eq search-invisible 'open) isearch-hide-immediately)
(when (and (eq isearch-invisible 'open) isearch-hide-immediately)
(if isearch-other-end
(isearch-range-invisible (min (point) isearch-other-end)
(max (point) isearch-other-end))
(let ((search-invisible isearch-invisible))
(isearch-range-invisible (min (point) isearch-other-end)
(max (point) isearch-other-end)))
(isearch-close-unnecessary-overlays (point) (point))))
(isearch-update))

5
lisp/net/gnutls.el
View File

@ -128,10 +128,7 @@ key exchange is against man-in-the-middle attacks.)
A value of nil says to use the default GnuTLS value.
The default value of this variable is such that virtually any
connection can be established, whether this connection can be
considered cryptographically \"safe\" or not. However, Emacs
network security is handled at a higher level via
Emacs network security is handled at a higher level via
`open-network-stream' and the Network Security Manager. See Info
node `(emacs) Network Security'."
:type '(choice (const :tag "Use default value" nil)

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

@ -487,92 +487,44 @@ For NODE, OVERRIDE, START, and END, see
(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."
Return nil if NODE is not a defun node or 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"
((or "struct_specifier" "enum_specifier"
"union_specifier" "class_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
the subtrees."
(let* ((ts-node (car node))
(subtrees (mapcan #'c-ts-mode--imenu-1 (cdr node)))
(name (when ts-node
(treesit-defun-name ts-node)))
(marker (when ts-node
(set-marker (make-marker)
(treesit-node-start ts-node)))))
(cond
;; A struct_specifier could be inside a parameter list, another
;; struct definition, a variable declaration, a function
;; declaration. In those cases we don't include it.
((string-match-p
(rx (or "parameter_declaration" "field_declaration"
"declaration" "function_definition"))
(or (treesit-node-type (treesit-node-parent ts-node))
""))
nil)
;; Ignore function local variable declarations.
((and (equal (treesit-node-type ts-node) "declaration")
(not (equal (treesit-node-type (treesit-node-parent ts-node))
"translation_unit")))
nil)
((or (null ts-node) (null name)) subtrees)
(subtrees
`((,name ,(cons name marker) ,@subtrees)))
(t
`((,name . ,marker))))))
(defun c-ts-mode--imenu ()
"Return Imenu alist for the current buffer."
(let* ((node (treesit-buffer-root-node))
(func-tree (treesit-induce-sparse-tree
node "^function_definition$" nil 1000))
(var-tree (treesit-induce-sparse-tree
node "^declaration$" nil 1000))
(struct-tree (treesit-induce-sparse-tree
node "^struct_specifier$" nil 1000))
(func-index (c-ts-mode--imenu-1 func-tree))
(var-index (c-ts-mode--imenu-1 var-tree))
(struct-index (c-ts-mode--imenu-1 struct-tree)))
(append
(when struct-index `(("Struct" . ,struct-index)))
(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
;; end, so we manually skip it.
(treesit-end-of-defun)
(when (looking-at (rx (* " ") ";"))
(goto-char (match-end 0))
;; This part is copied from `end-of-defun'.
(unless (bolp)
(skip-chars-forward " \t")
(if (looking-at "\\s<\\|\n")
(forward-line 1)))))
(defun c-ts-mode--defun-valid-p (node)
(if (string-match-p
(rx (or "struct_specifier"
"enum_specifier"
"union_specifier"))
(treesit-node-type node))
(null
(treesit-node-top-level
node (rx (or "function_definition"
"type_definition"))))
t))
"Return non-nil if NODE is a valid defun node.
Ie, NODE is not nested."
(not (or (and (member (treesit-node-type node)
'("struct_specifier"
"enum_specifier"
"union_specifier"
"declaration"))
;; If NODE's type is one of the above, make sure it is
;; top-level.
(treesit-node-top-level
node (rx (or "function_definition"
"type_definition"
"struct_specifier"
"enum_specifier"
"union_specifier"
"declaration"))))
(and (equal (treesit-node-type node) "declaration")
;; If NODE is a declaration, make sure it is not a
;; function declaration.
(equal (treesit-node-type
(treesit-node-child-by-field-name
node "declarator"))
"function_declarator")))))
(defun c-ts-mode--defun-skipper ()
"Custom defun skipper for `c-ts-mode' and friends.
@ -660,6 +612,59 @@ ARG is passed to `fill-paragraph'."
;; itself.
t)))
(defun c-ts-mode-comment-setup ()
"Set up local variables for C-like comment.
Set up:
- `comment-start'
- `comment-end'
- `comment-start-skip'
- `comment-end-skip'
- `adaptive-fill-mode'
- `adaptive-fill-first-line-regexp'
- `paragraph-start'
- `paragraph-separate'
- `fill-paragraph-function'"
(setq-local comment-start "// ")
(setq-local comment-end "")
(setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
(seq "/" (+ "*")))
(* (syntax whitespace))))
(setq-local comment-end-skip
(rx (* (syntax whitespace))
(group (or (syntax comment-end)
(seq (+ "*") "/")))))
(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))
;;; Modes
(defvar-keymap c-ts-mode-map
@ -694,44 +699,25 @@ ARG is passed to `fill-paragraph'."
(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)
;; Comment
(c-ts-mode-comment-setup)
;; Electric
(setq-local electric-indent-chars
(append "{}():;," electric-indent-chars))
;; Imenu.
(setq-local imenu-create-index-function #'c-ts-mode--imenu)
(setq-local which-func-functions nil)
(setq-local treesit-simple-imenu-settings
(let ((pred #'c-ts-mode--defun-valid-p))
`(("Struct" ,(rx bos (or "struct" "enum" "union")
"_specifier" eos)
,pred nil)
("Variable" ,(rx bos "declaration" eos) ,pred nil)
("Function" "\\`function_definition\\'" ,pred nil)
("Class" ,(rx bos (or "class_specifier"
"function_definition")
eos)
,pred nil))))
(setq-local treesit-font-lock-feature-list
'(( comment definition)
@ -752,13 +738,6 @@ ARG is passed to `fill-paragraph'."
;; Comments.
(setq-local comment-start "/* ")
(setq-local comment-end " */")
(setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
(seq "/" (+ "*")))
(* (syntax whitespace))))
(setq-local comment-end-skip
(rx (* (syntax whitespace))
(group (or (syntax comment-end)
(seq (+ "*") "/")))))
(setq-local treesit-simple-indent-rules
(c-ts-mode--set-indent-style 'c))
@ -766,11 +745,7 @@ ARG is passed to `fill-paragraph'."
;; Font-lock.
(setq-local treesit-font-lock-settings (c-ts-mode--font-lock-settings 'c))
(treesit-major-mode-setup)
;; Override default value of end-of-defun-function set by
;; `treesit-major-mode-setup'.
(setq-local end-of-defun-function #'c-ts-mode--end-of-defun))
(treesit-major-mode-setup))
;;;###autoload
(define-derived-mode c++-ts-mode c-ts-base-mode "C++"
@ -781,17 +756,6 @@ ARG is passed to `fill-paragraph'."
(unless (treesit-ready-p 'cpp)
(error "Tree-sitter for C++ isn't available"))
;; Comments.
(setq-local comment-start "// ")
(setq-local comment-end "")
(setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
(seq "/" (+ "*")))
(* (syntax whitespace))))
(setq-local comment-end-skip
(rx (* (syntax whitespace))
(group (or (syntax comment-end)
(seq (+ "*") "/")))))
(setq-local treesit-text-type-regexp
(regexp-opt '("comment"
"raw_string_literal")))
@ -804,11 +768,7 @@ ARG is passed to `fill-paragraph'."
;; Font-lock.
(setq-local treesit-font-lock-settings (c-ts-mode--font-lock-settings 'cpp))
(treesit-major-mode-setup)
;; Override default value of end-of-defun-function set by
;; `treesit-major-mode-setup'.
(setq-local end-of-defun-function #'c-ts-mode--end-of-defun))
(treesit-major-mode-setup))
(provide 'c-ts-mode)

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

@ -34,6 +34,7 @@
(require 'cc-mode)
(require 'cc-langs)
(require 'treesit)
(require 'c-ts-mode) ; For comment indenting and filling.
(eval-when-compile
(require 'cc-fonts)
@ -42,6 +43,7 @@
(declare-function treesit-parser-create "treesit.c")
(declare-function treesit-induce-sparse-tree "treesit.c")
(declare-function treesit-node-start "treesit.c")
(declare-function treesit-node-type "treesit.c")
(declare-function treesit-node-child-by-field-name "treesit.c")
(defgroup csharp nil
@ -632,6 +634,9 @@ compilation and evaluation time conflicts."
((node-is "}") parent-bol 0)
((node-is ")") parent-bol 0)
((node-is "]") parent-bol 0)
((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)
((parent-is "namespace_declaration") parent-bol 0)
((parent-is "class_declaration") parent-bol 0)
((parent-is "constructor_declaration") parent-bol 0)
@ -853,54 +858,6 @@ Return nil if there is no name or if NODE is not a defun node."
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
the subtrees."
(let* ((ts-node (car node))
(subtrees (mapcan #'csharp-ts-mode--imenu-1 (cdr node)))
(name (when ts-node
(or (treesit-defun-name ts-node)
"Unnamed node")))
(marker (when ts-node
(set-marker (make-marker)
(treesit-node-start ts-node)))))
(cond
((null ts-node) subtrees)
(subtrees
`((,name ,(cons name marker) ,@subtrees)))
(t
`((,name . ,marker))))))
(defun csharp-ts-mode--imenu ()
"Return Imenu alist for the current buffer."
(let* ((node (treesit-buffer-root-node))
(class-tree (treesit-induce-sparse-tree
node "^class_declaration$" nil 1000))
(interface-tree (treesit-induce-sparse-tree
node "^interface_declaration$" nil 1000))
(enum-tree (treesit-induce-sparse-tree
node "^enum_declaration$" nil 1000))
(struct-tree (treesit-induce-sparse-tree
node "^struct_declaration$" nil 1000))
(record-tree (treesit-induce-sparse-tree
node "^record_declaration$" nil 1000))
(method-tree (treesit-induce-sparse-tree
node "^method_declaration$" nil 1000))
(class-index (csharp-ts-mode--imenu-1 class-tree))
(interface-index (csharp-ts-mode--imenu-1 interface-tree))
(enum-index (csharp-ts-mode--imenu-1 enum-tree))
(record-index (csharp-ts-mode--imenu-1 record-tree))
(struct-index (csharp-ts-mode--imenu-1 struct-tree))
(method-index (csharp-ts-mode--imenu-1 method-tree)))
(append
(when class-index `(("Class" . ,class-index)))
(when interface-index `(("Interface" . ,interface-index)))
(when enum-index `(("Enum" . ,enum-index)))
(when record-index `(("Record" . ,record-index)))
(when struct-index `(("Struct" . ,struct-index)))
(when method-index `(("Method" . ,method-index))))))
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.cs\\'" . csharp-mode))
@ -929,15 +886,7 @@ Key bindings:
(treesit-parser-create 'c-sharp)
;; Comments.
(setq-local comment-start "// ")
(setq-local comment-end "")
(setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
(seq "/" (+ "*")))
(* (syntax whitespace))))
(setq-local comment-end-skip
(rx (* (syntax whitespace))
(group (or (syntax comment-end)
(seq (+ "*") "/")))))
(c-ts-mode-comment-setup)
(setq-local treesit-text-type-regexp
(regexp-opt '("comment"
@ -964,8 +913,14 @@ Key bindings:
( bracket delimiter)))
;; Imenu.
(setq-local imenu-create-index-function #'csharp-ts-mode--imenu)
(setq-local which-func-functions nil) ;; Piggyback on imenu
(setq-local treesit-simple-imenu-settings
'(("Class" "\\`class_declaration\\'" nil nil)
("Interface" "\\`interface_declaration\\'" nil nil)
("Enum" "\\`enum_declaration\\'" nil nil)
("Record" "\\`record_declaration\\'" nil nil)
("Struct" "\\`struct_declaration\\'" nil nil)
("Method" "\\`method_declaration\\'" nil nil)))
(treesit-major-mode-setup))
(provide 'csharp-mode)

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

@ -29,10 +29,12 @@
(require 'treesit)
(eval-when-compile (require 'rx))
(require 'c-ts-mode) ; For comment indent and filling.
(declare-function treesit-parser-create "treesit.c")
(declare-function treesit-induce-sparse-tree "treesit.c")
(declare-function treesit-node-start "treesit.c")
(declare-function treesit-node-type "treesit.c")
(declare-function treesit-node-child-by-field-name "treesit.c")
(defcustom java-ts-mode-indent-offset 4
@ -71,8 +73,9 @@
((node-is "}") (and parent parent-bol) 0)
((node-is ")") parent-bol 0)
((node-is "]") parent-bol 0)
((and (parent-is "comment") comment-end) comment-start -1)
((parent-is "comment") comment-start-skip 0)
((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)
((parent-is "text_block") no-indent)
((parent-is "class_body") parent-bol java-ts-mode-indent-offset)
((parent-is "interface_body") parent-bol java-ts-mode-indent-offset)
@ -264,50 +267,6 @@ Return nil if there is no name or if NODE is not a defun node."
(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
the subtrees."
(let* ((ts-node (car node))
(subtrees (mapcan #'java-ts-mode--imenu-1 (cdr node)))
(name (when ts-node
(or (treesit-defun-name ts-node)
"Unnamed node")))
(marker (when ts-node
(set-marker (make-marker)
(treesit-node-start ts-node)))))
(cond
((null ts-node) subtrees)
(subtrees
`((,name ,(cons name marker) ,@subtrees)))
(t
`((,name . ,marker))))))
(defun java-ts-mode--imenu ()
"Return Imenu alist for the current buffer."
(let* ((node (treesit-buffer-root-node))
(class-tree (treesit-induce-sparse-tree
node "^class_declaration$" nil 1000))
(interface-tree (treesit-induce-sparse-tree
node "^interface_declaration$" nil 1000))
(enum-tree (treesit-induce-sparse-tree
node "^enum_declaration$" nil 1000))
(record-tree (treesit-induce-sparse-tree
node "^record_declaration$" nil 1000))
(method-tree (treesit-induce-sparse-tree
node "^method_declaration$" nil 1000))
(class-index (java-ts-mode--imenu-1 class-tree))
(interface-index (java-ts-mode--imenu-1 interface-tree))
(enum-index (java-ts-mode--imenu-1 enum-tree))
(record-index (java-ts-mode--imenu-1 record-tree))
(method-index (java-ts-mode--imenu-1 method-tree)))
(append
(when class-index `(("Class" . ,class-index)))
(when interface-index `(("Interface" . ,interface-index)))
(when enum-index `(("Enum" . ,enum-index)))
(when record-index `(("Record" . ,record-index)))
(when method-index `(("Method" . ,method-index))))))
;;;###autoload
(define-derived-mode java-ts-mode prog-mode "Java"
"Major mode for editing Java, powered by tree-sitter."
@ -320,15 +279,7 @@ the subtrees."
(treesit-parser-create 'java)
;; Comments.
(setq-local comment-start "// ")
(setq-local comment-end "")
(setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
(seq "/" (+ "*")))
(* (syntax whitespace))))
(setq-local comment-end-skip
(rx (* (syntax whitespace))
(group (or (syntax comment-end)
(seq (+ "*") "/")))))
(c-ts-mode-comment-setup)
(setq-local treesit-text-type-regexp
(regexp-opt '("line_comment"
@ -363,8 +314,11 @@ the subtrees."
( bracket delimiter operator)))
;; Imenu.
(setq-local imenu-create-index-function #'java-ts-mode--imenu)
(setq-local which-func-functions nil) ;; Piggyback on imenu
(setq-local treesit-simple-imenu-settings
'(("Class" "\\`class_declaration\\'" nil nil)
("Interface" "\\`interface_declaration\\'" nil nil)
("Enum" "\\`record_declaration\\'" nil nil)
("Method" "\\`method_declaration\\'" nil nil)))
(treesit-major-mode-setup))
(provide 'java-ts-mode)

98
lisp/progmodes/js.el
View File

@ -54,6 +54,7 @@
(require 'json)
(require 'prog-mode)
(require 'treesit)
(require 'c-ts-mode) ; For comment indent and filling.
(eval-when-compile
(require 'cl-lib)
@ -3425,9 +3426,9 @@ This function is intended for use in `after-change-functions'."
((node-is ")") parent-bol 0)
((node-is "]") parent-bol 0)
((node-is ">") parent-bol 0)
((parent-is "comment") comment-start 0)
((and (parent-is "comment") comment-end) comment-start -1)
((parent-is "comment") comment-start-skip 0)
((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)
((parent-is "ternary_expression") parent-bol js-indent-level)
((parent-is "member_expression") parent-bol js-indent-level)
((node-is ,switch-case) parent-bol 0)
@ -3669,70 +3670,11 @@ Return nil if there is no name or if NODE is not a defun node."
"name")
t))
(defun js--treesit-imenu-1 (node)
"Given a sparse tree, create an imenu alist.
NODE is the root node of the tree returned by
`treesit-induce-sparse-tree' (not a tree-sitter node, its car is
a tree-sitter node). Walk that tree and return an imenu alist.
Return a list of ENTRY where
ENTRY := (NAME . MARKER)
| (NAME . ((JUMP-LABEL . MARKER)
ENTRY
...)
NAME is the function/class's name, JUMP-LABEL is like \"*function
definition*\"."
(let* ((ts-node (car node))
(children (cdr node))
(subtrees (mapcan #'js--treesit-imenu-1
children))
(type (pcase (treesit-node-type ts-node)
("lexical_declaration" 'variable)
("class_declaration" 'class)
("method_definition" 'method)
("function_declaration" 'function)))
;; The root of the tree could have a nil ts-node.
(name (when ts-node
(or (treesit-defun-name ts-node)
"Anonymous")))
(marker (when ts-node
(set-marker (make-marker)
(treesit-node-start ts-node)))))
(cond
((null ts-node)
subtrees)
;; Don't included non-top-level variable declarations.
((and (eq type 'variable)
(treesit-node-top-level ts-node))
nil)
(subtrees
`((,name
,(cons "" marker)
,@subtrees)))
(t (list (cons name marker))))))
(defun js--treesit-imenu ()
"Return Imenu alist for the current buffer."
(let* ((node (treesit-buffer-root-node))
(class-tree (treesit-induce-sparse-tree
node (rx (or "class_declaration"
"method_definition"))
nil 1000))
(func-tree (treesit-induce-sparse-tree
node "function_declaration" nil 1000))
(var-tree (treesit-induce-sparse-tree
node "lexical_declaration" nil 1000)))
;; When a sub-tree is empty, we should not return that pair at all.
(append
(and func-tree
`(("Function" . ,(js--treesit-imenu-1 func-tree))))
(and var-tree
`(("Variable" . ,(js--treesit-imenu-1 var-tree))))
(and class-tree
`(("Class" . ,(js--treesit-imenu-1 class-tree)))))))
(defun js--treesit-valid-imenu-entry (node)
"Return nil if NODE is a non-top-level \"lexical_declaration\"."
(pcase (treesit-node-type node)
("lexical_declaration" (treesit-node-top-level node))
(_ t)))
;;; Main Function
@ -3845,15 +3787,7 @@ Currently there are `js-mode' and `js-ts-mode'."
;; Which-func.
(setq-local which-func-imenu-joiner-function #'js--which-func-joiner)
;; Comment.
(setq-local comment-start "// ")
(setq-local comment-end "")
(setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
(seq "/" (+ "*")))
(* (syntax whitespace))))
(setq-local comment-end-skip
(rx (* (syntax whitespace))
(group (or (syntax comment-end)
(seq (+ "*") "/")))))
(c-ts-mode-comment-setup)
(setq-local comment-multi-line t)
(setq-local treesit-text-type-regexp
@ -3887,10 +3821,14 @@ Currently there are `js-mode' and `js-ts-mode'."
identifier jsx number pattern property)
( bracket delimiter operator)))
;; Imenu
(setq-local imenu-create-index-function
#'js--treesit-imenu)
;; Which-func (use imenu).
(setq-local which-func-functions nil)
(setq-local treesit-simple-imenu-settings
`(("Function" "\\`function_declaration\\'" nil nil)
("Variable" "\\`lexical_declaration\\'"
js--treesit-valid-imenu-entry nil)
("Class" ,(rx bos (or "class_declaration"
"method_definition")
eos)
nil nil)))
(treesit-major-mode-setup)))
;;;###autoload

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

@ -33,6 +33,7 @@
(declare-function treesit-parser-create "treesit.c")
(declare-function treesit-induce-sparse-tree "treesit.c")
(declare-function treesit-node-start "treesit.c")
(declare-function treesit-node-type "treesit.c")
(declare-function treesit-node-child-by-field-name "treesit.c")
@ -112,36 +113,11 @@
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
the subtrees."
(let* ((ts-node (car node))
(subtrees (mapcan #'json-ts-mode--imenu-1 (cdr node)))
(name (when ts-node
(or (treesit-defun-name ts-node)
"Anonymous")))
(marker (when ts-node
(set-marker (make-marker)
(treesit-node-start ts-node)))))
(cond
((null ts-node) subtrees)
(subtrees
`((,name ,(cons name marker) ,@subtrees)))
(t
`((,name . ,marker))))))
(defun json-ts-mode--imenu ()
"Return Imenu alist for the current buffer."
(let* ((node (treesit-buffer-root-node))
(tree (treesit-induce-sparse-tree
node "pair" nil 1000)))
(json-ts-mode--imenu-1 tree)))
(string-trim (treesit-node-text
(treesit-node-child-by-field-name
node "key")
t)
"\"" "\""))))
;;;###autoload
(define-derived-mode json-ts-mode prog-mode "JSON"
@ -179,8 +155,8 @@ the subtrees."
(bracket delimiter error)))
;; Imenu.
(setq-local imenu-create-index-function #'json-ts-mode--imenu)
(setq-local which-func-functions nil) ;; Piggyback on imenu
(setq-local treesit-simple-imenu-settings
'((nil "\\`pair\\'" nil nil)))
(treesit-major-mode-setup))

43
lisp/progmodes/python.el
View File

@ -1080,7 +1080,6 @@ fontified."
:feature 'string
:language 'python
:override t
'((string) @python--treesit-fontify-string)
:feature 'string-interpolation
@ -1097,9 +1096,7 @@ fontified."
:feature 'function
:language 'python
'((function_definition
name: (identifier) @font-lock-function-name-face)
(call function: (identifier) @font-lock-function-name-face)
'((call function: (identifier) @font-lock-function-name-face)
(call function: (attribute
attribute: (identifier) @font-lock-function-name-face)))
@ -1130,7 +1127,7 @@ fontified."
@font-lock-variable-name-face)
(assignment left: (attribute
attribute: (identifier)
@font-lock-variable-name-face))
@font-lock-property-face))
(pattern_list (identifier)
@font-lock-variable-name-face)
(tuple_pattern (identifier)
@ -1162,12 +1159,10 @@ fontified."
:feature 'number
:language 'python
:override t
'([(integer) (float)] @font-lock-number-face)
:feature 'property
:language 'python
:override t
'((attribute
attribute: (identifier) @font-lock-property-face)
(class_definition
@ -1178,20 +1173,44 @@ fontified."
:feature 'operator
:language 'python
:override t
`([,@python--treesit-operators] @font-lock-operator-face)
:feature 'bracket
:language 'python
:override t
'(["(" ")" "[" "]" "{" "}"] @font-lock-bracket-face)
:feature 'delimiter
:language 'python
:override t
'(["," "." ":" ";" (ellipsis)] @font-lock-delimiter-face))
'(["," "." ":" ";" (ellipsis)] @font-lock-delimiter-face)
:feature 'variable
:language 'python
'((identifier) @python--treesit-fontify-variable))
"Tree-sitter font-lock settings.")
(defun python--treesit-variable-p (node)
"Check whether NODE is a variable.
NODE's type should be \"identifier\"."
;; An identifier can be a function/class name, a property, or a
;; variables. This funtion filters out function/class names and
;; properties.
(pcase (treesit-node-type (treesit-node-parent node))
((or "function_definition" "class_definition") nil)
("attribute"
(pcase (treesit-node-field-name node)
("object" t)
(_ nil)))
(_ t)))
(defun python--treesit-fontify-variable (node override start end &rest _)
"Fontify an identifier node if it is a variable.
For NODE, OVERRIDE, START, END, and ARGS, see
`treesit-font-lock-rules'."
(when (python--treesit-variable-p node)
(treesit-fontify-with-override
(treesit-node-start node) (treesit-node-end node)
'font-lock-variable-name-face override start end)))
;;; Indentation
@ -6646,7 +6665,7 @@ implementations: `python-mode' and `python-ts-mode'."
( keyword string type)
( assignment builtin constant decorator
escape-sequence number property string-interpolation )
( function bracket delimiter operator)))
( bracket delimiter function operator variable)))
(setq-local treesit-font-lock-settings python--treesit-settings)
(setq-local imenu-create-index-function
#'python-imenu-treesit-create-index)

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

@ -29,6 +29,7 @@
(require 'treesit)
(eval-when-compile (require 'rx))
(require 'c-ts-mode) ; For comment indent and filling.
(declare-function treesit-parser-create "treesit.c")
(declare-function treesit-induce-sparse-tree "treesit.c")
@ -70,6 +71,9 @@
((node-is ")") parent-bol 0)
((node-is "]") parent-bol 0)
((node-is "}") (and parent parent-bol) 0)
((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)
((parent-is "arguments") parent-bol rust-ts-mode-indent-offset)
((parent-is "await_expression") parent-bol rust-ts-mode-indent-offset)
((parent-is "array_expression") parent-bol rust-ts-mode-indent-offset)
@ -244,35 +248,6 @@
'((ERROR) @font-lock-warning-face))
"Tree-sitter font-lock settings for `rust-ts-mode'.")
(defun rust-ts-mode--imenu ()
"Return Imenu alist for the current buffer."
(let* ((node (treesit-buffer-root-node))
(enum-tree (treesit-induce-sparse-tree
node "enum_item" nil))
(enum-index (rust-ts-mode--imenu-1 enum-tree))
(func-tree (treesit-induce-sparse-tree
node "function_item" nil))
(func-index (rust-ts-mode--imenu-1 func-tree))
(impl-tree (treesit-induce-sparse-tree
node "impl_item" nil))
(impl-index (rust-ts-mode--imenu-1 impl-tree))
(mod-tree (treesit-induce-sparse-tree
node "mod_item" nil))
(mod-index (rust-ts-mode--imenu-1 mod-tree))
(struct-tree (treesit-induce-sparse-tree
node "struct_item" nil))
(struct-index (rust-ts-mode--imenu-1 struct-tree))
(type-tree (treesit-induce-sparse-tree
node "type_item" nil))
(type-index (rust-ts-mode--imenu-1 type-tree)))
(append
(when mod-index `(("Module" . ,mod-index)))
(when enum-index `(("Enum" . ,enum-index)))
(when impl-index `(("Impl" . ,impl-index)))
(when type-index `(("Type" . ,type-index)))
(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."
@ -300,27 +275,6 @@ Return nil if there is no name or if NODE is not a defun node."
(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
the subtrees."
(let* ((ts-node (car node))
(children (cdr node))
(subtrees (mapcan #'rust-ts-mode--imenu-1
children))
(name (when ts-node
(or (treesit-defun-name ts-node)
"Anonymous")))
(marker (when ts-node
(set-marker (make-marker)
(treesit-node-start ts-node)))))
(cond
((or (null ts-node) (null name)) subtrees)
(subtrees
`((,name ,(cons name marker) ,@subtrees)))
(t
`((,name . ,marker))))))
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.rs\\'" . rust-ts-mode))
@ -334,15 +288,7 @@ the subtrees."
(treesit-parser-create 'rust)
;; Comments.
(setq-local comment-start "// ")
(setq-local comment-end "")
(setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
(seq "/" (+ "*")))
(* (syntax whitespace))))
(setq-local comment-end-skip
(rx (* (syntax whitespace))
(group (or (syntax comment-end)
(seq (+ "*") "/")))))
(c-ts-mode-comment-setup)
;; Font-lock.
(setq-local treesit-font-lock-settings rust-ts-mode--font-lock-settings)
@ -354,8 +300,13 @@ the subtrees."
( bracket delimiter error operator)))
;; Imenu.
(setq-local imenu-create-index-function #'rust-ts-mode--imenu)
(setq-local which-func-functions nil)
(setq-local treesit-simple-imenu-settings
`(("Module" "\\`mod_item\\'" nil nil)
("Enum" "\\`enum_item\\'" nil nil)
("Impl" "\\`impl_item\\'" nil nil)
("Type" "\\`type_item\\'" nil nil)
("Struct" "\\`struct_item\\'" nil nil)
("Fn" "\\`function_item\\'" nil nil)))
;; Indent.
(setq-local indent-tabs-mode nil

20
lisp/progmodes/scheme.el
View File

@ -115,7 +115,8 @@
(defvar scheme-imenu-generic-expression
`((nil
,(rx bol "(define"
,(rx bol (zero-or-more space)
"(define"
(zero-or-one "*")
(zero-or-one "-public")
(one-or-more space)
@ -123,36 +124,41 @@
(group (one-or-more (or word (syntax symbol)))))
1)
("Methods"
,(rx bol "(define-"
,(rx bol (zero-or-more space)
"(define-"
(or "generic" "method" "accessor")
(one-or-more space)
(zero-or-one "(")
(group (one-or-more (or word (syntax symbol)))))
1)
("Classes"
,(rx bol "(define-class"
,(rx bol (zero-or-more space)
"(define-class"
(one-or-more space)
(zero-or-one "(")
(group (one-or-more (or word (syntax symbol)))))
1)
("Records"
,(rx bol "(define-record-type"
,(rx bol (zero-or-more space)
"(define-record-type"
(zero-or-one "*")
(one-or-more space)
(group (one-or-more (or word (syntax symbol)))))
1)
("Conditions"
,(rx bol "(define-condition-type"
,(rx bol (zero-or-more space)
"(define-condition-type"
(one-or-more space)
(group (one-or-more (or word (syntax symbol)))))
1)
("Modules"
,(rx bol "(define-module"
,(rx bol (zero-or-more space)
"(define-module"
(one-or-more space)
(group "(" (one-or-more any) ")"))
1)
("Macros"
,(rx bol "("
,(rx bol (zero-or-more space) "("
(or (and "defmacro"
(zero-or-one "*")
(zero-or-one "-public"))

2
lisp/progmodes/sh-script.el
View File

@ -150,6 +150,8 @@
(require 'executable)
(require 'treesit)
(declare-function treesit-parser-create "treesit.c")
(autoload 'comint-completion-at-point "comint")
(autoload 'comint-filename-completion "comint")
(autoload 'comint-send-string "comint")

30
lisp/progmodes/typescript-ts-mode.el
View File

@ -30,6 +30,7 @@
(require 'treesit)
(require 'js)
(eval-when-compile (require 'rx))
(require 'c-ts-mode) ; For comment indent and filling.
(declare-function treesit-parser-create "treesit.c")
@ -73,8 +74,9 @@ Argument LANGUAGE is either `typescript' or `tsx'."
((node-is ")") parent-bol 0)
((node-is "]") parent-bol 0)
((node-is ">") parent-bol 0)
((and (parent-is "comment") comment-end) comment-start -1)
((parent-is "comment") comment-start-skip 0)
((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)
((parent-is "ternary_expression") parent-bol typescript-ts-mode-indent-offset)
((parent-is "member_expression") parent-bol typescript-ts-mode-indent-offset)
((parent-is "named_imports") parent-bol typescript-ts-mode-indent-offset)
@ -331,18 +333,12 @@ Argument LANGUAGE is either `typescript' or `tsx'."
:syntax-table typescript-ts-mode--syntax-table
;; Comments.
(setq-local comment-start "// ")
(setq-local comment-end "")
(setq-local comment-start-skip "\\(?://+\\|/\\*+\\)\\s *")
(setq-local comment-end-skip
(rx (* (syntax whitespace))
(group (or (syntax comment-end)
(seq (+ "*") "/")))))
(c-ts-mode-comment-setup)
(setq-local treesit-defun-prefer-top-level t)
(setq-local treesit-text-type-regexp
(regexp-opt '("comment"
"template_string")))
(setq-local treesit-defun-prefer-top-level t)
;; Electric
(setq-local electric-indent-chars
@ -354,11 +350,17 @@ Argument LANGUAGE is either `typescript' or `tsx'."
"method_definition"
"function_declaration"
"lexical_declaration")))
;; Imenu.
(setq-local imenu-create-index-function #'js--treesit-imenu)
(setq-local treesit-defun-name-function #'js--treesit-defun-name)
;; Which-func (use imenu).
(setq-local which-func-functions nil))
;; Imenu (same as in `js-ts-mode').
(setq-local treesit-simple-imenu-settings
`(("Function" "\\`function_declaration\\'" nil nil)
("Variable" "\\`lexical_declaration\\'"
js--treesit-valid-imenu-entry nil)
("Class" ,(rx bos (or "class_declaration"
"method_definition")
eos)
nil nil))))
;;;###autoload
(define-derived-mode typescript-ts-mode typescript-ts-base-mode "TypeScript"

3
lisp/repeat.el
View File

@ -399,7 +399,8 @@ but the property value is `t', then check the last key."
(defcustom repeat-echo-function #'repeat-echo-message
"Function to display a hint about available keys.
Function is called after every repeatable command with one argument:
a repeating map, or nil after deactivating the transient repeating mode."
a repeating map, or nil after deactivating the transient repeating mode.
You can use `add-function' for multiple functions simultaneously."
:type '(choice (const :tag "Show hints in the echo area"
repeat-echo-message)
(const :tag "Show indicator in the mode line"

7
lisp/subr.el
View File

@ -6905,11 +6905,8 @@ sentence (see Info node `(elisp) Documentation Tips')."
(defun json-available-p ()
"Return non-nil if Emacs has libjansson support."
(and (fboundp 'json-serialize)
(condition-case nil
(json-serialize t)
(:success t)
(json-unavailable nil))))
(and (fboundp 'json--available-p)
(json--available-p)))
(defun ensure-list (object)
"Return OBJECT as a list.

14
lisp/tab-line.el
View File

@ -572,9 +572,14 @@ For use in `tab-line-tab-face-functions'."
(defvar tab-line-auto-hscroll)
(defun tab-line-cache-key-default (_tabs)
(defun tab-line-cache-key-default (tabs)
"Return default list of cache keys."
(list
tabs
;; handle buffer renames
(buffer-name (window-buffer))
;; handle tab-line scrolling
(window-parameter nil 'tab-line-hscroll)
;; for setting face 'tab-line-tab-current'
(mode-line-window-selected-p)
;; for `tab-line-tab-face-modified'
@ -591,12 +596,7 @@ of cache keys. You can use `add-function' to add more cache keys.")
(defun tab-line-format ()
"Format for displaying the tab line of the selected window."
(let* ((tabs (funcall tab-line-tabs-function))
(cache-key (append (list tabs
;; handle buffer renames
(buffer-name (window-buffer))
;; handle tab-line scrolling
(window-parameter nil 'tab-line-hscroll))
(funcall tab-line-cache-key-function tabs)))
(cache-key (funcall tab-line-cache-key-function tabs))
(cache (window-parameter nil 'tab-line-cache)))
;; Enable auto-hscroll again after it was disabled on manual scrolling.
;; The moment to enable it is when the window-buffer was updated.

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

@ -1425,33 +1425,6 @@ Return nil if there is no name or if NODE is not a defun node."
(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
the subtrees."
(let* ((ts-node (car node))
(subtrees (mapcan #'css--treesit-imenu-1 (cdr node)))
(name (when ts-node
(or (treesit-defun-name ts-node)
"Anonymous")))
(marker (when ts-node
(set-marker (make-marker)
(treesit-node-start ts-node)))))
(cond
((or (null ts-node) (null name)) subtrees)
(subtrees
`((,name ,(cons name marker) ,@subtrees)))
(t
`((,name . ,marker))))))
(defun css--treesit-imenu ()
"Return Imenu alist for the current buffer."
(let* ((node (treesit-buffer-root-node))
(tree (treesit-induce-sparse-tree
node (rx (or "rule_set" "media_statement"))
nil 1000)))
(css--treesit-imenu-1 tree)))
;;; Completion
(defun css--complete-property ()
@ -1847,8 +1820,9 @@ can also be used to fill comments.
'((selector comment query keyword)
(property constant string)
(error variable function operator bracket)))
(setq-local imenu-create-index-function #'css--treesit-imenu)
(setq-local which-func-functions nil)
(setq-local treesit-simple-imenu-settings
`( nil ,(rx bos (or "rule_set" "media_statement") eos)
nil nil))
(treesit-major-mode-setup)))
;;;###autoload

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

@ -32,6 +32,8 @@
(declare-function treesit-parser-create "treesit.c")
(declare-function treesit-induce-sparse-tree "treesit.c")
(declare-function treesit-node-start "treesit.c")
(declare-function treesit-node-type "treesit.c")
(declare-function treesit-node-child "treesit.c")
(declare-function treesit-node-child-by-field-name "treesit.c")
(defcustom toml-ts-mode-indent-offset 2
@ -112,39 +114,8 @@
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'.
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 (or (treesit-defun-name ts-node)
"Root table"))
(marker (when ts-node
(set-marker (make-marker)
(treesit-node-start ts-node)))))
(cond
((null ts-node) subtrees)
(subtrees
`((,name ,(cons name marker) ,@subtrees)))
(t
`((,name . ,marker))))))
(defun toml-ts-mode--imenu ()
"Return Imenu alist for the current buffer."
(let* ((node (treesit-buffer-root-node))
(table-tree (treesit-induce-sparse-tree
node "^table$" nil 1000))
(table-array-tree (treesit-induce-sparse-tree
node "^table_array_element$" nil 1000))
(table-index (toml-ts-mode--imenu-1 table-tree))
(table-array-index (toml-ts-mode--imenu-1 table-array-tree)))
(append
(when table-index `(("Headers" . ,table-index)))
(when table-array-index `(("Arrays" . ,table-array-index))))))
(or (treesit-node-text (treesit-node-child node 1) t)
"Root table"))))
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.toml\\'" . toml-ts-mode))
@ -179,8 +150,9 @@ the subtrees."
(delimiter error)))
;; Imenu.
(setq-local imenu-create-index-function #'toml-ts-mode--imenu)
(setq-local which-func-functions nil) ;; Piggyback on imenu
(setq-local treesit-simple-imenu-settings
'(("Header" "\\`table\\'" nil nil)
("Array" "\\`table_array_element\\'" nil nil)))
(treesit-major-mode-setup)))

246
lisp/treesit.el
View File

@ -2,6 +2,10 @@
;; Copyright (C) 2021-2022 Free Software Foundation, Inc.
;; Maintainer: 付禹安 (Yuan Fu) <casouri@gmail.com>
;; Keywords: treesit, tree-sitter, languages
;; Package: emacs
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
@ -230,19 +234,27 @@ is nil, try to guess the language at BEG using `treesit-language-at'."
(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)
(defun treesit-node-top-level (node &optional pred include-node)
"Return the top-level equivalent of NODE.
Specifically, return the highest parent of NODE that has the same
type as it. If no such parent exists, return nil.
If TYPE is non-nil, match each parent's type with TYPE as a
regexp, rather than using NODE's type."
(let ((type (or type (treesit-node-type node)))
If PRED is non-nil, match each parent's type with PRED as a
regexp, rather than using NODE's type. PRED can also be a
function that takes the node as an argument, and return
non-nil/nil for match/no match.
If INCLUDE-NODE is non-nil, return NODE if it satisfies PRED."
(let ((pred (or pred (treesit-node-type node)))
(result nil))
(cl-loop for cursor = (treesit-node-parent node)
(cl-loop for cursor = (if include-node node
(treesit-node-parent node))
then (treesit-node-parent cursor)
while cursor
if (string-match-p type (treesit-node-type cursor))
if (if (stringp pred)
(string-match-p pred (treesit-node-type cursor))
(funcall pred cursor))
do (setq result cursor))
result))
@ -286,11 +298,16 @@ properties."
(treesit-node-start node)
(treesit-node-end node))))))
(defun treesit-parent-until (node pred)
(defun treesit-parent-until (node pred &optional include-node)
"Return the closest parent of NODE that satisfies PRED.
Return nil if none was found. PRED should be a function that
takes one argument, the parent node."
(let ((node (treesit-node-parent node)))
takes one argument, the parent node, and return non-nil/nil for
match/no match.
If INCLUDE-NODE is non-nil, return NODE if it satisfies PRED."
(let ((node (if include-node node
(treesit-node-parent node))))
(while (and node (not (funcall pred node)))
(setq node (treesit-node-parent node)))
node))
@ -305,8 +322,6 @@ takes one argument, the parent node."
node (treesit-node-parent node)))
last))
(defalias 'treesit-traverse-parent #'treesit-parent-until)
(defun treesit-node-children (node &optional named)
"Return a list of NODE's children.
If NAMED is non-nil, collect named child only."
@ -1644,7 +1659,7 @@ For example, \"(function|class)_definition\".
Sometimes not all nodes matched by the regexp are valid defuns.
In that case, set this variable to a cons cell of the
form (REGEXP . FILTER), where FILTER is a function that takes a
form (REGEXP . PRED), where PRED is a function that takes a
node (the matched node) and returns t if node is valid, or nil
for invalid node.
@ -1793,78 +1808,67 @@ sound things exists.
REGEXP and PRED are the same as in `treesit-thing-at-point'."
(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
;; defun, in that case we want to use a node that's actually
;; before/after point.
(node-before (if (>= (treesit-node-start node) pos)
(save-excursion
(treesit-search-forward-goto node "" t t t))
node))
(node-after (if (<= (treesit-node-end node) pos)
(save-excursion
(treesit-search-forward-goto
node "" nil nil t))
node))
(result (list nil nil nil))
(pred (or pred (lambda (_) t))))
(result (list nil nil nil)))
;; 1. Find previous and next sibling defuns.
(cl-loop
for idx from 0 to 1
for node in (list node-before node-after)
for backward in '(t nil)
;; Make sure we go in the right direction, and the defun we find
;; doesn't cover POS.
for pos-pred in (list (lambda (n) (<= (treesit-node-end n) pos))
(lambda (n) (>= (treesit-node-start n) pos)))
;; If point is inside a defun, our process below will never
;; return a next/prev sibling outside of that defun, effectively
;; any prev/next sibling is locked inside the smallest defun
;; covering point, which is the correct behavior. That's because
;; when there exists a defun that covers point,
;; `treesit-search-forward' will first reach that defun, after
;; that we only go upwards in the tree, so other defuns outside
;; of the covering defun is never reached. (Don't use
;; `treesit-search-forward-goto' as it breaks when NODE-AFTER is
;; the last token of a parent defun: it will skip the parent
;; defun because it wants to ensure progress.)
do (cl-loop for cursor = (when node
(save-excursion
(treesit-search-forward
node regexp backward backward)))
then (treesit-node-parent cursor)
while cursor
if (and (string-match-p
regexp (treesit-node-type cursor))
(funcall pred cursor)
(funcall pos-pred cursor))
do (setf (nth idx result) cursor)))
;; We repeatedly find next defun candidate with
;; `treesit-search-forward', and check if it is a valid defun,
;; until the node we find covers POS, meaning we've gone through
;; every possible sibling defuns. But there is a catch:
;; `treesit-search-forward' searches bottom-up, so for each
;; candidate we need to go up the tree and find the top-most
;; valid sibling, this defun will be at the same level as POS.
;; Don't use `treesit-search-forward-goto', it skips nodes in
;; order to enforce progress.
when node
do (let ((cursor node)
(iter-pred (lambda (node)
(and (string-match-p
regexp (treesit-node-type node))
(or (null pred) (funcall pred node))
(funcall pos-pred node)))))
;; Find the node just before/after POS to start searching.
(save-excursion
(while (and cursor (not (funcall pos-pred cursor)))
(setq cursor (treesit-search-forward-goto
cursor "" backward backward t))))
;; Keep searching until we run out of candidates.
(while (and cursor
(funcall pos-pred cursor)
(null (nth idx result)))
(setf (nth idx result)
(treesit-node-top-level cursor iter-pred t))
(setq cursor (treesit-search-forward
cursor regexp backward backward)))))
;; 2. Find the parent defun.
(setf (nth 2 result)
(cl-loop for cursor = (or (nth 0 result)
(nth 1 result)
node)
then (treesit-node-parent cursor)
while cursor
if (and (string-match-p
regexp (treesit-node-type cursor))
(funcall pred cursor)
(not (member cursor result)))
return cursor))
(let ((cursor (or (nth 0 result) (nth 1 result) node))
(iter-pred (lambda (node)
(and (string-match-p
regexp (treesit-node-type node))
(or (null pred) (funcall pred node))
(not (treesit-node-eq node (nth 0 result)))
(not (treesit-node-eq node (nth 1 result)))
(< (treesit-node-start node)
pos
(treesit-node-end node))))))
(setf (nth 2 result)
(treesit-parent-until cursor iter-pred)))
result))
(defun treesit--top-level-thing (node regexp &optional pred)
"Return the top-level parent thing of NODE.
REGEXP and PRED are the same as in `treesit-thing-at-point'."
(let* ((pred (or pred (lambda (_) t))))
;; `treesit-search-forward-goto' will make sure the matched node
;; is before POS.
(cl-loop for cursor = node
then (treesit-node-parent cursor)
while cursor
if (and (string-match-p
regexp (treesit-node-type cursor))
(funcall pred cursor))
do (setq node cursor))
node))
(treesit-node-top-level
node (lambda (node)
(and (string-match-p regexp (treesit-node-type node))
(or (null pred) (funcall pred node))))
t))
;; The basic idea for nested defun navigation is that we first try to
;; move across sibling defuns in the same level, if no more siblings
@ -2040,6 +2044,91 @@ The delimiter between nested defun names is controlled by
(setq node (treesit-node-parent node)))
name))
;;; Imenu
(defvar treesit-simple-imenu-settings nil
"Settings that configure `treesit-simple-imenu'.
It should be a list of (CATEGORY REGEXP PRED NAME-FN).
CATEGORY is the name of a category, like \"Function\", \"Class\",
etc. REGEXP should be a regexp matching the type of nodes that
belong to CATEGORY. PRED should be either nil or a function
that takes a node an the argument. It should return non-nil if
the node is a valid node for CATEGORY, or nil if not.
CATEGORY could also be nil. In that case the entries matched by
REGEXP and PRED are not grouped under CATEGORY.
NAME-FN should be either nil or a function that takes a defun
node and returns the name of that defun node. If NAME-FN is nil,
`treesit-defun-name' is used.
`treesit-major-mode-setup' automatically sets up Imenu if this
variable is non-nil.")
(defun treesit--simple-imenu-1 (node pred name-fn)
"Given a sparse tree, create an Imenu index.
NODE is a node in the tree returned by
`treesit-induce-sparse-tree' (not a tree-sitter node, its car is
a tree-sitter node). Walk that tree and return an Imenu index.
Return a list of entries where each ENTRY has the form:
ENTRY := (NAME . MARKER)
| (NAME . ((\" \" . MARKER)
ENTRY
...)
PRED and NAME-FN are the same as described in
`treesit-simple-imenu-settings'. NAME-FN computes NAME in an
ENTRY. MARKER marks the start of each tree-sitter node."
(let* ((ts-node (car node))
(children (cdr node))
(subtrees (mapcan (lambda (node)
(treesit--simple-imenu-1 node pred name-fn))
children))
;; The root of the tree could have a nil ts-node.
(name (when ts-node
(or (if name-fn
(funcall name-fn ts-node)
(treesit-defun-name ts-node))
"Anonymous")))
(marker (when ts-node
(set-marker (make-marker)
(treesit-node-start ts-node)))))
(cond
;; The tree-sitter node in the root node of the tree returned by
;; `treesit-induce-sparse-tree' is often nil.
((null ts-node)
subtrees)
;; This tree-sitter node is not a valid entry, skip it.
((and pred (not (funcall pred ts-node)))
subtrees)
;; Non-leaf node, return a (list of) subgroup.
(subtrees
`((,name
,(cons " " marker)
,@subtrees)))
;; Leaf node, return a (list of) plain index entry.
(t (list (cons name marker))))))
(defun treesit-simple-imenu ()
"Return an Imenu index for the current buffer."
(let ((root (treesit-buffer-root-node)))
(mapcan (lambda (setting)
(pcase-let ((`(,category ,regexp ,pred ,name-fn)
setting))
(when-let* ((tree (treesit-induce-sparse-tree
root regexp))
(index (treesit--simple-imenu-1
tree pred name-fn)))
(if category
(list (cons category index))
index))))
treesit-simple-imenu-settings)))
;;; Activating tree-sitter
(defun treesit-ready-p (language &optional quiet)
@ -2097,6 +2186,11 @@ If `treesit-simple-indent-rules' is non-nil, setup indentation.
If `treesit-defun-type-regexp' is non-nil, setup
`beginning/end-of-defun' functions.
If `treesit-defun-name-function' is non-nil, setup
`add-log-current-defun'.
If `treesit-simple-imenu-settings' is non-nil, setup Imenu.
Make sure necessary parsers are created for the current buffer
before calling this function."
;; Font-lock.
@ -2138,7 +2232,13 @@ before calling this function."
(when treesit-defun-name-function
(setq-local add-log-current-defun-function
#'treesit-add-log-current-defun))
(setq-local transpose-sexps-function #'treesit-transpose-sexps))
(setq-local transpose-sexps-function #'treesit-transpose-sexps)
;; Imenu.
(when treesit-simple-imenu-settings
(setq-local imenu-create-index-function
#'treesit-simple-imenu)))
;;; Debugging

3
lisp/vc/diff-mode.el
View File

@ -272,8 +272,7 @@ and hunk-based syntax highlighting otherwise as a fallback."
(defcustom diff-minor-mode-prefix "\C-c="
"Prefix key for `diff-minor-mode' commands."
:type '(choice (string "ESC")
(string "\C-c=") string))
:type '(choice (string "\e") (string "\C-c=") string))
(defvar-keymap diff-minor-mode-map
:doc "Keymap for `diff-minor-mode'. See also `diff-mode-shared-map'."

30
nt/INSTALL.W64
View File

@ -31,13 +31,14 @@ build tools for MinGW-w64 -- see https://msys2.org/.
** Download and install MinGW-w64 and MSYS2
Go to https://msys2.org and follow the instructions. It is not
necessary to install the packages suggested on those instructions.
Go to https://msys2.org and follow the Installation instructions, up
to where they say to use 'pacman -S' to install packages. Instead,
install the necessary packages as instructed in the next section.
** Download and install the necessary packages
Run mingw64.exe in your MSYS2 directory and you will see a BASH window
opened.
open.
In the BASH prompt, use the following command to install the necessary
packages (you can copy and paste it into the shell with Shift + Insert):
@ -45,6 +46,8 @@ packages (you can copy and paste it into the shell with Shift + Insert):
pacman -S --needed base-devel \
mingw-w64-x86_64-toolchain \
mingw-w64-x86_64-xpm-nox \
mingw-w64-x86_64-gmp \
mingw-w64-x86_64-gnutls \
mingw-w64-x86_64-libtiff \
mingw-w64-x86_64-giflib \
mingw-w64-x86_64-libpng \
@ -54,16 +57,21 @@ packages (you can copy and paste it into the shell with Shift + Insert):
mingw-w64-x86_64-lcms2 \
mingw-w64-x86_64-jansson \
mingw-w64-x86_64-libxml2 \
mingw-w64-x86_64-gnutls \
mingw-w64-x86_64-zlib \
mingw-w64-x86_64-harfbuzz
mingw-w64-x86_64-harfbuzz \
mingw-w64-x86_64-libgccjit \
mingw-w64-x86_64-sqlite3 \
mingw-w64-x86_64-tree-sitter
The packages include the base developer tools (autoconf, grep, make, etc.),
the compiler toolchain (gcc, gdb, etc.), several image libraries, an XML
library, the GnuTLS (transport layer security) library, zlib for
decompressing text, and HarfBuzz for use as the shaping engine. Only the
first three packages are required (base-devel, toolchain, xpm-nox); the
rest are optional. You can select only part of the libraries if you don't
The packages include the base developer tools (autoconf, grep, make,
etc.), the compiler toolchain (gcc, gdb, etc.), several image
libraries, an XML library, the GnuTLS (transport layer security)
library, zlib for decompressing text, HarfBuzz for use as the shaping
engine, libgccjit for native-compilation support, SQLite3 for
accessing SQL databases, and the tree-sitter library used by some
major modes. Only the first four packages are required (base-devel,
toolchain, xpm-nox, GMP), and GnuTLS is highly recommended; the rest
are optional. You can select only part of the libraries if you don't
need them all.
You now have a complete build environment for Emacs.

2
src/indent.c
View File

@ -887,6 +887,8 @@ DEFUN ("indent-to", Findent_to, Sindent_to, 1, 2, "NIndent to column: ",
Optional second argument MINIMUM says always do at least MINIMUM spaces
even if that goes past COLUMN; by default, MINIMUM is zero.
Whether this uses tabs or spaces depends on `indent-tabs-mode'.
The return value is the column where the insertion ends. */)
(Lisp_Object column, Lisp_Object minimum)
{

79
src/json.c
View File

@ -555,6 +555,40 @@ json_parse_args (ptrdiff_t nargs,
}
}
static bool
json_available_p (void)
{
#ifdef WINDOWSNT
if (!json_initialized)
{
Lisp_Object status;
json_initialized = init_json_functions ();
status = json_initialized ? Qt : Qnil;
Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache);
}
return json_initialized;
#else /* !WINDOWSNT */
return true;
#endif
}
#ifdef WINDOWSNT
static void
ensure_json_available (void)
{
if (!json_available_p ())
Fsignal (Qjson_unavailable,
list1 (build_unibyte_string ("jansson library not found")));
}
#endif
DEFUN ("json--available-p", Fjson__available_p, Sjson__available_p, 0, 0, NULL,
doc: /* Return non-nil if libjansson is available (internal use only). */)
(void)
{
return json_available_p () ? Qt : Qnil;
}
DEFUN ("json-serialize", Fjson_serialize, Sjson_serialize, 1, MANY,
NULL,
doc: /* Return the JSON representation of OBJECT as a string.
@ -587,16 +621,7 @@ usage: (json-serialize OBJECT &rest ARGS) */)
specpdl_ref count = SPECPDL_INDEX ();
#ifdef WINDOWSNT
if (!json_initialized)
{
Lisp_Object status;
json_initialized = init_json_functions ();
status = json_initialized ? Qt : Qnil;
Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache);
}
if (!json_initialized)
Fsignal (Qjson_unavailable,
list1 (build_unibyte_string ("jansson library not found")));
ensure_json_available ();
#endif
struct json_configuration conf =
@ -696,16 +721,7 @@ usage: (json-insert OBJECT &rest ARGS) */)
specpdl_ref count = SPECPDL_INDEX ();
#ifdef WINDOWSNT
if (!json_initialized)
{
Lisp_Object status;
json_initialized = init_json_functions ();
status = json_initialized ? Qt : Qnil;
Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache);
}
if (!json_initialized)
Fsignal (Qjson_unavailable,
list1 (build_unibyte_string ("jansson library not found")));
ensure_json_available ();
#endif
struct json_configuration conf =
@ -953,16 +969,7 @@ usage: (json-parse-string STRING &rest ARGS) */)
specpdl_ref count = SPECPDL_INDEX ();
#ifdef WINDOWSNT
if (!json_initialized)
{
Lisp_Object status;
json_initialized = init_json_functions ();
status = json_initialized ? Qt : Qnil;
Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache);
}
if (!json_initialized)
Fsignal (Qjson_unavailable,
list1 (build_unibyte_string ("jansson library not found")));
ensure_json_available ();
#endif
Lisp_Object string = args[0];
@ -1050,16 +1057,7 @@ usage: (json-parse-buffer &rest args) */)
specpdl_ref count = SPECPDL_INDEX ();
#ifdef WINDOWSNT
if (!json_initialized)
{
Lisp_Object status;
json_initialized = init_json_functions ();
status = json_initialized ? Qt : Qnil;
Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache);
}
if (!json_initialized)
Fsignal (Qjson_unavailable,
list1 (build_unibyte_string ("jansson library not found")));
ensure_json_available ();
#endif
struct json_configuration conf =
@ -1137,6 +1135,7 @@ syms_of_json (void)
DEFSYM (Qplist, "plist");
DEFSYM (Qarray, "array");
defsubr (&Sjson__available_p);
defsubr (&Sjson_serialize);
defsubr (&Sjson_insert);
defsubr (&Sjson_parse_string);

59
src/treesit.c
View File

@ -2,6 +2,8 @@
Copyright (C) 2021-2022 Free Software Foundation, Inc.
Maintainer: Yuan Fu <casouri@gmail.com>
This file is part of GNU Emacs.
GNU Emacs is free software: you can redistribute it and/or modify
@ -2168,6 +2170,8 @@ See Info node `(elisp)Pattern Matching' for detailed explanation. */)
return build_pure_c_string ("#equal");
if (EQ (pattern, QCmatch))
return build_pure_c_string ("#match");
if (EQ (pattern, QCpred))
return build_pure_c_string ("#pred");
Lisp_Object opening_delimeter
= build_pure_c_string (VECTORP (pattern) ? "[" : "(");
Lisp_Object closing_delimiter
@ -2267,10 +2271,10 @@ treesit_predicates_for_pattern (TSQuery *query, uint32_t pattern_index)
return Fnreverse (result);
}
/* Translate a capture NAME (symbol) to the text of the captured node.
/* Translate a capture NAME (symbol) to a node.
Signals treesit-query-error if such node is not captured. */
static Lisp_Object
treesit_predicate_capture_name_to_text (Lisp_Object name,
treesit_predicate_capture_name_to_node (Lisp_Object name,
struct capture_range captures)
{
Lisp_Object node = Qnil;
@ -2290,6 +2294,16 @@ treesit_predicate_capture_name_to_text (Lisp_Object name,
name, build_pure_c_string ("A predicate can only refer"
" to captured nodes in the "
"same pattern"));
return node;
}
/* Translate a capture NAME (symbol) to the text of the captured node.
Signals treesit-query-error if such node is not captured. */
static Lisp_Object
treesit_predicate_capture_name_to_text (Lisp_Object name,
struct capture_range captures)
{
Lisp_Object node = treesit_predicate_capture_name_to_node (name, captures);
struct buffer *old_buffer = current_buffer;
set_buffer_internal (XBUFFER (XTS_PARSER (XTS_NODE (node)->parser)->buffer));
@ -2363,13 +2377,30 @@ treesit_predicate_match (Lisp_Object args, struct capture_range captures)
return false;
}
/* About predicates: I decide to hard-code predicates in C instead of
implementing an extensible system where predicates are translated
to Lisp functions, and new predicates can be added by extending a
list of functions, because I really couldn't imagine any useful
predicates besides equal and match. If we later found out that
such system is indeed useful and necessary, it can be easily
added. */
/* Handles predicate (#pred FN ARG...). Return true if FN returns
non-nil; return false otherwise. The arity of FN must match the
number of ARGs */
static bool
treesit_predicate_pred (Lisp_Object args, struct capture_range captures)
{
if (XFIXNUM (Flength (args)) < 2)
xsignal2 (Qtreesit_query_error,
build_pure_c_string ("Predicate `pred' requires "
"at least two arguments, "
"but was only given"),
Flength (args));
Lisp_Object fn = Fintern (XCAR (args), Qnil);
Lisp_Object nodes = Qnil;
Lisp_Object tail = XCDR (args);
FOR_EACH_TAIL (tail)
nodes = Fcons (treesit_predicate_capture_name_to_node (XCAR (tail),
captures),
nodes);
nodes = Fnreverse (nodes);
return !NILP (CALLN (Fapply, fn, nodes));
}
/* If all predicates in PREDICATES passes, return true; otherwise
return false. */
@ -2385,14 +2416,17 @@ treesit_eval_predicates (struct capture_range captures, Lisp_Object predicates)
Lisp_Object fn = XCAR (predicate);
Lisp_Object args = XCDR (predicate);
if (!NILP (Fstring_equal (fn, build_pure_c_string ("equal"))))
pass = treesit_predicate_equal (args, captures);
pass &= treesit_predicate_equal (args, captures);
else if (!NILP (Fstring_equal (fn, build_pure_c_string ("match"))))
pass = treesit_predicate_match (args, captures);
pass &= treesit_predicate_match (args, captures);
else if (!NILP (Fstring_equal (fn, build_pure_c_string ("pred"))))
pass &= treesit_predicate_pred (args, captures);
else
xsignal3 (Qtreesit_query_error,
build_pure_c_string ("Invalid predicate"),
fn, build_pure_c_string ("Currently Emacs only supports"
" equal and match predicate"));
" equal, match, and pred"
" predicate"));
}
/* If all predicates passed, add captures to result list. */
return pass;
@ -3215,6 +3249,7 @@ syms_of_treesit (void)
DEFSYM (QCanchor, ":anchor");
DEFSYM (QCequal, ":equal");
DEFSYM (QCmatch, ":match");
DEFSYM (QCpred, ":pred");
DEFSYM (Qnot_found, "not-found");
DEFSYM (Qsymbol_error, "symbol-error");

13
src/w32menu.c
View File

@ -1073,7 +1073,10 @@ is_simple_dialog (Lisp_Object contents)
if (NILP (Fstring_equal (name, other)))
return false;
/* Check there are no more options. */
/* Check there are no more options.
(FIXME: Since we use MB_YESNOCANCEL, we could also consider
dialogs with 3 options: Yes/No/Cancel as "simple". */
options = XCDR (options);
return !(CONSP (options));
}
@ -1085,7 +1088,13 @@ simple_dialog_show (struct frame *f, Lisp_Object contents, Lisp_Object header)
UINT type;
Lisp_Object lispy_answer = Qnil, temp = XCAR (contents);
type = MB_YESNO;
/* We use MB_YESNOCANCEL to allow the user the equivalent of C-g
when the Yes/No question is asked vya y-or-n-p or
yes-or-no-p. */
if (w32_yes_no_dialog_show_cancel)
type = MB_YESNOCANCEL;
else
type = MB_YESNO;
/* Since we only handle Yes/No dialogs, and we already checked
is_simple_dialog, we don't need to worry about checking contents

11
src/w32term.c
View File

@ -7696,6 +7696,7 @@ static void
w32_initialize (void)
{
HANDLE shell;
BOOL caret;
HRESULT (WINAPI * set_user_model) (const wchar_t * id);
baud_rate = 19200;
@ -7732,8 +7733,9 @@ w32_initialize (void)
/* Initialize w32_use_visible_system_caret based on whether a screen
reader is in use. */
if (!SystemParametersInfo (SPI_GETSCREENREADER, 0,
&w32_use_visible_system_caret, 0))
if (SystemParametersInfo (SPI_GETSCREENREADER, 0, &caret, 0))
w32_use_visible_system_caret = caret == TRUE;
else
w32_use_visible_system_caret = 0;
any_help_event_p = 0;
@ -7923,6 +7925,11 @@ unconditionally set to nil on older systems. */);
w32_use_native_image_api = 0;
#endif
DEFVAR_BOOL ("w32-yes-no-dialog-show-cancel",
w32_yes_no_dialog_show_cancel,
doc: /* If non-nil, show Cancel button in MS-Windows GUI Yes/No dialogs. */);
w32_yes_no_dialog_show_cancel = 1;
/* FIXME: The following variable will be (hopefully) removed
before Emacs 25.1 gets released. */

8
src/xdisp.c
View File

@ -14271,12 +14271,14 @@ redisplay_tab_bar (struct frame *f)
frame_default_tab_bar_height = new_height;
}
/* If new_height or new_nrows indicate that we need to enlarge the
tab-bar window, we can return right away. */
/* If new_height or new_nrows indicate that we need to enlarge or
shrink the tab-bar window, we can return right away. */
if (new_nrows > f->n_tab_bar_rows
|| (EQ (Vauto_resize_tab_bars, Qgrow_only)
&& !f->minimize_tab_bar_window_p
&& new_height > WINDOW_PIXEL_HEIGHT (w)))
&& new_height > WINDOW_PIXEL_HEIGHT (w))
|| (! EQ (Vauto_resize_tab_bars, Qgrow_only)
&& new_height < WINDOW_PIXEL_HEIGHT (w)))
{
if (FRAME_TERMINAL (f)->change_tab_bar_height_hook)
FRAME_TERMINAL (f)->change_tab_bar_height_hook (f, new_height);

54
test/lisp/erc/erc-scenarios-base-unstable.el
View File

@ -24,7 +24,7 @@
(let ((load-path (cons (ert-resource-directory) load-path)))
(require 'erc-scenarios-common)))
(eval-when-compile (require 'erc-join))
(eval-when-compile (require 'erc-join) (require 'warnings))
;; Not unstable, but stashed here for now
@ -132,4 +132,56 @@
(not (setq failed (zerop (cl-decf tries)))))))
(should-not failed)))
;; The `erc-networks' library has slowly become a hard dependency of
;; the interactive client since its incorporation in 2006. But its
;; module, which was added in ERC 5.3 (2008) and thereafter loaded by
;; default, only became quasi-required in ERC 5.5 (2022). Despite
;; this, a basic connection should still always succeed, at least long
;; enough to warn users that their setup is abnormal. Of course,
;; third-party code intentionally omitting the module will have to
;; override various erc-server-*-functions to avoid operating in a
;; degraded state, which has likely been the case for a while.
(ert-deftest erc-scenarios-networks-no-module ()
:tags '(:expensive-test)
(erc-scenarios-common-with-cleanup
((erc-scenarios-common-dialog "networks/no-module")
(erc-server-flood-penalty 0.1)
(erc-networks-mode-orig erc-networks-mode)
(dumb-server (erc-d-run "localhost" t 'basic))
(port (process-contact dumb-server :service))
(erc-modules (remq 'networks erc-modules))
(warning-suppress-log-types '((erc)))
(expect (erc-d-t-make-expecter)))
(erc-networks-mode -1)
(ert-info ("Connect and retain dialed name")
(with-current-buffer (erc :server "127.0.0.1"
:port port
:nick "tester"
:user "tester"
:full-name "tester")
(funcall expect 10 "Required module `networks' not loaded")
(funcall expect 10 "This server is in debug mode")
;; Buffer not named after network
(should (string= (buffer-name) (format "127.0.0.1:%d" port)))
(erc-cmd-JOIN "#chan")))
(ert-info ("Join #chan, change nick, query op")
(with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
(funcall expect 20 "Even at thy teat thou")
(erc-cmd-NICK "dummy")
(funcall expect 10 "Your new nickname is dummy")
(erc-scenarios-common-say "/msg alice hi")))
(ert-info ("Switch to query and quit")
(with-current-buffer (erc-d-t-wait-for 10 (get-buffer "alice"))
(funcall expect 20 "bye"))
(with-current-buffer (format "127.0.0.1:%d" port)
(erc-cmd-QUIT "")
(funcall expect 10 "finished")))
(when erc-networks-mode-orig
(erc-networks-mode +1))))
;;; erc-scenarios-base-unstable.el ends here

44
test/lisp/erc/resources/networks/no-module/basic.eld Normal file
View File

@ -0,0 +1,44 @@
;; -*- mode: lisp-data; -*-
((nick 10 "NICK tester"))
((user 1 "USER tester 0 * :tester")
(0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
(0.00 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.8.0")
(0.00 ":irc.foonet.org 003 tester :This server was created Mon, 12 Dec 2022 01:25:38 UTC")
(0.00 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.8.0 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
(0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server")
(0.00 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
(0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server")
(0.00 ":irc.foonet.org 251 tester :There are 0 users and 4 invisible on 1 server(s)")
(0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online")
(0.00 ":irc.foonet.org 253 tester 0 :unregistered connections")
(0.00 ":irc.foonet.org 254 tester 1 :channels formed")
(0.00 ":irc.foonet.org 255 tester :I have 4 clients and 0 servers")
(0.00 ":irc.foonet.org 265 tester 4 4 :Current local users 4, max 4")
(0.01 ":irc.foonet.org 266 tester 4 4 :Current global users 4, max 4")
(0.00 ":irc.foonet.org 422 tester :MOTD File is missing"))
((mode 10 "MODE tester +i")
(0.00 ":irc.foonet.org 221 tester +i")
(0.00 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect."))
((join 10 "JOIN #chan")
(0.03 ":tester!~u@z5d6jyn8pwxge.irc JOIN #chan"))
((~nick 10 "NICK dummy")
(0.01 ":tester!~u@z5d6jyn8pwxge.irc NICK dummy"))
((mode-1 10 "MODE #chan")
(0.01 ":irc.foonet.org 353 tester = #chan :@alice bob foonet tester")
(0.00 ":irc.foonet.org 366 tester #chan :End of NAMES list")
(0.03 ":irc.foonet.org 324 tester #chan +nt")
(0.00 ":irc.foonet.org 329 tester #chan 1670808354")
(0.00 ":bob!~u@d6ftaiqzk8x2k.irc PRIVMSG #chan :tester, welcome!")
(0.00 ":alice!~u@d6ftaiqzk8x2k.irc PRIVMSG #chan :tester, welcome!")
(0.03 ":bob!~u@d6ftaiqzk8x2k.irc PRIVMSG #chan :alice: Forbear it therefore; give your cause to heaven.")
(0.01 ":alice!~u@d6ftaiqzk8x2k.irc PRIVMSG #chan :bob: Even at thy teat thou hadst thy tyranny."))
((privmsg 10 "PRIVMSG alice :hi")
(0.00 ":alice!~u@d6ftaiqzk8x2k.irc PRIVMSG dummy :bye"))
((quit 10 "QUIT :\2ERC\2")
(0.03 ":dummy!~u@z5d6jyn8pwxge.irc QUIT :Quit: \2ERC\2"))

121
test/src/treesit-tests.el
View File

@ -252,9 +252,7 @@ BODY is the test body."
(setq parser (treesit-parser-create 'json))
(setq root (treesit-parser-root-node
parser))
(setq array (treesit-node-child root 0))
;; First bracket.
(setq cursor (treesit-node-child array 0)))
(setq array (treesit-node-child root 0)))
,@body)))
(ert-deftest treesit-search-forward ()
@ -335,6 +333,9 @@ BODY is the test body."
;;; Query
(defun treesit--ert-pred-last-sibling (node)
(null (treesit-node-next-sibling node t)))
(ert-deftest treesit-query-api ()
"Tests for query API."
(skip-unless (treesit-language-available-p 'json))
@ -357,13 +358,16 @@ BODY is the test body."
(pair key: (_) @keyword)
((_) @bob (#match \"^B.b$\" @bob))
(number) @number
((number) @n3 (#equal \"3\" @n3)) "
((number) @n3 (#equal \"3\" @n3))
((number) @n3p (#pred treesit--ert-pred-last-sibling @n3p))"
;; Sexp query.
((string) @string
(pair key: (_) @keyword)
((_) @bob (:match "^B.b$" @bob))
(number) @number
((number) @n3 (:equal "3" @n3)))))
((number) @n3 (:equal "3" @n3))
((number) @n3p (:pred treesit--ert-pred-last-sibling
@n3p)))))
;; Test `treesit-query-compile'.
(dolist (query (list query1
(treesit-query-compile 'json query1)))
@ -375,7 +379,8 @@ BODY is the test body."
(string . "\"Bob\"")
(bob . "Bob")
(number . "3")
(n3 . "3"))
(n3 . "3")
(n3p . "3"))
(mapcar (lambda (entry)
(cons (car entry)
(treesit-node-text
@ -831,36 +836,40 @@ OPENING and CLOSING are the same as in
and \"]\"."
(with-temp-buffer
(funcall init)
(let* ((opening (or opening "["))
(closing (or closing "]"))
;; Insert program and parse marker positions.
(marker-alist (treesit--ert-insert-and-parse-marker
opening closing program))
;; Translate marker positions into buffer positions.
(decoded-master
(cl-loop for record in master
collect
(cl-loop for pos in record
collect (alist-get pos marker-alist))))
;; Collect positions each function returns.
(positions
(treesit--ert-collect-positions
;; The first column of DECODED-MASTER.
(mapcar #'car decoded-master)
;; Four functions: next-end, prev-beg, next-beg, prev-end.
(mapcar (lambda (conf)
(lambda ()
(if-let ((pos (funcall
#'treesit--navigate-defun
(point) (car conf) (cdr conf))))
(save-excursion
(goto-char pos)
(funcall treesit-defun-skipper)
(point)))))
'((-1 . beg)
(1 . end)
(-1 . end)
(1 . beg))))))
(pcase-let*
((opening (or opening "["))
(closing (or closing "]"))
;; Insert program and parse marker positions.
(marker-alist (treesit--ert-insert-and-parse-marker
opening closing program))
;; Translate marker positions into buffer positions.
(decoded-master
(cl-loop for record in master
collect
(cl-loop for pos in record
collect (alist-get pos marker-alist))))
(`(,regexp . ,pred) (treesit--thing-unpack-pattern
treesit-defun-type-regexp))
;; Collect positions each function returns.
(positions
(treesit--ert-collect-positions
;; The first column of DECODED-MASTER.
(mapcar #'car decoded-master)
;; Four functions: next-end, prev-beg, next-beg, prev-end.
(mapcar (lambda (conf)
(lambda ()
(if-let ((pos (funcall
#'treesit--navigate-thing
(point) (car conf) (cdr conf)
regexp pred)))
(save-excursion
(goto-char pos)
(funcall treesit-defun-skipper)
(point)))))
'((-1 . beg)
(1 . end)
(-1 . end)
(1 . beg))))))
;; Verify each position.
(cl-loop for record in decoded-master
for orig-record in master
@ -931,7 +940,28 @@ and \"]\"."
[999]}
[110]
"
"Javascript source for navigation test.")
"Bash source for navigation test.")
(defvar treesit--ert-defun-navigation-elixir-program
"[100]
[101]def bar() do
[999]end
[102]
[103]defmodule Example do[0]
[999] @impl true
[104] [1]def bar() do[2]
[999] end[3]
[105] [4]
[106] [5]def baz() do[6]
[999] end[7]
[107] [8]
[999]end[9]
[108]
[109]def bar() do
[999]end
[110]
"
"Elixir source for navigation test.")
(defvar treesit--ert-defun-navigation-nested-master
;; START PREV-BEG NEXT-END PREV-END NEXT-BEG
@ -1013,6 +1043,23 @@ the prev-beg, now point should be at marker 103\", etc.")
treesit--ert-defun-navigation-bash-program
treesit--ert-defun-navigation-nested-master)))
(ert-deftest treesit-defun-navigation-nested-4 ()
"Test defun navigation using Elixir.
This tests bug#60355."
(skip-unless (treesit-language-available-p 'elixir))
;; Nested defun navigation
(let ((treesit-defun-tactic 'nested)
(pred (lambda (node)
(member (treesit-node-text
(treesit-node-child-by-field-name node "target"))
'("def" "defmodule")))))
(treesit--ert-test-defun-navigation
(lambda ()
(treesit-parser-create 'elixir)
(setq-local treesit-defun-type-regexp `("call" . ,pred)))
treesit--ert-defun-navigation-elixir-program
treesit--ert-defun-navigation-nested-master)))
(ert-deftest treesit-defun-navigation-top-level ()
"Test top-level only defun navigation."
(skip-unless (treesit-language-available-p 'python))