Mercurial > emacs

changeset 94778:b9687393def1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Large simplification in (vc-deduce-fileset) logic.
author Eric S. Raymond <esr@snark.thyrsus.com>
date Fri, 09 May 2008 01:57:21 +0000
parents a5aa67c4ac98
children 6d637951ccf0
files lisp/ChangeLog lisp/vc-dispatcher.el lisp/vc.el
diffstat 3 files changed, 69 insertions(+), 95 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Thu May 08 18:10:05 2008 +0000
+++ b/lisp/ChangeLog	Fri May 09 01:57:21 2008 +0000
@@ -1,3 +1,12 @@
+2008-05-09  Eric S. Raymond  <esr@snark.thyrsus.com>
+
+	* vc.el (vc-deduce-fileset, vc-next-action, vc-version-diff)
+	(vc-diff, vc-rwevert, vc-rollback, vc-update), 
+	vc-dispatcher.el (vc-dispatcher-selection-set):
+	Get rid of 4 special cases in fileset selection.  This involved
+	changing the return value of (vc-deduce-fileset) so that it passes
+	back a deduced state as well as a deduced back end,
+
 2008-05-08  Sam Steingold  <sds@gnu.org>
 
 	* progmodes/compile.el (compilation-minor-mode-map)
--- a/lisp/vc-dispatcher.el	Thu May 08 18:10:05 2008 +0000
+++ b/lisp/vc-dispatcher.el	Fri May 09 01:57:21 2008 +0000
@@ -1328,64 +1328,31 @@
   "Are we in a directory browser buffer?"
   (eq major-mode 'vc-dir-mode))
 
-(defun vc-dispatcher-selection-set (eligible
-				   &optional 
-				   allow-directory-wildcard 
-				   allow-ineligible
-				   include-files-not-directories)
+(defun vc-dispatcher-selection-set ()
   "Deduce a set of files to which to apply an operation. Return the fileset.
-If we're in a directory display, the fileset is the list of marked files.
-Otherwise, if we're looking at a buffer for which ELIGIBLE returns non-NIL,
-the fileset is a singleton containing this file.
-If neither of these things is true, but ALLOW-DIRECTORY-WILDCARD is on
-and we're in a directory buffer, select the current directory.
-If none of these conditions is met, but ALLOW-INELIGIBLE is on and the
-visited file is not registered, return a singleton fileset containing it.
-If INCLUDE-FILES-NOT-DIRECTORIES then if directories are marked,
-return the list of VC files in those directories instead of
-the directories themselves.
-Otherwise, throw an error."
+If we're in a directory display, the fileset is the list of marked files (if
+there is one) else the file on the curreent line.  If not in a directory 
+display, but the current buffer visits a file, the fileset is a singleton 
+containing that file. Otherwise, throw an error."
   (let ((files
     (cond
      ;; Browsing with vc-dir
-     ((eq major-mode 'vc-dir-mode)
-      (or
-       (if include-files-not-directories
-	   (vc-dir-marked-only-files)
-	 (vc-dir-marked-files))
-       (list (vc-dir-current-file))))
+     ((vc-dispatcher-browsing)
+      (or (vc-dir-marked-files) (list (vc-dir-current-file))))
      ;; Visiting an eligible file
-     ((funcall eligible buffer-file-name)
+     ((buffer-file-name)
       (list buffer-file-name))
-     ;; No eligible file -- if there's a parent buffer, deuce from there
+     ;; No eligible file -- if there's a parent buffer, deduce from there
      ((and vc-parent-buffer (or (buffer-file-name vc-parent-buffer)
 				(with-current-buffer vc-parent-buffer
 				  (vc-dispatcher-browsing))))
-      (progn
-	(set-buffer vc-parent-buffer)
-	(vc-dispatcher-selection-set eligible)))
-     ;; No parent buffer, we may want to select entire directory
-     ;;
-     ;; This is guarded by an enabling arg so users won't potentially
-     ;; shoot themselves in the foot by modifying a fileset they can't
-     ;; verify by eyeball.  Allow it for nondestructive commands like
-     ;; making diffs, or possibly for destructive ones that have
-     ;; confirmation prompts.
-     ((and allow-directory-wildcard
-		(equal buffer-file-name nil)
-		(equal list-buffers-directory default-directory))
-      (progn
-	(message "All eligible files below %s selected."
-		 default-directory)
-	 (list default-directory)))
-     ;; Last, if we're allowing ineligible files and visiting one, select it.
-     ((and allow-ineligible (not (eligible buffer-file-name)))
-      (list buffer-file-name))
+      (with-current-buffer vc-parent-buffer
+			    (vc-dispatcher-selection-set)))
      ;; No good set here, throw error
      (t (error "No fileset is available here.")))))
     ;; We assume, in order to avoid unpleasant surprises to the user, 
     ;; that a fileset is not in good shape to be handed to the user if the  
-    ;; buffers visting the fileset don't match the on-disk contents.
+    ;; buffers visiting the fileset don't match the on-disk contents.
     (dolist (file files)
       (let ((visited (get-file-buffer file)))
 	(when visited
--- a/lisp/vc.el	Thu May 08 18:10:05 2008 +0000
+++ b/lisp/vc.el	Fri May 09 01:57:21 2008 +0000
@@ -1003,28 +1003,30 @@
 (defun vc-expand-dirs (file-or-dir-list)
   "Expands directories in a file list specification.
 Only files already under version control are noticed."
-  ;; FIXME: Kill this function.
   (let ((flattened '()))
     (dolist (node file-or-dir-list)
       (vc-file-tree-walk
        node (lambda (f) (when (vc-backend f) (push f flattened)))))
     (nreverse flattened)))
 
-(defun vc-deduce-fileset (&optional allow-directory-wildcard allow-unregistered
-				    include-files-not-directories)
-  "Deduce a set of files and a backend to which to apply an operation.
-Return (BACKEND . FILESET)."
-  (let* ((fileset (vc-dispatcher-selection-set
-		  #'vc-registered
-		  allow-directory-wildcard 
-		  allow-unregistered
-		  include-files-not-directories))
-	(backend (vc-backend (car fileset))))
-	;; All members of the fileset must have the same backend
-	(dolist (f (cdr fileset))
-	  (unless (eq (vc-backend f) backend)
-	    (error "All members of a fileset must be under the same version-control system.")))
-    (cons backend fileset)))
+(defun vc-deduce-fileset ()
+  "Deduce a set of files and a backend to which to apply an operation and
+the common state of the fileset.  Return (BACKEND . (STATE . FILESET))."
+  (let* ((fileset (vc-dispatcher-selection-set))
+	 (fileset-only-files (vc-expand-dirs fileset))
+	 (firstfile (car fileset-only-files))
+	 (firstbackend (vc-backend firstfile))
+	 (firstmodel (vc-checkout-model firstbackend (list firstfile)))
+	 (firststate (vc-state firstfile)))
+	(dolist (file (cdr fileset-only-files))
+	  (unless (eq (vc-backend file) firstbackend)
+	    (error "All members of a fileset must be under the same version-control system."))
+	  (unless (vc-compatible-state (vc-state file) firststate)
+	    (error "%s:%s clashes with %s:%s"
+		   file (vc-state file) firstfile firststate))
+	  (unless (eq (vc-checkout-model firstbackend (list file)) firstmodel)
+	    (error "Fileset has mixed checkout models")))
+	(cons firstbackend (cons firststate fileset))))
 
 (defun vc-ensure-vc-buffer ()
   "Make sure that the current buffer visits a version-controlled file."
@@ -1094,31 +1096,19 @@
    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))
-	 (vc-fileset-only-files (vc-deduce-fileset nil t t))
-	 (only-files (cdr vc-fileset-only-files))
+  (let* ((vc-fileset (vc-deduce-fileset))
          (backend (car vc-fileset))
-	 (files (cdr vc-fileset))
-	 (state (vc-state (car only-files)))
+	 (state (cadr vc-fileset))
+	 (files (cddr vc-fileset))
 	 (model (vc-checkout-model backend files))
 	 revision)
-
-    ;; Verify that the fileset is homogeneous
-    (dolist (file (cdr only-files))
-      ;; Ignore directories, they are compatible with anything.
-      (unless (file-directory-p file)
-	(unless (vc-compatible-state (vc-state file) state)
-	  (error "%s:%s clashes with %s:%s"
-		 file (vc-state file) (car files) state))
-	(unless (eq (vc-checkout-model backend (list file)) model)
-	  (error "Fileset has mixed checkout models"))))
     ;; Do the right thing
     (cond
      ((eq state 'missing)
       (error "Fileset files are missing, so cannot be operated on."))
-     ;; Files aren't registered
-     ((or (eq state 'unregistered)
-	  (eq state 'ignored))
+     ((eq state 'ignored)
+      (error "Fileset files are ignored by the version-control system."))
+     ((eq state 'unregistered)
       (mapc (lambda (arg) (vc-register nil arg)) files))
      ;; 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)))
@@ -1224,7 +1214,8 @@
 	(when (not (equal buffer-file-name file))
 	  (find-file-other-window file))
 	(if (save-window-excursion
-	      (vc-diff-internal nil (cons (car vc-fileset) (list file))
+	      (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))
@@ -1502,7 +1493,7 @@
   "Report diffs between two revisions of a fileset.
 Diff output goes to the *vc-diff* buffer.  The function
 returns t if the buffer had changes, nil otherwise."
-  (let* ((files (cdr vc-fileset))
+  (let* ((files (cddr vc-fileset))
 	 (messages (cons (format "Finding changes in %s..."
                                  (vc-delistify files))
                          (format "No changes between %s and %s"
@@ -1567,8 +1558,10 @@
 (defun vc-version-diff (files rev1 rev2)
   "Report diffs between revisions of the fileset in the repository history."
   (interactive
-   (let* ((vc-fileset (vc-deduce-fileset t))
-	  (files (cdr vc-fileset))
+   (let* ((vc-fileset (vc-deduce-fileset))
+	  (backend (car files))
+	  (state (cadr vc-fileset))
+	  (files (cddr vc-fileset))
 	  (first (car files))
 	  (completion-table
 	   (vc-call revision-completion-table files))
@@ -1609,10 +1602,12 @@
        (when (string= rev1 "") (setq rev1 nil))
        (when (string= rev2 "") (setq rev2 nil))
        (list files rev1 rev2))))
+  ;; All that was just so we could do argument completion!
   (when (and (not rev1) rev2)
     (error "Not a valid revision range."))
-  (vc-diff-internal
-   t (cons (car (vc-deduce-fileset t)) files) rev1 rev2 (interactive-p)))
+  ;; Yes, it's painful to call (vc-deduce-fileset) again.  Alas, the
+  ;; placement rules for (interactive) don't actually leave us a choice.
+  (vc-diff-internal t (vc-deduce-fileset) rev1 rev2 (interactive-p)))
 
 ;; (defun vc-contains-version-controlled-file (dir)
 ;;   "Return t if DIR contains a version-controlled file, nil otherwise."
@@ -1627,16 +1622,13 @@
 working revisions.  With a prefix argument HISTORIC, it reads two revision
 designators specifying which revisions to compare.
 
-If no current fileset is available and we're in a directory buffer, use
-the current directory.
 The optional argument NOT-URGENT non-nil means it is ok to say no to
 saving the buffer."
   (interactive (list current-prefix-arg t))
   (if historic
       (call-interactively 'vc-version-diff)
     (when buffer-file-name (vc-buffer-sync not-urgent))
-    (vc-diff-internal t (vc-deduce-fileset t) nil nil (interactive-p))))
-
+    (vc-diff-internal t (vc-deduce-fileset) nil nil (interactive-p))))
 
 ;;;###autoload
 (defun vc-revision-other-window (rev)
@@ -2128,8 +2120,9 @@
 If WORKING-REVISION is non-nil, leave the point at that revision."
   (interactive)
   (let* ((vc-fileset (vc-deduce-fileset))
-	 (files (cdr vc-fileset))
 	 (backend (car vc-fileset))
+	 (state (cadr vc-fileset))
+	 (files (cddr vc-fileset))
 	 (working-revision (or working-revision (vc-working-revision (car files)))))
     ;; Don't switch to the output buffer before running the command,
     ;; so that any buffer-local settings in the vc-controlled
@@ -2159,7 +2152,9 @@
 to the working revision (except for keyword expansion)."
   (interactive)
   (let* ((vc-fileset (vc-deduce-fileset))
-	 (files (cdr vc-fileset)))
+	 (backend (car vc-fileset))
+	 (state (cadr vc-fileset))
+	 (files (cddr vc-fileset)))
     ;; If any of the files is visited by the current buffer, make
     ;; sure buffer is saved.  If the user says `no', abort since
     ;; we cannot show the changes and ask for confirmation to
@@ -2190,8 +2185,9 @@
 depending on the underlying version-control system."
   (interactive)
   (let* ((vc-fileset (vc-deduce-fileset))
-	 (files (cdr vc-fileset))
 	 (backend (car vc-fileset))
+	 (state (cadr vc-fileset))
+	 (files (cddr vc-fileset))
 	 (granularity (vc-call-backend backend 'revision-granularity)))
     (unless (vc-find-backend-function backend 'rollback)
       (error "Rollback is not supported in %s" backend))
@@ -2245,8 +2241,9 @@
 changes from the current branch are merged into the working file."
   (interactive)
   (let* ((vc-fileset (vc-deduce-fileset))
-	 (files (cdr vc-fileset))
-	 (backend (car vc-fileset)))
+	 (backend (car vc-fileset))
+	 (state (cadr vc-fileset))
+	 (files (cddr vc-fileset)))
     (dolist (file files)
       (when (let ((buf (get-file-buffer file)))
 	      (and buf (buffer-modified-p buf)))
@@ -3138,7 +3135,8 @@
 	    (vc-diff-internal
 	     nil
 	     (cons (vc-backend vc-annotate-parent-file)
-		   (list vc-annotate-parent-file))
+		   (cons nil
+			 (list vc-annotate-parent-file)))
 	     prev-rev rev-at-line))
 	  (switch-to-buffer "*vc-diff*"))))))