Subject: [PATCH] vc-next-action destroys window configuration

From: Nathaniel Flath <[email-masked]>
Date: Tue, 9 Feb 2010 20:27:26 -0500

When doing vc-next-action, if the action is a commit, after you enter a
commit message and commit your window configuration is destroyed.  An
example of this is when you have one vertical split, created with C-x 3, and
commit a file using this.  After the commit, you will only have one window.
diff --git a/lisp/vc.el b/lisp/vc.el
index 9a71286..9b3be27 100644
--- a/lisp/vc.el
+++ b/lisp/vc.el
@@ -1012,166 +1012,168 @@ with the logmessage as change commentary.  A writable file is retained.
    If the repository file is changed, you are asked if you want to
 merge in the changes into your working copy."
   (interactive "P")
-  (let* ((vc-fileset (vc-deduce-fileset nil t 'state-model-only-files))
-         (backend (car vc-fileset))
-	 (files (nth 1 vc-fileset))
-         (fileset-only-files (nth 2 vc-fileset))
-         ;; FIXME: We used to call `vc-recompute-state' here.
-         (state (nth 3 vc-fileset))
-         ;; The backend should check that the checkout-model is consistent
-         ;; among all the `files'.
-	 (model (nth 4 vc-fileset))
-	 revision)
-
-    ;; Do the right thing
-    (cond
-     ((eq state 'missing)
-      (error "Fileset files are missing, so cannot be operated on"))
-     ((eq state 'ignored)
-      (error "Fileset files are ignored by the version-control system"))
-     ((or (null state) (eq state 'unregistered))
-      (vc-register nil vc-fileset))
-     ;; Files are up-to-date, or need a merge and user specified a revision
-     ((or (eq state 'up-to-date) (and verbose (eq state 'needs-update)))
-      (cond
-       (verbose
-	;; go to a different revision
-	(setq revision (read-string "Branch, revision, or backend to move to: "))
-	(let ((revision-downcase (downcase revision)))
-	  (if (member
-	       revision-downcase
-	       (mapcar (lambda (arg) (downcase (symbol-name arg))) vc-handled-backends))
-	      (let ((vsym (intern-soft revision-downcase)))
-		(dolist (file files) (vc-transfer-file file vsym)))
-	    (dolist (file files)
-              (vc-checkout file (eq model 'implicit) revision)))))
-       ((not (eq model 'implicit))
-	;; check the files out
-	(dolist (file files) (vc-checkout file t)))
-       (t
-        ;; do nothing
-        (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
+  (save-excursion
+    (save-window-excursion
+      (let* ((vc-fileset (vc-deduce-fileset nil t 'state-model-only-files))
+             (backend (car vc-fileset))
+             (files (nth 1 vc-fileset))
+             (fileset-only-files (nth 2 vc-fileset))
+             ;; FIXME: We used to call `vc-recompute-state' here.
+             (state (nth 3 vc-fileset))
+             ;; The backend should check that the checkout-model is consistent
+             ;; among all the `files'.
+             (model (nth 4 vc-fileset))
+             revision)
+
+        ;; Do the right thing
+        (cond
+         ((eq state 'missing)
+          (error "Fileset files are missing, so cannot be operated on"))
+         ((eq state 'ignored)
+          (error "Fileset files are ignored by the version-control system"))
+         ((or (null state) (eq state 'unregistered))
+          (vc-register nil vc-fileset))
+         ;; Files are up-to-date, or need a merge and user specified a revision
+         ((or (eq state 'up-to-date) (and verbose (eq state 'needs-update)))
+          (cond
+           (verbose
+            ;; go to a different revision
+            (setq revision (read-string "Branch, revision, or backend to move to: "))
+            (let ((revision-downcase (downcase revision)))
+              (if (member
+                   revision-downcase
+                   (mapcar (lambda (arg) (downcase (symbol-name arg))) vc-handled-backends))
+                  (let ((vsym (intern-soft revision-downcase)))
+                    (dolist (file files) (vc-transfer-file file vsym)))
+                (dolist (file files)
+                  (vc-checkout file (eq model 'implicit) revision)))))
+           ((not (eq model 'implicit))
+            ;; check the files out
+            (dolist (file files) (vc-checkout file t)))
+           (t
+            ;; do nothing
+            (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
+            (if (not ready-for-commit)
+                (message "No files remain to be committed")
+              (if (not verbose)
+                  (vc-checkin ready-for-commit backend)
+                (setq revision (read-string "New revision or backend: "))
+                (let ((revision-downcase (downcase revision)))
+                  (if (member
+                       revision-downcase
+                       (mapcar (lambda (arg) (downcase (symbol-name arg)))
+                               vc-handled-backends))
+                      (let ((vsym (intern revision-downcase)))
+                        (dolist (file files) (vc-transfer-file file vsym)))
+                    (vc-checkin ready-for-commit backend revision)))))))
+         ;; locked by somebody else (locking VCSes only)
+         ((stringp state)
+          ;; In the old days, we computed the revision once and used it on
+          ;; the single file.  Then, for the 2007-2008 fileset rewrite, we
+          ;; computed the revision once (incorrectly, using a free var) and
+          ;; used it on all files.  To fix the free var bug, we can either
+          ;; use `(car files)' or do what we do here: distribute the
+          ;; revision computation among `files'.  Although this may be
+          ;; tedious for those backends where a "revision" is a trans-file
+          ;; concept, it is nonetheless correct for both those and (more
+          ;; importantly) for those where "revision" is a per-file concept.
+          ;; If the intersection of the former group and "locking VCSes" is
+          ;; non-empty [I vaguely doubt it --ttn], we can reinstate the
+          ;; pre-computation approach of yore.
+          (dolist (file files)
+            (vc-steal-lock
+             file (if verbose
+                      (read-string (format "%s revision to steal: " file))
+                    (vc-working-revision file))
+             state)))
+         ;; conflict
+         ((eq state 'conflict)
+          ;; FIXME: Is it really the UI we want to provide?
+          ;; In my experience, the conflicted files should be marked as resolved
+          ;; one-by-one when saving the file after resolving the conflicts.
+          ;; I.e. stating explicitly that the conflicts are resolved is done
+          ;; very rarely.
+          (vc-mark-resolved backend files))
+         ;; needs-update
+         ((eq state 'needs-update)
           (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.
+            (if (yes-or-no-p (format
+                              "%s is not up-to-date.  Get latest revision? "
+                              (file-name-nondirectory file)))
+                (vc-checkout file (eq model 'implicit) t)
               (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
-	(if (not ready-for-commit)
-	    (message "No files remain to be committed")
-	  (if (not verbose)
-	      (vc-checkin ready-for-commit backend)
-	    (setq revision (read-string "New revision or backend: "))
-	    (let ((revision-downcase (downcase revision)))
-	      (if (member
-		   revision-downcase
-		   (mapcar (lambda (arg) (downcase (symbol-name arg)))
-			   vc-handled-backends))
-		  (let ((vsym (intern revision-downcase)))
-		    (dolist (file files) (vc-transfer-file file vsym)))
-		(vc-checkin ready-for-commit backend revision)))))))
-     ;; locked by somebody else (locking VCSes only)
-     ((stringp state)
-      ;; In the old days, we computed the revision once and used it on
-      ;; the single file.  Then, for the 2007-2008 fileset rewrite, we
-      ;; computed the revision once (incorrectly, using a free var) and
-      ;; used it on all files.  To fix the free var bug, we can either
-      ;; use `(car files)' or do what we do here: distribute the
-      ;; revision computation among `files'.  Although this may be
-      ;; tedious for those backends where a "revision" is a trans-file
-      ;; concept, it is nonetheless correct for both those and (more
-      ;; importantly) for those where "revision" is a per-file concept.
-      ;; If the intersection of the former group and "locking VCSes" is
-      ;; non-empty [I vaguely doubt it --ttn], we can reinstate the
-      ;; pre-computation approach of yore.
-      (dolist (file files)
-        (vc-steal-lock
-         file (if verbose
-                  (read-string (format "%s revision to steal: " file))
-                (vc-working-revision file))
-         state)))
-     ;; conflict
-     ((eq state 'conflict)
-      ;; FIXME: Is it really the UI we want to provide?
-      ;; In my experience, the conflicted files should be marked as resolved
-      ;; one-by-one when saving the file after resolving the conflicts.
-      ;; I.e. stating explicitly that the conflicts are resolved is done
-      ;; very rarely.
-      (vc-mark-resolved backend files))
-     ;; needs-update
-     ((eq state 'needs-update)
-      (dolist (file files)
-	(if (yes-or-no-p (format
-			  "%s is not up-to-date.  Get latest revision? "
-			  (file-name-nondirectory file)))
-	    (vc-checkout file (eq model 'implicit) t)
-	  (when (and (not (eq model 'implicit))
-		     (yes-or-no-p "Lock this revision? "))
-	    (vc-checkout file t)))))
-     ;; needs-merge
-     ((eq state 'needs-merge)
-      (dolist (file files)
-	(when (yes-or-no-p (format
-			  "%s is not up-to-date.  Merge in changes now? "
-			  (file-name-nondirectory file)))
-	  (vc-maybe-resolve-conflicts
-           file (vc-call-backend backend 'merge-news file)))))
-
-     ;; unlocked-changes
-     ((eq state 'unlocked-changes)
-      (dolist (file files)
-	(when (not (equal buffer-file-name file))
-	  (find-file-other-window file))
-	(if (save-window-excursion
-	      (vc-diff-internal nil
-				(cons (car vc-fileset) (cons (cadr vc-fileset) (list file)))
-				(vc-working-revision file) nil)
-	      (goto-char (point-min))
-	      (let ((inhibit-read-only t))
-		(insert
-		 (format "Changes to %s since last lock:\n\n" file)))
-	      (not (beep))
-	      (yes-or-no-p (concat "File has unlocked changes.  "
-				   "Claim lock retaining changes? ")))
-	    (progn (vc-call-backend backend 'steal-lock file)
-		   (clear-visited-file-modtime)
-		   ;; Must clear any headers here because they wouldn't
-		   ;; show that the file is locked now.
-		   (vc-clear-headers file)
-		   (write-file buffer-file-name)
-		   (vc-mode-line file backend))
-	  (if (not (yes-or-no-p
-		    "Revert to checked-in revision, instead? "))
-	      (error "Checkout aborted")
-	    (vc-revert-buffer-internal t t)
-	    (vc-checkout file t)))))
-     ;; Unknown fileset state
-     (t
-      (error "Fileset is in an unknown state %s" state)))))
+                         (yes-or-no-p "Lock this revision? "))
+                (vc-checkout file t)))))
+         ;; needs-merge
+         ((eq state 'needs-merge)
+          (dolist (file files)
+            (when (yes-or-no-p (format
+                                "%s is not up-to-date.  Merge in changes now? "
+                                (file-name-nondirectory file)))
+              (vc-maybe-resolve-conflicts
+               file (vc-call-backend backend 'merge-news file)))))
+
+         ;; unlocked-changes
+         ((eq state 'unlocked-changes)
+          (dolist (file files)
+            (when (not (equal buffer-file-name file))
+              (find-file-other-window file))
+            (if (save-window-excursion
+                  (vc-diff-internal nil
+                                    (cons (car vc-fileset) (cons (cadr vc-fileset) (list file)))
+                                    (vc-working-revision file) nil)
+                  (goto-char (point-min))
+                  (let ((inhibit-read-only t))
+                    (insert
+                     (format "Changes to %s since last lock:\n\n" file)))
+                  (not (beep))
+                  (yes-or-no-p (concat "File has unlocked changes.  "
+                                       "Claim lock retaining changes? ")))
+                (progn (vc-call-backend backend 'steal-lock file)
+                       (clear-visited-file-modtime)
+                       ;; Must clear any headers here because they wouldn't
+                       ;; show that the file is locked now.
+                       (vc-clear-headers file)
+                       (write-file buffer-file-name)
+                       (vc-mode-line file backend))
+              (if (not (yes-or-no-p
+                        "Revert to checked-in revision, instead? "))
+                  (error "Checkout aborted")
+                (vc-revert-buffer-internal t t)
+                (vc-checkout file t)))))
+         ;; Unknown fileset state
+         (t
+          (error "Fileset is in an unknown state %s" state)))))))
 
 (defun vc-create-repo (backend)
   "Create an empty repository in the current directory."
@@ -1269,21 +1271,21 @@ After check-out, runs the normal hook `vc-checkout-hook'."
        (vc-make-version-backup file))
   (let ((backend (vc-backend file)))
     (with-vc-properties (list file)
-      (condition-case err
-          (vc-call-backend backend 'checkout file writable rev)
-        (file-error
-         ;; Maybe the backend is not installed ;-(
-         (when writable
-           (let ((buf (get-file-buffer file)))
-             (when buf (with-current-buffer buf (toggle-read-only -1)))))
-         (signal (car err) (cdr err))))
-      `((vc-state . ,(if (or (eq (vc-checkout-model backend (list file)) 'implicit)
-                             (not writable))
-                         (if (vc-call-backend backend 'latest-on-branch-p file)
-                             'up-to-date
-                           'needs-update)
-                       'edited))
-        (vc-checkout-time . ,(nth 5 (file-attributes file))))))
+                        (condition-case err
+                            (vc-call-backend backend 'checkout file writable rev)
+                          (file-error
+                           ;; Maybe the backend is not installed ;-(
+                           (when writable
+                             (let ((buf (get-file-buffer file)))
+                               (when buf (with-current-buffer buf (toggle-read-only -1)))))
+                           (signal (car err) (cdr err))))
+                        `((vc-state . ,(if (or (eq (vc-checkout-model backend (list file)) 'implicit)
+                                               (not writable))
+                                           (if (vc-call-backend backend 'latest-on-branch-p file)
+                                               'up-to-date
+                                             'needs-update)
+                                         'edited))
+                          (vc-checkout-time . ,(nth 5 (file-attributes file))))))
   (vc-resynch-buffer file t t)
   (run-hooks 'vc-checkout-hook))
 
@@ -1343,29 +1345,29 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'."
   (when vc-before-checkin-hook
     (run-hooks 'vc-before-checkin-hook))
   (lexical-let
-   ((backend backend))
-   (vc-start-logentry
-    files rev comment initial-contents
-    "Enter a change comment."
-    "*VC-log*"
-    (lambda (files rev comment)
-      (message "Checking in %s..." (vc-delistify files))
-      ;; "This log message intentionally left almost blank".
-      ;; RCS 5.7 gripes about white-space-only comments too.
-      (or (and comment (string-match "[^\t\n ]" comment))
-	  (setq comment "*** empty log message ***"))
-      (with-vc-properties
-       files
-       ;; We used to change buffers to get local value of vc-checkin-switches,
-       ;; but 'the' local buffer is not a well-defined concept for filesets.
-       (progn
-	 (vc-call-backend backend 'checkin files rev comment)
-	 (mapc 'vc-delete-automatic-version-backups files))
-       `((vc-state . up-to-date)
-	 (vc-checkout-time . ,(nth 5 (file-attributes file)))
-	 (vc-working-revision . nil)))
-      (message "Checking in %s...done" (vc-delistify files)))
-    'vc-checkin-hook)))
+      ((backend backend))
+    (vc-start-logentry
+     files rev comment initial-contents
+     "Enter a change comment."
+     "*VC-log*"
+     (lambda (files rev comment)
+       (message "Checking in %s..." (vc-delistify files))
+       ;; "This log message intentionally left almost blank".
+       ;; RCS 5.7 gripes about white-space-only comments too.
+       (or (and comment (string-match "[^\t\n ]" comment))
+           (setq comment "*** empty log message ***"))
+       (with-vc-properties
+        files
+        ;; We used to change buffers to get local value of vc-checkin-switches,
+        ;; but 'the' local buffer is not a well-defined concept for filesets.
+        (progn
+          (vc-call-backend backend 'checkin files rev comment)
+          (mapc 'vc-delete-automatic-version-backups files))
+        `((vc-state . up-to-date)
+          (vc-checkout-time . ,(nth 5 (file-attributes file)))
+          (vc-working-revision . nil)))
+       (message "Checking in %s...done" (vc-delistify files)))
+     'vc-checkin-hook)))
 
 ;;; Additional entry points for examining version histories
 
@@ -1419,7 +1421,7 @@ to override the value of `vc-diff-switches' and `diff-switches'."
 	       (let ((sym (vc-make-backend-sym
 			   backend (intern (concat (symbol-name op)
 						   "-switches")))))
-		   (when (boundp sym) (symbol-value sym))))
+                 (when (boundp sym) (symbol-value sym))))
 	     (let ((sym (intern (format "vc-%s-switches" (symbol-name op)))))
 	       (when (boundp sym) (symbol-value sym)))
 	     (cond
@@ -1640,8 +1642,8 @@ If `F.~REV~' already exists, use it instead of checking it out again."
   (vc-ensure-vc-buffer)
   (let* ((file buffer-file-name)
 	 (revision (if (string-equal rev "")
-		      (vc-working-revision file)
-		    rev)))
+                       (vc-working-revision file)
+                     rev)))
     (switch-to-buffer-other-window (vc-find-revision file revision))))
 
 (defun vc-find-revision (file revision)
@@ -1711,17 +1713,17 @@ The headers are reset to their non-expanded form."
 	 (visited (find-buffer-visiting filename))
 	 (backend (vc-backend filename)))
     (when (vc-find-backend-function backend 'clear-headers)
-	(if visited
-	    (let ((context (vc-buffer-context)))
-	      ;; save-excursion may be able to relocate point and mark
-	      ;; properly.  If it fails, vc-restore-buffer-context
-	      ;; will give it a second try.
-	      (save-excursion
-		(vc-call-backend backend 'clear-headers))
-	      (vc-restore-buffer-context context))
-	  (set-buffer (find-file-noselect filename))
-	  (vc-call-backend backend 'clear-headers)
-	  (kill-buffer filename)))))
+      (if visited
+          (let ((context (vc-buffer-context)))
+            ;; save-excursion may be able to relocate point and mark
+            ;; properly.  If it fails, vc-restore-buffer-context
+            ;; will give it a second try.
+            (save-excursion
+              (vc-call-backend backend 'clear-headers))
+            (vc-restore-buffer-context context))
+        (set-buffer (find-file-noselect filename))
+        (vc-call-backend backend 'clear-headers)
+        (kill-buffer filename)))))
 
 (defun vc-modify-change-comment (files rev oldcomment)
   "Edit the comment associated with the given files and revision."
@@ -2418,7 +2420,7 @@ to provide the `find-revision' operation instead."
 
 (defun vc-default-show-log-entry (backend rev)
   (with-no-warnings
-   (log-view-goto-rev rev)))
+    (log-view-goto-rev rev)))
 
 (defun vc-default-comment-history (backend file)
   "Return a string with all log entries stored in BACKEND for FILE."
@@ -2437,10 +2439,10 @@ to provide the `find-revision' operation instead."
         (vc-file-tree-walk
          dir
          (lambda (f) (and
-		 (vc-up-to-date-p f)
-		 (vc-error-occurred
-		  (vc-call-backend backend 'checkout f nil "")
-		  (when update (vc-resynch-buffer f t t)))))))
+                      (vc-up-to-date-p f)
+                      (vc-error-occurred
+                       (vc-call-backend backend 'checkout f nil "")
+                       (when update (vc-resynch-buffer f t t)))))))
     (let ((result (vc-tag-precondition dir)))
       (if (stringp result)
           (error "File %s is locked" result)
@@ -2448,8 +2450,8 @@ to provide the `find-revision' operation instead."
         (vc-file-tree-walk
          dir
          (lambda (f) (vc-error-occurred
-		 (vc-call-backend backend 'checkout f nil name)
-		 (when update (vc-resynch-buffer f t t)))))))))
+                      (vc-call-backend backend 'checkout f nil name)
+                      (when update (vc-resynch-buffer f t t)))))))))
 
 (defun vc-default-revert (backend file contents-done)
   (unless contents-done
@@ -2513,13 +2515,13 @@ Invoke FUNC f ARGS on each VC-managed file f underneath it."
     (let ((dir (file-name-as-directory file)))
       (mapcar
        (lambda (f) (or
-               (string-equal f ".")
-               (string-equal f "..")
-               (member f vc-directory-exclusion-list)
-               (let ((dirf (expand-file-name f dir)))
-                 (or
-                  (file-symlink-p dirf) ;; Avoid possible loops.
-                  (vc-file-tree-walk-internal dirf func args)))))
+                    (string-equal f ".")
+                    (string-equal f "..")
+                    (member f vc-directory-exclusion-list)
+                    (let ((dirf (expand-file-name f dir)))
+                      (or
+                       (file-symlink-p dirf) ;; Avoid possible loops.
+                       (vc-file-tree-walk-internal dirf func args)))))
        (directory-files dir)))))
 
 (provide 'vc)