-;;; vc.el --- drive a version-control system from within Emacs -*- lexical-binding: t -*-
+;;; vc.el --- drive a version-control system from within Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1992-1998, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1992-1998, 2000-2014 Free Software Foundation, Inc.
;; Author: FSF (see below for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
;; This mode is fully documented in the Emacs user's manual.
;;
-;; Supported version-control systems presently include CVS, RCS, GNU
+;; Supported version-control systems presently include CVS, RCS, SRC, GNU
;; Arch, Subversion, Bzr, Git, Mercurial, Monotone and SCCS
;; (or its free replacement, CSSC).
;;
;; 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
+;; operations are assumed to be fast.
+;;
+;; The 'assumed to be fast' category includes SRC, even though it's
+;; a wrapper around RCS.
;;
;; ADDING SUPPORT FOR OTHER BACKENDS
;;
;; Unregister FILE from this backend. This is only needed if this
;; backend may be used as a "more local" backend for temporary editing.
;;
-;; * checkin (files rev comment)
+;; * checkin (files comment)
;;
-;; 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.
+;; Commit changes in FILES to this backend. COMMENT is used as a
+;; check-in comment. The implementation should pass the value of
+;; vc-checkin-switches to the backend command. The revision argument
+;; of some older VC versions is no longer supported.
;;
;; * find-revision (file rev buffer)
;;
;; The implementation should pass the value of vc-checkout-switches
;; to the backend command.
;;
-;; * checkout (file &optional editable rev)
+;; * checkout (file &optional rev)
;;
-;; Check out revision REV of FILE into the working area. If EDITABLE
-;; is non-nil, FILE should be writable by the user and if locking is
-;; used for FILE, a lock should also be set. If REV is non-nil, that
-;; is the revision to check out (default is the working revision).
-;; If REV is t, that means to check out the head of the current branch;
-;; if it is the empty string, check out the head of the trunk.
-;; The implementation should pass the value of vc-checkout-switches
-;; to the backend command.
+;; Check out revision REV of FILE into the working area. FILE
+;; should be writable by the user and if locking is used for FILE, a
+;; lock should also be set. If REV is non-nil, that is the revision
+;; to check out (default is the working revision). If REV is t,
+;; that means to check out the head of the current branch; if it is
+;; the empty string, check out the head of the trunk. The
+;; implementation should pass the value of vc-checkout-switches to
+;; the backend command. The 'editable' argument of older VC versions
+;; is gone; all files are checked out editable.
;;
;; * revert (file &optional contents-done)
;;
;; If the backend supports annotating through copies and renames,
;; and displays a file name and a revision, then return a cons
;; (REVISION . FILENAME).
+;;
+;; - region-history (FILE BUFFER LFROM LTO)
+;;
+;; Insert into BUFFER the history (log comments and diffs) of the content of
+;; FILE between lines LFROM and LTO. This is typically done asynchronously.
+;;
+;; - region-history-mode ()
+;;
+;; Major mode to use for the output of `region-history'.
;; TAG SYSTEM
;;
(require 'vc-hooks)
(require 'vc-dispatcher)
+(require 'cl-lib)
(declare-function diff-setup-whitespace "diff-mode" ())
(if observer
(vc-dired-deduce-fileset)
(error "State changing VC operations not supported in `dired-mode'")))
+ ((and (derived-mode-p 'log-view-mode)
+ (setq backend (vc-responsible-backend default-directory)))
+ (list backend default-directory))
((setq backend (vc-backend buffer-file-name))
(if state-model-only-files
(list backend (list buffer-file-name)
(let ((vsym (intern-soft revision-downcase)))
(dolist (file files) (vc-transfer-file file vsym)))
(dolist (file files)
- (vc-checkout file (eq model 'implicit) revision)))))
+ (vc-checkout file revision)))))
((not (eq model 'implicit))
;; check the files out
- (dolist (file files) (vc-checkout file t)))
+ (dolist (file files) (vc-checkout file)))
(t
;; do nothing
(message "Fileset is up-to-date"))))
(if (yes-or-no-p (format
"%s is not up-to-date. Get latest revision? "
(file-name-nondirectory file)))
- (vc-checkout file (eq model 'implicit) t)
+ (vc-checkout file t)
(when (and (not (eq model 'implicit))
(yes-or-no-p "Lock this revision? "))
- (vc-checkout file t)))))
+ (vc-checkout file)))))
;; needs-merge
((eq state 'needs-merge)
(dolist (file files)
"Revert to checked-in revision, instead? "))
(error "Checkout aborted")
(vc-revert-buffer-internal t t)
- (vc-checkout file t)))))
+ (vc-checkout file)))))
;; Unknown fileset state
(t
(error "Fileset is in an unknown state %s" state)))))
(replace-match ""))
(write-region (point-min) (point-max) file)))
-(defun vc-checkout (file &optional writable rev)
+(defun vc-checkout (file &optional rev)
"Retrieve a copy of the revision REV of FILE.
-If WRITABLE is non-nil, make sure the retrieved file is writable.
REV defaults to the latest revision.
After check-out, runs the normal hook `vc-checkout-hook'."
- (and writable
- (not rev)
+ (and (not rev)
(vc-call make-version-backups-p file)
(vc-up-to-date-p file)
(vc-make-version-backup file))
(let ((backend (vc-backend file)))
(with-vc-properties (list file)
(condition-case err
- (vc-call-backend backend 'checkout file writable rev)
+ (vc-call-backend backend 'checkout file rev)
(file-error
;; Maybe the backend is not installed ;-(
- (when writable
+ (when t
(let ((buf (get-file-buffer file)))
(when buf (with-current-buffer buf (read-only-mode -1)))))
(signal (car err) (cdr err))))
`((vc-state . ,(if (or (eq (vc-checkout-model backend (list file)) 'implicit)
- (not writable))
+ nil)
(if (vc-call-backend backend 'latest-on-branch-p file)
'up-to-date
'needs-update)
".\n")
(message "Please explain why you stole the lock. Type C-c C-c when done.")))
-(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 (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.
+(defun vc-checkin (files backend &optional comment initial-contents)
+ "Check in FILES. 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.
If `vc-keep-workfiles' is nil, FILE is deleted afterwards, provided
that the version control system supports this mode of operation.
;; vc-checkin-switches, but 'the' local buffer is
;; not a well-defined concept for filesets.
(progn
- (vc-call-backend backend 'checkin files rev comment)
+ (vc-call-backend backend 'checkin files comment)
(mapc 'vc-delete-automatic-version-backups files))
`((vc-state . up-to-date)
(vc-checkout-time . ,(nth 5 (file-attributes file)))
t (list backend (list rootdir) working-revision) nil nil
(called-interactively-p 'interactive))))))
+;;;###autoload
+(defun vc-root-dir ()
+ "Return the root directory for the current VC tree.
+Return nil if the root directory cannot be identified."
+ (let ((backend (vc-deduce-backend)))
+ (if backend
+ (condition-case err
+ (vc-call-backend backend 'root default-directory)
+ (vc-not-supported
+ (unless (eq (cadr err) 'root)
+ (signal (car err) (cdr err)))
+ nil)))))
+
;;;###autoload
(defun vc-revision-other-window (rev)
"Visit revision REV of the current file in another window.
;;;###autoload
(defun vc-retrieve-tag (dir name)
- "Descending recursively from DIR, retrieve the tag called NAME.
-If NAME is empty, it refers to the latest revisions.
+ "For each file in or below DIR, retrieve their tagged version NAME.
+NAME can name a branch, in which case this command will switch to the
+named branch in the directory DIR.
+Interactively, prompt for DIR only for VCS that works at file level;
+otherwise use the default directory of the current buffer.
+If NAME is empty, it refers to the latest revisions of the current branch.
If locking is used for the files in DIR, then there must not be any
locked files at or below DIR (but if NAME is empty, locked files are
allowed and simply skipped)."
;; 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.
- (let ((dir-present nil)
- (vc-short-log nil)
+ (let* ((dir-present (cl-some #'file-directory-p files))
+ (shortlog (not (null (memq (if dir-present 'directory 'file)
+ vc-log-short-style))))
(buffer-name "*vc-change-log*")
- type)
- (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))
- (let ((shortlog vc-short-log))
+ (type (if shortlog 'short 'long)))
(vc-log-internal-common
backend buffer-name files type
(lambda (bk buf _type-arg files-arg)
(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))))))
+ is-start-revision limit)))))
(defvar vc-log-view-type nil
"Set this to differentiate the different types of logs.")
(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))
+ (with-current-buffer (get-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)))
+ ;; Display after setting up major-mode, so display-buffer-alist can know
+ ;; the major-mode.
(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-run-delayed
(let ((inhibit-read-only t))
(funcall setup-buttons-func backend files retval)
(vc-incoming-outgoing-internal backend remote-location "*vc-outgoing*"
'log-outgoing)))
+;;;###autoload
+(defun vc-region-history (from to)
+ "Show the history of the region FROM..TO."
+ (interactive "r")
+ (let* ((lfrom (line-number-at-pos from))
+ (lto (line-number-at-pos to))
+ (file buffer-file-name)
+ (backend (vc-backend file))
+ (buf (get-buffer-create "*VC-history*")))
+ (with-current-buffer buf
+ (setq-local vc-log-view-type 'long))
+ (vc-call region-history file buf lfrom lto)
+ (with-current-buffer buf
+ (vc-call-backend backend 'region-history-mode)
+ (set (make-local-variable 'log-view-vc-backend) backend)
+ (set (make-local-variable 'log-view-vc-fileset) file)
+ (set (make-local-variable 'revert-buffer-function)
+ (lambda (_ignore-auto _noconfirm)
+ (with-current-buffer buf
+ (let ((inhibit-read-only t)) (erase-buffer)))
+ (vc-call region-history file buf lfrom lto))))
+ (display-buffer buf)))
+
;;;###autoload
(defun vc-revert ()
"Revert working copies of the selected fileset to their repository contents.
(error "Please revert all modified workfiles before rollback")))
;; Accumulate changes associated with the fileset
(vc-setup-buffer "*vc-diff*")
- (not-modified)
+ (set-buffer-modified-p nil)
(message "Finding changes...")
(let* ((tip (vc-working-revision (car files)))
;; FIXME: `previous-revision' should take the fileset.
(and file (member file files))))))
(dolist (file files)
(if (vc-up-to-date-p file)
- (vc-checkout file nil t)
+ (vc-checkout file 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))))
+ (vc-checkout file t))))
(t
(error "VC update is unsupported for `%s'" backend)))))
(when modified-file
(vc-switch-backend file new-backend)
(unless (eq (vc-checkout-model new-backend (list file)) 'implicit)
- (vc-checkout file t nil))
+ (vc-checkout file))
(rename-file modified-file file 'ok-if-already-exists)
(vc-file-setprop file 'vc-checkout-time nil)))))
(when move
(when (or move edited)
(vc-file-setprop file 'vc-state 'edited)
(vc-mode-line file new-backend)
- (vc-checkin file new-backend nil comment (stringp comment)))))
-
-(defun vc-rename-master (oldmaster newfile templates)
- "Rename OLDMASTER to be the master file for NEWFILE based on TEMPLATES."
- (let* ((dir (file-name-directory (expand-file-name oldmaster)))
- (newdir (or (file-name-directory newfile) ""))
- (newbase (file-name-nondirectory newfile))
- (masters
- ;; List of potential master files for `newfile'
- (mapcar
- (lambda (s) (vc-possible-master s newdir newbase))
- templates)))
- (when (or (file-symlink-p oldmaster)
- (file-symlink-p (file-name-directory oldmaster)))
- (error "This is unsafe in the presence of symbolic links"))
- (rename-file
- oldmaster
- (catch 'found
- ;; If possible, keep the master file in the same directory.
- (dolist (f masters)
- (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)))
- (file-directory-p dir))
- (throw 'found f)))
- (error "New file lacks a version control directory")))))
+ (vc-checkin file new-backend comment (stringp comment)))))
;;;###autoload
(defun vc-delete-file (file)