;;; 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
+;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
;; 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')
;; and then do a (funcall UPDATE-FUNCTION RESULT nil)
;; when all the results have been computed.
;; To provide more backend specific functionality for `vc-dir'
-;; the following functions might be needed: `status-extra-headers',
-;; `status-printer', `extra-status-menu' and `dir-status-files'.
+;; the following functions might be needed: `dir-extra-headers',
+;; `dir-printer', `extra-dir-menu' and `dir-status-files'.
;;
;; - dir-status-files (dir files default-state update-function)
;;
;; files. If not provided, the default is to consider that the files
;; are in DEFAULT-STATE.
;;
-;; - status-extra-headers (dir)
+;; - dir-extra-headers (dir)
;;
;; Return a string that will be added to the *vc-dir* buffer header.
;;
-;; - status-printer (fileinfo)
+;; - dir-printer (fileinfo)
;;
;; Pretty print the `vc-dir-fileinfo' FILEINFO.
;; If a backend needs to show more information than the default FILE
;; The default implementation deals well with all states that
;; `vc-state' can return.
;;
-;; - prettify-state-info (file)
-;;
-;; Translate the `vc-state' property of FILE into a string that can be
-;; used in a human-readable buffer. The default implementation deals well
-;; with all states that `vc-state' can return.
-;;
;; STATE-CHANGING FUNCTIONS
;;
;; * create-repo (backend)
;; arg CONTENTS-DONE is non-nil, then the contents of FILE have
;; already been reverted from a version backup, and this function
;; only needs to update the status of FILE within the backend.
+;; If FILE is in the `added' state it should be returned to the
+;; `unregistered' state.
;;
;; - rollback (files)
;;
;;
;; HISTORY FUNCTIONS
;;
-;; * print-log (files &optional buffer)
+;; * print-log (files &optional buffer shortlog)
;;
;; 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.)
+;; If SHORTLOG is true insert a short version of the log.
;;
;; - 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
;; Operation called in current buffer when opening a file. This can
;; be used by the backend to setup some local variables it might need.
;;
-;; - find-file-not-found-hook ()
-;;
-;; Operation called in current buffer when opening a non-existing file.
-;; By default, this asks the user if she wants to check out the file.
-;;
;; - extra-menu ()
;;
;; Return a menu keymap, the items in the keymap will appear at the
;; to your backend and which does not map to any of the VC generic
;; concepts.
;;
-;; - extra-status-menu ()
+;; - extra-dir-menu ()
;;
;; Return a menu keymap, the items in the keymap will appear at the
;; end of the VC Status menu. The goal is to allow backends to
;;
;;;; 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.
;;
(defcustom vc-diff-switches nil
"A string or list of strings specifying switches for diff under VC.
-When running diff under a given BACKEND, VC concatenates the values of
-`diff-switches', `vc-diff-switches', and `vc-BACKEND-diff-switches' to
-get the switches for that command. Thus, `vc-diff-switches' should
-contain switches that are specific to version control, but not
-specific to any particular backend."
- :type '(choice (const :tag "None" nil)
+When running diff under a given BACKEND, VC uses the first
+non-nil value of `vc-BACKEND-diff-switches', `vc-diff-switches',
+and `diff-switches', in that order. Since nil means to check the
+next variable in the sequence, either of the first two may use
+the value t to mean no switches at all. `vc-diff-switches'
+should contain switches that are specific to version control, but
+not specific to any particular backend."
+ :type '(choice (const :tag "Unspecified" nil)
+ (const :tag "None" t)
(string :tag "Argument String")
- (repeat :tag "Argument List"
- :value ("")
- string))
+ (repeat :tag "Argument List" :value ("") string))
:group 'vc
:version "21.1")
(defcustom vc-diff-knows-L nil
- "*Indicates whether diff understands the -L option.
+ "Indicates whether diff understands the -L option.
The value is either `yes', `no', or nil. If it is nil, VC tries
to use -L and sets this variable to remember whether it worked."
:type '(choice (const :tag "Work out" nil) (const yes) (const no))
(defcustom vc-static-header-alist
'(("\\.c\\'" .
"\n#ifndef lint\nstatic char vcid[] = \"\%s\";\n#endif /* lint */\n"))
- "*Associate static header string templates with file types.
+ "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'."
:type '(repeat (cons :format "%v"
(defcustom vc-comment-alist
'((nroff-mode ".\\\"" ""))
- "*Special comment delimiters for generating VC headers.
+ "Special comment delimiters for generating VC headers.
Add an entry in this list if you need to override the normal `comment-start'
and `comment-end' variables. This will only be necessary if the mode language
is sensitive to blank lines."
:group 'vc)
(defcustom vc-checkout-carefully (= (user-uid) 0)
- "*Non-nil means be extra-careful in checkout.
+ "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."
:type 'boolean
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
+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 and FILE is a directory, create a VC
+repository that can be used to register FILE.
+
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
(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")))))
+ (if (file-directory-p file)
+ (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
+ (file-name-as-directory
+ (let ((def-dir 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 nil t nil
+ (lambda (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))
+
+ ;; FIXME: this case does not happen with the current code.
+ ;; Should we keep it?
+ ;;
+ ;; 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")))))
(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)
-;; 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)))
-
(declare-function vc-dir-current-file "vc-dir" ())
(declare-function vc-dir-deduce-fileset "vc-dir" (&optional state-model-only-files))
;; FIXME: Why this test? --Stef
(or (buffer-file-name vc-parent-buffer)
(with-current-buffer vc-parent-buffer
- (eq major-mode 'vc-dir-mode))))
+ (derived-mode-p 'vc-dir-mode))))
(progn ;FIXME: Why not `with-current-buffer'? --Stef.
(set-buffer vc-parent-buffer)
(vc-deduce-fileset observer allow-unregistered state-model-only-files)))
((and allow-unregistered (not (vc-registered buffer-file-name)))
(if state-model-only-files
(list (vc-responsible-backend
- (file-name-directory (buffer-file-name)))
+ (file-name-directory (buffer-file-name)) t)
(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)))
+ (file-name-directory (buffer-file-name)) t)
(list buffer-file-name))))
- (t (error "No fileset is available here.")))))
+ (t (error "No fileset is available here")))))
(defun vc-ensure-vc-buffer ()
"Make sure that the current buffer visits a version-controlled file."
;; 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
(verbose
;; go to a different revision
(setq revision (read-string "Branch, revision, or backend to move to: "))
- (let ((vsym (intern-soft (upcase revision))))
- (if (member vsym vc-handled-backends)
- (dolist (file files) (vc-transfer-file file vsym))
+ (let ((revision-downcase (downcase revision)))
+ (if (member
+ revision-downcase
+ (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)
(vc-checkout file (eq model 'implicit) revision)))))
((not (eq model 'implicit))
(if (not ready-for-commit)
(message "No files remain to be committed")
(if (not verbose)
- (vc-checkin ready-for-commit)
- (progn
- (setq revision (read-string "New revision or backend: "))
- (let ((vsym (intern (upcase revision))))
- (if (member vsym vc-handled-backends)
- (dolist (file files) (vc-transfer-file file vsym))
- (vc-checkin ready-for-commit revision))))))))
+ (vc-checkin ready-for-commit backend)
+ (setq revision (read-string "New revision or backend: "))
+ (let ((revision-downcase (downcase revision)))
+ (if (member
+ revision-downcase
+ (mapcar (lambda (arg) (downcase (symbol-name arg)))
+ vc-handled-backends))
+ (let ((vsym (intern revision-downcase)))
+ (dolist (file files) (vc-transfer-file file vsym)))
+ (vc-checkin ready-for-commit backend revision)))))))
;; locked by somebody else (locking VCSes only)
((stringp state)
;; In the old days, we computed the revision once and used it on
;; show that the file is locked now.
(vc-clear-headers file)
(write-file buffer-file-name)
- (vc-mode-line file))
+ (vc-mode-line file backend))
(if (not (yes-or-no-p
"Revert to checked-in revision, instead? "))
(error "Checkout aborted")
nil t)))))
(vc-call-backend backend 'create-repo))
+(declare-function vc-dir-move-to-goal-column "vc-dir" ())
+
;;;###autoload
(defun vc-register (&optional set-revision vc-fileset comment)
"Register into a version control system.
(not (file-exists-p buffer-file-name)))
(set-buffer-modified-p t))
(vc-buffer-sync)))))
- (lexical-let ((backend backend)
- (files files))
- (vc-start-logentry
- files
- (if set-revision
- (read-string (format "Initial revision level for %s: " files))
- (vc-call-backend backend 'init-revision))
- (or comment (not vc-initial-comment))
- nil
- "Enter initial comment."
- "*VC-log*"
- (lambda (files rev comment)
- (message "Registering %s... " files)
- (mapc 'vc-file-clearprops files)
- (vc-call-backend backend 'register files rev comment)
- (dolist (file files)
- (vc-file-setprop file 'vc-backend backend)
- ;; FIXME: This is wrong: it should set `backup-inhibited' in all
- ;; the buffers visiting files affected by this `vc-register', not
- ;; in the current-buffer.
- ;; (unless vc-make-backup-files
- ;; (make-local-variable 'backup-inhibited)
- ;; (setq backup-inhibited t))
- )
- (message "Registering %s... done" files))))))
+ (message "Registering %s... " files)
+ (mapc 'vc-file-clearprops files)
+ (vc-call-backend backend 'register files
+ (if set-revision
+ (read-string (format "Initial revision level for %s: " files))
+ (vc-call-backend backend 'init-revision))
+ comment)
+ (mapc
+ (lambda (file)
+ (vc-file-setprop file 'vc-backend backend)
+ ;; FIXME: This is wrong: it should set `backup-inhibited' in all
+ ;; the buffers visiting files affected by this `vc-register', not
+ ;; in the current-buffer.
+ ;; (unless vc-make-backup-files
+ ;; (make-local-variable 'backup-inhibited)
+ ;; (setq backup-inhibited t))
+
+ (vc-resynch-buffer file vc-keep-workfiles t))
+ files)
+ (when (derived-mode-p 'vc-dir-mode)
+ (vc-dir-move-to-goal-column))
+ (message "Registering %s... done" files)))
(defun vc-register-with (backend)
"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)))
".\n")
(message "Please explain why you stole the lock. Type C-c C-c when done.")))
-(defun vc-checkin (files &optional rev comment initial-contents)
+(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
Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'."
(when vc-before-checkin-hook
(run-hooks 'vc-before-checkin-hook))
- (vc-start-logentry
- files rev 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 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))
+ (lexical-let
+ ((backend backend))
+ (vc-start-logentry
+ files rev 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)))
+ 'vc-checkin-hook)))
;;; Additional entry points for examining version histories
BACKEND is a symbol such as `CVS', which will be downcased.
OP is a symbol such as `diff'.
-In decreasing order of preference, returns the value of:
+In decreasing order of preference, return the value of:
vc-BACKEND-OP-switches (e.g. `vc-cvs-diff-switches');
vc-OP-switches (e.g. `vc-diff-switches'); or, in the case of
-diff only, `vc-diff-switches'.
+diff only, `diff-switches'.
-If the chosen value is not a string or a list, returns nil.
+If the chosen value is not a string or a list, return nil.
This is so that you may set, e.g. `vc-svn-diff-switches' to t in order
to override the value of `vc-diff-switches' and `diff-switches'."
(let ((switches
;; I made it conditional on vc-diff-added-files but it should probably
;; just be removed (or copied/moved to specific backends). --Stef.
(when vc-diff-added-files
- (let ((filtered '()))
+ (let ((filtered '())
+ process-file-side-effects)
(dolist (file files)
(if (or (file-directory-p file)
(not (string= (vc-working-revision file) "0")))
;; because we don't know that yet.
t)))
+(defun vc-read-revision (prompt &optional files backend default initial-input)
+ (cond
+ ((null files)
+ (let ((vc-fileset (vc-deduce-fileset t))) ;FIXME: why t? --Stef
+ (setq files (cadr vc-fileset))
+ (setq backend (car vc-fileset))))
+ ((null backend) (setq backend (vc-backend (car files)))))
+ (let ((completion-table
+ (vc-call-backend backend 'revision-completion-table files)))
+ (if completion-table
+ (completing-read prompt completion-table
+ nil nil initial-input nil default)
+ (read-string prompt initial-input nil default))))
+
;;;###autoload
(defun vc-version-diff (files rev1 rev2)
"Report diffs between revisions of the fileset in the repository history."
(files (cadr vc-fileset))
(backend (car vc-fileset))
(first (car files))
- (completion-table
- (vc-call-backend backend 'revision-completion-table files))
(rev1-default nil)
(rev2-default nil))
(cond
"Older revision: "))
(rev2-prompt (concat "Newer revision (default "
(or rev2-default "current source") "): "))
- (rev1 (if completion-table
- (completing-read rev1-prompt completion-table
- nil nil nil nil rev1-default)
- (read-string rev1-prompt nil nil rev1-default)))
- (rev2 (if completion-table
- (completing-read rev2-prompt completion-table
- nil nil nil nil rev2-default)
- (read-string rev2-prompt nil nil rev2-default))))
+ (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))))
;; 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 file revisions.
+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
+ ;; 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
+ (cond ((derived-mode-p 'vc-dir-mode) vc-dir-backend)
+ (vc-mode (vc-backend buffer-file-name))))
+ 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-internal
+ t (list backend (list rootdir) working-revision) nil nil
+ (called-interactively-p 'interactive)))))
;;;###autoload
(defun vc-revision-other-window (rev)
(interactive
(save-current-buffer
(vc-ensure-vc-buffer)
- (let ((completion-table
- (vc-call revision-completion-table buffer-file-name))
- (prompt "Revision to visit (default is working revision): "))
- (list
- (if completion-table
- (completing-read prompt completion-table)
- (read-string prompt))))))
+ (list
+ (vc-read-revision "Revision to visit (default is working revision): "
+ (list buffer-file-name)))))
(vc-ensure-vc-buffer)
(let* ((file buffer-file-name)
(revision (if (string-equal rev "")
(vc-checkout file t)
(error "Merge aborted"))))
(setq first-revision
- (read-string (concat "Branch or revision to merge from "
- "(default news on current branch): ")))
+ (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
- (read-string "Second revision: "
- (concat (vc-branch-part first-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)
;; Miscellaneous other entry points
+;; 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!")
+
+(defun vc-print-log-internal (backend files working-revision)
+ ;; 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))
+ (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)))))
+ (vc-call-backend backend 'print-log files "*vc-change-log*" vc-short-log)
+ (pop-to-buffer "*vc-change-log*")
+ (vc-exec-after
+ `(let ((inhibit-read-only t)
+ (vc-short-log ,vc-short-log))
+ (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)
+
+ (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)))))
+
;;;###autoload
(defun vc-print-log (&optional working-revision)
"List the change log of the current fileset in a window.
(backend (car vc-fileset))
(files (cadr 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
- ;; 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)
- (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)))))
+ (vc-print-log-internal backend files working-revision)))
+
+;;;###autoload
+(defun vc-print-root-log ()
+ "List the change log of for the current VC controlled tree in a window."
+ (interactive)
+ (let ((backend
+ (cond ((derived-mode-p 'vc-dir-mode) vc-dir-backend)
+ (vc-mode (vc-backend buffer-file-name))))
+ 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)))
;;;###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? " (vc-delistify files)))
+ (unless (yes-or-no-p
+ (format "Discard changes in %s? "
+ (let ((str (vc-delistify files)))
+ (if (< (length str) 50)
+ str
+ (format "%d files" (length files))))))
(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)
(vc-switch-backend file new-backend)
(when (or move edited)
(vc-file-setprop file 'vc-state 'edited)
- (vc-mode-line file)
- (vc-checkin file nil comment (stringp comment)))))
+ (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."
(throw 'found f)))
(error "New file lacks a version control directory")))))
+;;;###autoload
(defun vc-delete-file (file)
"Delete file and mark it as such in the version control system."
(interactive "fVC delete file: ")
(with-current-buffer oldbuf
(let ((buffer-read-only buffer-read-only))
(set-visited-file-name new))
- (vc-backend new)
- (vc-mode-line new)
+ (vc-mode-line new (vc-backend new))
(set-buffer-modified-p nil)))))
;;;###autoload
(vc-call-backend (vc-responsible-backend default-directory)
'update-changelog args))
-;;; The default back end. Assumes RCS-like revision numbering.
-
-(defun vc-default-revision-granularity ()
- (error "Your backend will not work with this version of VC mode."))
-
;; functions that operate on RCS revision numbers. This code should
;; also be moved into the backends. It stays for now, however, since
;; it is used in code below.
-;;;###autoload
-(defun vc-trunk-p (rev)
- "Return t if REV is a revision on the trunk."
- (not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev))))
-
(defun vc-branch-p (rev)
"Return t if REV is a branch revision."
(not (eq nil (string-match "\\`[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*\\'" rev))))
(when index
(substring rev 0 index))))
-(defun vc-minor-part (rev)
- "Return the minor revision number of a revision number REV."
- (string-match "[0-9]+\\'" rev)
- (substring rev (match-beginning 0) (match-end 0)))
-
(define-obsolete-function-alias
'vc-default-previous-version 'vc-default-previous-revision "23.1")
-(defun vc-default-previous-revision (backend file rev)
- "Return the revision number immediately preceding REV for FILE,
-or nil if there is no previous revision. This default
-implementation works for MAJOR.MINOR-style revision numbers as
-used by RCS and CVS."
- (let ((branch (vc-branch-part rev))
- (minor-num (string-to-number (vc-minor-part rev))))
- (when branch
- (if (> minor-num 1)
- ;; revision does probably not start a branch or release
- (concat branch "." (number-to-string (1- minor-num)))
- (if (vc-trunk-p rev)
- ;; we are at the beginning of the trunk --
- ;; don't know anything to return here
- nil
- ;; we are at the beginning of a branch --
- ;; return revision of starting point
- (vc-branch-part branch))))))
-
-(defun vc-default-next-revision (backend file rev)
- "Return the revision number immediately following REV for FILE,
-or nil if there is no next revision. This default implementation
-works for MAJOR.MINOR-style revision numbers as used by RCS
-and CVS."
- (when (not (string= rev (vc-working-revision file)))
- (let ((branch (vc-branch-part rev))
- (minor-num (string-to-number (vc-minor-part rev))))
- (concat branch "." (number-to-string (1+ minor-num))))))
-
(defun vc-default-responsible-p (backend file)
"Indicate whether BACKEND is reponsible for FILE.
The default is to return nil always."
(defun vc-default-init-revision (backend) vc-default-init-revision)
-(defalias 'vc-cvs-update-changelog 'vc-update-changelog-rcs2log)
-
-(defalias 'vc-rcs-update-changelog 'vc-update-changelog-rcs2log)
-
-;; FIXME: This should probably be moved to vc-rcs.el and replaced in
-;; vc-cvs.el by code using cvs2cl.
-(defun vc-update-changelog-rcs2log (files)
- "Default implementation of update-changelog.
-Uses `rcs2log' which only works for RCS and CVS."
- ;; FIXME: We (c|sh)ould add support for cvs2cl
- (let ((odefault default-directory)
- (changelog (find-change-log))
- ;; Presumably not portable to non-Unixy systems, along with rcs2log:
- (tempfile (make-temp-file
- (expand-file-name "vc"
- (or small-temporary-file-directory
- temporary-file-directory))))
- (login-name (or user-login-name
- (format "uid%d" (number-to-string (user-uid)))))
- (full-name (or add-log-full-name
- (user-full-name)
- (user-login-name)
- (format "uid%d" (number-to-string (user-uid)))))
- (mailing-address (or add-log-mailing-address
- user-mail-address)))
- (find-file-other-window changelog)
- (barf-if-buffer-read-only)
- (vc-buffer-sync)
- (undo-boundary)
- (goto-char (point-min))
- (push-mark)
- (message "Computing change log entries...")
- (message "Computing change log entries... %s"
- (unwind-protect
- (progn
- (setq default-directory odefault)
- (if (eq 0 (apply 'call-process
- (expand-file-name "rcs2log"
- exec-directory)
- nil (list t tempfile) nil
- "-c" changelog
- "-u" (concat login-name
- "\t" full-name
- "\t" mailing-address)
- (mapcar
- (lambda (f)
- (file-relative-name
- (expand-file-name f odefault)))
- files)))
- "done"
- (pop-to-buffer (get-buffer-create "*vc*"))
- (erase-buffer)
- (insert-file-contents tempfile)
- "failed"))
- (setq default-directory (file-name-directory changelog))
- (delete-file tempfile)))))
-
(defun vc-default-find-revision (backend file rev buffer)
"Provide the new `find-revision' op based on the old `checkout' op.
This is only for compatibility with old backends. They should be updated
(insert-file-contents-literally tmpfile)))
(delete-file tmpfile))))
-(defun vc-default-prettify-state-info (backend file)
- (let* ((state (vc-state file))
- (statestring
- (cond
- ((stringp state) (concat "(locked:" state ")"))
- ((eq state 'edited) "(modified)")
- ((eq state 'needs-merge) "(merge)")
- ((eq state 'needs-update) "(update)")
- ((eq state 'added) "(added)")
- ((eq state 'removed) "(removed)")
- ((eq state 'ignored) "(ignored)")
- ((eq state 'unregistered) "(unregistered)")
- ((eq state 'unlocked-changes) "(stale)")
- (t (format "(unknown:%s)" state))))
- (buffer
- (get-file-buffer file))
- (modflag
- (if (and buffer (buffer-modified-p buffer)) "+" "")))
- (concat statestring modflag)))
-
(defun vc-default-rename-file (backend old new)
(condition-case nil
(add-name-to-file old new)
(defun vc-default-receive-file (backend file rev)
"Let BACKEND receive FILE from another version control system."
- (vc-call-backend backend 'register file rev ""))
+ (vc-call-backend backend 'register (list file) rev ""))
(defun vc-default-retrieve-tag (backend dir name update)
(if (string= name "")
HCoop / bpt / emacs.git / blobdiff