diff options
50 files changed, 947 insertions, 815 deletions
diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index cf4f0414523..ce2dd0a78bc 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -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 diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 736c2d6841f..de17969566d 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -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} diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index 6baa253cfdf..b7199f071bc 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -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 diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 2ab2e908940..249b58c73d8 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -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} diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 76439f1d068..b577047ebcb 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -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 diff --git a/etc/NEWS.29 b/etc/NEWS.29 index 5b804b82b7f..d2e11e5adf4 100644 --- a/etc/NEWS.29 +++ b/etc/NEWS.29 @@ -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 @@ -1875,6 +1875,12 @@ 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 'completion-auto-select' to t, then pressing 'TAB' will switch to the @@ -1933,12 +1939,6 @@ 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 'minibuffer-inactive-mode-abbrev-table' are now defined. @@ -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 --- diff --git a/etc/package-keyring.gpg b/etc/package-keyring.gpg Binary files differindex 490dee41a92..563acbb16b6 100644 --- a/etc/package-keyring.gpg +++ b/etc/package-keyring.gpg diff --git a/lisp/elide-head.el b/lisp/elide-head.el index 71e7e67e3f7..8a95082c15f 100644 --- a/lisp/elide-head.el +++ b/lisp/elide-head.el @@ -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 diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 2dd04174f54..460d8eca586 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -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 diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index b01f87d0494..a9fbdfea210 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -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))) diff --git a/lisp/epa-ks.el b/lisp/epa-ks.el index bb64b61b8fa..668cdf9a618 100644 --- a/lisp/epa-ks.el +++ b/lisp/epa-ks.el @@ -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) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 43c5faad638..6820bf0d1a3 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -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 diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index fdcb146d42a..864c5882cf2 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -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))) diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index 2e2d0930118..f05a98be16d 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el @@ -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. diff --git a/lisp/erc/erc-sasl.el b/lisp/erc/erc-sasl.el index 78d02a46381..23110d74b5e 100644 --- a/lisp/erc/erc-sasl.el +++ b/lisp/erc/erc-sasl.el @@ -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))) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 6a5e0018964..16a0aba77b1 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -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))))) diff --git a/lisp/files.el b/lisp/files.el index 0fb080b53c0..e729c007821 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -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) diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 2dfbe3ad232..831e603239b 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -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") diff --git a/lisp/help.el b/lisp/help.el index b709062cb27..d7fd4d555ea 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -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)" diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index df4c6ab079c..32bf0bf4d44 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -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 diff --git a/lisp/indent.el b/lisp/indent.el index c7ec5c9a3ed..6b575a86b5e 100644 --- a/lisp/indent.el +++ b/lisp/indent.el @@ -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)) diff --git a/lisp/isearch.el b/lisp/isearch.el index 6a17d18c45e..ba67cce841a 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -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)) diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el index 6e3845aec1a..9f14df08a79 100644 --- a/lisp/net/gnutls.el +++ b/lisp/net/gnutls.el @@ -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) diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 161e01d4411..73e488a8058 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -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) diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el index dd2d877c969..33a5f7046f1 100644 --- a/lisp/progmodes/csharp-mode.el +++ b/lisp/progmodes/csharp-mode.el @@ -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) diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index b6f747cf1cc..215b5c16388 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -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) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 229bd53e1ed..653038a09e3 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -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 diff --git a/lisp/progmodes/json-ts-mode.el b/lisp/progmodes/json-ts-mode.el index 6725c5f2270..adba2f820fa 100644 --- a/lisp/progmodes/json-ts-mode.el +++ b/lisp/progmodes/json-ts-mode.el @@ -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)) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 0cd0c6c225a..07f86d31551 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -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) diff --git a/lisp/progmodes/rust-ts-mode.el b/lisp/progmodes/rust-ts-mode.el index 81f5b8765f1..d03dffe628e 100644 --- a/lisp/progmodes/rust-ts-mode.el +++ b/lisp/progmodes/rust-ts-mode.el @@ -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 diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el index 8454f24356a..f45d7992524 100644 --- a/lisp/progmodes/scheme.el +++ b/lisp/progmodes/scheme.el @@ -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")) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 3f995d17b5a..d12ade36af3 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -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") diff --git a/lisp/progmodes/typescript-ts-mode.el b/lisp/progmodes/typescript-ts-mode.el index 6ba1b9b12c0..05ddc0e7a94 100644 --- a/lisp/progmodes/typescript-ts-mode.el +++ b/lisp/progmodes/typescript-ts-mode.el @@ -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) - - ;; Which-func (use imenu). - (setq-local which-func-functions nil)) + (setq-local treesit-defun-name-function #'js--treesit-defun-name) + + ;; 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" diff --git a/lisp/repeat.el b/lisp/repeat.el index 3b3a444ee24..e382239fc86 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -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" diff --git a/lisp/subr.el b/lisp/subr.el index fff4c88ccf2..d24169276a5 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -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. diff --git a/lisp/tab-line.el b/lisp/tab-line.el index c4e4a688720..30612728bde 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -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. diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 99ef4f10a06..204331ec72f 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -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 diff --git a/lisp/textmodes/toml-ts-mode.el b/lisp/textmodes/toml-ts-mode.el index 790de2133e8..cbdc758d4b3 100644 --- a/lisp/textmodes/toml-ts-mode.el +++ b/lisp/textmodes/toml-ts-mode.el @@ -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))) diff --git a/lisp/treesit.el b/lisp/treesit.el index 203a724fe7a..f8c87c35aac 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -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 diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 357ce001b3c..b80337eb742 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -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'." diff --git a/nt/INSTALL.W64 b/nt/INSTALL.W64 index b543034e479..0e5e62117d2 100644 --- a/nt/INSTALL.W64 +++ b/nt/INSTALL.W64 @@ -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 - -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 + 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, 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. diff --git a/src/indent.c b/src/indent.c index 4671ccccf90..66edaff67de 100644 --- a/src/indent.c +++ b/src/indent.c @@ -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) { diff --git a/src/json.c b/src/json.c index cdcc11358e6..621c7d7c15f 100644 --- a/src/json.c +++ b/src/json.c @@ -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); diff --git a/src/treesit.c b/src/treesit.c index ce8a2804439..813d4222f98 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -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"); diff --git a/src/w32menu.c b/src/w32menu.c index b10239d5cc6..5f06f4c4170 100644 --- a/src/w32menu.c +++ b/src/w32menu.c @@ -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 diff --git a/src/w32term.c b/src/w32term.c index dff21489e5b..e40e4588fde 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -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. */ diff --git a/src/xdisp.c b/src/xdisp.c index 8a32ce66235..db6dd3fab63 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -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); diff --git a/test/lisp/erc/erc-scenarios-base-unstable.el b/test/lisp/erc/erc-scenarios-base-unstable.el index f5b8df6f4a1..e6db40c5efb 100644 --- a/test/lisp/erc/erc-scenarios-base-unstable.el +++ b/test/lisp/erc/erc-scenarios-base-unstable.el @@ -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 diff --git a/test/lisp/erc/resources/networks/no-module/basic.eld b/test/lisp/erc/resources/networks/no-module/basic.eld new file mode 100644 index 00000000000..f1bdbd1219f --- /dev/null +++ b/test/lisp/erc/resources/networks/no-module/basic.eld @@ -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")) diff --git a/test/src/treesit-tests.el b/test/src/treesit-tests.el index 48b61cf3dc3..f7f0c96efa9 100644 --- a/test/src/treesit-tests.el +++ b/test/src/treesit-tests.el @@ -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)) |