diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 40f91b7..d55bf48 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -941,33 +941,42 @@ Within directories, only files already under version control are noticed." (declare-function vc-dir-current-file "vc-dir" ()) (declare-function vc-dir-deduce-fileset "vc-dir" (&optional state-model-only-files)) -(defun vc-deduce-fileset (&optional observer allow-unregistered - state-model-only-files) - "Deduce a set of files and a backend to which to apply an operation. +(defun log-edit-deduce-fileset (state-model-only-files) + ;; Attempt to reconstruct the original fileset from the log-edit + ;; buffer. [We ought to be able to do a better job. Better still, + ;; we ought to be able to return the fileset used to create the + ;; buffer. At least we don't need state-model-only-files, since + ;; that has already been taken care of. -- rgr, 27-Nov-10.] + (let ((backend + (and vc-parent-buffer + (with-current-buffer vc-parent-buffer + (if (derived-mode-p 'vc-dir-mode) + vc-dir-backend + (vc-responsible-backend + (or buffer-file-name default-directory))))))) + (and backend + (list backend vc-log-fileset)))) + +(defun vc-deduce-fileset-internal (&optional nonviolent-p state-model-only-files) + "Deduce a set of registered files and a backend for an operation. Return (BACKEND FILESET FILESET-ONLY-FILES STATE CHECKOUT-MODEL). -If we're in VC-dir mode, the fileset is the list of marked files. -Otherwise, if we're looking at a buffer visiting a version-controlled file, -the fileset is a singleton containing this file. -If none of these conditions is met, but ALLOW_UNREGISTERED is on and the -visited file is not registered, return a singleton fileset containing it. -Otherwise, throw an error. +See vc-deduce-fileset for details; we do just the first part of the search, +looking for registered files, returning nil if nothing found. -STATE-MODEL-ONLY-FILES if non-nil, means that the caller needs -the FILESET-ONLY-FILES STATE and MODEL info. Otherwise, that -part may be skipped. -BEWARE: this function may change the -current buffer." - ;; FIXME: OBSERVER is unused. The name is not intuitive and is not - ;; documented. It's set to t when called from diff and print-log. +BEWARE: this function may change the current buffer." (let (backend) (cond ((derived-mode-p 'vc-dir-mode) (vc-dir-deduce-fileset state-model-only-files)) ((derived-mode-p 'dired-mode) - (if observer + (if nonviolent-p (vc-dired-deduce-fileset) (error "State changing VC operations not supported in `dired-mode'"))) + ((derived-mode-p 'log-edit-mode) + ;; This has a vc-parent-buffer, but that might result in a + ;; different fileset. + (log-edit-deduce-fileset state-model-only-files)) ((setq backend (vc-backend buffer-file-name)) (if state-model-only-files (list backend (list buffer-file-name) @@ -978,11 +987,37 @@ current buffer." ((and (buffer-live-p vc-parent-buffer) ;; FIXME: Why this test? --Stef (or (buffer-file-name vc-parent-buffer) - (with-current-buffer vc-parent-buffer - (derived-mode-p 'vc-dir-mode)))) + (with-current-buffer vc-parent-buffer + (derived-mode-p 'vc-dir-mode)))) + ;; Note that vc-parent-buffer must be registered. (progn ;FIXME: Why not `with-current-buffer'? --Stef. (set-buffer vc-parent-buffer) - (vc-deduce-fileset observer allow-unregistered state-model-only-files))) + (vc-deduce-fileset-internal nonviolent-p state-model-only-files)))))) + +(defun vc-deduce-fileset (&optional nonviolent-p allow-unregistered + state-model-only-files) + "Deduce a set of files and a backend to which to apply an operation. + +Return (BACKEND FILESET FILESET-ONLY-FILES STATE CHECKOUT-MODEL). +If we're in VC-dir mode, the fileset is the list of marked files. +Otherwise, if we're in dired-mode, use current/marked files. +Otherwise, if we're looking at a buffer visiting a version-controlled file, +the fileset is a singleton containing this file. +Otherwise, if we're in a VC buffer that has a parent, try again in the parent. +If none of these conditions is met, but ALLOW-UNREGISTERED is true and the +visited file is not registered, return a singleton fileset containing it. +Otherwise, throw an error. + +NONVIOLENT-P means that the fileset will be used for a non-state-changing +operation, such as vc-log or vc-diff. + +STATE-MODEL-ONLY-FILES if non-nil, means that the caller needs +the FILESET-ONLY-FILES STATE and MODEL info. Otherwise, that +part may be skipped. +BEWARE: this function may change the +current buffer." + (cond + ((vc-deduce-fileset-internal nonviolent-p state-model-only-files)) ((not buffer-file-name) (error "Buffer %s is not associated with a file" (buffer-name))) ((and allow-unregistered (not (vc-registered buffer-file-name))) @@ -994,7 +1029,7 @@ current buffer." nil) (list (vc-backend-for-registration (buffer-file-name)) (list buffer-file-name)))) - (t (error "No fileset is available here"))))) + (t (error "No fileset is available here")))) (defun vc-dired-deduce-fileset () (let ((backend (vc-responsible-backend default-directory))) @@ -1036,6 +1071,42 @@ current buffer." (eq p q) (and (member p '(edited added removed)) (member q '(edited added removed))))) +(defun vc-filter-files-to-commit (fileset) + ;; Given a fileset, return those that are ready to commit. + (let* ((files (nth 1 fileset)) + (model (nth 4 fileset)) + (ready-for-commit files)) + ;; If files are edited but read-only, give user a chance to correct + (dolist (file files) + (unless (file-writable-p file) + ;; Make the file+buffer read-write. + (unless (y-or-n-p (format "%s is edited but read-only; make it writable and continue?" file)) + (error "Aborted")) + (set-file-modes file (logior (file-modes file) 128)) + (let ((visited (get-file-buffer file))) + (when visited + (with-current-buffer visited + (toggle-read-only -1)))))) + ;; Allow user to revert files with no changes. + ;; [shouldn't we factor (not (eq model 'implicit)) out of the loop? + ;; -- rgr, 26-Nov-10.] + (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)) + (vc-workfile-unchanged-p file) + ;; 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)))) + (vc-revert-file file) + (setq ready-for-commit (delete file ready-for-commit)))))) + ;; Remaining files need to be committed + ready-for-commit)) + ;; Here's the major entry point. ;;;###autoload @@ -1112,34 +1183,7 @@ merge in the changes into your working copy." (message "Fileset is up-to-date")))) ;; Files have local changes ((vc-compatible-state state 'edited) - (let ((ready-for-commit files)) - ;; If files are edited but read-only, give user a chance to correct - (dolist (file files) - (unless (file-writable-p file) - ;; Make the file+buffer read-write. - (unless (y-or-n-p (format "%s is edited but read-only; make it writable and continue?" file)) - (error "Aborted")) - (set-file-modes file (logior (file-modes file) 128)) - (let ((visited (get-file-buffer file))) - (when visited - (with-current-buffer visited - (toggle-read-only -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)) - (vc-workfile-unchanged-p file) - ;; 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)))) - (vc-revert-file file) - (setq ready-for-commit (delete file ready-for-commit)))))) - ;; Remaining files need to be committed + (let ((ready-for-commit (vc-filter-files-to-commit vc-fileset))) (if (not ready-for-commit) (message "No files remain to be committed") (if (not verbose) @@ -1387,6 +1431,39 @@ Type \\[vc-next-action] to check in changes.") ".\n") (message "Please explain why you stole the lock. Type C-c C-c when done."))) +(defun vc-confirm-files-if-changed (old-files new-files) + ;; Given two lists of file names, return t if they are the same, the + ;; symbol confirmed if the user says to check in the new set, nil if + ;; the user says to use the old set, and throw an error otherwise. + (let ((removed-files nil) + (added-files nil)) + ;; Compute the difference sets. + (dolist (old-file old-files) + (unless (member old-file new-files) + (push old-file removed-files))) + (dolist (new-file new-files) + (unless (member new-file old-files) + (push new-file added-files))) + (cond ((and (null removed-files) (null added-files)) + ;; No change. + t) + ((let ((added-line + (if added-files + (concat "\n Added: " (vc-delistify added-files)) + "")) + (removed-line + (if removed-files + (concat "\n Removed: " (vc-delistify removed-files)) + ""))) + (yes-or-no-p (concat "Fileset has changed:" + added-line removed-line + "\nUse the new fileset? "))) + 'confirmed) + ((yes-or-no-p "Continue anyway? ") + nil) + (t + (error "Checkin aborted."))))) + (defun vc-checkin (files backend &optional rev comment initial-contents) "Check in FILES. The optional argument REV may be a string specifying the new revision @@ -1411,6 +1488,12 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." (vc-call-backend backend 'log-edit-mode)) (lexical-let ((rev rev)) (lambda (files comment) + ;; Check to see if the fileset has changed. + (let ((new (vc-filter-files-to-commit (vc-deduce-fileset-internal)))) + (when (vc-confirm-files-if-changed files new) + (setq files new) + ;; Apparently, this is needed to update the right fileset. + (setq vc-log-files new))) (message "Checking in %s..." (vc-delistify files)) ;; "This log message intentionally left almost blank". ;; RCS 5.7 gripes about white-space-only comments too.