More policy-mechanism separation.

3 files changed, 81 insertions, 49 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 415981c8e13..92bb56f5392 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
+2008-05-05  Eric S. Raymond  <esr@snark.thyrsus.com>
+
+        * 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  <sds@gnu.org>
 
         * window.el (delete-other-windows-vertically): New function.
diff --git a/lisp/vc-dispatcher.el b/lisp/vc-dispatcher.el
index b2484ec6b75..6dd459ddf74 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 8e9d0469b27..830951538ea 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."