More policy-mechanism separation.

3 files changed, 81 insertions, 49 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 415981c8e1..92bb56f539 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
+2008-05-05  Eric S. Raymond  <[email protected]>
+
+	* vc.el (vc-deduce-fileset): Lift all the policy and UI
+	stuff out of this function, move it to vc-dispatcher-selection-set.k
+
 2008-05-05  Sam Steingold  <[email protected]>
 
 	* window.el (delete-other-windows-vertically): New function.
diff --git a/lisp/vc-dispatcher.el b/lisp/vc-dispatcher.el
index b2484ec6b7..6dd459ddf7 100644
--- a/lisp/vc-dispatcher.el
+++ b/lisp/vc-dispatcher.el
@@ -1602,5 +1602,73 @@ U - if the cursor is on a file: unmark all the files with the same VC state
 
 (put 'vc-dir-mode 'mode-class 'special)
 
+(defun vc-dispatcher-browsing ()
+  "Are we in a directory browser buffer?"
+  (or vc-dired-mode (eq major-mode 'vc-dir-mode)))
+
+(defun vc-dispatcher-selection-set (eligible
+				   &optional 
+				   allow-directory-wildcard 
+				   allow-inegible
+				   include-files-not-directories)
+  "Deduce a set of files to which to apply an operation. Return the fileset.
+If we're in VC-dired mode, 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 dired 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."
+    (cond
+     ;; Browsing with dired
+     (vc-dired-mode
+      (let ((marked (dired-map-over-marks (dired-get-filename) nil)))
+	(if marked
+	    marked
+	  (error "No files have been selected."))))
+     ;; 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))))
+     ;; Visiting an eligible file
+     ((funcall eligible buffer-file-name)
+      (list buffer-file-name))
+     ;; No eligible file -- if there's a parent buffer, deuce 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)))
+     ;; 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
+	   ;; I think this is a misfeature.  For now, I'll leave it in, but
+	   ;; I'll disable it anywhere else than in dired buffers.  --Stef
+	   (and (derived-mode-p 'dired-mode)
+		(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))
+     ;; No good set here, throw error
+     (t (error "No fileset is available here."))))
+
 ;; arch-tag: 7d08b17f-5470-4799-914b-bfb9fcf6a246
 ;;; vc-dispatcher.el ends here
diff --git a/lisp/vc.el b/lisp/vc.el
index 8e9d0469b2..830951538e 100644
--- a/lisp/vc.el
+++ b/lisp/vc.el
@@ -1059,58 +1059,17 @@ If INCLUDE-FILES-NOT-DIRECTORIES then if directories are marked,
 return the list of files VC files in those directories instead of
 the directories themselves.
 Otherwise, throw an error."
-  (let (backend)
-    (cond
-     (vc-dired-mode
-      (let ((marked (dired-map-over-marks (dired-get-filename) nil)))
-	(unless marked
-	  (error "No files have been selected."))
+  (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
-	(setq backend (vc-backend (car marked)))
-	(dolist (f (cdr marked))
+	(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 marked)))
-     ((eq major-mode 'vc-dir-mode)
-      ;; FIXME: Maybe the backend should be stored in a buffer-local
-      ;; variable?
-      (cons (vc-responsible-backend default-directory)
-		(or
-		 (if include-files-not-directories
-		     (vc-dir-marked-only-files)
-		   (vc-dir-marked-files))
-		 (list (vc-dir-current-file)))))
-     ((setq backend (vc-backend buffer-file-name))
-      (cons backend (list buffer-file-name)))
-     ((and vc-parent-buffer (or (buffer-file-name vc-parent-buffer)
-				(with-current-buffer vc-parent-buffer
-				  (or vc-dired-mode (eq major-mode 'vc-dir-mode)))))
-      (progn
-	(set-buffer vc-parent-buffer)
-	(vc-deduce-fileset)))
-     ;; 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
-	   ;; I think this is a misfeature.  For now, I'll leave it in, but
-	   ;; I'll disable it anywhere else than in dired buffers.  --Stef
-	   (and (derived-mode-p 'dired-mode)
-		(equal buffer-file-name nil)
-		(equal list-buffers-directory default-directory)))
-      (progn
-	(message "All version-controlled files below %s selected."
-		 default-directory)
-	(cons
-	 (vc-responsible-backend default-directory)
-	 (list default-directory))))
-     ;; If we're allowing unregistered fiiles and visiting one, select it.
-     ((and allow-unregistered (not (vc-registered buffer-file-name)))
-      (cons (vc-responsible-backend
-	     (file-name-directory (buffer-file-name)))
-	    (list buffer-file-name)))
-     (t (error "No fileset is available here.")))))
+    (cons backend fileset)))
 
 (defun vc-ensure-vc-buffer ()
   "Make sure that the current buffer visits a version-controlled file."