# HG changeset patch # User Eric S. Raymond # Date 1210026824 0 # Node ID d0547efd97db3ec4765a8db4d304c14262938d65 # Parent 2234170de09edf33496693e62c87824e87f4103d More policy-mechanism separation. diff -r 2234170de09e -r d0547efd97db lisp/ChangeLog --- a/lisp/ChangeLog Mon May 05 22:11:15 2008 +0000 +++ b/lisp/ChangeLog Mon May 05 22:33:44 2008 +0000 @@ -1,3 +1,8 @@ +2008-05-05 Eric S. Raymond + + * 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 * window.el (delete-other-windows-vertically): New function. diff -r 2234170de09e -r d0547efd97db lisp/vc-dispatcher.el --- a/lisp/vc-dispatcher.el Mon May 05 22:11:15 2008 +0000 +++ b/lisp/vc-dispatcher.el Mon May 05 22:33:44 2008 +0000 @@ -1602,5 +1602,73 @@ (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 -r 2234170de09e -r d0547efd97db lisp/vc.el --- a/lisp/vc.el Mon May 05 22:11:15 2008 +0000 +++ b/lisp/vc.el Mon May 05 22:33:44 2008 +0000 @@ -1059,58 +1059,17 @@ 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."