;;; 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.345 2002/11/03 14:48:37 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. (Note that vc-BACKEND-diff must not run
+;; vc-BACKEND-diff. (Note that vc-BACKEND-diff must not run
;; asynchronously in this case.)
;;
;; - mode-line-string (file)
;; 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. The implementation should pass the value of vc-checkout-switches
+;; 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).
;; 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.
+;; 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 ()
;;
;; 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:
: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)))
- (set-keymap-parent map text-mode-map)
- (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.
(substring rev (match-beginning 0) (match-end 0)))
(defun vc-default-previous-version (backend file rev)
- "Guess the version number immediately preceding REV for FILE.
-This default implementation works for <major>.<minor>-style version numbers
-as used by RCS and CVS."
+ "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))))
(when 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)
(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)
;; 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))
+ (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)
(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-call previous-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))))
(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-symbol
- (intern (concat "vc-" (downcase (symbol-name ,backend))
- "-diff-switches")))
- (backend-switches
- (if (boundp backend-switches-symbol)
- (eval backend-switches-symbol)
- nil)))
- (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.
(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)
Replace various columns with version control information, VC-INFO.
This code, like dired, assumes UNIX -l format."
(beginning-of-line)
- (when (re-search-forward
+ (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]+\\)?\\) "
"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))
;; move point to the log entry for the current version
(vc-call-backend ',(vc-backend file)
'show-log-entry
- ',(vc-workfile-version file))
+ ',focus-rev)
(set-buffer-modified-p nil)))))
(defun vc-default-show-log-entry (backend rev)
- (log-view-goto-rev 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."
"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
+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-checkout file nil "")
(if (eq (vc-checkout-model file) 'locking)
(if (eq (vc-state file) 'edited)
- (error
- (substitute-command-keys
+ (error
+ (substitute-command-keys
"File is locked--type \\[vc-revert-buffer] to discard changes"))
- (error
+ (error
(substitute-command-keys
- "Unexpected file state (%s)--type \\[vc-next-action] to correct")
+ "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"
+ (error "Sorry, merging news is not implemented for %s"
(vc-backend file))
(vc-call merge-news file)
(vc-resynch-window file t t))))))
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
;; 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....
(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)))
(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
;;;; 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-display-select'."
+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))
-(defvar vc-annotate-offset nil)
-
(defun vc-annotate-lines (limit)
(let (difference)
(while (and (< (point) limit)
(set-face-background tmp-face
vc-annotate-background))
tmp-face))) ; Return the face
- (point (point))
- overlay)
+ (point (point)))
(forward-line 1)
(put-text-property point (point) 'face face)))
;; Pretend to font-lock there were no matches.
;;
;; Thus, there is no explicit recovery code.
+;;; arch-tag: ca82c1de-3091-4e26-af92-460abc6213a6
;;; vc.el ends here
HCoop / bpt / emacs.git / blobdiff