;;; vc.el --- drive a version-control system from within Emacs
-;; Copyright (C) 1992,93,94,95,96,97,98,2000,2001 Free Software Foundation, Inc.
+;; Copyright (C) 1992,93,94,95,96,97,98,2000,01,2003,2004
+;; Free Software Foundation, Inc.
;; Author: FSF (see below for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
;; Keywords: tools
-;; $Id: vc.el,v 1.322 2001/11/26 16:07:50 spiegel Exp $
+;; $Id: vc.el,v 1.366 2004/02/07 00:37:13 uid65598 Exp $
;; This file is part of GNU Emacs.
;; to be installed somewhere on Emacs's path for executables.
;;
;; If your site uses the ChangeLog convention supported by Emacs, the
-;; function vc-comment-to-change-log should prove a useful checkin hook.
+;; 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
;; contents with those of the master version. 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.
+;; vc-BACKEND-diff. (Note that vc-BACKEND-diff must not run
+;; asynchronously in this case.)
;;
;; - mode-line-string (file)
;;
;; The implementation should pass the value of vc-register-switches
;; to the backend command.
;;
+;; - init-version (file)
+;;
+;; The initial version to use when registering FILE if one is not
+;; specified by the user. If not provided, the variable
+;; vc-default-init-version is used instead.
+;;
;; - responsible-p (file)
;;
;; Return non-nil if this backend considers itself "responsible" for
;; check-in comment. The implementation should pass the value of
;; vc-checkin-switches to the backend command.
;;
-;; * checkout (file &optional editable rev destfile)
+;; * find-version (file rev buffer)
+;;
+;; Fetch revision REV of file FILE and put it into BUFFER.
+;; If REV is the empty string, fetch the head of the trunk.
+;; The implementation should pass the value of vc-checkout-switches
+;; to the backend command.
+;;
+;; * checkout (file &optional editable 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 current workfile version);
-;; if REV is the empty string, that means to check out the head of the
-;; trunk. If optional arg DESTFILE is given, it is an alternate
-;; filename to write the contents to. The implementation should
-;; pass the value of vc-checkout-switches to the backend command.
+;; is the revision to check out (default is current workfile version).
+;; 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.
;;
;; * revert (file &optional contents-done)
;;
;; is nil, use the current workfile version (as found in the
;; repository) as the older version; if REV2 is nil, use the current
;; workfile contents as the newer version. This function should
-;; pass the value of (vc-diff-switches-list BACKEND) to the backend
+;; pass the value of (vc-switches BACKEND 'diff) to the backend
;; command. It should return a status of either 0 (no differences
;; found), or 1 (either non-empty diff or the diff is run
;; asynchronously).
;; as a floating point fractional number of days. The helper
;; function `vc-annotate-convert-time' may be useful for converting
;; multi-part times as returned by `current-time' and `encode-time'
-;; to this format. Return NIL if no more lines of annotation appear
+;; to this format. Return nil if no more lines of annotation appear
;; in the buffer. You can safely assume that point is placed at the
;; beginning of each line, starting at `point-min'. The buffer that
;; point is placed in is the Annotate output, as defined by the
;; time with hours, minutes, and seconds included. Probably safe to
;; ignore. Return the current-time, in units of fractional days.
;;
+;; - annotate-extract-revision-at-line ()
+;;
+;; Only required if `annotate-command' is defined for the backend.
+;; 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.
+;;
;; SNAPSHOT SYSTEM
;;
;; - create-snapshot (dir name branchp)
;; `revert' operations itself, without calling the backend system. The
;; default implementation always returns nil.
;;
+;; - repository-hostname (dirname)
+;;
+;; Return the hostname that the backend will have to contact
+;; in order to operate on a file in DIRNAME. If the return value
+;; is nil, it is means that the repository is local.
+;; This function is used in `vc-stay-local-p' which backends can use
+;; for their convenience.
+;;
+;; - previous-version (file rev)
+;;
+;; Return the version number that precedes REV for FILE, or nil if no such
+;; version exists.
+;;
+;; - next-version (file rev)
+;;
+;; Return the version number that follows REV for FILE, or nil if no such
+;; version exists.
+;;
;; - check-headers ()
;;
;; Return non-nil if the current buffer contains any version headers.
;; version control state in such a way that the headers would give
;; wrong information.
;;
+;; - delete-file (file)
+;;
+;; Delete FILE and mark it as deleted in the repository. If this
+;; function is not provided, the command `vc-delete-file' will
+;; signal an error.
+;;
;; - rename-file (old new)
;;
;; Rename file OLD to NEW, both in the working area and in the
-;; repository. If this function is not provided, the command
-;; `vc-rename-file' will signal an error.
+;; repository. If this function is not provided, the renaming
+;; will be done by (vc-delete-file old) and (vc-register new).
+;;
;;; Code:
(defcustom vc-default-init-version "1.1"
"*A string used as the default version number when a new file is registered.
-This can be overridden by giving a prefix argument to \\[vc-register]."
+This can be overridden by giving a prefix argument to \\[vc-register]. This
+can also be overridden by a particular VC backend."
:type 'string
:group 'vc
:version "20.3")
:group 'vc
:version "20.3")
-(defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS")
+(defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS" "MCVS" ".svn")
"*List of directory names to be ignored when walking directory trees."
:type '(repeat string)
:group 'vc)
-(defconst vc-maximum-comment-ring-size 32
- "Maximum number of saved comments in the comment ring.")
-
(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
;;;###autoload
(defcustom vc-checkin-hook nil
"*Normal hook (list of functions) run after a checkin is done.
-See `run-hooks'."
+See also `log-edit-done-hook'."
:type 'hook
- :options '(vc-comment-to-change-log)
+ :options '(log-edit-comment-to-change-log)
:group 'vc)
;;;###autoload
m)
"Local keymap used for VC-Annotate mode.")
+(define-key vc-annotate-mode-map "A" 'vc-annotate-revision-previous-to-line)
+(define-key vc-annotate-mode-map "D" 'vc-annotate-show-diff-revision-at-line)
+(define-key vc-annotate-mode-map "J" 'vc-annotate-revision-at-line)
+(define-key vc-annotate-mode-map "L" 'vc-annotate-show-log-revision-at-line)
+(define-key vc-annotate-mode-map "N" 'vc-annotate-next-version)
+(define-key vc-annotate-mode-map "P" 'vc-annotate-prev-version)
+(define-key vc-annotate-mode-map "W" 'vc-annotate-workfile-version)
+
(defvar vc-annotate-mode-menu nil
"Local keymap used for VC-Annotate mode's menu bar menu.")
:group 'vc)
(defcustom vc-checkout-carefully (= (user-uid) 0)
- "*This variable is obsolete
-The corresponding checks are always done now.
-From the old doc string:
-
-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
:group 'vc)
-
-\f
-;; The main keymap
-
-;; Initialization code, to be done just once at load-time
-(defvar vc-log-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\M-n" 'vc-next-comment)
- (define-key map "\M-p" 'vc-previous-comment)
- (define-key map "\M-r" 'vc-comment-search-reverse)
- (define-key map "\M-s" 'vc-comment-search-forward)
- (define-key map "\C-c\C-c" 'vc-finish-logentry)
- map))
-;; Compatibility with old name. Should we bother ?
-(defvar vc-log-entry-mode vc-log-mode-map)
+(make-obsolete-variable 'vc-checkout-carefully
+ "the corresponding checks are always done now."
+ "21.1")
\f
;; Variables the user doesn't need to know about.
(defvar vc-dired-mode nil)
(make-variable-buffer-local 'vc-dired-mode)
-(defvar vc-comment-ring (make-ring vc-maximum-comment-ring-size))
-(defvar vc-comment-ring-index nil)
-(defvar vc-last-comment-match "")
-
;; 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.
"Return t if REV is a branch revision."
(not (eq nil (string-match "\\`[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*\\'" rev))))
+;;;###autoload
(defun vc-branch-part (rev)
"Return the branch part of a revision number REV."
- (substring rev 0 (string-match "\\.[0-9]+\\'" rev)))
+ (let ((index (string-match "\\.[0-9]+\\'" rev)))
+ (if index
+ (substring rev 0 index))))
(defun vc-minor-part (rev)
"Return the minor version number of a revision number REV."
(string-match "[0-9]+\\'" rev)
(substring rev (match-beginning 0) (match-end 0)))
-(defun vc-previous-version (rev)
- "Guess the version number immediately preceding REV."
+(defun vc-default-previous-version (backend file rev)
+ "Return the version number immediately preceding REV for FILE,
+or nil if there is no previous version. This default
+implementation works for <major>.<minor>-style version numbers as
+used by RCS and CVS."
(let ((branch (vc-branch-part rev))
(minor-num (string-to-number (vc-minor-part rev))))
- (if (> minor-num 1)
- ;; version 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
- ""
- ;; we are at the beginning of a branch --
- ;; return version of starting point
- (vc-branch-part branch)))))
+ (when branch
+ (if (> minor-num 1)
+ ;; version 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 version of starting point
+ (vc-branch-part branch))))))
+
+(defun vc-default-next-version (backend file rev)
+ "Return the version number immediately following REV for FILE,
+or nil if there is no next version. This default implementation
+works for <major>.<minor>-style version numbers as used by RCS
+and CVS."
+ (when (not (string= rev (vc-workfile-version file)))
+ (let ((branch (vc-branch-part rev))
+ (minor-num (string-to-number (vc-minor-part rev))))
+ (concat branch "." (number-to-string (1+ minor-num))))))
;; File property caching
(defun vc-clear-context ()
- "Clear all cached file properties and the comment ring."
+ "Clear all cached file properties."
(interactive)
- (fillarray vc-file-prop-obarray 0)
- ;; Note: there is potential for minor lossage here if there is an open
- ;; log buffer with a nonzero local value of vc-comment-ring-index.
- (setq vc-comment-ring (make-ring vc-maximum-comment-ring-size)))
+ (fillarray vc-file-prop-obarray 0))
(defmacro with-vc-properties (file form settings)
"Execute FORM, then maybe set per-file properties for FILE.
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
(mapcar (lambda (setting)
FILE is passed through `expand-file-name'; BODY executed within
`save-excursion'. If FILE is not under version control, or locked by
somebody else, signal error."
+ (declare (debug t) (indent 2))
(let ((filevar (make-symbol "file")))
`(let ((,filevar (expand-file-name ,file)))
(or (vc-backend ,filevar)
- (error (format "File not under version control: `%s'" file)))
+ (error "File not under version control: `%s'" file))
(unless (vc-editable-p ,filevar)
(let ((state (vc-state ,filevar)))
- (if (stringp state)
- (error (format "`%s' is locking `%s'" state ,filevar))
+ (if (stringp state)
+ (error "`%s' is locking `%s'" state ,filevar)
(vc-checkout ,filevar t))))
(save-excursion
,@body)
(vc-checkin ,filevar nil ,comment))))
-(put 'with-vc-file 'lisp-indent-function 2)
-
;;;###autoload
(defmacro edit-vc-file (file comment &rest body)
"Edit FILE under version control, executing body.
Checkin with COMMENT after executing BODY.
This macro uses `with-vc-file', passing args to it.
However, before executing BODY, find FILE, and after BODY, save buffer."
+ (declare (debug t) (indent 2))
(let ((filevar (make-symbol "file")))
`(let ((,filevar (expand-file-name ,file)))
(with-vc-file
,@body
(save-buffer)))))
-(put 'edit-vc-file 'lisp-indent-function 2)
-
(defun vc-ensure-vc-buffer ()
"Make sure that the current buffer visits a version-controlled file."
(if vc-dired-mode
(set-buffer (find-file-noselect (dired-get-filename)))
(while vc-parent-buffer
(pop-to-buffer vc-parent-buffer))
- (if (not (buffer-file-name))
+ (if (not buffer-file-name)
(error "Buffer %s is not associated with a file" (buffer-name))
- (if (not (vc-backend (buffer-file-name)))
- (error "File %s is not under version control" (buffer-file-name))))))
-
-(defvar vc-binary-assoc nil)
-(defvar vc-binary-suffixes
- (if (memq system-type '(ms-dos windows-nt))
- '(".exe" ".com" ".bat" ".cmd" ".btm" "")
- '("")))
+ (if (not (vc-backend buffer-file-name))
+ (error "File %s is not under version control" buffer-file-name)))))
(defun vc-process-filter (p s)
"An alternative output filter for async process P.
Each function is called inside the buffer in which the command was run
and is passed 3 arguments: the COMMAND, the FILE and the FLAGS.")
+(defvar w32-quote-process-args)
;;;###autoload
(defun vc-do-command (buffer okstatus command file &rest flags)
"Execute a VC command, notifying user and checking for errors.
(string= (buffer-name) buffer))
(eq buffer (current-buffer)))
(vc-setup-buffer buffer))
- (let ((squeezed nil)
+ (let ((squeezed (remq nil flags))
(inhibit-read-only t)
(status 0))
- (setq squeezed (delq nil (copy-sequence flags)))
(when file
;; FIXME: file-relative-name can return a bogus result because
;; it doesn't look at the actual file-system to see if symlinks
(mark-active nil)
;; We may want to reparse the compilation buffer after revert
(reparse (and (boundp 'compilation-error-list) ;compile loaded
- (let ((curbuf (current-buffer)))
- ;; Construct a list; each elt is nil or a buffer
- ;; iff that buffer is a compilation output buffer
- ;; that contains markers into the current buffer.
- (save-excursion
- (mapcar (lambda (buffer)
- (set-buffer buffer)
- (let ((errors (or
- compilation-old-error-list
- compilation-error-list))
- (buffer-error-marked-p nil))
- (while (and (consp errors)
- (not buffer-error-marked-p))
- (and (markerp (cdr (car errors)))
- (eq buffer
- (marker-buffer
- (cdr (car errors))))
- (setq buffer-error-marked-p t))
- (setq errors (cdr errors)))
- (if buffer-error-marked-p buffer)))
- (buffer-list)))))))
+ ;; Construct a list; each elt is nil or a buffer
+ ;; iff that buffer is a compilation output buffer
+ ;; that contains markers into the current buffer.
+ (save-current-buffer
+ (mapcar (lambda (buffer)
+ (set-buffer buffer)
+ (let ((errors (or
+ compilation-old-error-list
+ compilation-error-list))
+ (buffer-error-marked-p nil))
+ (while (and (consp errors)
+ (not buffer-error-marked-p))
+ (and (markerp (cdr (car errors)))
+ (eq buffer
+ (marker-buffer
+ (cdr (car errors))))
+ (setq buffer-error-marked-p t))
+ (setq errors (cdr errors)))
+ (if buffer-error-marked-p buffer)))
+ (buffer-list))))))
(list point-context mark-context reparse)))
(defun vc-restore-buffer-context (context)
(unless not-urgent
(error "Aborted")))))
-(defun vc-workfile-unchanged-p (file)
- "Return non-nil if FILE has not changed since the last checkout."
- (let ((checkout-time (vc-file-getprop file 'vc-checkout-time))
- (lastmod (nth 5 (file-attributes file))))
- (if checkout-time
- (equal checkout-time lastmod)
- (let ((unchanged (vc-call workfile-unchanged-p file)))
- (vc-file-setprop file 'vc-checkout-time (if unchanged lastmod 0))
- unchanged))))
-
-(defun vc-default-workfile-unchanged-p (backend file)
- "Check if FILE is unchanged by diffing against the master version.
-Return non-nil if FILE is unchanged."
- (zerop (vc-call diff file (vc-workfile-version file))))
-
(defun vc-default-latest-on-branch-p (backend file)
"Return non-nil if FILE is the latest on its branch.
This default implementation always returns non-nil, which means that
(let ((visited (get-file-buffer file))
state version)
(when visited
+ (if vc-dired-mode
+ (switch-to-buffer-other-window visited)
+ (set-buffer visited))
;; Check relation of buffer and file, and make sure
;; user knows what he's doing. First, finding the file
;; will check whether the file on disk is newer.
- (if vc-dired-mode
- (find-file-other-window file)
- (set-buffer (find-file-noselect file)))
+ ;; Ignore buffer-read-only during this test, and
+ ;; preserve find-file-literally.
+ (let ((buffer-read-only (not (file-writable-p file))))
+ (find-file-noselect file nil find-file-literally))
(if (not (verify-visited-file-modtime (current-buffer)))
(if (yes-or-no-p "Replace file on disk with buffer contents? ")
- (write-file (buffer-file-name))
+ (write-file buffer-file-name)
(error "Aborted"))
;; Now, check if we have unsaved changes.
(vc-buffer-sync t)
(if (yes-or-no-p (format
"%s is not up-to-date. Get latest version? "
(file-name-nondirectory file)))
- (vc-checkout file (eq (vc-checkout-model file) 'implicit) "")
+ (vc-checkout file (eq (vc-checkout-model file) 'implicit) t)
(if (and (not (eq (vc-checkout-model file) 'implicit))
(yes-or-no-p "Lock this version? "))
(vc-checkout file t)
(yes-or-no-p (concat "File has unlocked changes. "
"Claim lock retaining changes? ")))
(progn (vc-call steal-lock file)
+ (clear-visited-file-modtime)
;; Must clear any headers here because they wouldn't
;; show that the file is locked now.
(vc-clear-headers file)
+ (write-file buffer-file-name)
(vc-mode-line file))
(if (not (yes-or-no-p
"Revert to checked-in version, instead? "))
(defun vc-next-action-dired (file rev comment)
"Call `vc-next-action-on-file' on all the marked files.
Ignores FILE and REV, but passes on COMMENT."
- (let ((dired-buffer (current-buffer))
- (dired-dir default-directory))
+ (let ((dired-buffer (current-buffer)))
(dired-map-over-marks
(let ((file (dired-get-filename)))
(message "Processing %s..." file)
(if set-version
(read-string (format "Initial version level for %s: "
(buffer-name)))
- ;; TODO: Use backend-specific init version.
- vc-default-init-version)
+ (let ((backend (vc-responsible-backend buffer-file-name)))
+ (if (vc-find-backend-function backend 'init-version)
+ (vc-call-backend backend 'init-version)
+ vc-default-init-version)))
(or comment (not vc-initial-comment))
nil
"Enter initial comment."
(if (not (yes-or-no-p (format "Steal the lock on %s from %s? "
file-description owner)))
(error "Steal canceled"))
- (compose-mail owner (format "Stolen lock on %s" file-description)
- nil nil nil nil
- (list (list 'vc-finish-steal file rev)))
+ (message "Stealing lock on %s..." file)
+ (with-vc-properties
+ file
+ (vc-call steal-lock file rev)
+ `((vc-state . edited)))
+ (vc-resynch-buffer file t t)
+ (message "Stealing lock on %s...done" file)
+ ;; Write mail after actually stealing, because if the stealing
+ ;; goes wrong, we don't want to send any mail.
+ (compose-mail owner (format "Stolen lock on %s" file-description))
(setq default-directory (expand-file-name "~/"))
(goto-char (point-max))
(insert
".\n")
(message "Please explain why you stole the lock. Type C-c C-c when done.")))
-(defun vc-finish-steal (file version)
- ;; This is called when the notification has been sent.
- (message "Stealing lock on %s..." file)
- (with-vc-properties
- file
- (vc-call steal-lock file version)
- `((vc-state . edited)))
- (vc-resynch-buffer file t t)
- (message "Stealing lock on %s...done" file))
-
(defun vc-checkin (file &optional rev comment initial-contents)
"Check in FILE.
The optional argument REV may be a string specifying the new version
(message "Checking in %s...done" file))
'vc-checkin-hook))
-(defun vc-comment-to-change-log (&optional whoami file-name)
- "Enter last VC comment into the change log for the current file.
-WHOAMI (interactive prefix) non-nil means prompt for user name
-and site. FILE-NAME is the name of the change log; if nil, use
-`change-log-default-name'.
-
-This may be useful as a `vc-checkin-hook' to update change logs
-automatically."
- (interactive (if current-prefix-arg
- (list current-prefix-arg
- (prompt-for-change-log-name))))
- ;; Make sure the defvar for add-log-current-defun-function has been executed
- ;; before binding it.
- (require 'add-log)
- (let (;; Extract the comment first so we get any error before doing anything.
- (comment (ring-ref vc-comment-ring 0))
- ;; Don't let add-change-log-entry insert a defun name.
- (add-log-current-defun-function 'ignore)
- end)
- ;; Call add-log to do half the work.
- (add-change-log-entry whoami file-name t t)
- ;; Insert the VC comment, leaving point before it.
- (setq end (save-excursion (insert comment) (point-marker)))
- (if (looking-at "\\s *\\s(")
- ;; It starts with an open-paren, as in "(foo): Frobbed."
- ;; So remove the ": " add-log inserted.
- (delete-char -2))
- ;; Canonicalize the white space between the file name and comment.
- (just-one-space)
- ;; Indent rest of the text the same way add-log indented the first line.
- (let ((indentation (current-indentation)))
- (save-excursion
- (while (< (point) end)
- (forward-line 1)
- (indent-to indentation))
- (setq end (point))))
- ;; Fill the inserted text, preserving open-parens at bol.
- (let ((paragraph-separate (concat paragraph-separate "\\|\\s *\\s("))
- (paragraph-start (concat paragraph-start "\\|\\s *\\s(")))
- (beginning-of-line)
- (fill-region (point) end))
- ;; Canonicalize the white space at the end of the entry so it is
- ;; separated from the next entry by a single blank line.
- (skip-syntax-forward " " end)
- (delete-char (- (skip-syntax-backward " ")))
- (or (eobp) (looking-at "\n\n")
- (insert "\n"))))
-
(defun vc-finish-logentry (&optional nocomment)
"Complete the operation implied by the current log entry.
Use the contents of the current buffer as a check-in or registration
comment. If the optional arg NOCOMMENT is non-nil, then don't check
-the buffer contents as a comment, and don't add it to
-`vc-comment-ring'."
+the buffer contents as a comment."
(interactive)
;; Check and record the comment, if any.
(unless nocomment
(vc-call-backend (or (and vc-log-file (vc-backend vc-log-file))
(vc-responsible-backend default-directory))
'logentry-check)
- (run-hooks 'vc-logentry-check-hook)
- ;; Record the comment in the comment ring
- (let ((comment (buffer-string)))
- (unless (and (ring-p vc-comment-ring)
- (not (ring-empty-p vc-comment-ring))
- (equal comment (ring-ref vc-comment-ring 0)))
- (ring-insert vc-comment-ring comment))))
+ (run-hooks 'vc-logentry-check-hook))
;; Sync parent buffer in case the user modified it while editing the comment.
;; But not if it is a vc-dired buffer.
(with-current-buffer vc-parent-buffer
;; Code for access to the comment ring
-(defun vc-new-comment-index (stride len)
- "Return the comment index STRIDE elements from the current one.
-LEN is the length of `vc-comment-ring'."
- (mod (cond
- (vc-comment-ring-index (+ vc-comment-ring-index stride))
- ;; Initialize the index on the first use of this command
- ;; so that the first M-p gets index 0, and the first M-n gets
- ;; index -1.
- ((> stride 0) (1- stride))
- (t stride))
- len))
-
-(defun vc-previous-comment (arg)
- "Cycle backwards through comment history.
-With a numeric prefix ARG, go back ARG comments."
- (interactive "*p")
- (let ((len (ring-length vc-comment-ring)))
- (if (<= len 0)
- (progn (message "Empty comment ring") (ding))
- (erase-buffer)
- (setq vc-comment-ring-index (vc-new-comment-index arg len))
- (message "Comment %d" (1+ vc-comment-ring-index))
- (insert (ring-ref vc-comment-ring vc-comment-ring-index)))))
-
-(defun vc-next-comment (arg)
- "Cycle forwards through comment history.
-With a numeric prefix ARG, go forward ARG comments."
- (interactive "*p")
- (vc-previous-comment (- arg)))
-
-(defun vc-comment-search-reverse (str &optional stride)
- "Search backwards through comment history for substring match of STR.
-If the optional argument STRIDE is present, that is a step-width to use
-when going through the comment ring."
- ;; Why substring rather than regexp ? -sm
- (interactive
- (list (read-string "Comment substring: " nil nil vc-last-comment-match)))
- (unless stride (setq stride 1))
- (if (string= str "")
- (setq str vc-last-comment-match)
- (setq vc-last-comment-match str))
- (let* ((str (regexp-quote str))
- (len (ring-length vc-comment-ring))
- (n (vc-new-comment-index stride len)))
- (while (progn (when (or (>= n len) (< n 0)) (error "Not found"))
- (not (string-match str (ring-ref vc-comment-ring n))))
- (setq n (+ n stride)))
- (setq vc-comment-ring-index n)
- (vc-previous-comment 0)))
-
-(defun vc-comment-search-forward (str)
- "Search forwards through comment history for a substring match of STR."
- (interactive
- (list (read-string "Comment substring: " nil nil vc-last-comment-match)))
- (vc-comment-search-reverse str -1))
-
;; Additional entry points for examining version histories
;;;###autoload
(setq rel1-default (vc-workfile-version file)))
;; if the file is not locked, use last and previous version as default
(t
- (setq rel1-default (vc-previous-version (vc-workfile-version file)))
+ (setq rel1-default (vc-call previous-version file
+ (vc-workfile-version file)))
(if (string= rel1-default "") (setq rel1-default nil))
(setq rel2-default (vc-workfile-version file))))
;; construct argument list
(coding-system-for-read (vc-coding-system-for-diff file)))
(if (and file-rel1 file-rel2)
(apply 'vc-do-command "*vc-diff*" 1 "diff" nil
- (append (if (listp diff-switches)
- diff-switches
- (list diff-switches))
- (if (listp vc-diff-switches)
- vc-diff-switches
- (list vc-diff-switches))
- (list (file-relative-name file-rel1)
- (file-relative-name file-rel2))))
+ (append (vc-switches nil 'diff)
+ (list (file-relative-name file-rel1)
+ (file-relative-name file-rel2))))
(vc-call diff file rel1 rel2))))
-(defmacro vc-diff-switches-list (backend)
- "Return the list of switches to use for executing diff under BACKEND."
- `(append
- (if (listp diff-switches) diff-switches (list diff-switches))
- (if (listp vc-diff-switches) vc-diff-switches (list vc-diff-switches))
- (let ((backend-switches
- (eval (intern (concat "vc-" (symbol-name ',backend)
- "-diff-switches")))))
- (if (listp backend-switches) backend-switches (list backend-switches)))))
+
+(defun vc-switches (backend op)
+ (let ((switches
+ (or (if backend
+ (let ((sym (vc-make-backend-sym
+ backend (intern (concat (symbol-name op)
+ "-switches")))))
+ (if (boundp sym) (symbol-value sym))))
+ (let ((sym (intern (format "vc-%s-switches" (symbol-name op)))))
+ (if (boundp sym) (symbol-value sym)))
+ (cond
+ ((eq op 'diff) diff-switches)))))
+ (if (stringp switches) (list switches)
+ ;; If not a list, return nil.
+ ;; This is so we can set vc-diff-switches to t to override
+ ;; any switches in diff-switches.
+ (if (listp switches) switches))))
+
+;; Old def for compatibility with Emacs-21.[123].
+(defmacro vc-diff-switches-list (backend) `(vc-switches ',backend 'diff))
+(make-obsolete 'vc-diff-switches-list 'vc-switches "21.4")
(defun vc-default-diff-tree (backend dir rel1 rel2)
"List differences for all registered files at and below DIR.
(if buf (with-current-buffer buf
buffer-file-coding-system)))
;; otherwise, try to find one based on the file name
- (car (find-operation-coding-system 'insert-file-contents
- file))
+ (car (find-operation-coding-system 'insert-file-contents file))
;; and a final fallback
'undecided))
(defun vc-find-version (file version)
"Read VERSION of FILE into a buffer and return the buffer."
(let ((automatic-backup (vc-version-backup-file-name file version))
- (manual-backup (vc-version-backup-file-name file version 'manual)))
- (unless (file-exists-p manual-backup)
+ (filebuf (or (get-file-buffer file) (current-buffer)))
+ (filename (vc-version-backup-file-name file version 'manual)))
+ (unless (file-exists-p filename)
(if (file-exists-p automatic-backup)
- (rename-file automatic-backup manual-backup nil)
- (vc-call checkout file nil version manual-backup)))
- (find-file-noselect manual-backup)))
+ (rename-file automatic-backup filename nil)
+ (message "Checking out %s..." filename)
+ (with-current-buffer filebuf
+ (let ((failed t))
+ (unwind-protect
+ (let ((coding-system-for-read 'no-conversion)
+ (coding-system-for-write 'no-conversion))
+ (with-temp-file filename
+ (let ((outbuf (current-buffer)))
+ ;; Change buffer to get local value of
+ ;; vc-checkout-switches.
+ (with-current-buffer filebuf
+ (vc-call find-version file version outbuf))))
+ (setq failed nil))
+ (if (and failed (file-exists-p filename))
+ (delete-file filename))))
+ (vc-mode-line file))
+ (message "Checking out %s...done" filename)))
+ (find-file-noselect filename)))
+
+(defun vc-default-find-version (backend file rev buffer)
+ "Provide the new `find-version' op based on the old `checkout' op.
+This is only for compatibility with old backends. They should be updated
+to provide the `find-version' operation instead."
+ (let ((tmpfile (make-temp-file (expand-file-name file))))
+ (unwind-protect
+ (progn
+ (vc-call-backend backend 'checkout file nil rev tmpfile)
+ (with-current-buffer buffer
+ (insert-file-contents-literally tmpfile)))
+ (delete-file tmpfile))))
;; Header-insertion code
(let* ((delims (cdr (assq major-mode vc-comment-alist)))
(comment-start-vc (or (car delims) comment-start "#"))
(comment-end-vc (or (car (cdr delims)) comment-end ""))
- (hdsym (vc-make-backend-sym (vc-backend (buffer-file-name))
+ (hdsym (vc-make-backend-sym (vc-backend buffer-file-name)
'header))
(hdstrings (and (boundp hdsym) (symbol-value hdsym))))
(mapcar (lambda (s)
(defun vc-maybe-resolve-conflicts (file status &optional name-A name-B)
(vc-resynch-buffer file t (not (buffer-modified-p)))
(if (zerop status) (message "Merge successful")
- (if (fboundp 'smerge-mode) (smerge-mode 1))
+ (smerge-mode 1)
(if (y-or-n-p "Conflicts detected. Resolve them now? ")
- (if (fboundp 'smerge-ediff)
- (smerge-ediff)
- (vc-resolve-conflicts name-A name-B))
+ (vc-resolve-conflicts name-A name-B)
(message "File contains conflict markers"))))
-(defvar vc-ediff-windows)
-(defvar vc-ediff-result)
-(eval-when-compile
- (defvar ediff-buffer-A)
- (defvar ediff-buffer-B)
- (defvar ediff-buffer-C)
- (require 'ediff-util))
;;;###autoload
-(defun vc-resolve-conflicts (&optional name-A name-B)
- "Invoke ediff to resolve conflicts in the current buffer.
-The conflicts must be marked with rcsmerge conflict markers."
- (interactive)
- (vc-ensure-vc-buffer)
- (let* ((found nil)
- (file-name (file-name-nondirectory buffer-file-name))
- (your-buffer (generate-new-buffer
- (concat "*" file-name
- " " (or name-A "WORKFILE") "*")))
- (other-buffer (generate-new-buffer
- (concat "*" file-name
- " " (or name-B "CHECKED-IN") "*")))
- (result-buffer (current-buffer)))
- (save-excursion
- (set-buffer your-buffer)
- (erase-buffer)
- (insert-buffer result-buffer)
- (goto-char (point-min))
- (while (re-search-forward (concat "^<<<<<<< "
- (regexp-quote file-name) "\n") nil t)
- (setq found t)
- (replace-match "")
- (if (not (re-search-forward "^=======\n" nil t))
- (error "Malformed conflict marker"))
- (replace-match "")
- (let ((start (point)))
- (if (not (re-search-forward "^>>>>>>> [0-9.]+\n" nil t))
- (error "Malformed conflict marker"))
- (delete-region start (point))))
- (if (not found)
- (progn
- (kill-buffer your-buffer)
- (kill-buffer other-buffer)
- (error "No conflict markers found")))
- (set-buffer other-buffer)
- (erase-buffer)
- (insert-buffer result-buffer)
- (goto-char (point-min))
- (while (re-search-forward (concat "^<<<<<<< "
- (regexp-quote file-name) "\n") nil t)
- (let ((start (match-beginning 0)))
- (if (not (re-search-forward "^=======\n" nil t))
- (error "Malformed conflict marker"))
- (delete-region start (point))
- (if (not (re-search-forward "^>>>>>>> [0-9.]+\n" nil t))
- (error "Malformed conflict marker"))
- (replace-match "")))
- (let ((config (current-window-configuration))
- (ediff-default-variant 'default-B))
-
- ;; Fire up ediff.
-
- (set-buffer (ediff-merge-buffers your-buffer other-buffer))
-
- ;; Ediff is now set up, and we are in the control buffer.
- ;; Do a few further adjustments and take precautions for exit.
-
- (make-local-variable 'vc-ediff-windows)
- (setq vc-ediff-windows config)
- (make-local-variable 'vc-ediff-result)
- (setq vc-ediff-result result-buffer)
- (make-local-variable 'ediff-quit-hook)
- (setq ediff-quit-hook
- (lambda ()
- (let ((buffer-A ediff-buffer-A)
- (buffer-B ediff-buffer-B)
- (buffer-C ediff-buffer-C)
- (result vc-ediff-result)
- (windows vc-ediff-windows))
- (ediff-cleanup-mess)
- (set-buffer result)
- (erase-buffer)
- (insert-buffer buffer-C)
- (kill-buffer buffer-A)
- (kill-buffer buffer-B)
- (kill-buffer buffer-C)
- (set-window-configuration windows)
- (message "Conflict resolution finished; you may save the buffer"))))
- (message "Please resolve conflicts now; exit ediff when done")
- nil))))
+(defalias 'vc-resolve-conflicts 'smerge-ediff)
;; The VC directory major mode. Coopt Dired for this.
;; All VC commands get mapped into logical equivalents.
(set-keymap-parent vc-dired-mode-map dired-mode-map)
(add-hook 'dired-after-readin-hook 'vc-dired-hook nil t)
;; The following is slightly modified from dired.el,
- ;; because file lines look a bit different in vc-dired-mode.
+ ;; because file lines look a bit different in vc-dired-mode
+ ;; (the column before the date does not end in a digit).
(set (make-local-variable 'dired-move-to-filename-regexp)
- (let*
- ((l "\\([A-Za-z]\\|[^\0-\177]\\)")
- ;; In some locales, month abbreviations are as short as 2 letters,
- ;; and they can be padded on the right with spaces.
- (month (concat l l "+ *"))
- ;; Recognize any non-ASCII character.
- ;; The purpose is to match a Kanji character.
- (k "[^\0-\177]")
- ;; (k "[^\x00-\x7f\x80-\xff]")
- (s " ")
- (yyyy "[0-9][0-9][0-9][0-9]")
- (mm "[ 0-1][0-9]")
- (dd "[ 0-3][0-9]")
- (HH:MM "[ 0-2][0-9]:[0-5][0-9]")
- (western (concat "\\(" month s dd "\\|" dd s month "\\)"
- s "\\(" HH:MM "\\|" s yyyy"\\|" yyyy s "\\)"))
- (japanese (concat mm k s dd k s "\\(" s HH:MM "\\|" yyyy k "\\)")))
- ;; the .* below ensures that we find the last match on a line
- (concat ".*" s "\\(" western "\\|" japanese "\\)" s)))
+ (let* ((l "\\([A-Za-z]\\|[^\0-\177]\\)")
+ ;; In some locales, month abbreviations are as short as 2 letters,
+ ;; and they can be followed by ".".
+ (month (concat l l "+\\.?"))
+ (s " ")
+ (yyyy "[0-9][0-9][0-9][0-9]")
+ (dd "[ 0-3][0-9]")
+ (HH:MM "[ 0-2][0-9]:[0-5][0-9]")
+ (seconds "[0-6][0-9]\\([.,][0-9]+\\)?")
+ (zone "[-+][0-2][0-9][0-5][0-9]")
+ (iso-mm-dd "[01][0-9]-[0-3][0-9]")
+ (iso-time (concat HH:MM "\\(:" seconds "\\( ?" zone "\\)?\\)?"))
+ (iso (concat "\\(\\(" yyyy "-\\)?" iso-mm-dd "[ T]" iso-time
+ "\\|" yyyy "-" iso-mm-dd "\\)"))
+ (western (concat "\\(" month s "+" dd "\\|" dd "\\.?" s month "\\)"
+ s "+"
+ "\\(" HH:MM "\\|" yyyy "\\)"))
+ (western-comma (concat month s "+" dd "," s "+" yyyy))
+ ;; Japanese MS-Windows ls-lisp has one-digit months, and
+ ;; omits the Kanji characters after month and day-of-month.
+ (mm "[ 0-1]?[0-9]")
+ (japanese
+ (concat mm l "?" s dd l "?" s "+"
+ "\\(" HH:MM "\\|" yyyy l "?" "\\)")))
+ ;; the .* below ensures that we find the last match on a line
+ (concat ".*" s
+ "\\(" western "\\|" western-comma "\\|" japanese "\\|" iso "\\)"
+ s "+")))
(and (boundp 'vc-dired-switches)
vc-dired-switches
(set (make-local-variable 'dired-actual-switches)
((eq state 'needs-patch) "(patch)")
((eq state 'unlocked-changes) "(stale)"))))
-(defun vc-dired-reformat-line (x)
+(defun vc-dired-reformat-line (vc-info)
"Reformat a directory-listing line.
-Replace various columns with version control information.
+Replace various columns with version control information, VC-INFO.
This code, like dired, assumes UNIX -l format."
(beginning-of-line)
- (let ((pos (point)) limit perm date-and-file)
- (end-of-line)
- (setq limit (point))
- (goto-char pos)
- (when
- (or
- (re-search-forward ;; owner and group
- "^\\(..[drwxlts-]+ \\) *[0-9]+ [^ ]+ +[^ ]+ +[0-9]+\\( .*\\)"
- limit t)
- (re-search-forward ;; only owner displayed
- "^\\(..[drwxlts-]+ \\) *[0-9]+ [^ ]+ +[0-9]+\\( .*\\)"
- limit t)
- (re-search-forward ;; OS/2 -l format, no links, owner, group
- "^\\(..[drwxlts-]+ \\) *[0-9]+\\( .*\\)"
- limit t))
- (setq perm (match-string 1)
- date-and-file (match-string 2))
- (setq x (substring (concat x " ") 0 10))
- (replace-match (concat perm x date-and-file)))))
+ (when (re-search-forward
+ ;; Match link count, owner, group, size. Group may be missing,
+ ;; and only the size is present in OS/2 -l format.
+ "^..[drwxlts-]+ \\( *[0-9]+\\( [^ ]+ +\\([^ ]+ +\\)?[0-9]+\\)?\\) "
+ (line-end-position) t)
+ (replace-match (substring (concat vc-info " ") 0 10)
+ t t nil 1)))
(defun vc-dired-hook ()
"Reformat the listing according to version control.
Called by dired after any portion of a vc-dired buffer has been read in."
(message "Getting version information... ")
- (let (subdir filename (buffer-read-only nil) cvs-dir)
+ (let (subdir filename (buffer-read-only nil))
(goto-char (point-min))
(while (not (eobp))
(cond
(defun vc-dired-purge ()
"Remove empty subdirs."
- (let (subdir)
- (goto-char (point-min))
- (while (setq subdir (dired-get-subdir))
- (forward-line 2)
- (if (dired-get-filename nil t)
- (if (not (dired-next-subdir 1 t))
- (goto-char (point-max)))
- (forward-line -2)
- (if (not (string= (dired-current-directory) default-directory))
- (dired-do-kill-lines t "")
- ;; We cannot remove the top level directory.
- ;; Just make it look a little nicer.
- (forward-line 1)
- (kill-line)
- (if (not (dired-next-subdir 1 t))
- (goto-char (point-max))))))
- (goto-char (point-min))))
+ (goto-char (point-min))
+ (while (dired-get-subdir)
+ (forward-line 2)
+ (if (dired-get-filename nil t)
+ (if (not (dired-next-subdir 1 t))
+ (goto-char (point-max)))
+ (forward-line -2)
+ (if (not (string= (dired-current-directory) default-directory))
+ (dired-do-kill-lines t "")
+ ;; We cannot remove the top level directory.
+ ;; Just make it look a little nicer.
+ (forward-line 1)
+ (or (eobp) (kill-line))
+ (if (not (dired-next-subdir 1 t))
+ (goto-char (point-max))))))
+ (goto-char (point-min)))
(defun vc-dired-buffers-for-dir (dir)
"Return a list of all vc-dired buffers that currently display DIR."
(vc-file-tree-walk
dir
(lambda (f) (and
- (vc-up-to-date-p f)
- (vc-error-occurred
- (vc-call checkout f nil "")
- (if update (vc-resynch-buffer f t t)))))))
+ (vc-up-to-date-p f)
+ (vc-error-occurred
+ (vc-call checkout f nil "")
+ (if update (vc-resynch-buffer f t t)))))))
(let ((result (vc-snapshot-precondition dir)))
(if (stringp result)
(error "File %s is locked" result)
(vc-file-tree-walk
dir
(lambda (f) (vc-error-occurred
- (vc-call checkout f nil name)
- (if update (vc-resynch-buffer f t t)))))))))
+ (vc-call checkout f nil name)
+ (if update (vc-resynch-buffer f t t)))))))))
;; Miscellaneous other entry points
;;;###autoload
-(defun vc-print-log ()
- "List the change log of the current buffer in a window."
+(defun vc-print-log (&optional focus-rev)
+ "List the change log of the current buffer in a window. If
+FOCUS-REV is non-nil, leave the point at that revision."
(interactive)
(vc-ensure-vc-buffer)
(let ((file buffer-file-name))
+ (or focus-rev (setq focus-rev (vc-workfile-version file)))
(vc-call print-log file)
(set-buffer "*vc*")
(pop-to-buffer (current-buffer))
- (if (fboundp 'log-view-mode) (log-view-mode))
+ (log-view-mode)
(vc-exec-after
`(let ((inhibit-read-only t))
(goto-char (point-max)) (forward-line -1)
(delete-char (- (match-end 0) (match-beginning 0))))
(shrink-window-if-larger-than-buffer)
;; move point to the log entry for the current version
- (if (fboundp 'log-view-goto-rev)
- (log-view-goto-rev ',(vc-workfile-version file))
- (if (vc-find-backend-function ',(vc-backend file) 'show-log-entry)
- (vc-call-backend ',(vc-backend file)
- 'show-log-entry
- ',(vc-workfile-version file))))
+ (vc-call-backend ',(vc-backend file)
+ 'show-log-entry
+ ',focus-rev)
(set-buffer-modified-p nil)))))
+(defun vc-default-show-log-entry (backend rev)
+ (with-no-warnings
+ (log-view-goto-rev rev)))
+
(defun vc-default-comment-history (backend file)
"Return a string with all log entries stored in BACKEND for FILE."
(if (vc-find-backend-function backend 'print-log)
- (with-temp-buffer
+ (with-current-buffer "*vc*"
(vc-call print-log file)
(vc-call wash-log file)
(buffer-string))))
changes found in the master file; use \\[universal-argument] \\[vc-next-action] to do so."
(interactive)
(vc-ensure-vc-buffer)
+ ;; Make sure buffer is saved. If the user says `no', abort since
+ ;; we cannot show the changes and ask for confirmation to discard them.
+ (vc-buffer-sync nil)
(let ((file buffer-file-name)
;; This operation should always ask for confirmation.
(vc-suppress-confirm nil)
(vc-revert-file file)
(message "Reverting %s...done" file)))
+;;;###autoload
+(defun vc-update ()
+ "Update the current buffer's file to the latest version on its branch.
+If the file contains no changes, and is not locked, then this simply replaces
+the working file with the latest version on its branch. If the file contains
+changes, and the backend supports merging news, then any recent changes from
+the current branch are merged into the working file."
+ (interactive)
+ (vc-ensure-vc-buffer)
+ (vc-buffer-sync nil)
+ (let ((file buffer-file-name))
+ (if (vc-up-to-date-p file)
+ (vc-checkout file nil "")
+ (if (eq (vc-checkout-model file) 'locking)
+ (if (eq (vc-state file) 'edited)
+ (error
+ (substitute-command-keys
+ "File is locked--type \\[vc-revert-buffer] to discard changes"))
+ (error
+ (substitute-command-keys
+ "Unexpected file state (%s)--type \\[vc-next-action] to correct")
+ (vc-state file)))
+ (if (not (vc-find-backend-function (vc-backend file) 'merge-news))
+ (error "Sorry, merging news is not implemented for %s"
+ (vc-backend file))
+ (vc-call merge-news file)
+ (vc-resynch-window file t t))))))
+
(defun vc-version-backup-file (file &optional rev)
"Return name of backup file for revision REV of FILE.
If version backups should be used for FILE, and there exists
A prefix argument NOREVERT means do not revert the buffer afterwards."
(interactive "P")
(vc-ensure-vc-buffer)
- (let* ((file (buffer-file-name))
+ (let* ((file buffer-file-name)
(backend (vc-backend file))
- (target (vc-workfile-version file))
- (config (current-window-configuration)) done)
+ (target (vc-workfile-version file)))
(cond
((not (vc-find-backend-function backend 'cancel-version))
(error "Sorry, canceling versions is not supported under %s" backend))
((not (vc-call latest-on-branch-p file))
(error "This is not the latest version; VC cannot cancel it"))
((not (vc-up-to-date-p file))
- (error (substitute-command-keys "File is not up to date; use \\[vc-revert-buffer] to discard changes"))))
+ (error "%s" (substitute-command-keys "File is not up to date; use \\[vc-revert-buffer] to discard changes"))))
(if (null (yes-or-no-p (format "Remove version %s from master? " target)))
(error "Aborted")
(setq norevert (or norevert (not
;; `registered' might have switched under us.
(vc-switch-backend file old-backend)
(let* ((rev (vc-workfile-version file))
- (modified-file (and edited (make-temp-name file)))
+ (modified-file (and edited (make-temp-file file)))
(unmodified-file (and modified-file (vc-version-backup-file file))))
;; Go back to the base unmodified file.
(unwind-protect
(progn
(when modified-file
- (copy-file file modified-file)
+ (copy-file file modified-file 'ok-if-already-exists)
;; If we have a local copy of the unmodified file, handle that
;; here and not in vc-revert-file because we don't want to
;; delete that copy -- it is still useful for OLD-BACKEND.
(if unmodified-file
- (copy-file unmodified-file file 'ok-if-already-exists)
+ (copy-file unmodified-file file
+ 'ok-if-already-exists 'keep-date)
(if (y-or-n-p "Get base version from master? ")
(vc-revert-file file))))
(vc-call-backend new-backend 'receive-file file rev))
oldmaster
(catch 'found
;; If possible, keep the master file in the same directory.
- (mapcar (lambda (f)
- (if (and f (string= (file-name-directory (expand-file-name f))
- dir))
- (throw 'found f)))
- masters)
+ (dolist (f masters)
+ (if (and f (string= (file-name-directory (expand-file-name f)) dir))
+ (throw 'found f)))
;; If not, just use the first possible place.
- (mapcar (lambda (f)
- (and f
- (or (not (setq dir (file-name-directory f)))
- (file-directory-p dir))
- (throw 'found f)))
- masters)
+ (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")))))
+(defun vc-delete-file (file)
+ "Delete file and mark it as such in the version control system."
+ (interactive "fVC delete file: ")
+ (let ((buf (get-file-buffer file))
+ (backend (vc-backend file)))
+ (unless backend
+ (error "File %s is not under version control"
+ (file-name-nondirectory file)))
+ (unless (vc-find-backend-function backend 'delete-file)
+ (error "Deleting files under %s is not supported in VC" backend))
+ (if (and buf (buffer-modified-p buf))
+ (error "Please save files before deleting them"))
+ (unless (y-or-n-p (format "Really want to delete %s ? "
+ (file-name-nondirectory file)))
+ (error "Abort!"))
+ (unless (or (file-directory-p file) (null make-backup-files))
+ (with-current-buffer (or buf (find-file-noselect file))
+ (let ((backup-inhibited nil))
+ (backup-buffer))))
+ (vc-call delete-file file)
+ ;; If the backend hasn't deleted the file itself, let's do it for him.
+ (if (file-exists-p file) (delete-file file))))
+
+(defun vc-default-rename-file (backend old new)
+ (condition-case nil
+ (add-name-to-file old new)
+ (error (rename-file old new)))
+ (vc-delete-file old)
+ (with-current-buffer (find-file-noselect new)
+ (vc-register)))
+
;;;###autoload
(defun vc-rename-file (old new)
"Rename file OLD to NEW, and rename its master file likewise."
(interactive "fVC rename file: \nFRename to: ")
- (let ((oldbuf (get-file-buffer old))
- (backend (vc-backend old)))
- (unless (or (null backend) (vc-find-backend-function backend 'rename-file))
- (error "Renaming files under %s is not supported in VC" backend))
+ (let ((oldbuf (get-file-buffer old)))
(if (and oldbuf (buffer-modified-p oldbuf))
(error "Please save files before moving them"))
(if (get-file-buffer new)
(error "Already editing new file name"))
(if (file-exists-p new)
(error "New file already exists"))
- (when backend
- (if (and backend (not (vc-up-to-date-p old)))
- (error "Please check in files before moving them"))
- (vc-call-backend backend 'rename-file old new))
+ (let ((state (vc-state old)))
+ (unless (memq state '(up-to-date edited))
+ (error "Please %s files before moving them"
+ (if (stringp state) "check in" "update"))))
+ (vc-call rename-file old new)
+ (vc-file-clearprops old)
;; Move the actual file (unless the backend did it already)
- (if (or (not backend) (file-exists-p old))
- (rename-file old new))
+ (if (file-exists-p old) (rename-file old new))
;; ?? Renaming a file might change its contents due to keyword expansion.
;; We should really check out a new copy if the old copy was precisely equal
;; to some checked in version. However, testing for this is tricky....
(let ((odefault default-directory)
(changelog (find-change-log))
;; Presumably not portable to non-Unixy systems, along with rcs2log:
- (tempfile (funcall
- (if (fboundp 'make-temp-file) 'make-temp-file 'make-temp-name)
+ (tempfile (make-temp-file
(expand-file-name "vc"
(or small-temporary-file-directory
temporary-file-directory))))
(defvar vc-annotate-ratio nil "Global variable.")
(defvar vc-annotate-backend nil "Global variable.")
+;; internal buffer-local variables
+(defvar vc-annotate-parent-file nil)
+(defvar vc-annotate-parent-rev nil)
+(defvar vc-annotate-parent-display-mode nil)
+
+(defconst vc-annotate-font-lock-keywords
+ ;; The fontification is done by vc-annotate-lines instead of font-lock.
+ '((vc-annotate-lines)))
+
(defun vc-annotate-get-backend (buffer)
"Return the backend matching \"Annotate\" buffer BUFFER.
-Return NIL if no match made. Associations are made based on
+Return nil if no match made. Associations are made based on
`vc-annotate-buffers'."
(cdr (assoc buffer vc-annotate-buffers)))
You can use the mode-specific menu to alter the time-span of the used
colors. See variable `vc-annotate-menu-elements' for customizing the
menu items."
+ (set (make-local-variable 'truncate-lines) t)
+ (set (make-local-variable 'font-lock-defaults)
+ '(vc-annotate-font-lock-keywords t))
+ (view-mode 1)
(vc-annotate-add-menu))
(defun vc-annotate-display-default (&optional ratio)
(unless (eq vc-annotate-display-mode 'fullscale)
(vc-annotate-display-select nil 'fullscale))
:style toggle :selected
- (eq vc-annotate-display-mode 'fullscale)])))
+ (eq vc-annotate-display-mode 'fullscale)])
+ (list "--")
+ (list ["Annotate previous revision"
+ (call-interactively 'vc-annotate-prev-version)])
+ (list ["Annotate next revision"
+ (call-interactively 'vc-annotate-next-version)])
+ (list ["Annotate revision at line"
+ (vc-annotate-revision-at-line)])
+ (list ["Annotate revision previous to line"
+ (vc-annotate-revision-previous-to-line)])
+ (list ["Annotate latest revision"
+ (vc-annotate-workfile-version)])
+ (list ["Show log of revision at line"
+ (vc-annotate-show-log-revision-at-line)])
+ (list ["Show diff of revision at line"
+ (vc-annotate-show-diff-revision-at-line)])))
+
;; Define the menu
(if (or (featurep 'easymenu) (load "easymenu" t))
(easy-menu-define vc-annotate-mode-menu vc-annotate-mode-map
(display-buffer buffer))
(if (not vc-annotate-mode) ; Turn on vc-annotate-mode if not done
(vc-annotate-mode))
- (cond ((null vc-annotate-display-mode) (vc-annotate-display-default
- vc-annotate-ratio))
- ((symbolp vc-annotate-display-mode) ; One of the auto-scaling modes
- (cond ((eq vc-annotate-display-mode 'scale)
- (vc-annotate-display-autoscale))
- ((eq vc-annotate-display-mode 'fullscale)
- (vc-annotate-display-autoscale t))
- (t (error "No such display mode: %s"
- vc-annotate-display-mode))))
+ (cond ((null vc-annotate-display-mode)
+ (vc-annotate-display-default vc-annotate-ratio))
+ ;; One of the auto-scaling modes
+ ((eq vc-annotate-display-mode 'scale)
+ (vc-annotate-display-autoscale))
+ ((eq vc-annotate-display-mode 'fullscale)
+ (vc-annotate-display-autoscale t))
((numberp vc-annotate-display-mode) ; A fixed number of days lookback
(vc-annotate-display-default
(/ vc-annotate-display-mode (vc-annotate-car-last-cons
vc-annotate-color-map))))
- (t (error "Error in display mode select"))))
+ (t (error "No such display mode: %s"
+ vc-annotate-display-mode))))
;;;; (defun vc-BACKEND-annotate-command (file buffer) ...)
;;;; Execute "annotate" on FILE by using `call-process' and insert
;;;; the contents in BUFFER.
;;;###autoload
-(defun vc-annotate (prefix)
+(defun vc-annotate (prefix &optional revision display-mode)
"Display the edit history of the current file using colours.
This command creates a buffer that shows, for each line of the current
colors. `vc-annotate-background' specifies the background color."
(interactive "P")
(vc-ensure-vc-buffer)
- (let* ((temp-buffer-name (concat "*Annotate " (buffer-name) "*"))
+ (let* ((temp-buffer-name nil)
(temp-buffer-show-function 'vc-annotate-display-select)
- (rev (vc-workfile-version (buffer-file-name)))
+ (rev (or revision (vc-workfile-version buffer-file-name)))
+ (bfn buffer-file-name)
(vc-annotate-version
- (if prefix (read-string
- (format "Annotate from version: (default %s) " rev)
- nil nil rev)
- rev)))
- (if prefix
- (setq vc-annotate-display-mode
- (float (string-to-number
- (read-string "Annotate span days: (default 20) "
- nil nil "20")))))
- (setq vc-annotate-backend (vc-backend (buffer-file-name)))
+ (if prefix (read-string
+ (format "Annotate from version: (default %s) " rev)
+ nil nil rev)
+ rev)))
+ (if display-mode
+ (setq vc-annotate-display-mode display-mode)
+ (if prefix
+ (setq vc-annotate-display-mode
+ (float (string-to-number
+ (read-string "Annotate span days: (default 20) "
+ nil nil "20"))))))
+ (setq temp-buffer-name (format "*Annotate %s (rev %s)*"
+ (buffer-name) vc-annotate-version))
+ (setq vc-annotate-backend (vc-backend buffer-file-name))
(message "Annotating...")
(if (not (vc-find-backend-function vc-annotate-backend 'annotate-command))
(error "Sorry, annotating is not implemented for %s"
vc-annotate-backend))
(with-output-to-temp-buffer temp-buffer-name
(vc-call-backend vc-annotate-backend 'annotate-command
- (file-name-nondirectory (buffer-file-name))
+ buffer-file-name
(get-buffer temp-buffer-name)
vc-annotate-version))
+ (save-excursion
+ (set-buffer temp-buffer-name)
+ (set (make-local-variable 'vc-annotate-parent-file) bfn)
+ (set (make-local-variable 'vc-annotate-parent-rev) vc-annotate-version)
+ (set (make-local-variable 'vc-annotate-parent-display-mode)
+ vc-annotate-display-mode))
+
;; Don't use the temp-buffer-name until the buffer is created
;; (only after `with-output-to-temp-buffer'.)
(setq vc-annotate-buffers
(list (cons (get-buffer temp-buffer-name) vc-annotate-backend))))
(message "Annotating... done")))
+(defun vc-annotate-prev-version (prefix)
+ "Visit the annotation of the version previous to this one.
+
+With a numeric prefix argument, annotate the version that many
+versions previous."
+ (interactive "p")
+ (vc-annotate-warp-version (- 0 prefix)))
+
+(defun vc-annotate-next-version (prefix)
+ "Visit the annotation of the version after this one.
+
+With a numeric prefix argument, annotate the version that many
+versions after."
+ (interactive "p")
+ (vc-annotate-warp-version prefix))
+
+(defun vc-annotate-workfile-version ()
+ "Visit the annotation of the workfile version of this file."
+ (interactive)
+ (if (not (equal major-mode 'vc-annotate-mode))
+ (message "Cannot be invoked outside of a vc annotate buffer")
+ (let ((warp-rev (vc-workfile-version vc-annotate-parent-file)))
+ (if (equal warp-rev vc-annotate-parent-rev)
+ (message "Already at version %s" warp-rev)
+ (vc-annotate-warp-version warp-rev)))))
+
+(defun vc-annotate-extract-revision-at-line ()
+ "Extract the revision number of the current line."
+ ;; This function must be invoked from a buffer in vc-annotate-mode
+ (save-window-excursion
+ (vc-ensure-vc-buffer)
+ (setq vc-annotate-backend (vc-backend buffer-file-name)))
+ (vc-call-backend vc-annotate-backend 'annotate-extract-revision-at-line))
+
+(defun vc-annotate-revision-at-line ()
+ "Visit the annotation of the version identified in the current line."
+ (interactive)
+ (if (not (equal major-mode 'vc-annotate-mode))
+ (message "Cannot be invoked outside of a vc annotate buffer")
+ (let ((rev-at-line (vc-annotate-extract-revision-at-line)))
+ (if (not rev-at-line)
+ (message "Cannot extract revision number from the current line")
+ (if (equal rev-at-line vc-annotate-parent-rev)
+ (message "Already at version %s" rev-at-line)
+ (vc-annotate-warp-version rev-at-line))))))
+
+(defun vc-annotate-revision-previous-to-line ()
+ "Visit the annotation of the version before the version at line."
+ (interactive)
+ (if (not (equal major-mode 'vc-annotate-mode))
+ (message "Cannot be invoked outside of a vc annotate buffer")
+ (let ((rev-at-line (vc-annotate-extract-revision-at-line))
+ (prev-rev nil))
+ (if (not rev-at-line)
+ (message "Cannot extract revision number from the current line")
+ (setq prev-rev
+ (vc-call previous-version vc-annotate-parent-file rev-at-line))
+ (vc-annotate-warp-version prev-rev)))))
+
+(defun vc-annotate-show-log-revision-at-line ()
+ "Visit the log of the version at line."
+ (interactive)
+ (if (not (equal major-mode 'vc-annotate-mode))
+ (message "Cannot be invoked outside of a vc annotate buffer")
+ (let ((rev-at-line (vc-annotate-extract-revision-at-line)))
+ (if (not rev-at-line)
+ (message "Cannot extract revision number from the current line")
+ (vc-print-log rev-at-line)))))
+
+(defun vc-annotate-show-diff-revision-at-line ()
+ "Visit the diff of the version at line from its previous version."
+ (interactive)
+ (if (not (equal major-mode 'vc-annotate-mode))
+ (message "Cannot be invoked outside of a vc annotate buffer")
+ (let ((rev-at-line (vc-annotate-extract-revision-at-line))
+ (prev-rev nil))
+ (if (not rev-at-line)
+ (message "Cannot extract revision number from the current line")
+ (setq prev-rev
+ (vc-call previous-version vc-annotate-parent-file rev-at-line))
+ (if (not prev-rev)
+ (message "Cannot diff from any version prior to %s" rev-at-line)
+ (save-window-excursion
+ (vc-version-diff vc-annotate-parent-file prev-rev rev-at-line))
+ (switch-to-buffer "*vc-diff*"))))))
+
+(defun vc-annotate-warp-version (revspec)
+ "Annotate the version described by REVSPEC.
+
+If REVSPEC is a positive integer, warp that many versions
+forward, if possible, otherwise echo a warning message. If
+REVSPEC is a negative integer, warp that many versions backward,
+if possible, otherwise echo a warning message. If REVSPEC is a
+string, then it describes a revision number, so warp to that
+revision."
+ (if (not (equal major-mode 'vc-annotate-mode))
+ (message "Cannot be invoked outside of a vc annotate buffer")
+ (let* ((oldline (line-number-at-pos))
+ (revspeccopy revspec)
+ (newrev nil))
+ (cond
+ ((and (integerp revspec) (> revspec 0))
+ (setq newrev vc-annotate-parent-rev)
+ (while (and (> revspec 0) newrev)
+ (setq newrev (vc-call next-version
+ vc-annotate-parent-file newrev))
+ (setq revspec (1- revspec)))
+ (if (not newrev)
+ (message "Cannot increment %d versions from version %s"
+ revspeccopy vc-annotate-parent-rev)))
+ ((and (integerp revspec) (< revspec 0))
+ (setq newrev vc-annotate-parent-rev)
+ (while (and (< revspec 0) newrev)
+ (setq newrev (vc-call previous-version
+ vc-annotate-parent-file newrev))
+ (setq revspec (1+ revspec)))
+ (if (not newrev)
+ (message "Cannot decrement %d versions from version %s"
+ (- 0 revspeccopy) vc-annotate-parent-rev)))
+ ((stringp revspec) (setq newrev revspec))
+ (t (error "Invalid argument to vc-annotate-warp-version")))
+ (when newrev
+ (save-window-excursion
+ (find-file vc-annotate-parent-file)
+ (vc-annotate nil newrev vc-annotate-parent-display-mode))
+ (kill-buffer (current-buffer)) ;; kill the buffer we started from
+ (switch-to-buffer (car (car (last vc-annotate-buffers))))
+ (goto-line (min oldline (progn (goto-char (point-max))
+ (previous-line)
+ (line-number-at-pos))))))))
+
(defun vc-annotate-car-last-cons (a-list)
"Return car of last cons in association list A-LIST."
(if (not (eq nil (cdr a-list)))
"Return the current time, encoded as fractional days."
(vc-annotate-convert-time (current-time)))
+(defvar vc-annotate-offset nil)
+
(defun vc-annotate-display (&optional color-map offset)
"Highlight `vc-annotate' output in the current buffer.
-COLOR-MAP, if present, overrides `vc-annotate-color-map'. The
-annotations are relative to the current time, unless overridden by
-OFFSET.
-
-This function is obsolete, and has been replaced by
-`vc-annotate-select'."
- (save-excursion
- (goto-char (point-min)) ; Position at the top of the buffer.
- ;; Delete old overlays
- (mapcar
- (lambda (overlay)
- (if (overlay-get overlay 'vc-annotation)
- (delete-overlay overlay)))
- (overlays-in (point-min) (point-max)))
- (goto-char (point-min)) ; Position at the top of the buffer.
- (let (difference)
- (while (setq difference (vc-annotate-difference offset))
- (let*
- ((color (or (vc-annotate-compcar
- difference (or color-map vc-annotate-color-map))
- (cons nil vc-annotate-very-old-color)))
- ;; substring from index 1 to remove any leading `#' in the name
- (face-name (concat "vc-annotate-face-" (substring (cdr color) 1)))
- ;; Make the face if not done.
- (face (or (intern-soft face-name)
- (let ((tmp-face (make-face (intern face-name))))
- (set-face-foreground tmp-face (cdr color))
- (if vc-annotate-background
+COLOR-MAP, if present, overrides `vc-annotate-color-map'.
+The annotations are relative to the current time, unless overridden by OFFSET."
+ (if (and color-map (not (eq color-map vc-annotate-color-map)))
+ (set (make-local-variable 'vc-annotate-color-map) color-map))
+ (set (make-local-variable 'vc-annotate-offset) offset)
+ (font-lock-mode 1))
+
+(defun vc-annotate-lines (limit)
+ (let (difference)
+ (while (and (< (point) limit)
+ (setq difference (vc-annotate-difference vc-annotate-offset)))
+ (let* ((color (or (vc-annotate-compcar difference vc-annotate-color-map)
+ (cons nil vc-annotate-very-old-color)))
+ ;; substring from index 1 to remove any leading `#' in the name
+ (face-name (concat "vc-annotate-face-" (substring (cdr color) 1)))
+ ;; Make the face if not done.
+ (face (or (intern-soft face-name)
+ (let ((tmp-face (make-face (intern face-name))))
+ (set-face-foreground tmp-face (cdr color))
+ (if vc-annotate-background
(set-face-background tmp-face
vc-annotate-background))
- tmp-face))) ; Return the face
- (point (point))
- overlay)
+ tmp-face))) ; Return the face
+ (point (point)))
(forward-line 1)
- (setq overlay (make-overlay point (point)))
- (overlay-put overlay 'face face)
- (overlay-put overlay 'vc-annotation t))))))
+ (put-text-property point (point) 'face face)))
+ ;; Pretend to font-lock there were no matches.
+ nil))
\f
;; Collect back-end-dependent stuff here
;; Set up key bindings for use while editing log messages
-(define-derived-mode vc-log-mode text-mode "VC-Log"
- "Major mode for editing VC log entries.
-These bindings are added to the global keymap when you enter this mode:
-\\[vc-next-action] perform next logical version-control operation on current file
-\\[vc-register] register current file
-\\[vc-toggle-read-only] like next-action, but won't register files
-\\[vc-insert-headers] insert version-control headers in current file
-\\[vc-print-log] display change history of current file
-\\[vc-revert-buffer] revert buffer to latest version
-\\[vc-cancel-version] undo latest checkin
-\\[vc-diff] show diffs between file versions
-\\[vc-version-other-window] visit old version in another window
-\\[vc-directory] show all files locked by any user in or below .
-\\[vc-annotate] colorful display of the cvs annotate command
-\\[vc-update-change-log] add change log entry from recent checkins
-
-While you are entering a change log message for a version, the following
-additional bindings will be in effect.
-
-\\[vc-finish-logentry] proceed with check in, ending log message entry
-
-Whenever you do a checkin, your log comment is added to a ring of
-saved comments. These can be recalled as follows:
-
-\\[vc-next-comment] replace region with next message in comment ring
-\\[vc-previous-comment] replace region with previous message in comment ring
-\\[vc-comment-search-reverse] search backward for regexp in the comment ring
-\\[vc-comment-search-forward] search backward for regexp in the comment ring
-
-Entry to the change-log submode calls the value of `text-mode-hook', then
-the value of `vc-log-mode-hook'.
-
-Global user options:
- `vc-initial-comment' If non-nil, require user to enter a change
- comment upon first checkin of the file.
-
- `vc-keep-workfiles' Non-nil value prevents workfiles from being
- deleted when changes are checked in
-
- `vc-suppress-confirm' Suppresses some confirmation prompts.
-
- vc-BACKEND-header Which keywords to insert when adding headers
- with \\[vc-insert-headers]. Defaults to
- '(\"\%\W\%\") under SCCS, '(\"\$Id\$\") under
- RCS and CVS.
-
- `vc-static-header-alist' By default, version headers inserted in C files
- get stuffed in a static string area so that
- ident(RCS/CVS) or what(SCCS) can see them in
- the compiled object code. You can override
- this by setting this variable to nil, or change
- the header template by changing it.
-
- `vc-command-messages' if non-nil, display run messages from the
- actual version-control utilities (this is
- intended primarily for people hacking vc
- itself)."
- (make-local-variable 'vc-comment-ring-index))
-
(defun vc-log-edit (file)
- "Set up `log-edit' for use with VC on FILE.
-If `log-edit' is not available, resort to `vc-log-mode'."
+ "Set up `log-edit' for use with VC on FILE."
(setq default-directory
(if file (file-name-directory file)
(with-current-buffer vc-parent-buffer default-directory)))
- (if (fboundp 'log-edit)
- (log-edit 'vc-finish-logentry nil
- (if file `(lambda () ',(list (file-name-nondirectory file)))
- ;; If FILE is nil, we were called from vc-dired.
- (lambda ()
- (with-current-buffer vc-parent-buffer
- (dired-get-marked-files t)))))
- (vc-log-mode))
+ (log-edit 'vc-finish-logentry nil
+ (if file `(lambda () ',(list (file-name-nondirectory file)))
+ ;; If FILE is nil, we were called from vc-dired.
+ (lambda ()
+ (with-current-buffer vc-parent-buffer
+ (dired-get-marked-files t)))))
(set (make-local-variable 'vc-log-file) file)
(make-local-variable 'vc-log-version)
(set-buffer-modified-p nil)
;;
;; Thus, there is no explicit recovery code.
+;;; arch-tag: ca82c1de-3091-4e26-af92-460abc6213a6
;;; vc.el ends here
HCoop / bpt / emacs.git / blobdiff