;;; 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
+;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: FSF (see below for full credits)
;; Arch, Subversion, Bzr, Git, Mercurial, Monotone and SCCS
;; (or its free replacement, CSSC).
;;
-;; Some features will not work with old RCS versions. Where
-;; appropriate, VC finds out which version you have, and allows or
-;; disallows those features (stealing locks, for example, works only
-;; from 5.6.2 onwards).
-;; Even initial checkins will fail if your RCS version is so old that ci
-;; doesn't understand -t-; this has been known to happen to people running
-;; NExTSTEP 3.0.
-;;
-;; You can support the RCS -x option by customizing vc-rcs-master-templates.
-;;
-;; Proper function of the SCCS diff commands requires the shellscript vcdiff
-;; to be installed somewhere on Emacs's path for executables.
-;;
;; If your site uses the ChangeLog convention supported by Emacs, the
;; function `log-edit-comment-to-change-log' could prove a useful checkin hook,
;; although you might prefer to use C-c C-a (i.e. `log-edit-insert-changelog')
;; from the commit buffer instead or to set `log-edit-setup-invert'.
;;
-;; The vc code maintains some internal state in order to reduce expensive
-;; version-control operations to a minimum. Some names are only computed
-;; once. If you perform version control operations with the backend while
-;; vc's back is turned, or move/rename master files while vc is running,
-;; vc may get seriously confused. Don't do these things!
+;; When using SCCS, RCS, CVS: be careful not to do repo surgery, or
+;; operations like registrations and deletions and renames, outside VC
+;; while VC is running. The support for these systems was designed
+;; when disks were much slower, and the code maintains a lot of
+;; internal state in order to reduce expensive operations to a
+;; minimum. Thus, if you mess with the repo while VC's back is turned,
+;; VC may get seriously confused.
+;;
+;; When using Subversion or a later system, anything you do outside VC
+;; *through the VCS tools* should safely interlock with VC
+;; operations. Under these VC does little state caching, because local
+;; operations are assumed to be fast. The dividing line is
;;
;; ADDING SUPPORT FOR OTHER BACKENDS
;;
;;
;; Return non-nil if FILE is unchanged from the working revision.
;; This function should do a brief comparison of FILE's contents
-;; with those of the repository master of the working revision. If
+;; with those of the repository copy of the working revision. If
;; the backend does not have such a brief-comparison feature, the
;; default implementation of this function can be used, which
;; delegates to a full vc-BACKEND-diff. (Note that vc-BACKEND-diff
;;
;; * checkin (files rev comment)
;;
-;; Commit changes in FILES to this backend. If REV is non-nil, that
-;; should become the new revision number (not all backends do
-;; anything with it). COMMENT is used as a check-in comment. The
-;; implementation should pass the value of vc-checkin-switches to
-;; the backend command. (Note: in older versions of VC, this
-;; command took a single file argument and not a list.)
+;; Commit changes in FILES to this backend. REV is a historical artifact
+;; and should be ignored. COMMENT is used as a check-in comment.
+;; The implementation should pass the value of vc-checkin-switches to
+;; the backend command.
;;
;; * find-revision (file rev buffer)
;;
;;
;; HISTORY FUNCTIONS
;;
-;; * print-log (files &optional buffer)
+;; * print-log (files buffer &optional shortlog start-revision limit)
+;;
+;; Insert the revision log for FILES into BUFFER.
+;; If SHORTLOG is true insert a short version of the log.
+;; If LIMIT is true insert only insert LIMIT log entries. If the
+;; backend does not support limiting the number of entries to show
+;; it should return `limit-unsupported'.
+;; If START-REVISION is given, then show the log starting from the
+;; revision. At this point START-REVISION is only required to work
+;; in conjunction with LIMIT = 1.
+;;
+;; * log-outgoing (backend remote-location)
+;;
+;; Insert in BUFFER the revision log for the changes that will be
+;; sent when performing a push operation to REMOTE-LOCATION.
;;
-;; Insert the revision log for FILES into BUFFER, or the *vc* buffer
-;; if BUFFER is nil. (Note: older versions of this function expected
-;; only a single file argument.)
+;; * log-incoming (backend remote-location)
+;;
+;; Insert in BUFFER the revision log for the changes that will be
+;; received when performing a pull operation from REMOTE-LOCATION.
;;
;; - log-view-mode ()
;;
;; Invoked from a buffer in vc-annotate-mode, return the revision
;; corresponding to the current line, or nil if there is no revision
;; corresponding to the current line.
+;; 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
;;
;; `revert' operations itself, without calling the backend system. The
;; default implementation always returns nil.
;;
+;; - root (file)
+;; Return the root of the VC controlled hierarchy for file.
+;;
;; - repository-hostname (dirname)
;;
;; Return the hostname that the backend will have to contact
;; Return the revision number that follows REV for FILE, or nil if no such
;; revision exists.
;;
+;; - log-edit-mode ()
+;;
+;; Turn on the mode used for editing the check in log. This
+;; defaults to `log-edit-mode'. If changed, it should use a mode
+;; derived from`log-edit-mode'.
+;;
;; - check-headers ()
;;
;; Return non-nil if the current buffer contains any version headers.
;; makes it possible to provide menu entries for functionality that
;; is specific to a backend and which does not map to any of the VC
;; generic concepts.
+;;
+;; - conflicted-files (dir)
+;;
+;; Return the list of files where conflict resolution is needed in
+;; the project that contains DIR.
+;; FIXME: what should it do with non-text conflicts?
;;; Todo:
;; display the branch name in the mode-line. Replace
;; vc-cvs-sticky-tag with that.
;;
-;; - vc-create-tag and vc-retrieve-tag should update the
-;; buffers that might be visiting the affected files.
-;;
-;;;; Default Behavior:
-;;
-;; - do not default to RCS anymore when the current directory is not
-;; controlled by any VCS and the user does C-x v v
-;;
-;; - vc-responsible-backend should not return RCS if no backend
-;; declares itself responsible.
-;;
;;;; Internal cleanups:
;;
;; - backends that care about vc-stay-local should try to take it into
(require 'vc-dispatcher)
(eval-when-compile
- (require 'cl))
+ (require 'cl)
+ (require 'dired))
(unless (assoc 'vc-parent-buffer minor-mode-alist)
(setq minor-mode-alist
:type '(choice (const :tag "Work out" nil) (const yes) (const no))
:group 'vc)
+(defcustom vc-log-show-limit 2000
+ "Limit the number of items shown by the VC log commands.
+Zero means unlimited.
+Not all VC backends are able to support this feature."
+ :type 'integer
+ :group 'vc)
+
(defcustom vc-allow-async-revert nil
"Specifies whether the diff during \\[vc-revert] may be asynchronous.
Enabling this option means that you can confirm a revert operation even
"\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")))
(defcustom vc-checkout-carefully (= (user-uid) 0)
"Non-nil means be extra-careful in checkout.
Verify that the file really is not locked
-and that its contents match what the master file says."
+and that its contents match what the repository version says."
:type 'boolean
:group 'vc)
(make-obsolete-variable 'vc-checkout-carefully
(defmacro with-vc-properties (files form settings)
"Execute FORM, then maybe set per-file properties for FILES.
+If any of FILES is actually a directory, then do the same for all
+buffers for files in that directory.
SETTINGS is an association list of property/value pairs. After
executing FORM, set those properties from SETTINGS that have not yet
been updated to their corresponding values."
(declare (debug t))
- `(let ((vc-touched-properties (list t)))
- ,form
+ `(let ((vc-touched-properties (list t))
+ (flist nil))
(dolist (file ,files)
+ (if (file-directory-p file)
+ (dolist (buffer (buffer-list))
+ (let ((fname (buffer-file-name buffer)))
+ (when (and fname (vc-string-prefix-p file fname))
+ (push fname flist))))
+ (push file flist)))
+ ,form
+ (dolist (file flist)
(dolist (setting ,settings)
(let ((property (car setting)))
(unless (memq property vc-touched-properties)
;;; Code for deducing what fileset and backend to assume
-(defun vc-responsible-backend (file &optional register)
+(defun vc-backend-for-registration (file)
+ "Return a backend that can be used for registering FILE.
+
+If no backend declares itself responsible for FILE, then FILE
+must not be in a version controlled directory, so try to create a
+repository, prompting for the directory and the VC backend to
+use."
+ (catch 'found
+ ;; First try: find a responsible backend, it must be a backend
+ ;; under which FILE is not yet registered.
+ (dolist (backend vc-handled-backends)
+ (and (not (vc-call-backend backend 'registered file))
+ (vc-call-backend backend 'responsible-p file)
+ (throw 'found backend)))
+ ;; no responsible backend
+ (let* ((possible-backends
+ (let (pos)
+ (dolist (crt vc-handled-backends)
+ (when (vc-find-backend-function crt 'create-repo)
+ (push crt pos)))
+ pos))
+ (bk
+ (intern
+ ;; Read the VC backend from the user, only
+ ;; complete with the backends that have the
+ ;; 'create-repo method.
+ (completing-read
+ (format "%s is not in a version controlled directory.\nUse VC backend: " file)
+ (mapcar 'symbol-name possible-backends) nil t)))
+ (repo-dir
+ (let ((def-dir (file-name-directory file)))
+ ;; read the directory where to create the
+ ;; repository, make sure it's a parent of
+ ;; file.
+ (read-file-name
+ (format "create %s repository in: " bk)
+ default-directory def-dir t nil
+ (lambda (arg)
+ (message "arg %s" arg)
+ (and (file-directory-p arg)
+ (vc-string-prefix-p (expand-file-name arg) def-dir)))))))
+ (let ((default-directory repo-dir))
+ (vc-call-backend bk 'create-repo))
+ (throw 'found bk))))
+
+(defun vc-responsible-backend (file)
"Return the name of a backend system that is responsible for FILE.
-The optional argument REGISTER means that a backend suitable for
-registration should be found.
-If REGISTER is nil, then if FILE is already registered, return the
-backend of FILE. If FILE is not registered, or a directory, then the
+If FILE is already registered, return the
+backend of FILE. If FILE is not registered, then the
first backend in `vc-handled-backends' that declares itself
-responsible for FILE is returned. If no backend declares itself
-responsible, return the first backend.
-
-If REGISTER is non-nil, return the first responsible backend under
-which FILE is not yet registered. If there is no such backend, return
-the first backend under which FILE is not yet registered, but could
-be registered."
- (when (not vc-handled-backends)
- (error "No handled backends"))
- (or (and (not (file-directory-p file)) (not register) (vc-backend file))
+responsible for FILE is returned."
+ (or (and (not (file-directory-p file)) (vc-backend file))
(catch 'found
;; First try: find a responsible backend. If this is for registration,
;; it must be a backend under which FILE is not yet registered.
(dolist (backend vc-handled-backends)
- (and (or (not register)
- (not (vc-call-backend backend 'registered file)))
- (vc-call-backend backend 'responsible-p file)
- (throw 'found backend)))
- ;; no responsible backend
- (if (not register)
- ;; if this is not for registration, the first backend must do
- (car vc-handled-backends)
- ;; for registration, we need to find a new backend that
- ;; could register FILE
- (dolist (backend vc-handled-backends)
- (and (not (vc-call-backend backend 'registered file))
- (vc-call-backend backend 'could-register file)
- (throw 'found backend)))
- (error "No backend that could register")))))
+ (and (vc-call-backend backend 'responsible-p file)
+ (throw 'found backend))))
+ (error "No VC backend is responsible for %s" file)))
(defun vc-expand-dirs (file-or-dir-list)
"Expands directories in a file list specification.
(unless (file-directory-p node) (push node flattened)))
(nreverse flattened)))
-(defun vc-derived-from-dir-mode (&optional buffer)
- "Are we in a VC-directory buffer, or do we have one as an ancestor?"
- (let ((buffer (or buffer (current-buffer))))
- (cond ((derived-mode-p 'vc-dir-mode) t)
- (vc-parent-buffer (vc-derived-from-dir-mode vc-parent-buffer))
- (t nil))))
-
(defvar vc-dir-backend)
+(defvar log-view-vc-backend)
+(defvar diff-vc-backend)
-;; FIXME: this is not functional, commented out.
-;; (defun vc-deduce-fileset (&optional observer)
-;; "Deduce a set of files and a backend to which to apply an operation and
-;; the common state of the fileset. Return (BACKEND . FILESET)."
-;; (let* ((selection (vc-dispatcher-selection-set observer))
-;; (raw (car selection)) ;; Selection as user made it
-;; (cooked (cdr selection)) ;; Files only
-;; ;; FIXME: Store the backend in a buffer-local variable.
-;; (backend (if (vc-derived-from-dir-mode (current-buffer))
-;; ;; FIXME: this should use vc-dir-backend from
-;; ;; the *vc-dir* buffer.
-;; (vc-responsible-backend default-directory)
-;; (assert (and (= 1 (length raw))
-;; (not (file-directory-p (car raw)))))
-;; (vc-backend (car cooked)))))
-;; (cons backend selection)))
+(defun vc-deduce-backend ()
+ (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)
+ (vc-responsible-backend default-directory))
+ (vc-mode (vc-backend buffer-file-name))))
(declare-function vc-dir-current-file "vc-dir" ())
(declare-function vc-dir-deduce-fileset "vc-dir" (&optional state-model-only-files))
(cond
((derived-mode-p 'vc-dir-mode)
(vc-dir-deduce-fileset state-model-only-files))
+ ((derived-mode-p 'dired-mode)
+ (if observer
+ (vc-dired-deduce-fileset)
+ (error "State changing VC operations not supported in `dired-mode'")))
((setq backend (vc-backend buffer-file-name))
(if state-model-only-files
(list backend (list buffer-file-name)
(error "Buffer %s is not associated with a file" (buffer-name)))
((and allow-unregistered (not (vc-registered buffer-file-name)))
(if state-model-only-files
- (list (vc-responsible-backend
- (file-name-directory (buffer-file-name)))
+ (list (vc-backend-for-registration (buffer-file-name))
(list buffer-file-name)
(list buffer-file-name)
(when state-model-only-files 'unregistered)
nil)
- (list (vc-responsible-backend
- (file-name-directory (buffer-file-name)))
+ (list (vc-backend-for-registration (buffer-file-name))
(list buffer-file-name))))
- (t (error "No fileset is available here.")))))
+ (t (error "No fileset is available here")))))
+
+(defun vc-dired-deduce-fileset ()
+ (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))))
(defun vc-ensure-vc-buffer ()
"Make sure that the current buffer visits a version-controlled file."
(state (nth 3 vc-fileset))
;; The backend should check that the checkout-model is consistent
;; among all the `files'.
- (model (nth 4 vc-fileset))
- revision)
+ (model (nth 4 vc-fileset)))
;; Do the right thing
(cond
((eq state 'missing)
- (error "Fileset files are missing, so cannot be operated on."))
+ (error "Fileset files are missing, so cannot be operated on"))
((eq state 'ignored)
- (error "Fileset files are ignored by the version-control system."))
+ (error "Fileset files are ignored by the version-control system"))
((or (null state) (eq state 'unregistered))
(vc-register nil vc-fileset))
;; Files are up-to-date, or need a merge and user specified a revision
(cond
(verbose
;; go to a different revision
- (setq revision (read-string "Branch, revision, or backend to move to: "))
- (let ((revision-downcase (downcase revision)))
+ (let* ((revision
+ (read-string "Branch, revision, or backend to move to: "))
+ (revision-downcase (downcase revision)))
(if (member
revision-downcase
- (mapcar (lambda (arg) (downcase (symbol-name arg))) vc-handled-backends))
+ (mapcar (lambda (arg) (downcase (symbol-name arg)))
+ vc-handled-backends))
(let ((vsym (intern-soft revision-downcase)))
(dolist (file files) (vc-transfer-file file vsym)))
(dolist (file files)
(message "No files remain to be committed")
(if (not verbose)
(vc-checkin ready-for-commit backend)
- (setq revision (read-string "New revision or backend: "))
- (let ((revision-downcase (downcase revision)))
+ (let* ((revision (read-string "New revision or backend: "))
+ (revision-downcase (downcase revision)))
(if (member
revision-downcase
(mapcar (lambda (arg) (downcase (symbol-name arg)))
"Register the current file with a specified back end."
(interactive "SBackend: ")
(when (not (member backend vc-handled-backends))
- (error "Unknown back end."))
+ (error "Unknown back end"))
(let ((vc-handled-backends (list backend)))
(call-interactively 'vc-register)))
(defun vc-checkin (files backend &optional rev comment initial-contents)
"Check in FILES.
The optional argument REV may be a string specifying the new revision
-level (if nil increment the current level). COMMENT is a comment
+level (strongly deprecated). COMMENT is a comment
string; if omitted, a buffer is popped up to accept a comment. If
INITIAL-CONTENTS is non-nil, then COMMENT is used as the initial contents
of the log entry buffer.
(lexical-let
((backend backend))
(vc-start-logentry
- files rev comment initial-contents
+ files comment initial-contents
"Enter a change comment."
"*VC-log*"
- (lambda (files rev comment)
- (message "Checking in %s..." (vc-delistify files))
- ;; "This log message intentionally left almost blank".
- ;; RCS 5.7 gripes about white-space-only comments too.
- (or (and comment (string-match "[^\t\n ]" comment))
- (setq comment "*** empty log message ***"))
- (with-vc-properties
- files
- ;; We used to change buffers to get local value of vc-checkin-switches,
- ;; but 'the' local buffer is not a well-defined concept for filesets.
- (progn
- (vc-call-backend backend 'checkin files rev comment)
- (mapc 'vc-delete-automatic-version-backups files))
- `((vc-state . up-to-date)
- (vc-checkout-time . ,(nth 5 (file-attributes file)))
- (vc-working-revision . nil)))
- (message "Checking in %s...done" (vc-delistify files)))
+ (lambda ()
+ (vc-call-backend backend 'log-edit-mode))
+ (lexical-let ((rev rev))
+ (lambda (files comment)
+ (message "Checking in %s..." (vc-delistify files))
+ ;; "This log message intentionally left almost blank".
+ ;; RCS 5.7 gripes about white-space-only comments too.
+ (or (and comment (string-match "[^\t\n ]" comment))
+ (setq comment "*** empty log message ***"))
+ (with-vc-properties
+ files
+ ;; We used to change buffers to get local value of
+ ;; vc-checkin-switches, but 'the' local buffer is
+ ;; not a well-defined concept for filesets.
+ (progn
+ (vc-call-backend backend 'checkin files rev comment)
+ (mapc 'vc-delete-automatic-version-backups files))
+ `((vc-state . up-to-date)
+ (vc-checkout-time . ,(nth 5 (file-attributes file)))
+ (vc-working-revision . nil)))
+ (message "Checking in %s...done" (vc-delistify files))))
'vc-checkin-hook)))
;;; Additional entry points for examining version histories
;; (vc-call-backend ',(vc-backend f)
;; 'diff (list ',f) ',rev1 ',rev2))))))
+(defvar vc-coding-system-inherit-eol t
+ "When non-nil, inherit the EOL format for reading Diff output from the file.
+
+Used in `vc-coding-system-for-diff' to determine the EOL format to use
+for reading Diff output for a file. If non-nil, the EOL format is
+inherited from the file itself.
+Set this variable to nil if your Diff tool might use a different
+EOL. Then Emacs will auto-detect the EOL format in Diff output, which
+gives better results.") ;; Cf. bug#4451.
+
(defun vc-coding-system-for-diff (file)
"Return the coding system for reading diff output for FILE."
(or coding-system-for-read
;; use the buffer's coding system
(let ((buf (find-buffer-visiting file)))
(when buf (with-current-buffer buf
- buffer-file-coding-system)))
+ (if vc-coding-system-inherit-eol
+ buffer-file-coding-system
+ ;; Don't inherit the EOL part of the coding-system,
+ ;; because some Diff tools may choose to use
+ ;; a different one. bug#4451.
+ (coding-system-base buffer-file-coding-system)))))
;; otherwise, try to find one based on the file name
(car (find-operation-coding-system 'insert-file-contents file))
;; and a final fallback
(not (string= (vc-working-revision file) "0")))
(push file filtered)
;; This file is added but not yet committed;
- ;; there is no master file to diff against.
+ ;; there is no repository version to diff against.
(if (or rev1 rev2)
(error "No revisions of %s exist" file)
;; We regard this as "changed".
(message "%s" (cdr messages))
nil)
(diff-mode)
+ (set (make-local-variable 'diff-vc-backend) (car vc-fileset))
+ (set (make-local-variable 'revert-buffer-function)
+ `(lambda (ignore-auto noconfirm)
+ (vc-diff-internal ,async ',vc-fileset ,rev1 ,rev2 ,verbose)))
;; Make the *vc-diff* buffer read only, the diff-mode key
;; bindings are nicer for read only buffers. pcl-cvs does the
;; same thing.
(list files rev1 rev2))))
;; All that was just so we could do argument completion!
(when (and (not rev1) rev2)
- (error "Not a valid revision range."))
+ (error "Not a valid revision range"))
;; Yes, it's painful to call (vc-deduce-fileset) again. Alas, the
;; placement rules for (interactive) don't actually leave us a choice.
- (vc-diff-internal t (vc-deduce-fileset) rev1 rev2 (interactive-p)))
-
-;; (defun vc-contains-version-controlled-file (dir)
-;; "Return t if DIR contains a version-controlled file, nil otherwise."
-;; (catch 'found
-;; (mapc (lambda (f) (and (not (file-directory-p f)) (vc-backend f) (throw 'found 't))) (directory-files dir))
-;; nil))
+ (vc-diff-internal t (vc-deduce-fileset t) rev1 rev2
+ (called-interactively-p 'interactive)))
;;;###autoload
(defun vc-diff (historic &optional not-urgent)
(if historic
(call-interactively 'vc-version-diff)
(when buffer-file-name (vc-buffer-sync not-urgent))
- (vc-diff-internal t (vc-deduce-fileset) nil nil (interactive-p))))
+ (vc-diff-internal t (vc-deduce-fileset t) nil nil
+ (called-interactively-p 'interactive))))
+
+;;;###autoload
+(defun vc-root-diff (historic &optional not-urgent)
+ "Display diffs between VC-controlled whole tree revisions.
+Normally, this compares the tree corresponding to the current
+fileset with the working revision.
+With a prefix argument HISTORIC, prompt for 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
+ ;; FIXME: this does not work right, `vc-version-diff' ends up
+ ;; calling `vc-deduce-fileset' to find the files to diff, and
+ ;; that's not what we want here, we want the diff for the VC root dir.
+ (call-interactively 'vc-version-diff)
+ (when buffer-file-name (vc-buffer-sync not-urgent))
+ (let ((backend (vc-deduce-backend))
+ rootdir working-revision)
+ (unless backend
+ (error "Buffer is not version controlled"))
+ (setq rootdir (vc-call-backend backend 'root default-directory))
+ (setq working-revision (vc-working-revision rootdir))
+ ;; VC diff for the root directory produces output that is
+ ;; relative to it. Bind default-directory to the root directory
+ ;; here, this way the *vc-diff* buffer is setup correctly, so
+ ;; relative file names work.
+ (let ((default-directory rootdir))
+ (vc-diff-internal
+ t (list backend (list rootdir) working-revision) nil nil
+ (called-interactively-p 'interactive))))))
;;;###autoload
(defun vc-revision-other-window (rev)
rev)))
(switch-to-buffer-other-window (vc-find-revision file revision))))
-(defun vc-find-revision (file revision)
- "Read REVISION of FILE into a buffer and return the buffer."
+(defun vc-find-revision (file revision &optional backend)
+ "Read REVISION of FILE into a buffer and return the buffer.
+Use BACKEND as the VC backend if specified."
(let ((automatic-backup (vc-version-backup-file-name file revision))
(filebuf (or (get-file-buffer file) (current-buffer)))
(filename (vc-version-backup-file-name file revision 'manual)))
;; Change buffer to get local value of
;; vc-checkout-switches.
(with-current-buffer filebuf
- (vc-call find-revision file revision outbuf))))
+ (if backend
+ (vc-call-backend backend 'find-revision file revision outbuf)
+ (vc-call find-revision file revision outbuf)))))
(setq failed nil))
(when (and failed (file-exists-p filename))
(delete-file filename))))
(defun vc-modify-change-comment (files rev oldcomment)
"Edit the comment associated with the given files and revision."
- (vc-start-logentry
- files rev oldcomment t
- "Enter a replacement change comment."
- "*VC-log*"
- (lambda (files rev comment)
- (vc-call-backend
- ;; Less of a kluge than it looks like; log-view mode only passes
- ;; this function a singleton list. Arguments left in this form in
- ;; case the more general operation ever becomes meaningful.
- (vc-responsible-backend (car files))
- 'modify-change-comment files rev comment))))
+ ;; Less of a kluge than it looks like; log-view mode only passes
+ ;; this function a singleton list. Arguments left in this form in
+ ;; case the more general operation ever becomes meaningful.
+ (let ((backend (vc-responsible-backend (car files))))
+ (vc-start-logentry
+ files oldcomment t
+ "Enter a replacement change comment."
+ "*VC-log*"
+ (lambda () (vc-call-backend backend 'log-edit-mode))
+ (lexical-let ((rev rev))
+ (lambda (files comment)
+ (vc-call-backend backend
+ 'modify-change-comment files rev comment))))))
;;;###autoload
(defun vc-merge ()
;;;###autoload
(defalias 'vc-resolve-conflicts 'smerge-ediff)
+;; TODO: This is OK but maybe we could integrate it better.
+;; E.g. it could be run semi-automatically (via a prompt?) when saving a file
+;; that was conflicted (i.e. upon mark-resolved).
+;; FIXME: should we add an "other-window" version? Or maybe we should
+;; hook it inside find-file so it automatically works for
+;; find-file-other-window as well. E.g. find-file could use a new
+;; `default-next-file' variable for its default file (M-n), and
+;; we could then set it upon mark-resolve, so C-x C-s C-x C-f M-n would
+;; automatically offer the next conflicted file.
+(defun vc-find-conflicted-file ()
+ "Visit the next conflicted file in the current project."
+ (interactive)
+ (let* ((backend (or (if buffer-file-name (vc-backend buffer-file-name))
+ (vc-responsible-backend default-directory)
+ (error "No VC backend")))
+ (files (vc-call-backend backend
+ 'conflicted-files default-directory)))
+ ;; Don't try and visit the current file.
+ (if (equal (car files) buffer-file-name) (pop files))
+ (if (null files)
+ (message "No more conflicted files")
+ (find-file (pop files))
+ (message "%s more conflicted files after this one"
+ (if files (length files) "No")))))
+
;; Named-configuration entry points
(defun vc-tag-precondition (dir)
given, the tag is made as a new branch and the files are
checked out in that new branch."
(interactive
- (list (read-file-name "Directory: " default-directory default-directory t)
- (read-string "New tag name: ")
- current-prefix-arg))
+ (let ((granularity
+ (vc-call-backend (vc-responsible-backend default-directory)
+ 'revision-granularity)))
+ (list
+ (if (eq granularity 'repository)
+ ;; 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-string (if current-prefix-arg "New branch name: " "New tag name: "))
+ current-prefix-arg)))
(message "Making %s... " (if branchp "branch" "tag"))
(when (file-directory-p dir) (setq dir (file-name-as-directory dir)))
(vc-call-backend (vc-responsible-backend dir)
'create-tag dir name branchp)
+ (vc-resynch-buffer dir t t t)
(message "Making %s... done" (if branchp "branch" "tag")))
;;;###autoload
locked files at or below DIR (but if NAME is empty, locked files are
allowed and simply skipped)."
(interactive
- (list (read-file-name "Directory: " default-directory default-directory t)
- (read-string "Tag name to retrieve (default latest revisions): ")))
+ (let ((granularity
+ (vc-call-backend (vc-responsible-backend default-directory)
+ 'revision-granularity)))
+ (list
+ (if (eq granularity 'repository)
+ ;; 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-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 ""))
(format "Updating %s... " (abbreviate-file-name dir))
(message "%s" msg)
(vc-call-backend (vc-responsible-backend dir)
'retrieve-tag dir name update)
+ (vc-resynch-buffer dir t t t)
(message "%s" (concat msg "done"))))
+
;; Miscellaneous other entry points
-(defun vc-print-log-internal (backend files working-revision)
+;; FIXME: this should be a defcustom
+;; FIXME: maybe add another choice:
+;; `root-directory' (or somesuch), which would mean show a short log
+;; for the root directory.
+(defvar vc-log-short-style '(directory)
+ "Whether or not to show a short log.
+If it contains `directory' then if the fileset contains a directory show a short log.
+If it contains `file' then show short logs for files.
+Not all VC backends support short logs!")
+
+(defvar log-view-vc-fileset)
+
+(defun vc-print-log-setup-buttons (working-revision is-start-revision limit pl-return)
+ (when (and limit (not (eq 'limit-unsupported pl-return))
+ (not is-start-revision))
+ (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)))
+
+(defun vc-print-log-internal (backend files working-revision
+ &optional is-start-revision limit)
;; Don't switch to the output buffer before running the command,
;; so that any buffer-local settings in the vc-controlled
;; buffer can be accessed by the command.
- (vc-call-backend backend 'print-log files "*vc-change-log*")
- (pop-to-buffer "*vc-change-log*")
- (vc-exec-after
- `(let ((inhibit-read-only t))
- (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)
-
- ;; FIXME: this seems to apply only to RCS/CVS, it doesn't quite
- ;; belong here in the generic code.
- (goto-char (point-max))
- (forward-line -1)
- (while (looking-at "=*\n")
- (delete-char (- (match-end 0) (match-beginning 0)))
- (forward-line -1))
- (goto-char (point-min))
- (when (looking-at "[\b\t\n\v\f\r ]+")
- (delete-char (- (match-end 0) (match-beginning 0))))
-
- (shrink-window-if-larger-than-buffer)
- ;; move point to the log entry for the working revision
- (vc-call-backend ',backend 'show-log-entry ',working-revision)
- (setq vc-sentinel-movepoint (point))
- (set-buffer-modified-p nil))))
+ (let ((dir-present nil)
+ (vc-short-log nil)
+ (buffer-name "*vc-change-log*")
+ type
+ pl-return)
+ (dolist (file files)
+ (when (file-directory-p file)
+ (setq dir-present t)))
+ (setq vc-short-log
+ (not (null (if dir-present
+ (memq 'directory vc-log-short-style)
+ (memq 'file vc-log-short-style)))))
+ (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
+ (lambda (bk buf type-arg files-arg)
+ (vc-call-backend bk 'print-log files-arg buf
+ shortlog (when is-start-revision working-revision) limit))
+ (lambda (bk files-arg ret)
+ (vc-print-log-setup-buttons working-revision
+ is-start-revision limit ret))
+ (lambda (bk)
+ (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.")
+(put 'vc-log-view-type 'permanent-local t)
+
+(defun vc-log-internal-common (backend
+ buffer-name
+ files
+ type
+ backend-func
+ setup-buttons-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))
+ (setq retval (funcall backend-func backend buffer-name type files))
+ (pop-to-buffer buffer-name)
+ (let ((inhibit-read-only t))
+ ;; log-view-mode used to be called with inhibit-read-only bound
+ ;; 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 'revert-buffer-function)
+ rev-buff-func))
+ (vc-exec-after
+ `(let ((inhibit-read-only t))
+ (funcall ',setup-buttons-func ',backend ',files ',retval)
+ (shrink-window-if-larger-than-buffer)
+ (funcall ',goto-location-func ',backend)
+ (setq vc-sentinel-movepoint (point))
+ (set-buffer-modified-p nil)))))
+
+(defun vc-incoming-outgoing-internal (backend remote-location buffer-name type)
+ (vc-log-internal-common
+ backend buffer-name nil type
+ (lexical-let
+ ((remote-location remote-location))
+ (lambda (bk buf type-arg files)
+ (vc-call-backend bk type-arg buf remote-location)))
+ (lambda (bk files-arg ret))
+ (lambda (bk)
+ (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)
+(defun vc-print-log (&optional working-revision limit)
"List the change log of the current fileset in a window.
-If WORKING-REVISION is non-nil, leave the point at that revision."
- (interactive)
+If WORKING-REVISION is non-nil, leave point at that revision.
+If LIMIT is non-nil, it should be a number specifying the maximum
+number of revisions to show; the default is `vc-log-show-limit'.
+
+When called interactively with a prefix argument, prompt for
+WORKING-REVISION and LIMIT."
+ (interactive
+ (cond
+ (current-prefix-arg
+ (let ((rev (read-from-minibuffer "Log from revision (default: last revision): " nil
+ nil nil nil))
+ (lim (string-to-number
+ (read-from-minibuffer
+ "Limit display (unlimited: 0): "
+ (format "%s" vc-log-show-limit)
+ nil nil nil))))
+ (when (string= rev "") (setq rev nil))
+ (when (<= lim 0) (setq lim nil))
+ (list rev lim)))
+ (t
+ (list nil (when (> vc-log-show-limit 0) vc-log-show-limit)))))
(let* ((vc-fileset (vc-deduce-fileset t)) ;FIXME: Why t? --Stef
(backend (car vc-fileset))
(files (cadr vc-fileset))
(working-revision (or working-revision (vc-working-revision (car files)))))
- (vc-print-log-internal backend files working-revision)))
+ (vc-print-log-internal backend files working-revision nil limit)))
+
+;;;###autoload
+(defun vc-print-root-log (&optional limit)
+ "List the change log for the current VC controlled tree in a window.
+If LIMIT is non-nil, it should be a number specifying the maximum
+number of revisions to show; the default is `vc-log-show-limit'.
+When called interactively with a prefix argument, prompt for LIMIT."
+ (interactive
+ (cond
+ (current-prefix-arg
+ (let ((lim (string-to-number
+ (read-from-minibuffer
+ "Limit display (unlimited: 0): "
+ (format "%s" vc-log-show-limit)
+ nil nil nil))))
+ (when (<= lim 0) (setq lim nil))
+ (list lim)))
+ (t
+ (list (when (> vc-log-show-limit 0) vc-log-show-limit)))))
+ (let ((backend (vc-deduce-backend))
+ rootdir working-revision)
+ (unless backend
+ (error "Buffer is not version controlled"))
+ (setq rootdir (vc-call-backend backend 'root default-directory))
+ (setq working-revision (vc-working-revision rootdir))
+ (vc-print-log-internal backend (list rootdir) working-revision nil 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.
+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
+ (error "Buffer is not version controlled"))
+ (vc-incoming-outgoing-internal backend remote-location "*vc-incoming*" 'log-incoming)))
+
+;;;###autoload
+(defun vc-log-outgoing (&optional remote-location)
+ "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
+ (error "Buffer is not version controlled"))
+ (vc-incoming-outgoing-internal backend remote-location "*vc-outgoing*" 'log-outgoing)))
;;;###autoload
(defun vc-revert ()
(dolist (file files)
(let ((buf (get-file-buffer file)))
(when (and buf (buffer-modified-p buf))
- (error "Please kill or save all modified buffers before reverting.")))
+ (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))
(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)))
+ (let ((str (vc-delistify files))
+ (nfiles (length files)))
(if (< (length str) 50)
str
- (format "%d files" (length files))))))
+ (format "%d file%s" nfiles
+ (if (= nfiles 1) "" "s"))))))
(error "Revert canceled"))
(delete-windows-on "*vc-diff*")
(kill-buffer "*vc-diff*"))
(error "Rollback requires a singleton fileset or repository versioning"))
;; FIXME: latest-on-branch-p should take the fileset.
(when (not (vc-call-backend backend 'latest-on-branch-p (car files)))
- (error "Rollback is only possible at the tip revision."))
+ (error "Rollback is only possible at the tip revision"))
;; 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
(vc-buffer-sync nil))
(dolist (file files)
(when (buffer-modified-p (get-file-buffer file))
- (error "Please kill or save all modified buffers before rollback."))
+ (error "Please kill or save all modified buffers before rollback"))
(when (not (vc-up-to-date-p file))
- (error "Please revert all modified workfiles before rollback.")))
+ (error "Please revert all modified workfiles before rollback")))
;; Accumulate changes associated with the fileset
(vc-setup-buffer "*vc-diff*")
(not-modified)
(if unmodified-file
(copy-file unmodified-file file
'ok-if-already-exists 'keep-date)
- (when (y-or-n-p "Get base revision from master? ")
+ (when (y-or-n-p "Get base revision from repository? ")
(vc-revert-file file))))
(vc-call-backend new-backend 'receive-file file rev))
(when modified-file
;;;###autoload
(defun vc-rename-file (old new)
- "Rename file OLD to NEW, and rename its master file likewise."
+ "Rename file OLD to NEW in both work area and repository."
(interactive "fVC rename file: \nFRename to: ")
;; in CL I would have said (setq new (merge-pathnames new old))
(let ((old-base (file-name-nondirectory old)))
(defalias 'vc-default-check-headers 'ignore)
+(declare-function log-edit-mode "log-edit" ())
+
+(defun vc-default-log-edit-mode (backend) (log-edit-mode))
+
(defun vc-default-log-view-mode (backend) (log-view-mode))
(defun vc-default-show-log-entry (backend rev)