andros/emacs-gpu
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

More policy-mechanism separation.

Browse source
This commit is contained in:
Eric S. Raymond 2008-05-05 22:33:44 +00:00
parent 834ee13130
commit b236ab0da9
3 changed files with 81 additions and 49 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
lisp/ChangeLog
View file

@ -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.

68
lisp/vc-dispatcher.el
View file

@ -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

57
lisp/vc.el
View file

@ -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."