bug#7675: 24.0.50; vc-checkin should prompt if the fileset changes

[Bob Rogers]

   If you start a multifile commit from *vc-dir* and then change the
selected fileset, log-edit-done (C-c C-c) commits the original fileset
without comment.  The attached patch fixes this by recomputing the
fileset, and prompting the user if anything changed.  First, the user is
offered a chance to use the new fileset (since that is probably what was
intended), then to continue the commit with the original fileset.  If
both choices are refused, then the commit is aborted.  Most of the patch
factors vc-deduce-fileset-internal out of vc-deduce-fileset and
vc-filter-files-to-commit out of vc-next-action in order to avoid code
duplication.

   For symmetry, C-x v v ought to make the equivalent check when reusing
an existing log buffer.  It currently overwrites the changeset for any
commit in progress.  If that change is acceptable, I will submit a
separate patch.

   Along the way, I've also changed the name of the "observer" parameter
of vc-deduce-fileset to "nonviolent-p", and documented it as such, since
this seems to be what was intended:  This is passed non-nil only from
places that do not change VC state, such as vc-diff and vc-log.

                                        -- Bob Rogers
                                           http://www.rgrjr.com/

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.