vc-rename-file: New OK-IF-ALREADY-EXISTS parameter

* lisp/vc/vc.el (vc-delete-file): New NOCONFIRM parameter.
(vc-rename-file): New OK-IF-ALREADY-EXISTS parameter.
* lisp/dired-aux.el (dired-rename-file): Pass it.
* test/lisp/vc/vc-tests/vc-tests.el (vc-test--rename-file): Test
it.  Also test moving files into an existing directory.
This commit is contained in:
Sean Whitton
2026-04-15 10:04:58 -04:00
parent 8b823737ff
commit 5347b221da
3 changed files with 54 additions and 12 deletions

View File

@@ -2362,7 +2362,7 @@ unless OK-IF-ALREADY-EXISTS is non-nil."
(ignore-errors (vc-responsible-backend file))
(vc-backend file))
(ignore-errors (vc-responsible-backend newname)))
(vc-rename-file file newname)
(vc-rename-file file newname ok-if-already-exists)
;; error is caught in -create-files
(rename-file file newname ok-if-already-exists))
;; Silently rename the visited file of any buffer visiting this file.

View File

@@ -4958,12 +4958,14 @@ backend to NEW-BACKEND, and unregister FILE from the current backend.
(vc-checkin file new-backend comment (stringp comment)))))
;;;###autoload
(defun vc-delete-file (file-or-files)
(defun vc-delete-file (file-or-files &optional noconfirm)
"Delete file and mark it as such in the version control system.
If called interactively, read FILE-OR-FILES, defaulting to the current
buffer's file name if it's under version control.
When called from Lisp, FILE-OR-FILES can be a file name or a list of
file names."
file names.
When called from Lisp, optional argument NOCONFIRM non-nil means don't
prompt to confirm deletion."
(interactive (list (read-file-name "VC delete file: " nil
(when (vc-backend buffer-file-name)
buffer-file-name)
@@ -4982,11 +4984,12 @@ file names."
(error "Please commit or undo your changes before deleting %s" file))
(when (eq state 'conflict)
(error "Please resolve the conflicts before deleting %s" file)))))
(unless (y-or-n-p (if (cdr file-or-files)
(format "Really want to delete these %d files? "
(length file-or-files))
(format "Really want to delete %s? "
(file-name-nondirectory (car file-or-files)))))
(unless (or noconfirm
(y-or-n-p (if (cdr file-or-files)
(format "Really want to delete these %d files? "
(length file-or-files))
(format "Really want to delete %s? "
(file-name-nondirectory (car file-or-files))))))
(error "Abort!"))
(let ((post-backend-deletion
;; Things to do after calling the backend's `delete-file' or
@@ -5032,10 +5035,14 @@ file names."
(funcall post-backend-deletion file)))))))
;;;###autoload
(defun vc-rename-file (old new)
(defun vc-rename-file (old new &optional ok-if-already-exists)
"Rename file OLD to NEW in both working tree and repository.
When called interactively, read OLD and NEW, defaulting OLD to the
current buffer's file name if it's under version control."
current buffer's file name if it's under version control.
If NEW is a directory name, rename FILE to a like-named file under NEW.
For NEW to be recognized as a directory name, it should end in a slash.
Signal a `file-already-exists' error if a file NEW already exists unless
called from Lisp with optional argument OK-IF-ALREADY-EXISTS non-nil."
;; FIXME: Support renaming whole directories.
;; The use of `vc-call' will need to change to something like
;;
@@ -5064,8 +5071,14 @@ current buffer's file name if it's under version control."
(error "Please save files before moving them"))
(when (get-file-buffer new)
(error "Already editing new file name"))
;; Handle OK-IF-ALREADY-EXISTS here because it's not part of the VC
;; backend `delete-file' API.
;; If NEW is a directory we'll fail to delete it, consistent with
;; `rename-file' whose OK-IF-ALREADY-EXISTS argument similarly can't
;; delete existing directories.
(when (file-exists-p new)
(error "New file already exists"))
(if ok-if-already-exists (vc-delete-file new 'noconfirm)
(signal 'file-already-exists `("File exists" ,new))))
(unless dirp
(let ((state (vc-state old)))
(unless (memq state '(up-to-date edited added))

View File

@@ -589,7 +589,36 @@ This checks also `vc-backend' and `vc-responsible-backend'."
(should (equal (vc-state new-name)
(if (memq backend '(RCS SCCS))
'up-to-date
'added)))))
'added))))
;; Test OK-IF-ALREADY-EXISTS.
(let ((tmp-name (expand-file-name "qux" default-directory))
(new-name (expand-file-name "quuux" default-directory)))
(write-region "qux" nil tmp-name nil 'nomessage)
(write-region "quuux" nil new-name nil 'nomessage)
(vc-register
(list backend (list (file-name-nondirectory tmp-name)
(file-name-nondirectory new-name))))
(should-error (vc-rename-file tmp-name new-name)
:type 'file-already-exists)
(vc-rename-file tmp-name new-name 'ok-if-already-exists)
(should-not (file-exists-p tmp-name))
(should (file-exists-p new-name)))
;; Test moving into an existing directory.
(let ((tmp-name (expand-file-name "quux" default-directory))
(new-dir (expand-file-name "dir1/" default-directory))
(new-name (expand-file-name "dir1/quux" default-directory)))
(make-directory new-dir)
(write-region "quux" nil tmp-name nil 'nomessage)
(vc-register
`(,backend (,(file-relative-name new-dir default-directory)
,(file-name-nondirectory tmp-name))))
(vc-rename-file tmp-name new-dir)
(should-not (file-exists-p tmp-name))
(should (file-exists-p new-name))))
;; Save exit.
(ignore-errors