commit 757f6cb0ac710533d5e18035e8b20a4bc7dcdc7c (HEAD, refs/remotes/origin/master) Author: Sean Whitton Date: Fri Jun 6 11:52:32 2025 +0100 New revert-files VC backend function for faster mass reverts * lisp/vc/vc-git.el (vc-git-revert-files): * lisp/vc/vc-hg.el (vc-hg-revert-files): * lisp/vc/vc.el (vc-revert-files): New functions. (vc-revert-files): Incorporate vc-revert's calls to message here so that the messages are displayed more consistently. (vc-next-action, vc-default-checkin-patch, vc-revert): Use vc-revert-files instead of vc-revert-file. diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index a0f64163470..bea1a2a282a 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1333,12 +1333,17 @@ It is based on `log-edit-mode', and has Git-specific extensions." (vc-git-command nil 0 file "checkout" (or rev "HEAD"))) (defun vc-git-revert (file &optional contents-done) - "Revert FILE to the version stored in the git repository." + "Revert FILE to the version stored in the Git repository." (if contents-done (vc-git-command nil 0 file "update-index" "--") (vc-git-command nil 0 file "reset" "-q" "--") (vc-git-command nil nil file "checkout" "-q" "--"))) +(defun vc-git-revert-files (files) + "Revert FILES to the versions stored in the Git repository." + (vc-git-command nil 0 files "reset" "-q" "--") + (vc-git-command nil nil files "checkout" "-q" "--")) + (defvar vc-git-error-regexp-alist '(("^ \\(.+\\)\\> *|" 1 nil nil 0)) "Value of `compilation-error-regexp-alist' in *vc-git* buffers.") diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 04a85fadd92..31506ee6493 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -1315,11 +1315,14 @@ REV is the revision to check out into WORKFILE." (defun vc-hg-revert (file &optional contents-done) (unless contents-done (with-temp-buffer - (apply #'vc-hg-command - t 0 file - "revert" + (apply #'vc-hg-command t 0 file "revert" (append (vc-switches 'hg 'revert)))))) +(defun vc-hg-revert-files (files) + (with-temp-buffer + (apply #'vc-hg-command t 0 files "revert" + (append (vc-switches 'hg 'revert))))) + ;;; Hg specific functionality. (defvar-keymap vc-hg-extra-menu-map) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 6f7b40ae057..14378a85346 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -283,6 +283,12 @@ ;; If FILE is in the `added' state it should be returned to the ;; `unregistered' state. ;; +;; - revert-files (files) +;; +;; As revert, except that the first argument is a list of files, all +;; of which require reversion, and reversion from version backups is +;; not done. Backends can implement this for faster mass reverts. +;; ;; - merge-file (file &optional rev1 rev2) ;; ;; Merge the changes between REV1 and REV2 into the current working @@ -1546,19 +1552,22 @@ from which to check out the file(s)." (read-only-mode -1))))))) ;; Allow user to revert files with no changes (save-excursion - (dolist (file files) - (let ((visited (get-file-buffer file))) - ;; For files with locking, if the file does not contain - ;; any changes, just let go of the lock, i.e. revert. - (when (and (not (eq model 'implicit)) - (eq state 'up-to-date) - ;; If buffer is modified, that means the user just - ;; said no to saving it; in that case, don't revert, - ;; because the user might intend to save after - ;; finishing the log entry and committing. - (not (and visited (buffer-modified-p visited)))) - (vc-revert-file file) - (setq ready-for-commit (delete file ready-for-commit)))))) + (let (to-revert) + (dolist (file files) + (let ((visited (get-file-buffer file))) + ;; For files with locking, if the file does not contain + ;; any changes, just let go of the lock, i.e. revert. + (when (and (not (eq model 'implicit)) + (eq state 'up-to-date) + ;; If buffer is modified, that means the user just + ;; said no to saving it; in that case, don't revert, + ;; because the user might intend to save after + ;; finishing the log entry and committing. + (not (and visited (buffer-modified-p visited)))) + (push file to-revert)))) + (vc-revert-files backend to-revert) + (setq ready-for-commit + (cl-nset-difference ready-for-commit to-revert)))) ;; Remaining files need to be committed (if (not ready-for-commit) (message "No files remain to be committed") @@ -1951,9 +1960,11 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." (expand-file-name f tmpdir))) (unwind-protect (progn - (dolist (f files) - (with-current-buffer (find-file-noselect f) - (vc-revert-file buffer-file-name))) + (vc-revert-files backend + (mapcar (lambda (f) + (with-current-buffer (find-file-noselect f) + buffer-file-name)) + files)) (with-temp-buffer ;; Trying to support CVS too. Assuming that vc-diff ;; there will usually have diff root in default-directory. @@ -3355,6 +3366,7 @@ This asks for confirmation if the buffer contents are not identical to the working revision (except for keyword expansion)." (interactive) (let* ((vc-fileset (vc-deduce-fileset)) + (backend (car vc-fileset)) (files (cadr vc-fileset)) (queried nil) diff-buffer) @@ -3397,10 +3409,7 @@ to the working revision (except for keyword expansion)." (error "Revert canceled"))) (when diff-buffer (quit-windows-on diff-buffer (eq vc-revert-show-diff 'kill)))) - (dolist (file files) - (message "Reverting %s..." (vc-delistify files)) - (vc-revert-file file) - (message "Reverting %s...done" (vc-delistify files))))) + (vc-revert-files backend files))) ;;;###autoload (defun vc-pull (&optional arg) @@ -3533,6 +3542,23 @@ If FILE is a directory, revert all files inside that directory." (file-attributes file))))) (vc-resynch-buffer file t t)) +(defun vc-revert-files (backend files) + "Revert each of FILES to the repository working version it was based on. +For entries in FILES that are directories, revert all files inside them." + (when files + (message "Reverting %s..." (vc-delistify files)) + (if (not (vc-find-backend-function backend 'revert-files)) + (mapc #'vc-revert-file files) + (with-vc-properties files + (vc-call-backend backend 'revert-files files) + `((vc-state . up-to-date))) + (dolist (file files) + (vc-file-setprop file 'vc-checkout-time + (file-attribute-modification-time + (file-attributes file))) + (vc-resynch-buffer file t t))) + (message "Reverting %s...done" (vc-delistify files)))) + ;;;###autoload (defun vc-change-backend (file backend) "Make BACKEND the current version control system for FILE. commit 8f85cf2ae93a089ea78f55915aa5f7c6776d3362 Author: Sean Whitton Date: Fri Jun 6 11:47:10 2025 +0100 Fix apparent thinko in vc-next-action * lisp/vc/vc.el (vc-next-action): Pass an argument to buffer-modified-p because the loop does not set the current buffer before calling that function. diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index f51bd2b85b3..6f7b40ae057 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1556,8 +1556,8 @@ from which to check out the file(s)." ;; said no to saving it; in that case, don't revert, ;; because the user might intend to save after ;; finishing the log entry and committing. - (not (and visited (buffer-modified-p)))) - (vc-revert-file file) + (not (and visited (buffer-modified-p visited)))) + (vc-revert-file file) (setq ready-for-commit (delete file ready-for-commit)))))) ;; Remaining files need to be committed (if (not ready-for-commit) commit ac4869c71293c28f861f306420f5d0620cf3a7cc Author: Sean Whitton Date: Fri Jun 6 09:53:32 2025 +0100 VC: Deprecate log-incoming and log-outgoing backend functions * lisp/vc/vc-git.el (vc-git-incoming-revision): Inline vc-git--fetch-incoming. (vc-git--fetch-incoming, vc-git-log-incoming) (vc-git-log-outgoing): Delete. * lisp/vc/vc-hg.el (vc-hg-mergebase): * lisp/vc/vc.el (vc-default-log-incoming) (vc-default-log-outgoing): New functions. * lisp/vc/vc.el: * etc/NEWS: Document the deprecation. diff --git a/etc/NEWS b/etc/NEWS index 9cf3c626449..0ecd911633c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1809,6 +1809,12 @@ This replaces and generalizes the old 'vc-annotate-parent-rev'. --- *** vc-dav.el is now obsolete. +--- +*** The 'log-incoming' and 'log-outgoing' functions are deprecated. +Backend authors should implement the 'incoming-revision' and 'mergebase' +backend functions instead. These are jointly sufficient to support the +'C-x v I' and 'C-x v O' commands. + ** Diff mode +++ diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index 392c2b04377..f345a1b2779 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -816,6 +816,7 @@ If LIMIT is non-nil, show no more than this many entries." (indent-region (match-end 0) (point-max) 2) (buffer-substring (match-end 0) (point-max))))) +;; FIXME: Implement `vc-bzr-mergebase' and then delete this. (defun vc-bzr-log-incoming (buffer remote-location) (apply #'vc-bzr-command "missing" buffer 'async nil (list "--theirs-only" (and (not (string-empty-p remote-location)) @@ -832,6 +833,7 @@ If LIMIT is non-nil, show no more than this many entries." (and (re-search-forward "^revision-id: " nil t) (buffer-substring (point) (pos-eol))))) +;; FIXME: Implement `vc-bzr-mergebase' and then delete this. (defun vc-bzr-log-outgoing (buffer remote-location) (apply #'vc-bzr-command "missing" buffer 'async nil (list "--mine-only" (and (not (string-empty-p remote-location)) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index f460eafacbf..a0f64163470 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -70,8 +70,7 @@ ;; - get-change-comment (files rev) OK ;; HISTORY FUNCTIONS ;; * print-log (files buffer &optional shortlog start-revision limit) OK -;; * log-outgoing (buffer remote-location) OK -;; * log-incoming (buffer remote-location) OK +;; * incoming-revision (remote-location) OK ;; - log-search (buffer pattern) OK ;; - log-view-mode () OK ;; - show-log-entry (revision) OK @@ -1577,41 +1576,12 @@ If LIMIT is a revision string, use it as an end-revision." (list "-p")) '("--"))))))) -(defun vc-git-log-outgoing (buffer remote-location) - (vc-setup-buffer buffer) - (apply #'vc-git-command buffer 'async nil - `("log" - "--no-color" "--graph" "--decorate" "--date=short" - ,(format "--pretty=tformat:%s" (car vc-git-root-log-format)) - "--abbrev-commit" - ,@(ensure-list vc-git-shortlog-switches) - ,(concat (if (string-empty-p remote-location) - "@{upstream}" - remote-location) - "..HEAD")))) - -(defun vc-git--fetch-incoming (remote-location) +(defun vc-git-incoming-revision (remote-location) (vc-git-command nil 0 nil "fetch" (and (not (string-empty-p remote-location)) ;; Extract remote from "remote/branch". (replace-regexp-in-string "/.*" "" - remote-location)))) - -(defun vc-git-log-incoming (buffer remote-location) - (vc-setup-buffer buffer) - (vc-git--fetch-incoming remote-location) - (apply #'vc-git-command buffer 'async nil - `("log" - "--no-color" "--graph" "--decorate" "--date=short" - ,(format "--pretty=tformat:%s" (car vc-git-root-log-format)) - "--abbrev-commit" - ,@(ensure-list vc-git-shortlog-switches) - ,(concat "HEAD.." (if (string-empty-p remote-location) - "@{upstream}" - remote-location))))) - -(defun vc-git-incoming-revision (remote-location) - (vc-git--fetch-incoming remote-location) + remote-location))) (ignore-errors ; in order to return nil if no such branch (with-output-to-string (vc-git-command standard-output 0 nil diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index e1527935861..04a85fadd92 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -1458,6 +1458,7 @@ This runs the command \"hg summary\"." (nreverse result)) "\n")))) +;; FIXME: Resolve issue with `vc-hg-mergebase' and then delete this. (defun vc-hg-log-incoming (buffer remote-location) (vc-setup-buffer buffer) (vc-hg-command buffer 1 nil "incoming" "-n" @@ -1475,12 +1476,23 @@ This runs the command \"hg summary\"." (and (not (string-empty-p output)) output))) +;; FIXME: Resolve issue with `vc-hg-mergebase' and then delete this. (defun vc-hg-log-outgoing (buffer remote-location) (vc-setup-buffer buffer) (vc-hg-command buffer 1 nil "outgoing" "-n" (and (not (string-empty-p remote-location)) remote-location))) +;; FIXME: This works only when both rev1 and rev2 have already been pulled. +;; That means it can't do the work +;; `vc-default-log-incoming' and `vc-default-log-outgoing' need it to do. +(defun vc-hg-mergebase (rev1 &optional rev2) + (or (vc-hg--run-log "{node}" + (format "last(ancestors(%s) and ancestors(%s))" + rev1 (or rev2 "tip")) + nil) + (error "No common ancestor for merge base"))) + (defvar vc-hg-error-regexp-alist '(("^M \\(.+\\)" 1 nil nil 0)) "Value of `compilation-error-regexp-alist' in *vc-hg* buffers.") diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 67b7fbd9232..f51bd2b85b3 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -347,15 +347,17 @@ ;; revision shown, rather than the working revision, which is normally ;; the case). Not all backends support this. ;; -;; * log-outgoing (buffer remote-location) +;; - log-outgoing (buffer remote-location) (DEPRECATED) ;; ;; Insert in BUFFER the revision log for the changes that will be ;; sent when performing a push operation to REMOTE-LOCATION. +;; Deprecated: implement incoming-revision and mergebase instead. ;; -;; * log-incoming (buffer remote-location) +;; - log-incoming (buffer remote-location) (DEPRECATED) ;; ;; Insert in BUFFER the revision log for the changes that will be ;; received when performing a pull operation from REMOTE-LOCATION. +;; Deprecated: implement incoming-revision and mergebase instead. ;; ;; * incoming-revision (remote-location) ;; @@ -3252,6 +3254,16 @@ In some version control systems REMOTE-LOCATION can be a remote branch name." (vc-incoming-outgoing-internal backend (or remote-location "") "*vc-incoming*" 'log-incoming))) +(defun vc-default-log-incoming (_backend buffer remote-location) + (vc--with-backend-in-rootdir "" + (let ((incoming (or (vc-call-backend backend + 'incoming-revision + remote-location) + (user-error "No incoming revision -- local-only branch?")))) + (vc-call-backend backend 'print-log (list rootdir) buffer t + (vc-call-backend backend 'mergebase incoming) + incoming)))) + ;;;###autoload (defun vc-log-outgoing (&optional remote-location) "Show log of changes that will be sent with a push operation to REMOTE-LOCATION. @@ -3264,6 +3276,16 @@ In some version control systems REMOTE-LOCATION can be a remote branch name." (vc-incoming-outgoing-internal backend (or remote-location "") "*vc-outgoing*" 'log-outgoing))) +(defun vc-default-log-outgoing (_backend buffer remote-location) + (vc--with-backend-in-rootdir "" + (let ((incoming (or (vc-call-backend backend + 'incoming-revision + remote-location) + (user-error "No incoming revision -- local-only branch?")))) + (vc-call-backend backend 'print-log (list rootdir) buffer t + (vc-call-backend backend 'mergebase incoming) + "")))) + ;;;###autoload (defun vc-log-search (pattern) "Search the VC log of changes for PATTERN and show log of matching changes. diff --git a/test/lisp/vc/vc-tests/vc-tests.el b/test/lisp/vc/vc-tests/vc-tests.el index 632a6a792bd..e8aaa070018 100644 --- a/test/lisp/vc/vc-tests/vc-tests.el +++ b/test/lisp/vc/vc-tests/vc-tests.el @@ -69,8 +69,8 @@ ;; HISTORY FUNCTIONS ;; ;; * print-log (files buffer &optional shortlog start-revision limit) -;; * log-outgoing (backend remote-location) -;; * log-incoming (backend remote-location) +;; - log-outgoing (backend remote-location) +;; - log-incoming (backend remote-location) ;; - log-view-mode () ;; - show-log-entry (revision) ;; - comment-history (file) commit b3f4486b04d92fd1b34c43edb5c864f3cada234b Author: Sean Whitton Date: Fri Jun 6 09:49:37 2025 +0100 * lisp/vc/vc.el: Update specification of print-log backend function. diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 119d9d1a6f7..67b7fbd9232 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -337,15 +337,15 @@ ;; * print-log (files buffer &optional shortlog start-revision limit) ;; ;; Insert the revision log for FILES into BUFFER. -;; If SHORTLOG is true insert a short version of the log. -;; If LIMIT is true insert only insert LIMIT log entries. If the -;; backend does not support limiting the number of entries to show -;; it should return `limit-unsupported'. +;; If SHORTLOG is non-nil insert a short version of the log. +;; If LIMIT is non-nil insert only insert LIMIT log entries. +;; When LIMIT is a string it means stop at that revision. +;; If the backend does not support limiting the number of entries to +;; show it should return `limit-unsupported'. ;; If START-REVISION is given, then show the log starting from that ;; revision ("starting" in the sense of it being the _newest_ ;; revision shown, rather than the working revision, which is normally -;; the case). Not all backends support this. At present, this is -;; only ever used with LIMIT = 1 (by vc-annotate-show-log-revision-at-line). +;; the case). Not all backends support this. ;; ;; * log-outgoing (buffer remote-location) ;; commit 4456ca3d3bebf35f4ed3a89bac437f35940dfe1b Author: Sean Whitton Date: Fri Jun 6 09:48:01 2025 +0100 ; vc--with-backend-in-rootdir: Fix Edebug declaration. diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 64d58265816..119d9d1a6f7 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1030,7 +1030,7 @@ Not supported by all backends." "Backends which support `vc-async-checkin'.") (defmacro vc--with-backend-in-rootdir (desc &rest body) - (declare (indent 1) (debug (sexp sexp body))) + (declare (indent 1) (debug (sexp body))) ;; Intentionally capture `backend' and `rootdir': ;; no need to keep repeating them. `(let ((backend (vc-deduce-backend)) commit 1110696f022b29c2b5029e8fadaaeba6ebe58da8 Author: Mattias Engdegård Date: Fri Jun 6 09:58:20 2025 +0200 ; * lisp/register.el (cl-find-class): declare to silence warning diff --git a/lisp/register.el b/lisp/register.el index 8d8c3ab5b8f..6d2524b94e8 100644 --- a/lisp/register.el +++ b/lisp/register.el @@ -36,6 +36,7 @@ ;; FIXME: Clean up namespace usage! (declare-function dired-current-directory "dired") +(declare-function cl-find-class "cl-extra") (cl-defstruct (registerv (:constructor nil) commit 1c465fc0879b68b1cd7a05c033f6bb82fd5fa3aa Author: Dmitry Gutov Date: Fri Jun 6 05:38:55 2025 +0300 project-switch-to-buffer: Don't disambiguate too much * lisp/progmodes/project.el (project--read-project-buffer): Use the new function from 'uniquify' to generate buffer names that are just unique to the current project, not globally (bug#77312). diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 6e9c81ee581..5cf9a68a294 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1574,13 +1574,28 @@ general form of conditions." (and (memq (cdr buffer) buffers) (not (project--buffer-check - (cdr buffer) project-ignore-buffer-conditions))))) - (buffer (read-buffer - "Switch to buffer: " - (when (funcall predicate (cons other-name other-buffer)) - other-name) - nil - predicate))) + buffer project-ignore-buffer-conditions))))) + (buffer + (if (and (fboundp 'uniquify-get-unique-names) + uniquify-buffer-name-style) + ;; Forgo the use of `buffer-read-function' (often nil) in + ;; favor of uniquifying the buffers better. + (let* ((unique-names (uniquify-get-unique-names buffers)) + (other-name (when (funcall predicate (cons other-name other-buffer)) + (car (rassoc other-buffer unique-names)))) + (result (completing-read + "Switch to buffer: " + unique-names + predicate + nil nil nil + other-name))) + (assoc-default result unique-names #'equal result)) + (read-buffer + "Switch to buffer: " + (when (funcall predicate (cons other-name other-buffer)) + other-name) + nil + predicate)))) ;; XXX: This check hardcodes the default buffer-belonging relation ;; which `project-buffers' is allowed to override. Straighten ;; this up sometime later. Or not. Since we can add a method commit 79cd1cc30e0c9a5f058279dc6f618e5dc22a1945 Author: Spencer Baugh Date: Thu Mar 27 09:32:47 2025 -0400 Add uniquify-get-unique-names (bug#77312) This new function provides an interface to uniquify.el which doesn't change the actual names of the buffers. This is useful for any commands which deal with a subset of all buffers; for example, project.el. * lisp/uniquify.el (uniquify-rationalize--generic): Add. (uniquify-rationalize, uniquify-rationalize-a-list) (uniquify-rationalize-conflicting-sublist): Explicitly pass RENAME-BUFFER-FN and GET-BUFFER-FN. (uniquify--stateless-curname, uniquify-get-unique-names): Add. diff --git a/lisp/uniquify.el b/lisp/uniquify.el index 1f5bdcd6224..6e25323bf5a 100644 --- a/lisp/uniquify.el +++ b/lisp/uniquify.el @@ -371,14 +371,19 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil." (defun uniquify-rationalize (fix-list) ;; Set up uniquify to re-rationalize after killing/renaming ;; if there is a conflict. + (dolist (item fix-list) + (with-current-buffer (uniquify-item-buffer item) + (setq uniquify-managed fix-list))) + (uniquify-rationalize--generic fix-list #'uniquify-rename-buffer #'get-buffer)) + +(defun uniquify-rationalize--generic (fix-list rename-buffer-fn get-buffer-fn) (dolist (item fix-list) (with-current-buffer (uniquify-item-buffer item) ;; Refresh the dirnames and proposed names. (setf (uniquify-item-proposed item) (uniquify-get-proposed-name (uniquify-item-base item) (uniquify-item-dirname item) - nil)) - (setq uniquify-managed fix-list))) + nil)))) ;; Strip any shared last directory names of the dirname. (when (and (cdr fix-list) uniquify-strip-common-suffix) (let ((strip t)) @@ -404,13 +409,13 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil." fix-list))))) ;; If uniquify-min-dir-content is 0, this will end up just ;; passing fix-list to uniquify-rationalize-conflicting-sublist. - (uniquify-rationalize-a-list fix-list)) + (uniquify-rationalize-a-list fix-list nil rename-buffer-fn get-buffer-fn)) (defun uniquify-item-greaterp (item1 item2) (string-lessp (uniquify-item-proposed item2) (uniquify-item-proposed item1))) -(defun uniquify-rationalize-a-list (fix-list &optional depth) +(defun uniquify-rationalize-a-list (fix-list depth rename-buffer-fn get-buffer-fn) (unless depth (setq depth uniquify-min-dir-content)) (let (conflicting-sublist ; all elements have the same proposed name (old-proposed "") @@ -421,12 +426,14 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil." (setq proposed (uniquify-item-proposed item)) (unless (equal proposed old-proposed) (uniquify-rationalize-conflicting-sublist conflicting-sublist - old-proposed depth) + old-proposed depth + rename-buffer-fn get-buffer-fn) (setq conflicting-sublist nil)) (push item conflicting-sublist) (setq old-proposed proposed)) (uniquify-rationalize-conflicting-sublist conflicting-sublist - old-proposed depth))) + old-proposed depth + rename-buffer-fn get-buffer-fn))) (defun uniquify-get-proposed-name (base dirname &optional depth) (unless depth (setq depth uniquify-min-dir-content)) @@ -478,12 +485,12 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil." ;; Deal with conflicting-sublist, all of whose elements have identical ;; "base" components. -(defun uniquify-rationalize-conflicting-sublist (conf-list old-name depth) +(defun uniquify-rationalize-conflicting-sublist (conf-list old-name depth rename-buffer-fn get-buffer-fn) (when conf-list (if (or (cdr conf-list) ;; Check that the proposed name doesn't conflict with some ;; existing buffer. - (let ((buf (get-buffer old-name))) + (let ((buf (funcall get-buffer-fn old-name))) (and buf (not (eq buf (uniquify-item-buffer (car conf-list))))))) (when uniquify-possibly-resolvable (setq uniquify-possibly-resolvable nil @@ -494,10 +501,9 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil." (uniquify-item-base item) (uniquify-item-dirname item) depth))) - (uniquify-rationalize-a-list conf-list depth)) + (uniquify-rationalize-a-list conf-list depth rename-buffer-fn get-buffer-fn)) (unless (string= old-name "") - (uniquify-rename-buffer (car conf-list) old-name))))) - + (funcall rename-buffer-fn (car conf-list) old-name))))) (defun uniquify-rename-buffer (item newname) (let ((buffer (uniquify-item-buffer item))) @@ -507,6 +513,44 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil." ;; Pass the `unique' arg, so the advice doesn't mark it as unmanaged. (rename-buffer newname t)))))) +(defvar-local uniquify--stateless-curname nil + "The current unique name of this buffer in `uniquify-get-unique-names'.") + +(defun uniquify-get-unique-names (buffers) + "Return an alist with a unique name for each buffer in BUFFERS. + +The names are unique only among BUFFERS, and may conflict with other +buffers not in that list. + +This does not rename the buffers or change any state; the unique name is +only present in the returned alist." + (let ((buffer-names (make-hash-table :size (length buffers) :test 'equal)) + fix-lists-by-base) + (dolist (buf buffers) + (with-current-buffer buf + (setq uniquify--stateless-curname (buffer-name buf)) + (puthash (buffer-name buf) buf buffer-names) + (when uniquify-managed + (let ((base (uniquify-item-base (car uniquify-managed)))) + (push + (uniquify-make-item base (uniquify-buffer-file-name buf) buf nil) + (alist-get base fix-lists-by-base nil nil #'equal)))))) + (dolist (pair fix-lists-by-base) + (uniquify-rationalize--generic + (cdr pair) + (lambda (item name) ; rename-buffer + (with-current-buffer (uniquify-item-buffer item) + (remhash uniquify--stateless-curname buffer-names) + (setq uniquify--stateless-curname name) + (puthash name (current-buffer) buffer-names))) + (lambda (name) ; get-buffer + (gethash name buffer-names))))) + (mapcar (lambda (buf) + (with-current-buffer buf + (prog1 (cons uniquify--stateless-curname buf) + (kill-local-variable 'uniquify--stateless-curname)))) + buffers)) + ;;; Hooks from the rest of Emacs (defun uniquify-maybe-rerationalize-w/o-cb () commit 8b0f5b05976a99e82e54d6c602d47a8668ccd9d5 Author: Mattias Engdegård Date: Thu Jun 5 18:11:43 2025 +0200 Fix function arity check for noncompiled callees (bug#78685) This is a regression from Emacs 29. * lisp/emacs-lisp/bytecomp.el (byte-compile-fdefinition): Make it work for functions that aren't compiled. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--f): (bytecomp-tests--warn-arity-noncompiled-callee): Add test. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 0ec8db214bc..5fa65ff71a6 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1456,10 +1456,7 @@ when printing the error message." (let ((fn name)) (while (and (symbolp fn) (fboundp fn) - (or (symbolp (symbol-function fn)) - (consp (symbol-function fn)) - (and (not macro-p) - (compiled-function-p (symbol-function fn))))) + (functionp (symbol-function fn))) (setq fn (symbol-function fn))) (let ((advertised (get-advertised-calling-convention (if (and (symbolp fn) (fboundp fn)) @@ -1471,7 +1468,7 @@ when printing the error message." (if macro-p `(macro lambda ,advertised) `(lambda ,advertised))) - ((and (not macro-p) (compiled-function-p fn)) fn) + ((and (not macro-p) (functionp fn)) fn) ((not (consp fn)) nil) ((eq 'macro (car fn)) (cdr fn)) (macro-p nil) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 8b0c1dad4c0..d1f272f7a4d 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -1357,6 +1357,20 @@ byte-compiled. Run with dynamic binding." (concat ";;; -*-lexical-binding:nil-*-\n" some-code))) (should (cookie-warning some-code)))))) +(defun bytecomp-tests--f (x y &optional u v) (list x y u v)) + +(ert-deftest bytecomp-tests--warn-arity-noncompiled-callee () + "Check that calls to non-compiled functions are arity-checked (bug#78685)" + (should (not (compiled-function-p (symbol-function 'bytecomp-tests--f)))) + (let* ((source (concat ";;; -*-lexical-binding:t-*-\n" + "(defun my-fun () (bytecomp-tests--f 11))\n")) + (lexical-binding t) + (log (bytecomp-tests--log-from-compilation source))) + (should (string-search + (concat "Warning: `bytecomp-tests--f' called with 1 argument," + " but requires 2-4") + log)))) + (ert-deftest bytecomp-tests--unescaped-char-literals () "Check that byte compiling warns about unescaped character literals (Bug#20852)." commit 7393d7419e97272fbca6323cf374ec021dbe82e2 Author: Michael Albinus Date: Thu Jun 5 16:29:18 2025 +0200 Fix Tramp connection property * lisp/net/tramp-gvfs.el (tramp-gvfs-maybe-open-connection): * lisp/net/tramp-rclone.el (tramp-rclone-maybe-open-connection): Set "connected" property in time. diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 65a1595c29e..3dba7b1bad6 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -2347,11 +2347,11 @@ connection if a previous connection has died for some reason." ;; Save the password. (ignore-errors (and (functionp tramp-password-save-function) - (funcall tramp-password-save-function))) + (funcall tramp-password-save-function)))))) - ;; Mark it as connected. - (tramp-set-connection-property - (tramp-get-connection-process vec) "connected" t)))))) + ;; Mark it as connected. + (tramp-set-connection-property + (tramp-get-connection-process vec) "connected" t))) (defun tramp-gvfs-gio-tool-p (vec) "Check, whether the gio tool is available." diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 5ad5c8f5c27..e4008c197fb 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -412,11 +412,11 @@ connection if a previous connection has died for some reason." (tramp-get-method-parameter vec 'tramp-mount-args)) (while (not (file-exists-p (tramp-make-tramp-file-name vec 'noloc))) (tramp-cleanup-connection vec 'keep-debug 'keep-password)) + (add-to-list 'tramp-fuse-mount-points (tramp-file-name-unify vec))) - ;; Mark it as connected. - (add-to-list 'tramp-fuse-mount-points (tramp-file-name-unify vec)) - (tramp-set-connection-property - (tramp-get-connection-process vec) "connected" t)))) + ;; Mark it as connected. + (tramp-set-connection-property + (tramp-get-connection-process vec) "connected" t))) ;; In `tramp-check-cached-permissions', the connection properties ;; "{uid,gid}-{integer,string}" are used. We set them to proper values. commit b15743d71399ed44fb431adb149f98c6ac86d26f Author: Kazuhiro Ito Date: Wed Jun 4 20:40:06 2025 +0900 * lisp/subr.el (play-sound): Update docstring (bug#78694). diff --git a/lisp/subr.el b/lisp/subr.el index e1036df885c..729f8b3e09b 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -4479,7 +4479,7 @@ don't change the volume setting of the sound device. :device DEVICE - play sound on DEVICE. If not specified, a system-dependent default device name is used. -Note: :data and :device are currently not supported on Windows." +Note: :device is currently not supported on Windows." (if (fboundp 'play-sound-internal) (play-sound-internal sound) (error "This Emacs binary lacks sound support"))) commit 5bf6585de23a7efc1a01d907704325e702e9410a Author: Eli Zaretskii Date: Thu Jun 5 14:25:06 2025 +0300 ; Improve documentation of treesit nodes * doc/lispref/parsing.texi (Retrieving Nodes): Fix and describe the printed representation of treesit nodes. diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index 374eeb28b7a..2ff2e5f6160 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -644,6 +644,14 @@ Nodes are not automatically updated when the associated buffer is modified, and there is no way to update a node once it is retrieved. Using an outdated node signals the @code{treesit-node-outdated} error. +@cindex printed representation, of treesit nodes +The printed representation of a tree-sitter node uses the hash notation +described in @ref{Printed Representation}. It looks like +@w{@samp{#}}, where +@var{type} is the type of the node (which comes from the tree-sitter +grammar used by the buffer), and @var{pos1} and @var{pos2} are buffer +positions of the node's span. Tree-sitter nodes have no read syntax. + @heading Retrieving nodes from syntax tree @cindex retrieving tree-sitter nodes @cindex syntax tree, retrieving nodes @@ -684,7 +692,7 @@ Example: @group ;; Find the node at point in a C parser's syntax tree. (treesit-node-at (point) 'c) - @result{} # + @result{} # @end group @end example @end defun @@ -791,7 +799,7 @@ This function finds the child of @var{node} whose field name is @group ;; Get the child that has "body" as its field name. (treesit-node-child-by-field-name node "body") - @result{} # + @result{} # @end group @end example @end defun commit 7d0a605a70215acd79f920d1c250d6ea4e40bb78 Author: Sean Whitton Date: Fri May 30 13:32:00 2025 +0100 Delay running vc-checkin-hook for an async checkin * lisp/vc/vc-git.el (vc-git-checkin): * lisp/vc/vc-hg.el (vc-hg-checkin, vc-hg-checkin-patch): Run vc-checkin-hook using vc-run-delayed. * lisp/vc/vc.el (vc-checkin): Don't pass vc-checkin-hook to vc-start-logentry when doing an async checkin. That runs the hook too early. diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 77f1f747d69..f460eafacbf 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1125,7 +1125,8 @@ It is based on `log-edit-mode', and has Git-specific extensions." (delete-file ,temp)))) (defun vc-git-checkin (files comment &optional _rev) - (let* ((file1 (or (car files) default-directory)) + (let* ((parent (current-buffer)) + (file1 (or (car files) default-directory)) (root (vc-git-root file1)) (default-directory (expand-file-name root)) (only (or (cdr files) @@ -1253,7 +1254,10 @@ It is based on `log-edit-mode', and has Git-specific extensions." (with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'git) - (funcall post))) + (funcall post) + (when (buffer-live-p parent) + (with-current-buffer parent + (run-hooks 'vc-checkin-hook))))) (vc-set-async-update buffer)) (apply #'vc-git-command nil 0 files args) (funcall post))))) diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 490118ad0f3..e1527935861 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -1186,7 +1186,8 @@ It is based on `log-edit-mode', and has Hg-specific extensions.") (defun vc-hg-checkin (files comment &optional _rev) "Hg-specific version of `vc-backend-checkin'. REV is ignored." - (let ((args (nconc (list "commit" "-m") + (let ((parent (current-buffer)) + (args (nconc (list "commit" "-m") (vc-hg--extract-headers comment)))) (if vc-async-checkin (let ((buffer (vc-hg--async-buffer))) @@ -1195,12 +1196,16 @@ REV is ignored." "Finishing checking in files...") (with-current-buffer buffer (vc-run-delayed - (vc-compilation-mode 'hg))) + (vc-compilation-mode 'hg) + (when (buffer-live-p parent) + (with-current-buffer parent + (run-hooks 'vc-checkin-hook))))) (vc-set-async-update buffer)) (apply #'vc-hg-command nil 0 files args)))) (defun vc-hg-checkin-patch (patch-string comment) - (let ((patch-file (make-temp-file "hg-patch"))) + (let ((parent (current-buffer)) + (patch-file (make-temp-file "hg-patch"))) (write-region patch-string nil patch-file) (unwind-protect (let ((args (list "update" @@ -1214,7 +1219,10 @@ REV is ignored." (apply #'vc-hg--async-command buffer args) (with-current-buffer buffer (vc-run-delayed - (vc-compilation-mode 'hg))) + (vc-compilation-mode 'hg) + (when (buffer-live-p parent) + (with-current-buffer parent + (run-hooks 'vc-checkin-hook))))) (vc-set-async-update buffer)) (apply #'vc-hg-command nil 0 nil args))) (delete-file patch-file)))) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 1fad73face1..64d58265816 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1894,41 +1894,49 @@ The optional argument PATCH-STRING is a string to check in as a patch. Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." (run-hooks 'vc-before-checkin-hook) - (vc-start-logentry - files comment initial-contents - "Enter a change comment." - "*vc-log*" - (lambda () - (vc-call-backend backend 'log-edit-mode)) - (lambda (files comment) - ;; "This log message intentionally left almost blank". - ;; RCS 5.7 gripes about whitespace-only comments too. - (unless (and comment (string-match "[^\t\n ]" comment)) - (setq comment "*** empty log message ***")) - (cl-labels ((do-it () - ;; We used to change buffers to get local value of - ;; `vc-checkin-switches', but the (singular) local - ;; buffer is not well defined for filesets. - (if patch-string - (vc-call-backend backend 'checkin-patch - patch-string comment) - (vc-call-backend backend 'checkin - files comment rev)) - (mapc #'vc-delete-automatic-version-backups files))) - (if (and vc-async-checkin (memq backend vc-async-checkin-backends)) - ;; Rely on `vc-set-async-update' to update properties. - (do-it) - (message "Checking in %s..." (vc-delistify files)) - (with-vc-properties files (do-it) - `((vc-state . up-to-date) - (vc-checkout-time - . ,(file-attribute-modification-time - (file-attributes file))) - (vc-working-revision . nil))) - (message "Checking in %s...done" (vc-delistify files))))) - 'vc-checkin-hook - backend - patch-string)) + (let ((do-async (and vc-async-checkin + (memq backend vc-async-checkin-backends)))) + (vc-start-logentry + files comment initial-contents + "Enter a change comment." + "*vc-log*" + (lambda () + (vc-call-backend backend 'log-edit-mode)) + (lambda (files comment) + ;; "This log message intentionally left almost blank". + ;; RCS 5.7 gripes about whitespace-only comments too. + (unless (and comment (string-match "[^\t\n ]" comment)) + (setq comment "*** empty log message ***")) + (cl-labels ((do-it () + ;; We used to change buffers to get local value of + ;; `vc-checkin-switches', but the (singular) local + ;; buffer is not well defined for filesets. + (if patch-string + (vc-call-backend backend 'checkin-patch + patch-string comment) + (vc-call-backend backend 'checkin + files comment rev)) + (mapc #'vc-delete-automatic-version-backups files))) + (if do-async + ;; Rely on `vc-set-async-update' to update properties. + (do-it) + (message "Checking in %s..." (vc-delistify files)) + (with-vc-properties files (do-it) + `((vc-state . up-to-date) + (vc-checkout-time + . ,(file-attribute-modification-time + (file-attributes file))) + (vc-working-revision . nil))) + (message "Checking in %s...done" (vc-delistify files))))) + + ;; FIXME: In the async case we need the hook to be added to the + ;; buffer with the checkin process, using `vc-run-delayed'. Ideally + ;; the identity of that buffer would be exposed to this code, + ;; somehow, so we could always handle running the hook up here. + (and (not do-async) 'vc-checkin-hook) + + backend + patch-string))) (defun vc-default-checkin-patch (_backend patch-string comment) (pcase-let* ((`(,backend ,files) (with-temp-buffer commit 6d0a71af9a99b50b2c5a8db778311123ba3ecbcf Author: Eli Zaretskii Date: Thu Jun 5 11:09:36 2025 +0300 ; * etc/NEWS: Call out incompatible change in 'date-to-time'. diff --git a/etc/NEWS b/etc/NEWS index 01ed372a2da..9cf3c626449 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2209,6 +2209,17 @@ removed. The initial terminal frame of an Emacs process running as daemon can be deleted via 'delete-frame' if and only if its optional FORCE argument is non-nil. + +--- +** 'date-to-time' no longer accepts malformed times with time zone like "EDT". +Time strings like "2025-06-04T13:21:00 EDT" are not in valid ISO 8601 +time format, and 'date-to-time' now signals an error for them. Use a +numerical time-zone specification, like "2025-06-04T13:21:00-0400", +instead, which gives the time offset as +/-hh or +/-hh:mm. A designator +"Z" for UTC time is also supported. Less formal space-separated time +formats, like "2025-06-04 13:21:00 EDT", without the ISO 8601 "T" +separator, are also supported. + * Lisp Changes in Emacs 31.1 commit bcf005fa774194d434c68cc191566b58c297ca86 Author: Eli Zaretskii Date: Thu Jun 5 10:30:44 2025 +0300 Improve documentation of treesit "thing" * src/treesit.c (syms_of_treesit): * lisp/treesit.el (treesit-cycle-sexp-type): (treesit-thing-at, treesit-thing-at-point): Doc fixes. * doc/lispref/parsing.texi (User-defined Things): Improve documentation of treesit "thing" and related functions; add cross-references and indexing. diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index aa321785460..374eeb28b7a 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -1619,14 +1619,16 @@ documentation about pattern-matching. The documentation can be found at It's often useful to be able to identify and find certain @dfn{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 corresponds to a ``thing''. This enables handy -features like jumping to the next function, marking the code block at -point, or transposing two function arguments. +strings, comments, etc., in terms of node types defined by the +tree-sitter grammar used in the buffer. Emacs allows Lisp programs to +define what kinds of tree-sitter nodes corresponds to each ``thing''. +This enables handy features like jumping to the next function, marking +the code block at point, transposing two function arguments, etc. The ``things'' feature in Emacs is independent of the pattern matching -feature of tree-sitter, and comparatively less powerful, but more -suitable for navigation and traversing the parse tree. +feature of tree-sitter (@pxref{Pattern Matching}), and comparatively +less powerful, but more suitable for navigation and traversing the +buffer text in terms of the tree-sitter parse tree. @findex treesit-thing-definition @findex treesit-thing-defined-p @@ -1635,12 +1637,22 @@ predicate of a defined thing with @code{treesit-thing-definition}, and test if a thing is defined with @code{treesit-thing-defined-p}. @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})}}, where -@var{thing} is a symbol representing the thing, like @code{defun}, -@code{sexp}, or @code{sentence}; and @var{pred} specifies what kind of -tree-sitter node is this @var{thing}. +This is an alist of thing definitions for each language supported by the +grammar used in a buffer; it should be defined by the buffer's major +mode (the default value is @code{nil}). The key of each entry is a +language symbol (e.g., @code{c} for C, @code{cpp} for C@t{++}, etc.), +and the value is a list of thing definitions of the form +@w{@code{(@var{thing} @var{pred})}}, where @var{thing} is a symbol +representing the thing, and @var{pred} specifies what kinds of +tree-sitter nodes are considered as this @var{thing}. + +@cindex @code{sexp}, treesit-defined thing +@cindex @code{list}, treesit-defined thing +The symbol used to define the @var{thing} can be anything meaningful for +the major mode: @code{defun}, @code{defclass}, @code{sentence}, +@code{comment}, @code{string}, etc. To support tree-sitter based +navigation commands (@pxref{List Motion}), the mode should define two +things: @code{list} and @code{sexp}. @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 @@ -1660,13 +1672,16 @@ meaning that 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} thing or a @code{sentence} thing, as defined -by some other rule in the alist. +by some other rules in the alist. +@cindex @code{named}, treesit-defined thing +@cindex @code{anonymous}, treesit-defined thing There are two pre-defined predicates: @code{named} and @code{anonymous}, -which qualify, respectively, named and anonymous nodes. They can be -combined with @code{and} to narrow down the match. +which qualify, respectively, named and anonymous nodes of the +tree-sitter grammar. They can be combined with @code{and} to narrow +down the match. -Here's an example @code{treesit-thing-settings} for C and C++: +Here's an example @code{treesit-thing-settings} for C and C@t{++}: @example @group @@ -1676,6 +1691,8 @@ Here's an example @code{treesit-thing-settings} for C and C++: (comment "comment") (string "raw_string_literal") (text (or comment string))) +@end group +@group (cpp (defun ("function_definition" . cpp-ts-mode-defun-valid-p)) (defclass "class_specifier") @@ -1685,12 +1702,12 @@ Here's an example @code{treesit-thing-settings} for C and C++: @noindent Note that this example is modified for didactic purposes, and isn't -exactly how C and C@t{++} modes define things. +exactly how tree-sitter based C and C@t{++} modes define things. @end defvar -Emacs builtin functions already make use some thing definitions. +Emacs builtin functions already make use of some thing definitions. Command @code{treesit-forward-sexp} uses the @code{sexp} definition if -major mode defines it; @code{treesit-forward-list}, +major mode defines it (@pxref{List Motion}); @code{treesit-forward-list}, @code{treesit-down-list}, @code{treesit-up-list}, @code{treesit-show-paren-data} use the @code{list} definition (its symbol @code{list} has the symbol property @code{treesit-thing-symbol} @@ -1699,8 +1716,8 @@ to avoid ambiguity with the function that has the same name); Defun movement functions like @code{treesit-end-of-defun} uses the @code{defun} definition (@code{defun} definition is overridden by @var{treesit-defun-type-regexp} for backward compatibility). Major -modes can also define @code{comment}, @code{string}, @code{text} -(generally comments and strings). +modes can also define @code{comment}, @code{string}, and @code{text} +things (to match comments and strings). The rest of this section lists a few functions that take advantage of the thing definitions. Besides the functions below, some other @@ -1709,10 +1726,10 @@ tree-traversing functions like @code{treesit-search-forward}, @code{treesit-induce-sparse-tree}, etc. @xref{Retrieving Nodes}. @defun treesit-node-match-p node thing &optional ignore-missing -This function checks whether @var{node} is a @var{thing}. +This function checks whether @var{node} represents a @var{thing}. -If @var{node} is a @var{thing}, return non-@code{nil}, otherwise return -@code{nil}. For convenience, if @code{node} is @code{nil}, this +If @var{node} represents @var{thing}, return non-@code{nil}, otherwise +return @code{nil}. For convenience, if @code{node} is @code{nil}, this function just returns @code{nil}. The @var{thing} can be either a thing symbol like @code{defun}, or @@ -1727,8 +1744,9 @@ undefined and just returns @code{nil}; but it still signals the error if @end defun @defun treesit-thing-prev position thing -This function returns the first node before @var{position} that is the -specified @var{thing}. If no such node exists, it returns @code{nil}. +This function returns the first node before @var{position} in the +current buffer that is the specified @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{position}. In other words, this function never returns a node that encloses @var{position}. @@ -1753,8 +1771,9 @@ function doesn't move point. A positive @var{arg} means moving forward that many instances of @var{thing}; negative @var{arg} means moving backward. If @var{side} is -@code{beg}, this function stops at the beginning of @var{thing}; if -@code{end}, stop at the end of @var{thing}. +@code{beg}, this function returns the position of the beginning of +@var{thing}; if it's @code{end}, it returns the position at the end of +@var{thing}. Like in @code{treesit-thing-prev}, @var{thing} can be a thing symbol defined in @code{treesit-thing-settings}, or a predicate. @@ -1780,8 +1799,8 @@ less or equal to @var{position}, and it's end position is greater or equal to @var{position}. If @var{strict} is non-@code{nil}, this function uses strict comparison, -i.e., start position must be strictly greater than @var{position}, and end -position must be strictly less than @var{position}. +i.e., start position must be strictly smaller than @var{position}, and end +position must be strictly greater than @var{position}. @var{thing} can be either a thing symbol defined in @code{treesit-thing-settings}, or a predicate. diff --git a/lisp/treesit.el b/lisp/treesit.el index 5df8eb70cbf..45626e77b99 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -3237,11 +3237,14 @@ The type can be `list' (the default) or `sexp'. The `list' type uses the `list' thing defined in `treesit-thing-settings'. See `treesit-thing-at-point'. With this type commands use syntax tables to -navigate symbols and treesit definition to navigate lists. +navigate symbols and treesit definitions to navigate lists. The `sexp' type uses the `sexp' thing defined in `treesit-thing-settings'. -With this type commands use only the treesit definition of parser nodes, -without distinction between symbols and lists." +With this type commands use only the treesit definitions of parser nodes, +without distinction between symbols and lists. Since tree-sitter grammars +could group node types in arbitrary ways, navigation by `sexp' might not +match your expectations, and might produce different results in differnt +treesit-based modes." (interactive "p") (if (not (treesit-thing-defined-p 'list (treesit-language-at (point)))) (user-error "No `list' thing is defined in `treesit-thing-settings'") @@ -3630,14 +3633,15 @@ predicate as described in `treesit-thing-settings'." (treesit--thing-sibling pos thing nil)) (defun treesit-thing-at (pos thing &optional strict) - "Return the smallest THING enclosing POS. + "Return the smallest node enclosing POS for THING. -The returned node, if non-nil, must enclose POS, i.e., its start -<= POS, its end > POS. If STRICT is non-nil, the returned node's -start must < POS rather than <= POS. +The returned node, if non-nil, must enclose POS, i.e., its +start <= POS, its end > POS. If STRICT is non-nil, the returned +node's start must be < POS rather than <= POS. -THING should be a thing defined in `treesit-thing-settings', or -it can be a predicate described in `treesit-thing-settings'." +THING should be a thing defined in `treesit-thing-settings' for +the current buffer's major mode, or it can be a predicate +described in `treesit-thing-settings'." (let* ((cursor (treesit-node-at pos)) (iter-pred (lambda (node) (and (treesit-node-match-p node thing t) @@ -3789,13 +3793,14 @@ function is called recursively." (if (eq counter 0) pos nil))) (defun treesit-thing-at-point (thing tactic) - "Return the THING at point, or nil if none is found. + "Return the node for THING at point, or nil if no THING is found at point. THING can be a symbol, a regexp, a predicate function, and more; -see `treesit-thing-settings' for details. +for details, see `treesit-thing-settings' as defined by the +current buffer's major mode. -Return the top-level THING if TACTIC is `top-level'; return the -smallest enclosing THING as POS if TACTIC is `nested'." +Return the top-level node for THING if TACTIC is `top-level'; return +the smallest node enclosing THING at point if TACTIC is `nested'." (let ((node (treesit-thing-at (point) thing))) (if (eq tactic 'top-level) diff --git a/src/treesit.c b/src/treesit.c index de74e41c89a..67dd2ee3a7a 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -5193,13 +5193,16 @@ then in the system default locations for dynamic libraries, in that order. */); doc: /* A list defining things. -The value should be an alist of (LANGUAGE . DEFINITIONS), where -LANGUAGE is a language symbol, and DEFINITIONS is a list of +The value should be defined by the major mode, and should be an alist +of the form (LANGUAGE . DEFINITIONS), where LANGUAGE is a language +symbol and DEFINITIONS is a list whose elements are of the form (THING PRED) -THING is a symbol representing the thing, like `defun', `sexp', or -`sentence'; PRED defines what kind of node can be qualified as THING. +THING is a symbol representing the thing, like `defun', `defclass', +`sexp', `sentence', `comment', or any other symbol that is meaningful +for the major mode; PRED defines what kind of node can be qualified +as THING. PRED can be a regexp string that matches the type of the node; it can be a predicate function that takes the node as the sole argument and @@ -5207,12 +5210,13 @@ returns t if the node is the thing, and nil otherwise; it can be a cons (REGEXP . FN), which is a combination of a regexp and a predicate function, and the node has to match both to qualify as the thing. -PRED can also be recursively defined. It can be (or PRED...), meaning -satisfying anyone of the inner PREDs qualifies the node; or (and -PRED...) meaning satisfying all of the inner PREDs qualifies the node; -or (not PRED), meaning not satisfying the inner PRED qualifies the node. +PRED can also be recursively defined. It can be: -There are two pre-defined predicates, `named' and `anonymous`. They + (or PRED...), meaning satisfying any of the inner PREDs qualifies the node; + (and PRED...) meaning satisfying all of the inner PREDs qualifies the node; + (not PRED), meaning not satisfying the inner PRED qualifies the node. + +There are two pre-defined predicates, `named' and `anonymous'. They match named nodes and anonymous nodes, respectively. Finally, PRED can refer to other THINGs defined in this list by using