;;; vc.el --- drive a version-control system from within Emacs
-;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2000,
-;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1992-1998, 2000-2011 Free Software Foundation, Inc.
;; Author: FSF (see below for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
;; In the list of functions below, each identifier needs to be prepended
;; with `vc-sys-'. Some of the functions are mandatory (marked with a
;; `*'), others are optional (`-').
-;;
+
;; BACKEND PROPERTIES
;;
;; * revision-granularity
;; that return 'file have per-file revision numbering; backends
;; that return 'repository have per-repository revision numbering,
;; so a revision level implicitly identifies a changeset
-;;
+
;; STATE-QUERYING FUNCTIONS
;;
;; * registered (file)
;; * working-revision (file)
;;
;; Return the working revision of FILE. This is the revision fetched
-;; by the last checkout or upate, not necessarily the same thing as the
+;; by the last checkout or update, not necessarily the same thing as the
;; head or tip revision. Should return "0" for a file added but not yet
;; committed.
;;
;;
;; - merge (file rev1 rev2)
;;
-;; Merge the changes between REV1 and REV2 into the current working file.
+;; Merge the changes between REV1 and REV2 into the current working file
+;; (for non-distributed VCS).
+;;
+;; - merge-branch ()
+;;
+;; Merge another branch into the current one, prompting for a
+;; location to merge from.
;;
;; - merge-news (file)
;;
;; Merge recent changes from the current branch into FILE.
+;; (for non-distributed VCS).
+;;
+;; - pull (prompt)
+;;
+;; Pull "upstream" changes into the current branch (for distributed
+;; VCS). If PROMPT is non-nil, or if necessary, prompt for a
+;; location to pull from.
;;
;; - steal-lock (file &optional revision)
;;
;;
;; Mark conflicts as resolved. Some VC systems need to run a
;; command to mark conflicts as resolved.
-;;
+
;; HISTORY FUNCTIONS
;;
;; * print-log (files buffer &optional shortlog start-revision limit)
;; If the backend supports annotating through copies and renames,
;; and displays a file name and a revision, then return a cons
;; (REVISION . FILENAME).
-;;
+
;; TAG SYSTEM
;;
;; - create-tag (dir name branchp)
;; does a sanity check whether there aren't any uncommitted changes at
;; or below DIR, and then performs a tree walk, using the `checkout'
;; function to retrieve the corresponding revisions.
-;;
+
;; MISCELLANEOUS
;;
;; - make-version-backups-p (file)
;; buffer, if one is present, instead of adding to the ChangeLog.
;;
;; - When vc-next-action calls vc-checkin it could pre-fill the
-;; *VC-log* buffer with some obvious items: the list of files that
+;; *vc-log* buffer with some obvious items: the list of files that
;; were added, the list of files that were removed. If the diff is
;; available, maybe it could even call something like
;; `diff-add-change-log-entries-other-window' to create a detailed
(require 'vc-hooks)
(require 'vc-dispatcher)
+(require 'ediff)
(eval-when-compile
(require 'cl)
:type 'boolean
:group 'vc)
+(make-obsolete-variable 'vc-initial-comment "it has no effect." "23.2")
+
(defcustom vc-default-init-revision "1.1"
"A string used as the default revision number when a new file is registered.
This can be overridden by giving a prefix argument to \\[vc-register]. This
:type 'hook
:group 'vc)
+(defcustom vc-revert-show-diff t
+ "If non-nil, `vc-revert' shows a `vc-diff' buffer before querying."
+ :type 'boolean
+ :group 'vc
+ :version "24.1")
+
;; Header-insertion hair
(defcustom vc-static-header-alist
"\n#ifndef lint\nstatic char vcid[] = \"\%s\";\n#endif /* lint */\n"))
"Associate static header string templates with file types.
A \%s in the template is replaced with the first string associated with
-the file's version control type in `vc-header-alist'."
+the file's version control type in `vc-BACKEND-header'."
:type '(repeat (cons :format "%v"
(regexp :tag "File Type")
(string :tag "Header String")))
(cond ((derived-mode-p 'vc-dir-mode) vc-dir-backend)
((derived-mode-p 'log-view-mode) log-view-vc-backend)
((derived-mode-p 'diff-mode) diff-vc-backend)
- ((derived-mode-p 'dired-mode)
+ ;; Maybe we could even use comint-mode rather than shell-mode?
+ ((derived-mode-p 'dired-mode 'shell-mode 'compilation-mode)
(vc-responsible-backend default-directory))
(vc-mode (vc-backend buffer-file-name))))
(let ((backend (vc-responsible-backend default-directory)))
(unless backend (error "Directory not under VC"))
(list backend
- (dired-map-over-marks (dired-get-filename nil t) nil))))
+ (dired-map-over-marks (dired-get-filename nil t) nil))))
(defun vc-ensure-vc-buffer ()
"Make sure that the current buffer visits a version-controlled file."
;; Files have local changes
((vc-compatible-state state 'edited)
(let ((ready-for-commit files))
- ;; If files are edited but read-only, give user a chance to correct
+ ;; If files are edited but read-only, give user a chance to correct.
(dolist (file files)
- (unless (file-writable-p file)
+ ;; If committing a mix of removed and edited files, the
+ ;; fileset has state = 'edited. Rather than checking the
+ ;; state of each individual file in the fileset, it seems
+ ;; simplest to just check if the file exists. Bug#9781.
+ (when (and (file-exists-p file) (not (file-writable-p file)))
;; Make the file+buffer read-write.
- (unless (y-or-n-p (format "%s is edited but read-only; make it writable and continue?" file))
+ (unless (y-or-n-p (format "%s is edited but read-only; make it writable and continue? " file))
(error "Aborted"))
- (set-file-modes file (logior (file-modes file) 128))
+ ;; Maybe we somehow lost permissions on the directory.
+ (condition-case nil
+ (set-file-modes file (logior (file-modes file) 128))
+ (error (error "Unable to make file writable")))
(let ((visited (get-file-buffer file)))
(when visited
(with-current-buffer visited
(vc-start-logentry
files comment initial-contents
"Enter a change comment."
- "*VC-log*"
+ "*vc-log*"
(lambda ()
(vc-call-backend backend 'log-edit-mode))
(lexical-let ((rev rev))
(defvar vc-diff-added-files nil
"If non-nil, diff added files by comparing them to /dev/null.")
-(defun vc-diff-internal (async vc-fileset rev1 rev2 &optional verbose)
+(defun vc-diff-internal (async vc-fileset rev1 rev2 &optional verbose buffer)
"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."
+Output goes to the buffer BUFFER, which defaults to *vc-diff*.
+BUFFER, if non-nil, should be a buffer or a buffer name.
+Return t if the buffer had changes, nil otherwise."
+ (unless buffer
+ (setq buffer "*vc-diff*"))
(let* ((files (cadr vc-fileset))
(messages (cons (format "Finding changes in %s..."
(vc-delistify files))
;; be to call the back end separately for each file.
(coding-system-for-read
(if files (vc-coding-system-for-diff (car files)) 'undecided)))
- (vc-setup-buffer "*vc-diff*")
+ (vc-setup-buffer buffer)
(message "%s" (car messages))
;; Many backends don't handle well the case of a file that has been
;; added but not yet committed to the repo (notably CVS and Subversion).
(error "No revisions of %s exist" file)
;; We regard this as "changed".
;; Diff it against /dev/null.
- (apply 'vc-do-command "*vc-diff*"
+ (apply 'vc-do-command buffer
1 "diff" file
(append (vc-switches nil 'diff) '("/dev/null"))))))
(setq files (nreverse filtered))))
(let ((vc-disable-async-diff (not async)))
- (vc-call-backend (car vc-fileset) 'diff files rev1 rev2 "*vc-diff*"))
- (set-buffer "*vc-diff*")
+ (vc-call-backend (car vc-fileset) 'diff files rev1 rev2 buffer))
+ (set-buffer buffer)
(if (and (zerop (buffer-size))
(not (get-buffer-process (current-buffer))))
;; Treat this case specially so as not to pop the buffer.
;; bindings are nicer for read only buffers. pcl-cvs does the
;; same thing.
(setq buffer-read-only t)
- (vc-exec-after `(vc-diff-finish ,(current-buffer) ',(when verbose
- messages)))
;; Display the buffer, but at the end because it can change point.
(pop-to-buffer (current-buffer))
+ ;; The diff process may finish early, so call `vc-diff-finish'
+ ;; after `pop-to-buffer'; the former assumes the diff buffer is
+ ;; shown in some window.
+ (vc-exec-after `(vc-diff-finish ,(current-buffer)
+ ',(when verbose messages)))
;; In the async case, we return t even if there are no differences
;; because we don't know that yet.
t)))
nil nil initial-input nil default)
(read-string prompt initial-input nil default))))
+(defun vc-diff-build-argument-list-internal ()
+ "Build argument list for calling internal diff functions."
+ (let* ((vc-fileset (vc-deduce-fileset t)) ;FIXME: why t? --Stef
+ (files (cadr vc-fileset))
+ (backend (car vc-fileset))
+ (first (car files))
+ (rev1-default nil)
+ (rev2-default nil))
+ (cond
+ ;; someday we may be able to do revision completion on non-singleton
+ ;; filesets, but not yet.
+ ((/= (length files) 1)
+ nil)
+ ;; if it's a directory, don't supply any revision default
+ ((file-directory-p first)
+ nil)
+ ;; if the file is not up-to-date, use working revision as older revision
+ ((not (vc-up-to-date-p first))
+ (setq rev1-default (vc-working-revision first)))
+ ;; if the file is not locked, use last and previous revisions as defaults
+ (t
+ (setq rev1-default (vc-call-backend backend 'previous-revision first
+ (vc-working-revision first)))
+ (when (string= rev1-default "") (setq rev1-default nil))
+ (setq rev2-default (vc-working-revision first))))
+ ;; construct argument list
+ (let* ((rev1-prompt (if rev1-default
+ (concat "Older revision (default "
+ rev1-default "): ")
+ "Older revision: "))
+ (rev2-prompt (concat "Newer revision (default "
+ (or rev2-default "current source") "): "))
+ (rev1 (vc-read-revision rev1-prompt files backend rev1-default))
+ (rev2 (vc-read-revision rev2-prompt files backend rev2-default)))
+ (when (string= rev1 "") (setq rev1 nil))
+ (when (string= rev2 "") (setq rev2 nil))
+ (list files rev1 rev2))))
+
;;;###autoload
(defun vc-version-diff (files rev1 rev2)
"Report diffs between revisions of the fileset in the repository history."
- (interactive
- (let* ((vc-fileset (vc-deduce-fileset t)) ;FIXME: why t? --Stef
- (files (cadr vc-fileset))
- (backend (car vc-fileset))
- (first (car files))
- (rev1-default nil)
- (rev2-default nil))
- (cond
- ;; someday we may be able to do revision completion on non-singleton
- ;; filesets, but not yet.
- ((/= (length files) 1)
- nil)
- ;; if it's a directory, don't supply any revision default
- ((file-directory-p first)
- nil)
- ;; if the file is not up-to-date, use working revision as older revision
- ((not (vc-up-to-date-p first))
- (setq rev1-default (vc-working-revision first)))
- ;; if the file is not locked, use last and previous revisions as defaults
- (t
- (setq rev1-default (vc-call-backend backend 'previous-revision first
- (vc-working-revision first)))
- (when (string= rev1-default "") (setq rev1-default nil))
- (setq rev2-default (vc-working-revision first))))
- ;; construct argument list
- (let* ((rev1-prompt (if rev1-default
- (concat "Older revision (default "
- rev1-default "): ")
- "Older revision: "))
- (rev2-prompt (concat "Newer revision (default "
- (or rev2-default "current source") "): "))
- (rev1 (vc-read-revision rev1-prompt files backend rev1-default))
- (rev2 (vc-read-revision rev2-prompt files backend rev2-default)))
- (when (string= rev1 "") (setq rev1 nil))
- (when (string= rev2 "") (setq rev2 nil))
- (list files rev1 rev2))))
+ (interactive (vc-diff-build-argument-list-internal))
;; All that was just so we could do argument completion!
(when (and (not rev1) rev2)
(error "Not a valid revision range"))
(vc-diff-internal t (vc-deduce-fileset t) nil nil
(called-interactively-p 'interactive))))
+(declare-function ediff-vc-internal (rev1 rev2 &optional startup-hooks))
+
+;;;###autoload
+(defun vc-version-ediff (files rev1 rev2)
+ "Show differences between revisions of the fileset in the
+repository history using ediff."
+ (interactive (vc-diff-build-argument-list-internal))
+ ;; All that was just so we could do argument completion!
+ (when (and (not rev1) rev2)
+ (error "Not a valid revision range"))
+
+ (message "%s" (format "Finding changes in %s..." (vc-delistify files)))
+
+ ;; Functions ediff-(vc|rcs)-internal use "" instead of nil.
+ (when (null rev1) (setq rev1 ""))
+ (when (null rev2) (setq rev2 ""))
+
+ (cond
+ ;; FIXME We only support running ediff on one file for now.
+ ;; We could spin off an ediff session per file in the file set.
+ ((= (length files) 1)
+ (ediff-load-version-control)
+ (find-file (car files)) ;FIXME: find-file from Elisp is bad.
+ (ediff-vc-internal rev1 rev2 nil))
+ (t
+ (error "More than one file is not supported"))))
+
+;;;###autoload
+(defun vc-ediff (historic &optional not-urgent)
+ "Display diffs between file revisions using ediff.
+Normally this compares the currently selected fileset with their
+working revisions. With a prefix argument HISTORIC, it reads two revision
+designators specifying which revisions to compare.
+
+The optional argument NOT-URGENT non-nil means it is ok to say no to
+saving the buffer."
+ (interactive (list current-prefix-arg t))
+ (if historic
+ (call-interactively 'vc-version-ediff)
+ (when buffer-file-name (vc-buffer-sync not-urgent))
+ (vc-version-ediff (cadr (vc-deduce-fileset t)) nil nil)))
+
;;;###autoload
(defun vc-root-diff (historic &optional not-urgent)
"Display diffs between VC-controlled whole tree revisions.
(vc-start-logentry
files oldcomment t
"Enter a replacement change comment."
- "*VC-log*"
+ "*vc-log*"
(lambda () (vc-call-backend backend 'log-edit-mode))
(lexical-let ((rev rev))
(lambda (files comment)
;;;###autoload
(defun vc-merge ()
- "Merge changes between two revisions into the current buffer's file.
-This asks for two revisions to merge from in the minibuffer. If the
-first revision is a branch number, then merge all changes from that
-branch. If the first revision is empty, merge news, i.e. recent changes
-from the current branch.
-
-See Info node `Merging'."
+ "Perform a version control merge operation.
+On a distributed version control system, this runs a \"merge\"
+operation to incorporate changes from another branch onto the
+current branch, prompting for an argument list.
+
+On a non-distributed version control system, this merges changes
+between two revisions into the current fileset. This asks for
+two revisions to merge from in the minibuffer. If the first
+revision is a branch number, then merge all changes from that
+branch. If the first revision is empty, merge the most recent
+changes from the current branch."
(interactive)
- (vc-ensure-vc-buffer)
- (vc-buffer-sync)
- (let* ((file buffer-file-name)
- (backend (vc-backend file))
- (state (vc-state file))
- first-revision second-revision status)
+ (let* ((vc-fileset (vc-deduce-fileset t))
+ (backend (car vc-fileset))
+ (files (cadr vc-fileset)))
(cond
- ((stringp state) ;; Locking VCses only
- (error "File is locked by %s" state))
- ((not (vc-editable-p file))
- (if (y-or-n-p
- "File must be checked out for merging. Check out now? ")
- (vc-checkout file t)
- (error "Merge aborted"))))
- (setq first-revision
- (vc-read-revision
- (concat "Branch or revision to merge from "
- "(default news on current branch): ")
- (list file)
- backend))
- (if (string= first-revision "")
- (setq status (vc-call-backend backend 'merge-news file))
- (if (not (vc-find-backend-function backend 'merge))
- (error "Sorry, merging is not implemented for %s" backend)
- (if (not (vc-branch-p first-revision))
- (setq second-revision
- (vc-read-revision
- "Second revision: "
- (list file) backend nil
- ;; FIXME: This is CVS/RCS/SCCS specific.
- (concat (vc-branch-part first-revision) ".")))
- ;; We want to merge an entire branch. Set revisions
- ;; accordingly, so that vc-BACKEND-merge understands us.
- (setq second-revision first-revision)
- ;; first-revision must be the starting point of the branch
- (setq first-revision (vc-branch-part first-revision)))
- (setq status (vc-call-backend backend 'merge file
- first-revision second-revision))))
- (vc-maybe-resolve-conflicts file status "WORKFILE" "MERGE SOURCE")))
+ ;; If a branch-merge operation is defined, use it.
+ ((vc-find-backend-function backend 'merge-branch)
+ (vc-call-backend backend 'merge-branch))
+ ;; Otherwise, do a per-file merge.
+ ((vc-find-backend-function backend 'merge)
+ (vc-buffer-sync)
+ (dolist (file files)
+ (let* ((state (vc-state file))
+ first-revision second-revision status)
+ (cond
+ ((stringp state) ;; Locking VCses only
+ (error "File %s is locked by %s" file state))
+ ((not (vc-editable-p file))
+ (vc-checkout file t)))
+ (setq first-revision
+ (vc-read-revision
+ (concat "Merge " file
+ "from branch or revision "
+ "(default news on current branch): ")
+ (list file)
+ backend))
+ (cond
+ ((string= first-revision "")
+ (setq status (vc-call-backend backend 'merge-news file)))
+ (t
+ (if (not (vc-branch-p first-revision))
+ (setq second-revision
+ (vc-read-revision
+ "Second revision: "
+ (list file) backend nil
+ ;; FIXME: This is CVS/RCS/SCCS specific.
+ (concat (vc-branch-part first-revision) ".")))
+ ;; We want to merge an entire branch. Set revisions
+ ;; accordingly, so that vc-BACKEND-merge understands us.
+ (setq second-revision first-revision)
+ ;; first-revision must be the starting point of the branch
+ (setq first-revision (vc-branch-part first-revision)))
+ (setq status (vc-call-backend backend 'merge file
+ first-revision second-revision))))
+ (vc-maybe-resolve-conflicts file status "WORKFILE" "MERGE SOURCE"))))
+ (t
+ (error "Sorry, merging is not implemented for %s" backend)))))
+
(defun vc-maybe-resolve-conflicts (file status &optional name-A name-B)
(vc-resynch-buffer file t (not (buffer-modified-p)))
;; For VC's that do not work at file level, it's pointless
;; to ask for a directory, branches are created at repository level.
default-directory
- (read-file-name "Directory: " default-directory default-directory t))
+ (read-directory-name "Directory: " default-directory default-directory t))
(read-string (if current-prefix-arg "New branch name: " "New tag name: "))
current-prefix-arg)))
(message "Making %s... " (if branchp "branch" "tag"))
;; For VC's that do not work at file level, it's pointless
;; to ask for a directory, branches are created at repository level.
default-directory
- (read-file-name "Directory: " default-directory default-directory t))
+ (read-directory-name "Directory: " default-directory default-directory t))
(read-string "Tag name to retrieve (default latest revisions): "))))
(let ((update (yes-or-no-p "Update any affected buffers? "))
(msg (if (or (not name) (string= name ""))
(goto-char (point-max))
(lexical-let ((working-revision working-revision)
(limit limit))
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (vc-print-log-internal
- log-view-vc-backend log-view-vc-fileset
- working-revision nil (* 2 limit)))
- :help-echo "Show the log again, and double the number of log entries shown"
- "Show 2X entries")
- (widget-insert " ")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (vc-print-log-internal
- log-view-vc-backend log-view-vc-fileset
- working-revision nil nil))
- :help-echo "Show the log again, showing all entries"
- "Show unlimited entries"))
- (widget-setup)))
+ (insert "\n")
+ (insert-text-button "Show 2X entries"
+ 'action (lambda (&rest ignore)
+ (vc-print-log-internal
+ log-view-vc-backend log-view-vc-fileset
+ working-revision nil (* 2 limit)))
+ 'help-echo "Show the log again, and double the number of log entries shown")
+ (insert " ")
+ (insert-text-button "Show unlimited entries"
+ 'action (lambda (&rest ignore)
+ (vc-print-log-internal
+ log-view-vc-backend log-view-vc-fileset
+ working-revision nil nil))
+ 'help-echo "Show the log again, including all entries"))))
(defun vc-print-log-internal (backend files working-revision
&optional is-start-revision limit)
(setq type (if vc-short-log 'short 'long))
(lexical-let
((working-revision working-revision)
+ (backend backend)
(limit limit)
(shortlog vc-short-log)
+ (files files)
(is-start-revision is-start-revision))
(vc-log-internal-common
backend buffer-name files type
(vc-print-log-setup-buttons working-revision
is-start-revision limit ret))
(lambda (bk)
- (vc-call-backend bk 'show-log-entry working-revision))))))
+ (vc-call-backend bk 'show-log-entry working-revision))
+ (lambda (ignore-auto noconfirm)
+ (vc-print-log-internal backend files working-revision is-start-revision limit))))))
(defvar vc-log-view-type nil
"Set this to differentiate the different types of logs.")
type
backend-func
setup-buttons-func
- goto-location-func)
+ goto-location-func
+ rev-buff-func)
(let (retval)
(with-current-buffer (get-buffer-create buffer-name)
(set (make-local-variable 'vc-log-view-type) type))
;; to t, so let's keep doing it, just in case.
(vc-call-backend backend 'log-view-mode)
(set (make-local-variable 'log-view-vc-backend) backend)
- (set (make-local-variable 'log-view-vc-fileset) files))
+ (set (make-local-variable 'log-view-vc-fileset) files)
+ (set (make-local-variable 'revert-buffer-function)
+ rev-buff-func))
(vc-exec-after
`(let ((inhibit-read-only t))
(funcall ',setup-buttons-func ',backend ',files ',retval)
(vc-call-backend bk type-arg buf remote-location)))
(lambda (bk files-arg ret))
(lambda (bk)
- (goto-char (point-min)))))
+ (goto-char (point-min)))
+ (lexical-let
+ ((backend backend)
+ (remote-location remote-location)
+ (buffer-name buffer-name)
+ (type type))
+ (lambda (ignore-auto noconfirm)
+ (vc-incoming-outgoing-internal backend remote-location buffer-name type)))))
;;;###autoload
(defun vc-print-log (&optional working-revision limit)
;;;###autoload
(defun vc-log-incoming (&optional remote-location)
- "Show a log of changes that will be received with a pull operation from REMOTE-LOCATION."
- (interactive "sRemote location (empty for default): ")
+ "Show a log of changes that will be received with a pull operation from REMOTE-LOCATION.
+When called interactively with a prefix argument, prompt for REMOTE-LOCATION.."
+ (interactive
+ (when current-prefix-arg
+ (list (read-string "Remote location (empty for default): "))))
(let ((backend (vc-deduce-backend))
rootdir working-revision)
(unless backend
;;;###autoload
(defun vc-log-outgoing (&optional remote-location)
- "Show a log of changes that will be sent with a push operation to REMOTE-LOCATION."
- (interactive "sRemote location (empty for default): ")
+ "Show a log of changes that will be sent with a push operation to REMOTE-LOCATION.
+When called interactively with a prefix argument, prompt for REMOTE-LOCATION."
+ (interactive
+ (when current-prefix-arg
+ (list (read-string "Remote location (empty for default): "))))
(let ((backend (vc-deduce-backend))
rootdir working-revision)
(unless backend
to the working revision (except for keyword expansion)."
(interactive)
(let* ((vc-fileset (vc-deduce-fileset))
- (files (cadr 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
- ;; discard them.
+ (files (cadr vc-fileset))
+ (queried nil)
+ diff-buffer)
+ ;; 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 discard them.
(when (or (not files) (memq (buffer-file-name) files))
(vc-buffer-sync nil))
(dolist (file files)
(when (and buf (buffer-modified-p buf))
(error "Please kill or save all modified buffers before reverting")))
(when (vc-up-to-date-p file)
- (unless (yes-or-no-p (format "%s seems up-to-date. Revert anyway? " file))
+ (if (yes-or-no-p (format "%s seems up-to-date. Revert anyway? " file))
+ (setq queried t)
(error "Revert canceled"))))
- (when (vc-diff-internal vc-allow-async-revert vc-fileset nil nil)
- (unless (yes-or-no-p
- (format "Discard changes in %s? "
- (let ((str (vc-delistify files))
- (nfiles (length files)))
- (if (< (length str) 50)
- str
- (format "%d file%s" nfiles
- (if (= nfiles 1) "" "s"))))))
- (error "Revert canceled"))
- (delete-windows-on "*vc-diff*")
- (kill-buffer "*vc-diff*"))
+ (unwind-protect
+ (when (if vc-revert-show-diff
+ (progn
+ (setq diff-buffer (generate-new-buffer-name "*vc-diff*"))
+ (vc-diff-internal vc-allow-async-revert vc-fileset
+ nil nil nil diff-buffer))
+ ;; Avoid querying the user again.
+ (null queried))
+ (unless (yes-or-no-p
+ (format "Discard changes in %s? "
+ (let ((str (vc-delistify files))
+ (nfiles (length files)))
+ (if (< (length str) 50)
+ str
+ (format "%d file%s" nfiles
+ (if (= nfiles 1) "" "s"))))))
+ (error "Revert canceled")))
+ (when diff-buffer
+ (quit-windows-on diff-buffer t)))
(dolist (file files)
(message "Reverting %s..." (vc-delistify files))
(vc-revert-file file)
;; Display changes
(unless (yes-or-no-p "Discard these revisions? ")
(error "Rollback canceled"))
- (delete-windows-on "*vc-diff*")
- (kill-buffer"*vc-diff*")
+ (quit-windows-on "*vc-diff*" t)
;; Do the actual reversions
(message "Rolling back %s..." (vc-delistify files))
(with-vc-properties
(define-obsolete-function-alias 'vc-revert-buffer 'vc-revert "23.1")
;;;###autoload
-(defun vc-update ()
- "Update the current fileset's files to their tip revisions.
-For each one that contains no changes, and is not locked, then this simply
-replaces the work file with the latest revision on its branch. If the file
-contains changes, and the backend supports merging news, then any recent
-changes from the current branch are merged into the working file."
- (interactive)
- (let* ((vc-fileset (vc-deduce-fileset))
+(defun vc-pull (&optional arg)
+ "Update the current fileset or branch.
+On a distributed version control system, this runs a \"pull\"
+operation to update the current branch, prompting for an argument
+list if required. Optional prefix ARG forces a prompt.
+
+On a non-distributed version control system, update the current
+fileset to the tip revisions. For each unchanged and unlocked
+file, this simply replaces the work file with the latest revision
+on its branch. If the file contains changes, any changes in the
+tip revision are merged into the working file."
+ (interactive "P")
+ (let* ((vc-fileset (vc-deduce-fileset t))
(backend (car vc-fileset))
(files (cadr vc-fileset)))
- (save-some-buffers ; save buffers visiting files
- nil (lambda ()
- (and (buffer-modified-p)
- (let ((file (buffer-file-name)))
- (and file (member file files))))))
- (dolist (file files)
- (if (vc-up-to-date-p file)
- (vc-checkout file nil t)
- (if (eq (vc-checkout-model backend (list 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
- "\\[vc-next-action] to correct")))
- (vc-maybe-resolve-conflicts
- file (vc-call-backend backend 'merge-news file)))))))
+ (cond
+ ;; If a pull operation is defined, use it.
+ ((vc-find-backend-function backend 'pull)
+ (vc-call-backend backend 'pull arg))
+ ;; If VCS has `merge-news' functionality (CVS and SVN), use it.
+ ((vc-find-backend-function backend 'merge-news)
+ (save-some-buffers ; save buffers visiting files
+ nil (lambda ()
+ (and (buffer-modified-p)
+ (let ((file (buffer-file-name)))
+ (and file (member file files))))))
+ (dolist (file files)
+ (if (vc-up-to-date-p file)
+ (vc-checkout file nil t)
+ (vc-maybe-resolve-conflicts
+ file (vc-call-backend backend 'merge-news file)))))
+ ;; For a locking VCS, check out each file.
+ ((eq (vc-checkout-model backend files) 'locking)
+ (dolist (file files)
+ (if (vc-up-to-date-p file)
+ (vc-checkout file nil t))))
+ (t
+ (error "VC update is unsupported for `%s'" backend)))))
+
+;;;###autoload
+(defalias 'vc-update 'vc-pull)
(defun vc-version-backup-file (file &optional rev)
"Return name of backup file for revision REV of FILE.
(list file)
(let ((backup-file (vc-version-backup-file file)))
(when backup-file
- (copy-file backup-file file 'ok-if-already-exists 'keep-date)
+ (copy-file backup-file file 'ok-if-already-exists)
(vc-delete-automatic-version-backups file))
(vc-call revert file backup-file))
`((vc-state . up-to-date)
(when index
(substring rev 0 index))))
-(define-obsolete-function-alias
- 'vc-default-previous-version 'vc-default-previous-revision "23.1")
-
(defun vc-default-responsible-p (backend file)
- "Indicate whether BACKEND is reponsible for FILE.
+ "Indicate whether BACKEND is responsible for FILE.
The default is to return nil always."
nil)
(provide 'vc)
-;; arch-tag: ca82c1de-3091-4e26-af92-460abc6213a6
;;; vc.el ends here
HCoop / bpt / emacs.git / blobdiff