commit 4efe3b99a5d0d72b6a96bf339601f9390ca5c03a (HEAD, refs/remotes/origin/master) Author: Yuan Fu Date: Sun Apr 7 15:59:48 2024 -0700 Document tree-sitter things feature (bug#70016) (bug#68824) * doc/lispref/parsing.texi (Retrieving Nodes): Mention new kinds of predicate argument that the tree-traversing functions accept (which are thing symbols and thing definitions). (User-defined Things): New node dedicated to thing definition and navigation functions. diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index 3d2192ace64..4fa5fb3d7ee 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -743,12 +743,17 @@ is non-@code{nil}, it looks for the smallest named child. @heading Searching for node @defun treesit-search-subtree node predicate &optional backward all depth -This function traverses the subtree of @var{node} (including -@var{node} itself), looking for a node for which @var{predicate} -returns non-@code{nil}. @var{predicate} is a regexp that is matched -against each node's type, or a predicate function that takes a node -and returns non-@code{nil} if the node matches. The function returns -the first node that matches, or @code{nil} if none does. +This function traverses the subtree of @var{node} (including @var{node} +itself), looking for a node for which @var{predicate} returns +non-@code{nil}. @var{predicate} is a regexp that is matched against +each node's type, or a predicate function that takes a node and returns +non-@code{nil} if the node matches. @var{predicate} can also be a thing +symbol or thing definition (@pxref{User-defined Things}). Using an +undefined thing doesn't raise an error, the function simply returns +@code{nil}. + +This function returns the first node that matches, or @code{nil} if node +matches @var{predicate}. By default, this function only traverses named nodes, but if @var{all} is non-@code{nil}, it traverses all the nodes. If @var{backward} is @@ -762,9 +767,13 @@ defaults to 1000. @defun treesit-search-forward start predicate &optional backward all Like @code{treesit-search-subtree}, this function also traverses the parse tree and matches each node with @var{predicate} (except for -@var{start}), where @var{predicate} can be a regexp or a function. -For a tree like the one below where @var{start} is marked @samp{S}, -this function traverses as numbered from 1 to 12: +@var{start}), where @var{predicate} can be a regexp or a predicate +function. @var{predicate} can also be a thing symbol or thing +definition (@pxref{User-defined Things}). Using an undefined thing +doesn't raise an error, the function simply returns @code{nil}. + +For a tree like the one below where @var{start} is marked @samp{S}, this +function traverses as numbered from 1 to 12: @example @group @@ -818,9 +827,11 @@ This function creates a sparse tree from @var{root}'s subtree. It takes the subtree under @var{root}, and combs it so only the nodes that match @var{predicate} are left. Like previous functions, the -@var{predicate} can be a regexp string that matches against each -node's type, or a function that takes a node and returns -non-@code{nil} if it matches. +@var{predicate} can be a regexp string that matches against each node's +type, or a function that takes a node and returns non-@code{nil} if it +matches. @var{predicate} can also be a thing symbol or thing definition +(@pxref{User-defined Things}). Using an undefined thing doesn't raise +an error, the function simply returns @code{nil}. For example, given the subtree on the left that consists of both numbers and letters, if @var{predicate} is ``letter only'', the @@ -1508,6 +1519,149 @@ For more details, read the tree-sitter project's documentation about pattern-matching, which can be found at @uref{https://tree-sitter.github.io/tree-sitter/using-parsers#pattern-matching-with-queries}. +@node User-defined Things +@section User-defined ``Things'' and Navigation +It's often useful to be able to identify and find certain ``things'' in +a buffer, like function and class definitions, statements, code blocks, +strings, comments, etc. Emacs allows users to define what kind of +tree-sitter node are what ``thing''. This enables handy features like +jumping to the next function, marking the code block at point, or +transposing two function arguments. + +The ``things'' feature in Emacs is independent of the pattern matching +feature of tree-sitter, comparatively less powerful, but more suitable +for navigation and traversing the parse tree. + +Users can define things with @var{treesit-thing-settings}. + +@defvar treesit-thing-settings +This is an alist of thing definitions for each language. The key of +each entry is a language symbol, and the value is a list of thing +definitions of the form @w{@code{(@var{thing} @var{pred})}}. + +@var{thing} is a symbol representing the thing, like @code{defun}, +@code{sexp}, or @code{sentence}; @var{pred} specifies what kind of +tree-sitter node is the @var{thing}. + +@var{pred} can be a regexp string that matches the type of the node; it +can be a function that takes a node as the argument and returns a +boolean that indicates whether the node qualifies as the thing; it can +be a cons @w{@code{(@var{regexp} . @var{fn})}}, which is a combination +of a regexp and a function---the node has to match both to qualify as the +thing. + +@var{pred} can also be recursively defined. It can be @w{@code{(or +@var{pred}...)}}, meaning satisfying any one of the @var{pred}s +qualifies the node as the thing. It can be @w{@code{(not @var{pred})}}, +meaning not satisfying @var{pred} qualifies the node. + +Finally, @var{pred} can refer to other @var{thing}s defined in this +list. For example, @w{@code{(or sexp sentence)}} defines something +that's either a @code{sexp} or a @code{sentence}. + +Here's an example @var{treesit-thing-settings} for C and C++: + +@example +@group +((c + (defun "function_definition") + (sexp (not "[](),[@{@}]")) + (comment "comment") + (string "raw_string_literal") + (text (or comment string))) + (cpp + (defun ("function_definition" . cpp-ts-mode-defun-valid-p)) + (defclass "class_specifier") + (comment "comment"))) +@end group +@end example + +Note that this example is modified for demonstration and isn't exactly +how C and C++ mode define things. +@end defvar + +The next section lists a few functions that take advantage of the thing +definitions. Besides these functions, some other functions listed +elsewhere also utilizes the thing feature, e.g., tree-traversing +functions like @code{treesit-search-forward}, +@code{treesit-induce-sparse-tree}, etc. + +@defun treesit-thing-prev pos thing +This function returns the first node before @var{pos} that's a +@var{thing}. If no such node exists, it returns @code{nil}. It's +guaranteed that, if a node is returned, the node's end position is less +or equal to @var{pos}. In other words, this function never return a +node that encloses @var{pos}. + +@var{thing} can be either a thing symbol like @code{defun}, or simply a +thing definition like @code{"function_definition"}. +@end defun + +@defun treesit-thing-next pos thing +This function is similar to @code{treesit-thing-prev}, only that it +returns the first node @emph{after} @var{pos} that's a @var{thing}. And +it guarantees that if a node is returned, the node's start position is +be greater or equal to @var{pos}. +@end defun + +@defun treesit-navigate-thing pos arg side thing &optional tactic +This function builds upon @code{treesit-thing-prev} and +@code{treesit-thing-next} and provides functionality that a navigation +command would find useful. + +It returns the position after navigating @var{arg} steps from @var{pos}, +without actually moving point. If there aren't enough things to +navigate across, it returns nil. + +A positive @var{arg} means moving forward that many steps; negative +means moving backward. If @var{side} is @code{beg}, this function stops +at the beginning of the thing; if @code{end}, stop at the end. + +Like in @code{treesit-thing-prev}, @var{thing} can be a thing symbol +defined in @var{treesit-thing-settings}, or a thing definition. + +@var{tactic} determines how does this function move between things. +@var{tactic} can be @code{nested}, @code{top-level}, @code{restricted}, +or @code{nil}. @code{nested} or @code{nil} means normal nested +navigation: first try to move across siblings; if there aren't any +siblings left in the current level, move to the parent, then it's +siblings, and so on. @code{top-level} means only navigate across +top-level things and ignore nested things. @code{restricted} means +movement is restricted within the thing that encloses @var{pos}, if +there is one such thing. This tactic is useful for the commands that +want to stop at the current nest level and not move up. +@end defun + +@defun treesit-thing-at pos thing &optional strict +This function returns the smallest node that's a @var{thing} and +encloses @var{pos}; if there's no such node, return nil. + +The returned node must enclose @var{pos}, i.e., its start position is +less or equal to @var{pos}, and it's end position is greater or equal to +@var{pos}. + +If @var{strict} is non-@code{nil}, this function uses strict comparison, +i.e., start position must be strictly greater than @var{pos}, and end +position must be strictly less than @var{pos}. + +@var{thing} can be either a thing symbol defined in +@var{treesit-thing-settings}, or a thing definition. +@end defun + +@findex treesit-beginning-of-thing +@findex treesit-end-of-thing +@findex treesit-thing-at-point +There are also some convenient wrapper functions. +@code{treesit-beginning-of-thing} moves point to the beginning of a +thing, @code{treesit-beginning-of-thing} to the end of a thing. +@code{treesit-thing-at-point} returns the thing at point. + +There are defun commands that specifically use the @code{defun} +definition, like @code{treesit-beginning-of-defun}, +@code{treesit-end-of-defun}, and @code{treesit-defun-at-point}. In +addition, these functions use @var{treesit-defun-tactic} as the +navigation tactic. They are described in more detail in other sections. + @node Multiple Languages @section Parsing Text in Multiple Languages @cindex multiple languages, parsing with tree-sitter diff --git a/etc/NEWS b/etc/NEWS index d4bba66e4aa..b2543ae77d9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2380,6 +2380,35 @@ objects is still necessary. ** The JSON encoder and decoder now accept arbitarily large integers. Previously, they were limited to the range of signed 64-bit integers. +** New tree-sitter functions and variables for defining and using "things" + ++++ +*** New variable 'treesit-thing-settings'. + +New variable that allows users to define "things" like 'defun', 'text', +'sexp', for navigation commands and tree-traversal functions. + ++++ +*** New navigation functions 'treesit-thing-prev', 'treesit-thing-next', 'treesit-navigate-thing', 'treesit-beginning-of-thing', 'treesit-end-of-thing'. + ++++ +*** New functions 'treesit-thing-at', 'treesit-thing-at-point'. + ++++ +*** Tree-tarversing functions 'treesit-search-subtree', 'treesit-search-forward', 'treesit-search-forward-goto', 'treesit-induce-sparse-tree' now accepts more kinds of predicates. + +Now users can use thing symbols (defined in 'treesit-thing-settings'), +and any thing definitions for the predicate argument. + +** Other tree-sitter function and variable changes + ++++ +*** 'treesit-parser-list' now takes additional optional arguments, LANGUAGE and TAG. + +If LANGUAGE is given, only return parsers for that language. If TAG is +given, only return parsers with that tag. Note that passing nil as tag +doesn't mean return all parsers, but rather "all parsers with no tags". + * Changes in Emacs 30.1 on Non-Free Operating Systems commit 64854869ae0cacddb16926670e2a67c03a3f9618 Author: Yuan Fu Date: Sun Apr 7 13:33:31 2024 -0700 Make tree-sitter thing feature public and remove obsolete functions * lisp/treesit.el (treesit--things-around): Remove function. (treesit-forward-sexp): (treesit-beginning-of-thing): (treesit-end-of-thing): (treesit-navigate-thing): (treesit-thing-at-point): (treesit-outline-search): Use public version of thing-functions. (treesit--thing-prev): (treesit--thing-next): (treesit--thing-at): (treesit--navigate-thing): Make public. * test/src/treesit-tests.el (treesit--ert-test-defun-navigation): Use public version of thing-functions. diff --git a/lisp/treesit.el b/lisp/treesit.el index 2b4893e6129..1443162f79c 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2152,7 +2152,7 @@ return nil without moving point." ;; the obstacle, like `forward-sexp' does. If we couldn't ;; find a parent, we simply return nil without moving point, ;; then functions like `up-list' will signal "at top level". - (when-let* ((parent (treesit--thing-at (point) pred t)) + (when-let* ((parent (treesit-thing-at (point) pred t)) (boundary (if (> arg 0) (treesit-node-child parent -1) (treesit-node-child parent 0)))) @@ -2206,18 +2206,14 @@ friends." ;; - treesit-thing/defun-at-point ;; ;; And more generic functions like: -;; - treesit--thing-prev/next -;; - treesit--thing-at -;; - treesit--top-level-thing -;; - treesit--navigate-thing +;; - treesit-thing-prev/next +;; - treesit-thing-at +;; - treesit-top-level-thing +;; - treesit-navigate-thing ;; ;; There are also some defun-specific functions, like ;; treesit-defun-name, treesit-add-log-current-defun. ;; -;; TODO: I'm not entirely sure how would this go, so I only documented -;; the "defun" functions and didn't document any "thing" functions. -;; We should also document `treesit-thing-settings'. - ;; TODO: Integration with thing-at-point: once our thing interface is ;; stable. ;; @@ -2295,7 +2291,7 @@ should there be one. If omitted, TACTIC is considered to be Return non-nil if successfully moved, nil otherwise." (pcase-let* ((arg (or arg 1)) - (dest (treesit--navigate-thing + (dest (treesit-navigate-thing (point) (- arg) 'beg thing tactic))) (when dest (goto-char dest)))) @@ -2318,7 +2314,7 @@ should there be one. If omitted, TACTIC is considered to be Return non-nil if successfully moved, nil otherwise." (pcase-let* ((arg (or arg 1)) - (dest (treesit--navigate-thing + (dest (treesit-navigate-thing (point) arg 'end thing tactic))) (when dest (goto-char dest)))) @@ -2451,68 +2447,6 @@ the current line if the beginning of the defun is indented." (line-beginning-position)) (beginning-of-line)))) -(make-obsolete 'treesit--things-around - "`treesit--things-around' will be removed soon, use `treesit--thing-prev', `treesit--thing-next', `treesit--thing-at' instead." "30.1") -(defun treesit--things-around (pos thing) - "Return the previous, next, and parent thing around POS. - -Return a list of (PREV NEXT PARENT), where PREV and NEXT are -previous and next sibling things around POS, and PARENT is the -parent thing surrounding POS. All of three could be nil if no -sound things exists. - -THING should be a thing defined in `treesit-thing-settings', -which see; it can also be a predicate." - (let* ((node (treesit-node-at pos)) - (result (list nil nil nil))) - ;; 1. Find previous and next sibling defuns. - (cl-loop - for idx from 0 to 1 - 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))) - ;; 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 (treesit-node-match-p node thing t) - (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 thing backward backward))))) - ;; 2. Find the parent defun. - (let ((cursor (or (nth 0 result) (nth 1 result) node)) - (iter-pred (lambda (node) - (and (treesit-node-match-p node thing t) - (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--thing-sibling (pos thing prev) "Return the next or previous THING at POS. @@ -2546,7 +2480,7 @@ in `treesit-thing-settings'." (setq cursor (treesit-search-forward cursor thing prev prev))) sibling))) -(defun treesit--thing-prev (pos thing) +(defun treesit-thing-prev (pos thing) "Return the previous THING at POS. The returned node, if non-nil, must be before POS, i.e., its end @@ -2556,7 +2490,7 @@ THING should be a thing defined in `treesit-thing-settings', or a predicate as described in `treesit-thing-settings'." (treesit--thing-sibling pos thing t)) -(defun treesit--thing-next (pos thing) +(defun treesit-thing-next (pos thing) "Return the next THING at POS. The returned node, if non-nil, must be after POS, i.e., its @@ -2566,7 +2500,7 @@ THING should be a thing defined in `treesit-thing-settings', or a predicate as described in `treesit-thing-settings'." (treesit--thing-sibling pos thing nil)) -(defun treesit--thing-at (pos thing &optional strict) +(defun treesit-thing-at (pos thing &optional strict) "Return the smallest THING enclosing POS. The returned node, if non-nil, must enclose POS, i.e., its start @@ -2611,7 +2545,7 @@ it can be a predicate described in `treesit-thing-settings'." ;; -> Obviously we don't want to go to parent's end, instead, we ;; want to go to parent's prev-sibling's end. Again, we recurse ;; in the function to do that. -(defun treesit--navigate-thing (pos arg side thing &optional tactic recursing) +(defun treesit-navigate-thing (pos arg side thing &optional tactic recursing) "Navigate thing ARG steps from POS. If ARG is positive, move forward that many steps, if negative, @@ -2650,9 +2584,9 @@ function is called recursively." dest))))) (catch 'term (while (> counter 0) - (let ((prev (treesit--thing-prev pos thing)) - (next (treesit--thing-next pos thing)) - (parent (treesit--thing-at pos thing t))) + (let ((prev (treesit-thing-prev pos thing)) + (next (treesit-thing-next pos thing)) + (parent (treesit-thing-at pos thing t))) (when (and parent prev (not (treesit-node-enclosed-p prev parent))) (setq prev nil)) @@ -2702,7 +2636,7 @@ function is called recursively." ;; recurring, that doesn't count as special case, ;; because we have already made progress (by moving ;; the end of next before recurring.) - (setq pos (or (treesit--navigate-thing + (setq pos (or (treesit-navigate-thing (treesit-node-end (or next parent)) 1 'beg thing tactic t) (throw 'term nil))) @@ -2714,7 +2648,7 @@ function is called recursively." (eq pos (funcall advance prev)))) (parent t))) ;; Special case: go to prev end-of-defun. - (setq pos (or (treesit--navigate-thing + (setq pos (or (treesit-navigate-thing (treesit-node-start (or prev parent)) -1 'end thing tactic t) (throw 'term nil))) @@ -2735,7 +2669,7 @@ see `treesit-thing-settings' for details. Return the top-level THING if TACTIC is `top-level'; return the smallest enclosing THING as POS if TACTIC is `nested'." - (let ((node (treesit--thing-at (point) thing))) + (let ((node (treesit-thing-at (point) thing))) (if (eq tactic 'top-level) (treesit-node-top-level node thing t) node))) @@ -2897,8 +2831,8 @@ when a major mode sets it.") "Search for the next outline heading in the syntax tree. See the descriptions of arguments in `outline-search-function'." (if looking-at - (when-let* ((node (or (treesit--thing-at (pos-eol) treesit-outline-predicate) - (treesit--thing-at (pos-bol) treesit-outline-predicate))) + (when-let* ((node (or (treesit-thing-at (pos-eol) treesit-outline-predicate) + (treesit-thing-at (pos-bol) treesit-outline-predicate))) (start (treesit-node-start node))) (eq (pos-bol) (save-excursion (goto-char start) (pos-bol)))) @@ -2909,8 +2843,8 @@ See the descriptions of arguments in `outline-search-function'." (if (eq (point) (pos-bol)) (if (bobp) (point) (1- (point))) (pos-eol))) - (found (treesit--navigate-thing pos (if backward -1 1) 'beg - treesit-outline-predicate))) + (found (treesit-navigate-thing pos (if backward -1 1) 'beg + treesit-outline-predicate))) (if found (if (or (not bound) (if backward (>= found bound) (<= found bound))) (progn diff --git a/test/src/treesit-tests.el b/test/src/treesit-tests.el index bdc9630c783..5d0c92ae8a6 100644 --- a/test/src/treesit-tests.el +++ b/test/src/treesit-tests.el @@ -927,7 +927,7 @@ starting marker position, and the rest are marker positions the corresponding navigation should stop at (after running `treesit-defun-skipper'). -TACTIC is the same as in `treesit--navigate-thing'. +TACTIC is the same as in `treesit-navigate-thing'. OPENING and CLOSING are the same as in `treesit--ert-insert-and-parse-marker', by default they are \"[\" @@ -939,7 +939,7 @@ and \"]\"." (closing (or closing "]")) ;; Insert program and parse marker positions. (marker-alist (treesit--ert-insert-and-parse-marker - opening closing program)) + opening closing program)) ;; Translate marker positions into buffer positions. (decoded-master (cl-loop for record in master @@ -955,7 +955,7 @@ and \"]\"." (mapcar (lambda (conf) (lambda () (if-let ((pos (funcall - #'treesit--navigate-thing + #'treesit-navigate-thing (point) (car conf) (cdr conf) treesit-defun-type-regexp tactic))) (save-excursion commit ee377aaddf9d73116b93c3d54b1ffef9a3a8b925 Author: F. Jason Park Date: Sun Mar 31 16:32:44 2024 -0700 Fix invisible erc-speedbar cursor in text terminals * lisp/erc/erc-speedbar.el (erc-speedbar--reset-last-ran-on-timer): Use `with-current-buffer' instead of `setf' and `buffer-local-value'. (erc-nickbar-mode, erc-nickbar-enable, erc-nickbar-disable) (erc-speedbar-toggle-nicknames-window-lock): Revise doc string. (erc-speedbar-toggle-nicknames-window-lock): Set `cursor-type' in speedbar buffer. (erc-nickbar-toggle-nicknames-window-lock): New function alias. Note that this name flouts traditional library namespacing conventions. * lisp/erc/erc-status-sidebar.el (erc-status-sidebar-get-window): Use `cursor-type' instead of `internal-show-cursor'. (Bug#63595) diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el index a81a3869436..b156f61d5d9 100644 --- a/lisp/erc/erc-speedbar.el +++ b/lisp/erc/erc-speedbar.el @@ -566,9 +566,8 @@ The INDENT level is ignored." (defun erc-speedbar--reset-last-ran-on-timer () "Reset `erc-speedbar--last-ran'." (when speedbar-buffer - (with-suppressed-warnings ((obsolete buffer-local-value)) ; <=29 - (setf (buffer-local-value 'erc-speedbar--last-ran speedbar-buffer) - (current-time))))) + (with-current-buffer speedbar-buffer + (setq erc-speedbar--last-ran (current-time))))) ;;;###autoload(autoload 'erc-nickbar-mode "erc-speedbar" nil t) (define-erc-module nickbar nil @@ -578,10 +577,12 @@ show its buffer in an `erc-status-sidebar' window instead of a separate frame. When disabling, close the window or, with a negative prefix arg, destroy the session. -WARNING: this module may produce unwanted side effects, like the -raising of frames or the stealing of input focus. If you witness -such a thing and can reproduce it, please file a bug report with -\\[erc-bug]." +For controlling whether the speedbar window is selectable with +`other-window', see `erc-nickbar-toggle-nicknames-window-lock'. +Note that during initialization, this module may produce unwanted +side effects, like the raising of frames or the stealing of input +focus. If you witness such a thing and can reproduce it, please +file a bug report with \\[erc-bug]." ((add-hook 'erc--setup-buffer-hook #'erc-speedbar--ensure) (add-hook 'erc-insert-post-hook #'erc-speedbar--run-timer-on-post-insert) (add-hook 'speedbar-timer-hook #'erc-speedbar--reset-last-ran-on-timer) @@ -638,8 +639,8 @@ such a thing and can reproduce it, please file a bug report with (defun erc-speedbar-toggle-nicknames-window-lock (arg) "Toggle whether nicknames window is selectable with \\[other-window]. -When arg is a number, lock the window if non-negative, otherwise -unlock." +When ARG is a number, lock the window if non-negative. Otherwise, +unlock the window." (interactive "P") (unless erc-nickbar-mode (user-error "`erc-nickbar-mode' inactive")) @@ -648,10 +649,14 @@ unlock." ((integerp arg) nil) (t (not (window-parameter window 'no-other-window)))))) + (with-current-buffer speedbar-buffer + (setq cursor-type (not val))) (set-window-parameter window 'no-other-window val) (unless (numberp arg) (message "nick-window: %s" (if val "protected" "selectable")))))) +(defalias 'erc-nickbar-toggle-nicknames-window-lock + #'erc-speedbar-toggle-nicknames-window-lock) ;;;; Nicks integration diff --git a/lisp/erc/erc-status-sidebar.el b/lisp/erc/erc-status-sidebar.el index b7695651e4c..dcdef7cfafc 100644 --- a/lisp/erc/erc-status-sidebar.el +++ b/lisp/erc/erc-status-sidebar.el @@ -192,7 +192,7 @@ If NO-CREATION is non-nil, the window is not created." (set-window-parameter sidebar-window 'no-delete-other-windows t) ;; Don't cycle to this window with `other-window'. (set-window-parameter sidebar-window 'no-other-window t) - (internal-show-cursor sidebar-window nil) + (setq cursor-type nil) (set-window-fringes sidebar-window 0 0) ;; Set a custom display table so the window doesn't show a ;; truncation symbol when a channel name is too big. commit e0df2841fb78251d5461a17e2d9be581c152bdc2 Author: F. Jason Park Date: Mon Apr 1 15:27:47 2024 -0700 Allow updating of /IGNORE timeouts in ERC * lisp/erc/erc.el (erc--read-time-period, erc--decode-time-period): Move body of former, now a superficial wrapper, to latter, a new function. (erc--format-time-period): New function. (erc--get-ignore-timer-args): New function. (erc--find-ignore-timer): New function to search through `timer-list' to find matching ignore timer. (erc-cmd-IGNORE): Refactor and redo doc string. Add new optional `timespec' parameter, primarily to aid in testing. Update an existing timer instead of always creating one, and display time remaining in "ignore list" output. Pass server buffer instead of current buffer to timer callbacks because `erc--unignore-user' displays its messages in the `active' buffer, not necessarily the issuing one. Note that doing this does discard potentially useful information, so if ever reverting, we can change the `cl-find' :test in `erc--find-ignore-timer' to something that compares the `erc-server-process' of both buffers. ;; ;; Something like: ;; ;; (defun erc--ignore-timers-equal-p (a b) ;; (and (equal (car a) (car b)) ;; (eq (buffer-local-value 'erc-server-process (cadr a)) ;; (buffer-local-value 'erc-server-process (cadr b))))) ;; (erc-cmd-UNIGNORE): Pass `erc-ignore-list' member matching `user' parameter to `erc--unignore-user' instead of original, raw parameter, along with the server buffer. (erc--unignore-user): Cancel existing timer and don't bother switching to server buffer since we're already there. (erc-message-english-ignore-list): New variable. * test/lisp/erc/erc-scenarios-ignore.el: New file. * test/lisp/erc/erc-tests.el (erc--read-time-period): New test. (erc-cmd-UNIGNORE): New test. (Bug#70127) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 0750463a4e7..4ed77655f19 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -4191,8 +4191,11 @@ If there's no letter spec, the input is interpreted as a number of seconds. If input is blank, this function returns nil. Otherwise it returns the time spec converted to a number of seconds." - (let ((period (string-trim - (read-string prompt nil 'erc--read-time-period-history)))) + (erc--decode-time-period + (string-trim (read-string prompt nil 'erc--read-time-period-history)))) + +(defun erc--decode-time-period (period) + (progn ; unprogn on next major refactor (cond ;; Blank input. ((zerop (length period)) @@ -4223,36 +4226,76 @@ returns the time spec converted to a number of seconds." (user-error "%s is not a valid time period" period)) (decoded-time-period time)))))) -(defun erc-cmd-IGNORE (&optional user) - "Ignore USER. This should be a regexp matching nick!user@host. -If no USER argument is specified, list the contents of `erc-ignore-list'." +(defun erc--format-time-period (secs) + "Return a string with hour/minute/second labels for duration in SECS." + (let* ((hours (floor secs 3600)) + (minutes (floor (mod secs 3600) 60)) + (seconds (mod secs 60))) + (cond ((>= secs 3600) (format "%dh%dm%ds" hours minutes (floor seconds))) + ((>= secs 60) (format "%dm%ds" minutes (floor seconds))) + (t (format "%ds" (floor seconds)))))) + +(defun erc--get-ignore-timer-args (inst) + ;; The `cl-struct' `pcase' pattern and `cl-struct-slot-value' emit + ;; warnings when compiling because `timer' is un-`:named'. + (when (and (timerp inst) + (eq (aref inst (cl-struct-slot-offset 'timer 'function)) + 'erc--unignore-user)) + (aref inst (cl-struct-slot-offset 'timer 'args)))) + +(defun erc--find-ignore-timer (&rest args) + "Find an existing ignore timer." + (cl-find args timer-list :key #'erc--get-ignore-timer-args :test #'equal)) + +(defun erc-cmd-IGNORE (&optional user timespec) + "Drop messages from senders, like nick!user@host, matching regexp USER. +With human-readable TIMESPEC, ignore messages from matched senders for +the specified duration, like \"20m\". Without USER, list the contents +of `erc-ignore-list'." (if user - (let ((quoted (regexp-quote user))) + (let ((quoted (regexp-quote user)) + (prompt "Add a timeout? (Blank for no, or a time spec like 2h): ") + timeout msg) (when (and (not (string= user quoted)) (y-or-n-p (format "Use regexp-quoted form (%s) instead? " quoted))) (setq user quoted)) - (let ((timeout - (erc--read-time-period - "Add a timeout? (Blank for no, or a time spec like 2h): ")) - (buffer (current-buffer))) + (unless timespec + (setq timespec + (read-string prompt nil 'erc--read-time-period-history))) + (setq timeout (erc--decode-time-period (string-trim timespec)) + msg (if timeout + (format "Now ignoring %s for %s" user + (erc--format-time-period timeout)) + (format "Now ignoring %s" user))) + (erc-with-server-buffer (when timeout - (run-at-time timeout nil - (lambda () - (erc--unignore-user user buffer)))) - (erc-display-message nil 'notice 'active - (format "Now ignoring %s" user)) - (erc-with-server-buffer (add-to-list 'erc-ignore-list user)))) + (if-let ((existing (erc--find-ignore-timer user (current-buffer)))) + (timer-set-time existing (timer-relative-time nil timeout)) + (run-at-time timeout nil #'erc--unignore-user user + (current-buffer)))) + (erc-display-message nil 'notice 'active msg) + (cl-pushnew user erc-ignore-list :test #'equal))) (if (null (erc-with-server-buffer erc-ignore-list)) (erc-display-message nil 'notice 'active "Ignore list is empty") (erc-display-message nil 'notice 'active "Ignore list:") - (mapc (lambda (item) - (erc-display-message nil 'notice 'active item)) - (erc-with-server-buffer erc-ignore-list)))) + (erc-with-server-buffer + (let ((seen (copy-sequence erc-ignore-list))) + (dolist (timer timer-list) + (when-let ((args (erc--get-ignore-timer-args timer)) + ((eq (current-buffer) (nth 1 args))) + (user (car args)) + (delta (- (timer-until timer (current-time)))) + (duration (erc--format-time-period delta))) + (setq seen (delete user seen)) + (erc-display-message nil 'notice 'active 'ignore-list + ?p user ?s duration))) + (dolist (pattern seen) + (erc-display-message nil 'notice 'active pattern)))))) t) (defun erc-cmd-UNIGNORE (user) - "Remove the user specified in USER from the ignore list." + "Remove the first pattern in `erc-ignore-list' matching USER." (let ((ignored-nick (car (erc-with-server-buffer (erc-member-ignore-case (regexp-quote user) erc-ignore-list))))) @@ -4264,16 +4307,18 @@ If no USER argument is specified, list the contents of `erc-ignore-list'." (erc-display-message nil 'notice 'active (format "%s is not currently ignored!" user)))) (when ignored-nick - (erc--unignore-user user (current-buffer)))) + (erc--unignore-user ignored-nick (erc-server-buffer)))) t) (defun erc--unignore-user (user buffer) (when (buffer-live-p buffer) (with-current-buffer buffer + (cl-assert (erc--server-buffer-p)) (erc-display-message nil 'notice 'active (format "No longer ignoring %s" user)) - (erc-with-server-buffer - (setq erc-ignore-list (delete user erc-ignore-list)))))) + (setq erc-ignore-list (delete user erc-ignore-list)) + (when-let ((existing (erc--find-ignore-timer user buffer))) + (cancel-timer existing))))) (defvar erc--pre-clear-functions nil "Abnormal hook run when truncating buffers. @@ -9299,6 +9344,7 @@ SOFTP, only do so when defined as a variable." . "\n\n*** Connection failed! Re-establishing connection...\n") (disconnected-noreconnect . "\n\n*** Connection failed! Not re-establishing connection.\n") + (ignore-list . "%-8p %s") (reconnecting . "Reconnecting in %ms: attempt %i/%n ...") (reconnect-canceled . "Canceled %u reconnect timer with %cs to go...") (finished . "\n\n*** ERC finished ***\n") diff --git a/test/lisp/erc/erc-scenarios-ignore.el b/test/lisp/erc/erc-scenarios-ignore.el new file mode 100644 index 00000000000..1142bbef14d --- /dev/null +++ b/test/lisp/erc/erc-scenarios-ignore.el @@ -0,0 +1,79 @@ +;;; erc-scenarios-ignore.el --- /IGNORE scenarios ERC -*- lexical-binding: t -*- + +;; Copyright (C) 2024 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; TODO add test covering the same ignored speaker in two different +;; channels on the same server: they should be ignored in both. + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(ert-deftest erc-scenarios-ignore/basic () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/assoc/multi-net") + (erc-server-flood-penalty 0.1) + (dumb-server-foonet (erc-d-run "localhost" t 'foonet)) + (dumb-server-barnet (erc-d-run "localhost" t 'barnet)) + (erc-autojoin-channels-alist '((foonet "#chan") (barnet "#chan"))) + (port-foonet (process-contact dumb-server-foonet :service)) + (port-barnet (process-contact dumb-server-barnet :service)) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect to two networks") + (with-current-buffer (erc :server "127.0.0.1" + :port port-barnet + :nick "tester" + :password "changeme" + :full-name "tester")) + (with-current-buffer (erc :server "127.0.0.1" + :port port-foonet + :nick "tester" + :password "changeme" + :full-name "tester") + (funcall expect 10 "debug mode"))) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan@foonet")) + (funcall expect 10 " tester, welcome!") + (funcall expect 10 " tester, welcome!") + (erc-scenarios-common-say "/ignore alice 1m") + (erc-scenarios-common-say "/ignore mike 1h") + (funcall expect 10 "ignoring alice for 1m0s") + (funcall expect 10 " alice: Signior Iachimo") + (erc-scenarios-common-say "/ignore") + (funcall expect 10 "alice 59s") + (funcall expect 10 "mike 59m59s") + (funcall expect -0.1 "") + (funcall expect 10 " alice: The ground is bloody") + (erc-scenarios-common-say "/unignore alice") + (funcall expect 10 "")) + + ;; No messages were ignored on network barnet. + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan@barnet")) + (funcall expect 10 " tester, welcome!") + (funcall expect 10 " tester, welcome!") + (funcall expect 10 " joe: Whipp'd") + (funcall expect 10 " joe: Double")))) + +;;; erc-scenarios-ignore.el ends here diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 3e8ddef3731..22432a68034 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -50,6 +50,34 @@ (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "1d"))) (should (equal (erc--read-time-period "foo: ") 86400)))) +(ert-deftest erc--format-time-period () + (should (equal (erc--format-time-period 59) "59s")) + (should (equal (erc--format-time-period 59.9) "59s")) + (should (equal (erc--format-time-period 60) "1m0s")) + (should (equal (erc--format-time-period 119) "1m59s")) + (should (equal (erc--format-time-period 119.9) "1m59s")) + (should (equal (erc--format-time-period 120.9) "2m0s")) + (should (equal (erc--format-time-period 3599.9) "59m59s")) + (should (equal (erc--format-time-period 3600) "1h0m0s"))) + +;; This asserts that the first pattern on file matching a supplied +;; `user' parameter will be removed after confirmation. +(ert-deftest erc-cmd-UNIGNORE () + ;; XXX these functions mutate `erc-ignore-list' via `delete'. + (should (local-variable-if-set-p 'erc-ignore-list)) + (erc-tests-common-make-server-buf) + + (setq erc-ignore-list (list ".")) ; match anything + (ert-simulate-keys (list ?\r) + (erc-cmd-IGNORE "abc")) + (should (equal erc-ignore-list (list "abc" "."))) + + (cl-letf (((symbol-function 'y-or-n-p) #'always)) + (erc-cmd-UNIGNORE "abcdef") + (should (equal erc-ignore-list (list "."))) + (erc-cmd-UNIGNORE "foo")) + (should-not erc-ignore-list)) + (ert-deftest erc-with-all-buffers-of-server () (let (proc-exnet proc-onet commit c1266d355a2801271f2f875a1f7d47030c6c0e7a Author: F. Jason Park Date: Mon Apr 1 08:14:52 2024 -0700 ; * lisp/erc/erc-nicks.el: Fix typo in Commentary. diff --git a/lisp/erc/erc-nicks.el b/lisp/erc/erc-nicks.el index 64f9ec42783..ccf65f15abd 100644 --- a/lisp/erc/erc-nicks.el +++ b/lisp/erc/erc-nicks.el @@ -59,7 +59,7 @@ ;; 2008/12 - erc-highlight-nicknames.el ;; First release from Andy Stewart ;; 2007/09 - erc-highlight-nicknames.el -;; Initial release by by André Riemann +;; Initial release by André Riemann ;; [1] ;; [2] commit 63588775fcb64e4fd88a97e0882aae38c9f5fb1c Author: Stefan Monnier Date: Sun Apr 7 14:16:38 2024 -0400 (Freplace_match): Fix bug#65451 * src/search.c (Freplace_match): For ordering of *-change-functions. * test/src/editfns-tests.el (editfns-tests--before/after-change-functions): New test. (sanity-check--message, sanity-check-change-functions-error) (sanity-check-change-functions-check-size) (sanity-check-change-functions-before) (sanity-check-change-functions-after): New functions. (sanity-check--verbose, sanity-check-change-functions-beg) (sanity-check-change-functions-end) (sanity-check-change-functions-buffer-size) (sanity-check-change-functions-errors): New vars. diff --git a/src/search.c b/src/search.c index f2d1f1f5449..b092d5b7fef 100644 --- a/src/search.c +++ b/src/search.c @@ -2759,6 +2759,7 @@ since only regular expressions have distinguished subexpressions. */) /* Replace the old text with the new in the cleanest possible way. */ replace_range (sub_start, sub_end, newtext, 1, 0, 1, true, true); + signal_after_change (sub_start, sub_end - sub_start, SCHARS (newtext)); if (case_action == all_caps) Fupcase_region (make_fixnum (search_regs.start[sub]), @@ -2783,7 +2784,6 @@ since only regular expressions have distinguished subexpressions. */) /* Now move point "officially" to the end of the inserted replacement. */ move_if_not_intangible (newpoint); - signal_after_change (sub_start, sub_end - sub_start, SCHARS (newtext)); update_compositions (sub_start, newpoint, CHECK_BORDER); return Qnil; diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index b3b7da65ad3..a14a5f90b65 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -426,4 +426,78 @@ (should (= (field-beginning) 7)) (should (= (field-end) (point-max))))) +;;; Try and catch `*-changes-functions' bugs! + +(defvar sanity-check--verbose nil) +(defun sanity-check--message (&rest args) + (if sanity-check--verbose (apply #'message args))) + +(defvar-local sanity-check-change-functions-beg 0) +(defvar-local sanity-check-change-functions-end 0) +(defvar-local sanity-check-change-functions-buffer-size nil) +(defvar sanity-check-change-functions-errors nil) + +(defun sanity-check-change-functions-error (description &rest args) + (push (apply #'format description args) + sanity-check-change-functions-errors)) + +(defun sanity-check-change-functions-check-size () + (sanity-check--message "Size : %S == %S" + sanity-check-change-functions-buffer-size + (buffer-size)) + (cond + ((null sanity-check-change-functions-buffer-size) + (setq sanity-check-change-functions-buffer-size (buffer-size))) + ((equal sanity-check-change-functions-buffer-size (buffer-size)) nil) + (t + (sanity-check-change-functions-error + "buffer-size %S == %S" + (buffer-size) sanity-check-change-functions-buffer-size) + (setq sanity-check-change-functions-buffer-size (buffer-size))))) + +(defun sanity-check-change-functions-before (beg end) + (sanity-check--message "Before: %S %S" beg end) + (unless (<= (point-min) beg end (point-max)) + (sanity-check-change-functions-error + "Position bounds: %S <= %S <= %S <= %S" + (point-min) beg end (point-max))) + (sanity-check-change-functions-check-size) + (setq sanity-check-change-functions-beg beg) + (setq sanity-check-change-functions-end end)) + +(defun sanity-check-change-functions-after (beg end len) + (sanity-check--message "After : %S %S (%S)" beg end len) + (unless (<= (point-min) beg end (point-max)) + (sanity-check-change-functions-error + "Position bounds: %S <= %S <= %S <= %S" + (point-min) beg end (point-max))) + (unless (>= len 0) + (sanity-check-change-functions-error "len: %S >= 0" len)) + (let ((bend (+ beg len))) + (unless (<= sanity-check-change-functions-beg + beg bend + sanity-check-change-functions-end) + (sanity-check-change-functions-error + "After covered by before: %S <= %S <= %S <= %S" + sanity-check-change-functions-beg beg bend + sanity-check-change-functions-end))) + (let ((offset (- end beg len))) + (setq sanity-check-change-functions-end + (+ sanity-check-change-functions-end offset)) + (setq sanity-check-change-functions-buffer-size + (+ sanity-check-change-functions-buffer-size offset))) + (sanity-check-change-functions-check-size)) + +(ert-deftest editfns-tests--before/after-change-functions () + (with-temp-buffer + (add-hook 'before-change-functions + #'sanity-check-change-functions-before nil t) + (add-hook 'after-change-functions + #'sanity-check-change-functions-after nil t) + + ;; Bug#65451 + (insert "utf-8-unix\n\nUTF") + (call-interactively 'dabbrev-expand) + (should (null sanity-check-change-functions-errors)))) + ;;; editfns-tests.el ends here commit 8f93cba324e4d4022a9422b8c56186213ba2de8d Author: Eli Zaretskii Date: Sun Apr 7 12:08:18 2024 +0300 Fix truncation of long lines in compilation buffers * lisp/progmodes/compile.el (compilation--insert-abbreviated-line): Handle long lines that end in a newline. (Bug#70236) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 11d400e145a..d7690b7fa74 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -2644,24 +2644,29 @@ and runs `compilation-filter-hook'." (text-properties-at (1- beg)))) (insert string) ;; If we exceeded the limit, hide the last portion of the line. - (when (> (current-column) width) - (let ((start (save-excursion - (move-to-column width) - (point)))) - (buttonize-region - start (point) - (lambda (start) - (let ((inhibit-read-only t)) - (remove-text-properties start (save-excursion - (goto-char start) - (line-end-position)) - (text-properties-at start))))) - (put-text-property - start (if (= (aref string (1- (length string))) ?\n) - ;; Don't hide the final newline. - (1- (point)) - (point)) - 'display (if (char-displayable-p ?…) "[…]" "[...]")))))) + (let* ((ends-in-nl (= (aref string (1- (length string))) ?\n)) + (curcol (if ends-in-nl + (progn (backward-char) (current-column)) + (current-column)))) + (when (> curcol width) + (let ((start (save-excursion + (move-to-column width) + (point)))) + (buttonize-region + start (point) + (lambda (start) + (let ((inhibit-read-only t)) + (remove-text-properties start (save-excursion + (goto-char start) + (line-end-position)) + (text-properties-at start))))) + (put-text-property + start (if ends-in-nl + ;; Don't hide the final newline. + (1- (point)) + (point)) + 'display (if (char-displayable-p ?…) "[…]" "[...]")))) + (if ends-in-nl (forward-char))))) (defsubst compilation-buffer-internal-p () "Test if inside a compilation buffer." commit 03b23302bd326f981e1328f0e9ea9f4a40a13ee1 Author: Arash Esbati Date: Sat Apr 6 21:58:03 2024 +0200 Fix tex-tabbing-separator alignment rule * lisp/align.el (align-rules-list): Remove the check of `latex-mode' with `eq' which doesn't work with newer AUCTeX mode names and modes defined by user with `define-derived-mode'. (bug#69187) diff --git a/lisp/align.el b/lisp/align.el index 81ccc4b5e2d..0e77a857585 100644 --- a/lisp/align.el +++ b/lisp/align.el @@ -537,10 +537,8 @@ The possible settings for `align-region-separate' are: (regexp . ,(lambda (end reverse) (align-match-tex-pattern "\\\\[=>]" end reverse))) (group . (1 2)) - (modes . align-tex-modes) - (repeat . t) - (run-if . ,(lambda () - (eq major-mode 'latex-mode)))) + (modes . '(latex-mode)) + (repeat . t)) (tex-record-break (regexp . "\\(\\s-*\\)\\\\\\\\")