1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-04-27 08:43:40 -07:00

Improve syncing VC buffers before generating diffs

* lisp/vc/vc.el (vc-maybe-buffer-sync): Delete.  Correct
handling of indirect buffers is now implicitly achieved by
vc-buffer-sync-fileset.
(vc-buffer-sync-fileset): Make NOT-ESSENTIAL argument optional,
new MISSING-IN-DIRS optional argument.  Rewrite to handle
directories named in the fileset, not only files.
(vc-ediff): Replace call to vc-maybe-buffer-sync with a call to
vc-buffer-sync-fileset.
(vc-root-diff): Similarly replace call to vc-maybe-buffer-sync.
This means the user is prompted to save additional buffers, that
they likely want to save before generating the diffs.
* test/lisp/vc/vc-misc-tests.el: New file.
This commit is contained in:
Sean Whitton 2025-04-27 11:45:54 +08:00
parent d047a89e76
commit 07c2b169ed
2 changed files with 109 additions and 16 deletions

View file

@ -2281,10 +2281,6 @@ state of each file in the fileset."
t (list backend (list rootdir)) rev1 rev2
(called-interactively-p 'interactive)))))
(defun vc-maybe-buffer-sync (not-essential)
(with-current-buffer (or (buffer-base-buffer) (current-buffer))
(when buffer-file-name (vc-buffer-sync not-essential))))
;;;###autoload
(defun vc-diff (&optional historic not-essential fileset)
"Display diffs between file revisions.
@ -2303,11 +2299,40 @@ Optional argument FILESET, if non-nil, overrides the fileset."
(vc-diff-internal t fileset nil nil
(called-interactively-p 'interactive)))))
(defun vc-buffer-sync-fileset (fileset not-essential)
(dolist (filename (cadr fileset))
(when-let* ((buffer (find-buffer-visiting filename)))
(with-current-buffer buffer
(vc-buffer-sync not-essential)))))
(defun vc-buffer-sync-fileset (fileset &optional not-essential missing-in-dirs)
"Call `vc-buffer-sync' for most buffers visiting files in FILESET.
NOT-ESSENTIAL means it is okay to continue if the user says not to save.
For files named explicitly in FILESET, this function always syncs their
buffers. By contrast, for directories named in FILESET, its behavior
depends on MISSING-IN-DIRS. For each directory named in FILESET, it
considers buffers visiting any file contained within that directory or
its subdirectories. If MISSING-IN-DIRS is nil, it syncs only those
buffers whose files exist on disk. Otherwise it syncs all of them."
;; This treatment of directories named in FILESET is wanted for, at
;; least, users with `vc-find-revision-no-save' set to non-nil: not
;; treating directories this way would imply calling `vc-buffer-sync'
;; on all buffers generated by \\`C-x v ~' during \\`C-x v D'.
(let (dirs buffers)
(dolist (name (cadr fileset))
(if (file-directory-p name)
(push name dirs)
(when-let* ((buf (find-buffer-visiting name)))
(push buf buffers))))
(when dirs
(setq buffers
(cl-nunion buffers
(match-buffers
(lambda (buf)
(and-let*
((file (buffer-local-value 'buffer-file-name buf))
((or missing-in-dirs (file-exists-p file)))
((cl-some (lambda (dir)
(file-in-directory-p file dir))
dirs)))))))))
(dolist (buf buffers)
(with-current-buffer buf
(vc-buffer-sync not-essential)))))
;;;###autoload
(defun vc-diff-mergebase (_files rev1 rev2)
@ -2384,8 +2409,9 @@ saving the buffer."
(interactive (list current-prefix-arg t))
(if historic
(call-interactively 'vc-version-ediff)
(vc-maybe-buffer-sync not-essential)
(vc-version-ediff (cadr (vc-deduce-fileset t)) nil nil)))
(let ((fileset (vc-deduce-fileset)))
(vc-buffer-sync-fileset fileset not-essential)
(vc-version-ediff (cadr fileset) nil nil))))
;;;###autoload
(defun vc-root-diff (historic &optional not-essential)
@ -2401,7 +2427,6 @@ saving the buffer."
(if historic
;; We want the diff for the VC root dir.
(call-interactively 'vc-root-version-diff)
(vc-maybe-buffer-sync not-essential)
(let ((backend (vc-deduce-backend))
(default-directory default-directory)
rootdir)
@ -2416,10 +2441,11 @@ saving the buffer."
;; relative to it. Bind default-directory to the root directory
;; here, this way the *vc-diff* buffer is setup correctly, so
;; relative file names work.
(let ((default-directory rootdir))
(vc-diff-internal
t (list backend (list rootdir)) nil nil
(called-interactively-p 'interactive))))))
(let ((default-directory rootdir)
(fileset `(,backend (,rootdir))))
(vc-buffer-sync-fileset fileset not-essential)
(vc-diff-internal t fileset nil nil
(called-interactively-p 'interactive))))))
;;;###autoload
(defun vc-root-dir ()

View file

@ -0,0 +1,67 @@
;;; vc-misc-tests.el --- backend-agnostic VC tests -*- lexical-binding:t -*-
;; Copyright (C) 2025 Free Software Foundation, Inc.
;; Author: Sean Whitton <spwhitton@spwhitton.name>
;; 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 <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'ert-x)
(require 'vc)
(ert-deftest vc-test-buffer-sync-fileset ()
"Test `vc-buffer-sync-fileset'."
(cl-flet ((test-it (&rest args)
(let (buffers)
(cl-letf (((symbol-function 'vc-buffer-sync)
(lambda (&rest _)
(push (current-buffer) buffers))))
(apply #'vc-buffer-sync-fileset args)
(sort buffers)))))
(ert-with-temp-directory temp
(let* ((default-directory temp)
(present (find-file-noselect "present"))
(missing (find-file-noselect "missing"))
(only-present (list present))
(only-missing (list missing))
(missing+present (list missing present)))
(with-current-buffer present (basic-save-buffer))
(with-temp-file "unvisited")
;; Regular behavior for files.
(should (equal (test-it `(Git ("missing")))
only-missing))
(should (equal (test-it `(Git ("present" "missing")))
missing+present))
;; Regular behavior for directories.
(should (equal (test-it `(Git (,temp)))
only-present))
;; Two ways to override regular behavior for directories.
(should (equal (test-it `(Git (,temp)) nil t)
missing+present))
(should (equal (test-it `(Git (,temp "missing")))
missing+present))
;; Doesn't sync PRESENT twice.
(should (equal (test-it `(Git ("present" ,temp)))
only-present))
(should (equal (test-it `(Git ("missing" ,temp "present")))
missing+present))))))
(provide 'vc-misc-tests)
;;; vc-misc-tests.el ends here