More policy-mechanism separation.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 415981c8e13f0a94fdc674b099911033b363a698..92bb56f539232929fc6e044acf2827279489c2f0 100644 (file)
--- 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 b2484ec6b755321aaf5dab2a3b2c086e4dd0f554..6dd459ddf74d615b94a5dbb773fd29c7d69e0c0b 100644 (file)
--- 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 8e9d0469b2760c854244f6271eba4c28d11c2829..830951538ea499ffab6d045c97d3467b5636968f 100644 (file)
--- 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."