# HG changeset patch # User Dan Nicolaescu # Date 1208854814 0 # Node ID 9f1f284d17b32e1a6bffe7edf1efb7e8be7eb0cd # Parent 4c40dfdeec2f86a4bf5f1a8f6230c2bcdef339ce (vc-next-action): Do not consider directories when checking for state compatibility. (vc-transfer-file): Use when not if. (vc-dir-parent-marked-p, vc-dir-children-marked-p): New functions. (vc-dir-mark-file): Use them. (vc-deduce-fileset): Also return the backend. (vc-diff-internal): Take as argument the value returned by vc-deduce-fileset instead of just the fileset. (vc-next-action, vc-finish-logentry, vc-version-diff, vc-diff) (vc-dir-mark-file, vc-print-log, vc-revert, vc-rollback) (vc-update): Update the vc-deduce-fileset and vc-diff-internal calls. diff -r 4c40dfdeec2f -r 9f1f284d17b3 lisp/ChangeLog --- a/lisp/ChangeLog Tue Apr 22 06:53:52 2008 +0000 +++ b/lisp/ChangeLog Tue Apr 22 09:00:14 2008 +0000 @@ -1,3 +1,17 @@ +2008-04-22 Dan Nicolaescu + + * vc.el (vc-next-action): Do not consider directories when + checking for state compatibility. + (vc-transfer-file): Use when not if. + (vc-dir-parent-marked-p, vc-dir-children-marked-p): New functions. + (vc-dir-mark-file): Use them. + (vc-deduce-fileset): Also return the backend. + (vc-diff-internal): Take as argument the value returned by + vc-deduce-fileset instead of just the fileset. + (vc-next-action, vc-finish-logentry, vc-version-diff, vc-diff) + (vc-dir-mark-file, vc-print-log, vc-revert, vc-rollback) + (vc-update): Update the vc-deduce-fileset and vc-diff-internal calls. + 2008-04-22 Tassilo Horn * doc-view.el (doc-view-scroll-up-or-next-page): Don't use diff -r 4c40dfdeec2f -r 9f1f284d17b3 lisp/vc.el --- a/lisp/vc.el Tue Apr 22 06:53:52 2008 +0000 +++ b/lisp/vc.el Tue Apr 22 09:00:14 2008 +0000 @@ -648,6 +648,10 @@ ;; ;; - vc-dir toolbar needs more icons. ;; +;; - implement `vc-dir-parent-marked-p' and `vc-dir-children-marked-p'. +;; +;; - test operations on directories in vc-dir. +;; ;; - vc-diff, vc-annotate, etc. need to deal better with unregistered ;; files. Now that unregistered and ignored files are shown in ;; vc-dired/vc-dir, it is possible that these commands are called @@ -1419,6 +1423,7 @@ (defun vc-deduce-fileset (&optional allow-directory-wildcard allow-unregistered) "Deduce a set of files and a backend to which to apply an operation. +Return (BACKEND . FILESET). If we're in VC-dired mode, the fileset is the list of marked files. Otherwise, if we're looking at a buffer visiting a version-controlled file, the fileset is a singleton containing this file. @@ -1427,45 +1432,54 @@ If none of these conditions is met, but ALLOW_UNREGISTERED is in and the visited file is not registered, return a singletin fileset containing it. Otherwise, throw an error." - (cond (vc-dired-mode - (let ((marked (dired-map-over-marks (dired-get-filename) nil))) - (unless marked - (error "No files have been selected.")) - ;; All members of the fileset must have the same backend - (let ((firstbackend (vc-backend (car marked)))) - (dolist (f (cdr marked)) - (unless (eq (vc-backend f) firstbackend) - (error "All members of a fileset must be under the same version-control system.")))) - marked)) - ((eq major-mode 'vc-dir-mode) - (or (vc-dir-marked-files) - (list (vc-dir-current-file)))) - ((vc-backend buffer-file-name) - (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) - (list default-directory))) - ((and allow-unregistered (not (vc-registered buffer-file-name))) - (list buffer-file-name)) - (t (error "No fileset is available here.")))) + (let (backend) + (cond + (vc-dired-mode + (let ((marked (dired-map-over-marks (dired-get-filename) nil))) + (unless marked + (error "No files have been selected.")) + ;; All members of the fileset must have the same backend + (setq backend (vc-backend (car marked))) + (dolist (f (cdr marked)) + (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 (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)))) + ((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."))))) (defun vc-ensure-vc-buffer () "Make sure that the current buffer visits a version-controlled file." @@ -1564,16 +1578,19 @@ If the repository file is changed, you are asked if you want to merge in the changes into your working copy." (interactive "P") - (let* ((files (vc-deduce-fileset nil t)) + (let* ((vc-fileset (vc-deduce-fileset nil t)) + (files (cdr vc-fileset)) (state (vc-state (car files))) (model (vc-checkout-model (car files))) revision) ;; Verify that the fileset is homogeneous (dolist (file (cdr files)) - (unless (vc-compatible-state (vc-state file) state) - (error "Fileset is in a mixed-up state")) - (unless (eq (vc-checkout-model file) model) - (error "Fileset has mixed checkout models"))) + ;; Ignore directories, they are compatible with anything. + (unless (file-directory-p file) + (unless (vc-compatible-state (vc-state file) state) + (error "Fileset is in a mixed-up state")) + (unless (eq (vc-checkout-model file) model) + (error "Fileset has mixed checkout models")))) ;; Check for buffers in the fileset not matching the on-disk contents. (dolist (file files) (let ((visited (get-file-buffer file))) @@ -1708,7 +1725,8 @@ (when (not (equal buffer-file-name file)) (find-file-other-window file)) (if (save-window-excursion - (vc-diff-internal nil (list file) (vc-working-revision file) nil) + (vc-diff-internal nil (cons (car vc-fileset) (list file)) + (vc-working-revision file) nil) (goto-char (point-min)) (let ((inhibit-read-only t)) (insert @@ -2035,8 +2053,10 @@ (mapc (lambda (file) (vc-resynch-buffer file vc-keep-workfiles t)) log-fileset)) - (when (or vc-dired-mode (eq major-mode 'vc-dir-mode)) + (when vc-dired-mode (dired-move-to-filename)) + (when (eq major-mode 'vc-dir-mode) + (vc-dir-move-to-goal-column)) (run-hooks after-hook 'vc-finish-logentry-hook))) ;;; Additional entry points for examining version histories @@ -2114,11 +2134,12 @@ (defvar vc-diff-added-files nil "If non-nil, diff added files by comparing them to /dev/null.") -(defun vc-diff-internal (async files rev1 rev2 &optional verbose) +(defun vc-diff-internal (async vc-fileset rev1 rev2 &optional verbose) "Report diffs between two revisions of a fileset. Diff output goes to the *vc-diff* buffer. The function returns t if the buffer had changes, nil otherwise." - (let* ((messages (cons (format "Finding changes in %s..." + (let* ((files (cdr vc-fileset)) + (messages (cons (format "Finding changes in %s..." (vc-delistify files)) (format "No changes between %s and %s" (or rev1 "working revision") @@ -2157,7 +2178,7 @@ (append (vc-switches nil 'diff) '("/dev/null")))))) (setq files (nreverse filtered)))) (let ((vc-disable-async-diff (not async))) - (vc-call diff files rev1 rev2 "*vc-diff*")) + (vc-call-backend (car vc-fileset) 'diff files rev1 rev2 "*vc-diff*")) (set-buffer "*vc-diff*") (if (and (zerop (buffer-size)) (not (get-buffer-process (current-buffer)))) @@ -2182,7 +2203,8 @@ (defun vc-version-diff (files rev1 rev2) "Report diffs between revisions of the fileset in the repository history." (interactive - (let* ((files (vc-deduce-fileset t)) + (let* ((vc-fileset (vc-deduce-fileset t)) + (files (cdr vc-fileset)) (first (car files)) (completion-table (vc-call revision-completion-table files)) @@ -2223,9 +2245,10 @@ (when (string= rev1 "") (setq rev1 nil)) (when (string= rev2 "") (setq rev2 nil)) (list files rev1 rev2)))) - (if (and (not rev1) rev2) - (error "Not a valid revision range.")) - (vc-diff-internal t files rev1 rev2 (interactive-p))) + (when (and (not rev1) rev2) + (error "Not a valid revision range.")) + (vc-diff-internal + t (cons (car (vc-deduce-fileset t)) files) rev1 rev2 (interactive-p))) ;; (defun vc-contains-version-controlled-file (dir) ;; "Return t if DIR contains a version-controlled file, nil otherwise." @@ -2249,9 +2272,8 @@ (interactive (list current-prefix-arg t)) (if historic (call-interactively 'vc-version-diff) - (let* ((files (vc-deduce-fileset t))) - (when buffer-file-name (vc-buffer-sync not-urgent)) - (vc-diff-internal t files nil nil (interactive-p))))) + (when buffer-file-name (vc-buffer-sync not-urgent)) + (vc-diff-internal t (vc-deduce-fileset t) nil nil (interactive-p)))) ;;;###autoload @@ -3268,13 +3290,24 @@ (funcall mark-unmark-function)))) (funcall mark-unmark-function))) +(defun vc-dir-parent-marked-p (arg) + ;; Return t if any of the children of arg is marked. + nil) + +(defun vc-dir-children-marked-p (arg) + ;; Return t if any of the children of arg is marked. + nil) + (defun vc-dir-mark-file () ;; Mark the current file and move to the next line. (let* ((crt (ewoc-locate vc-ewoc)) - (file (ewoc-data crt))) - (setf (vc-dir-fileinfo->marked file) t) - (ewoc-invalidate vc-ewoc crt) - (vc-dir-next-line 1))) + (file (ewoc-data crt)) + (isdir (vc-dir-fileinfo->directory file))) + (when (or (and isdir (not (vc-dir-children-marked-p crt))) + (and (not isdir) (not (vc-dir-parent-marked-p crt)))) + (setf (vc-dir-fileinfo->marked file) t) + (ewoc-invalidate vc-ewoc crt) + (vc-dir-next-line 1)))) (defun vc-dir-mark () "Mark the current file or all files in the region. @@ -3508,8 +3541,9 @@ "List the change log of the current fileset in a window. If WORKING-REVISION is non-nil, leave the point at that revision." (interactive) - (let* ((files (vc-deduce-fileset)) - (backend (vc-backend files)) + (let* ((vc-fileset (vc-deduce-fileset)) + (files (cdr vc-fileset)) + (backend (car vc-fileset)) (working-revision (or working-revision (vc-working-revision (car files))))) ;; Don't switch to the output buffer before running the command, ;; so that any buffer-local settings in the vc-controlled @@ -3538,7 +3572,8 @@ This asks for confirmation if the buffer contents are not identical to the working revision (except for keyword expansion)." (interactive) - (let* ((files (vc-deduce-fileset))) + (let* ((vc-fileset (vc-deduce-fileset)) + (files (cdr vc-fileset))) ;; If any of the files is visited by the current buffer, make ;; sure buffer is saved. If the user says `no', abort since ;; we cannot show the changes and ask for confirmation to @@ -3552,7 +3587,7 @@ (when (vc-up-to-date-p file) (unless (yes-or-no-p (format "%s seems up-to-date. Revert anyway? " file)) (error "Revert canceled")))) - (when (vc-diff-internal vc-allow-async-revert files nil nil) + (when (vc-diff-internal vc-allow-async-revert vc-fileset nil nil) (unless (yes-or-no-p (format "Discard changes in %s? " (vc-delistify files))) (error "Revert canceled")) (delete-windows-on "*vc-diff*") @@ -3568,8 +3603,9 @@ This may be either a file-level or a repository-level operation, depending on the underlying version-control system." (interactive) - (let* ((files (vc-deduce-fileset)) - (backend (vc-backend files)) + (let* ((vc-fileset (vc-deduce-fileset)) + (files (cdr vc-fileset)) + (backend (car vc-fileset)) (granularity (vc-call-backend backend 'revision-granularity))) (unless (vc-find-backend-function backend 'rollback) (error "Rollback is not supported in %s" backend)) @@ -3594,7 +3630,7 @@ (message "Finding changes...") (let* ((tip (vc-working-revision (car files))) (previous (vc-call previous-revision (car files) tip))) - (vc-diff-internal nil files previous tip)) + (vc-diff-internal nil vc-fileset previous tip)) ;; Display changes (unless (yes-or-no-p "Discard these revisions? ") (error "Rollback canceled")) @@ -3622,25 +3658,28 @@ contains changes, and the backend supports merging news, then any recent changes from the current branch are merged into the working file." (interactive) - (dolist (file (vc-deduce-fileset)) - (when (let ((buf (get-file-buffer file))) - (and buf (buffer-modified-p buf))) - (error "Please kill or save all modified buffers before updating.")) - (if (vc-up-to-date-p file) - (vc-checkout file nil t) - (if (eq (vc-checkout-model file) 'locking) - (if (eq (vc-state file) 'edited) - (error "%s" + (let* ((vc-fileset (vc-deduce-fileset)) + (files (cdr vc-fileset)) + (backend (car vc-fileset))) + (dolist (file files) + (when (let ((buf (get-file-buffer file))) + (and buf (buffer-modified-p buf))) + (error "Please kill or save all modified buffers before updating.")) + (if (vc-up-to-date-p file) + (vc-checkout file nil t) + (if (eq (vc-checkout-model file) 'locking) + (if (eq (vc-state file) 'edited) + (error "%s" + (substitute-command-keys + "File is locked--type \\[vc-revert] to discard changes")) + (error "Unexpected file state (%s) -- type %s" + (vc-state file) (substitute-command-keys - "File is locked--type \\[vc-revert] to discard changes")) - (error "Unexpected file state (%s) -- type %s" - (vc-state file) - (substitute-command-keys - "\\[vc-next-action] to correct"))) - (if (not (vc-find-backend-function (vc-backend file) 'merge-news)) - (error "Sorry, merging news is not implemented for %s" - (vc-backend file)) - (vc-maybe-resolve-conflicts file (vc-call merge-news file))))))) + "\\[vc-next-action] to correct"))) + (if (not (vc-find-backend-function backend 'merge-news)) + (error "Sorry, merging news is not implemented for %s" + backend) + (vc-maybe-resolve-conflicts file (vc-call merge-news file)))))))) (defun vc-version-backup-file (file &optional rev) "Return name of backup file for revision REV of FILE. @@ -3730,8 +3769,8 @@ (or (memq new-backend (memq old-backend vc-handled-backends)) (y-or-n-p "Final transfer? ")))) (comment nil)) - (if (eq old-backend new-backend) - (error "%s is the current backend of %s" new-backend file)) + (when (eq old-backend new-backend) + (error "%s is the current backend of %s" new-backend file)) (if registered (set-file-modes file (logior (file-modes file) 128)) ;; `registered' might have switched under us. @@ -3750,8 +3789,8 @@ (if unmodified-file (copy-file unmodified-file file 'ok-if-already-exists 'keep-date) - (if (y-or-n-p "Get base revision from master? ") - (vc-revert-file file)))) + (when (y-or-n-p "Get base revision from master? ") + (vc-revert-file file)))) (vc-call-backend new-backend 'receive-file file rev)) (when modified-file (vc-switch-backend file new-backend) @@ -3787,8 +3826,8 @@ (catch 'found ;; If possible, keep the master file in the same directory. (dolist (f masters) - (if (and f (string= (file-name-directory (expand-file-name f)) dir)) - (throw 'found f))) + (when (and f (string= (file-name-directory (expand-file-name f)) dir)) + (throw 'found f))) ;; If not, just use the first possible place. (dolist (f masters) (and f (or (not (setq dir (file-name-directory f))) @@ -4505,8 +4544,11 @@ (if (not prev-rev) (message "Cannot diff from any revision prior to %s" rev-at-line) (save-window-excursion - (vc-diff-internal nil (list vc-annotate-parent-file) - prev-rev rev-at-line)) + (vc-diff-internal + nil + (cons (vc-backend vc-annotate-parent-file) + (list vc-annotate-parent-file)) + prev-rev rev-at-line)) (switch-to-buffer "*vc-diff*")))))) (defun vc-annotate-warp-revision (revspec)