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

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

[Bob Rogers]

[-- Attachment #1: message body text --]
[-- Type: text/plain, Size: 1204 bytes --]

   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/


[-- Attachment #2: Type: text/plain, Size: 10870 bytes --]

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.

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

[Bob Rogers]

   Oops; please hold off on this.  It seems that this patch does the
wrong thing if the commit is not started from *vc-dir*, or started on a
single unmarked file.

					-- Bob

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

[Stefan Monnier]

Thanks for submitting a patch to try and fix this problem.
A quick obvious issue, tho:

> --- a/lisp/vc/vc.el
> +++ b/lisp/vc/vc.el
[...]
> +(defun log-edit-deduce-fileset (state-model-only-files)

If it's in vc.el it can't start with the "log-edit-" prefix.


        Stefan "who hasn't yet had time to look at the rest of the patch"

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

[Bob Rogers]

   From: Stefan Monnier <monnier@iro.umontreal.ca>
   Date: Sun, 19 Dec 2010 08:57:00 -0500

   Thanks for submitting a patch to try and fix this problem.
   A quick obvious issue, tho:

   > --- a/lisp/vc/vc.el
   > +++ b/lisp/vc/vc.el
   [...]
   > +(defun log-edit-deduce-fileset (state-model-only-files)

   If it's in vc.el it can't start with the "log-edit-" prefix.

Yes, I was wondering about that.  I had thought about putting it in
log-edit.el, but it seems closer to VC internals than log-edit
internals.  Which would you prefer:  Rename it, or move it?  If
"rename", would "vc-log-edit-deduce-fileset" suffice?

	   Stefan "who hasn't yet had time to look at the rest of the patch"

Just as well, considering that the patch fails for single-file commits.
I am thinking that vc-commit only ever needs to re-examine the fileset
if the commit was (a) started in *vc-dir* and (b) with marked files.
Otherwise, the fileset is determined by the way C-x v v is invoked, and
there's no way to change it later.  True?

   And while I'm thinking of it, a VC fileset really ought to be
represented by a struct, since all this car-ing and cdr-ing is really
messy.  But filesets are passed to backends, so testing such a change
would be a pain.  What are your thoughts?  It is worth it?

					-- Bob

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

[Stefan Monnier]

>    Thanks for submitting a patch to try and fix this problem.
>    A quick obvious issue, tho:

>> --- a/lisp/vc/vc.el
>> +++ b/lisp/vc/vc.el
>    [...]
>> +(defun log-edit-deduce-fileset (state-model-only-files)

>    If it's in vc.el it can't start with the "log-edit-" prefix.

> Yes, I was wondering about that.  I had thought about putting it in
> log-edit.el, but it seems closer to VC internals than log-edit
> internals.

log-edit deals with editing the text buffer, so clearly this job is not
about log-edit but VC.

> Which would you prefer:  Rename it, or move it?  If
> "rename", would "vc-log-edit-deduce-fileset" suffice?

I guess so, tho I don't understand why you need this function.  IIUC you
should switch to vc-parent before calling vc-deduce-fileset, so that
function never needs to handle log-edit buffers.

>    And while I'm thinking of it, a VC fileset really ought to be
> represented by a struct, since all this car-ing and cdr-ing is really
> messy.  But filesets are passed to backends, so testing such a change
> would be a pain.  What are your thoughts?  It is worth it?

It doesn't seem complex enough to warrant such a change.
Maybe another approach is to use pcase.
E.g. instead of

   (let ((backend (car fs))
         (files (cdr fs)))
     ..)

or something like that, you'd write

   (pcase-let ((`(,backend . ,files) fileset))
     ...)

Experience with ML-style languages tends to indicate that such pattern
matching tends to reduce the need for named fields, tho obviously type
checking (and inference) is also an important part of it since it
catches incorrect patterns.


        Stefan

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

[Bob Rogers]

   From: Stefan Monnier <monnier@iro.umontreal.ca>
   Date: Sun, 19 Dec 2010 21:50:03 -0500

   >    Thanks for submitting a patch to try and fix this problem.
   >    A quick obvious issue, tho:

   >> --- a/lisp/vc/vc.el
   >> +++ b/lisp/vc/vc.el
   >    [...]
   >> +(defun log-edit-deduce-fileset (state-model-only-files)

   >    If it's in vc.el it can't start with the "log-edit-" prefix.

   > Yes, I was wondering about that.  I had thought about putting it in
   > log-edit.el, but it seems closer to VC internals than log-edit
   > internals.

   log-edit deals with editing the text buffer, so clearly this job is not
   about log-edit but VC.

Fair enough.

   > Which would you prefer:  Rename it, or move it?  If
   > "rename", would "vc-log-edit-deduce-fileset" suffice?

   I guess so, tho I don't understand why you need this function.  IIUC you
   should switch to vc-parent before calling vc-deduce-fileset, so that
   function never needs to handle log-edit buffers.

Ah, that's a good question.  That is what the existing vc-deduce-fileset
does (as I'm sure you know), which means that if you change the *vc-dir*
fileset after starting a commit, C-x v = in the log buffer will diff the
new fileset, but C-c C-c will still commit the old one; this is also a
bug in the pretest [1], and probably back to 23.1.

   ISTM that if we want to detect when the *VC-log* buffer and the
*vc-dir* buffer have different filesets, then it makes sense to consider
that the *VC-log* buffer implies a fileset is independent of its parent.
That is the model to which I was coding.

   Another way to fix the problem would be to define the existing
vc-deduce-fileset behavior as correct, and fix vc-commit always to
commit the most current fileset.  Then you would need a different patch
entirely.  I am not crazy about this idea, because it would make it
harder to perform multiple commits in parallel.

   A third way to fix it would be to put vc-deduce-fileset in charge of
detecting when the *vc-dir* fileset has changed.  In other words, not
only would C-c C-c ask you what was up, C-x v = would as well.  This
ISTM would make parallel commits even harder.

   >    And while I'm thinking of it, a VC fileset really ought to be
   > represented by a struct, since all this car-ing and cdr-ing is really
   > messy.  But filesets are passed to backends, so testing such a change
   > would be a pain.  What are your thoughts?  It is worth it?

   It doesn't seem complex enough to warrant such a change.
   Maybe another approach is to use pcase.
   E.g. instead of

      (let ((backend (car fs))
	    (files (cdr fs)))
	..)

   or something like that, you'd write

      (pcase-let ((`(,backend . ,files) fileset))
	...)

   Experience with ML-style languages tends to indicate that such pattern
   matching tends to reduce the need for named fields,

I was thinking more of abstraction.  This sort of destructuring means
you need to know that a fileset is represented as a list in which the
backend comes first and the files come second.  When I was trying to
find out how the various backends used the "state" element of that list,
for example, it would have been really nice to have been able to grep
for calls to something like "vc-fileset-state".

   tho obviously type checking (and inference) is also an important part
   of it since it catches incorrect patterns.

	   Stefan

Indeed.  In fact, the correct pattern for a fileset is more like
`(,backend ,files ,nondir-files ,state ,model) -- so thank you for
illustrating my point.  ;-}

   I think that is part of why I am less than keen on Haskell and
Erlang, the only two ML-style languages which which I have any
acquaintance.

					-- Bob

[1] I hadn't noticed this before because I have a hacked version of
    vc-deduce-fileset I wrote more than two years ago that fixes this,
    by doing almost the same thing for log buffers as the code in the
    patch.  Not sure why I didn't report this bug at the time.  In any
    case, I had forgotten about it completely.