;;; vc.el --- drive a version-control system from within Emacs
-;; Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 93, 94, 95, 96, 97 Free Software Foundation, Inc.
-;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
-;; Modified by:
-;; ttn@netcom.com
-;; Per Cederqvist <ceder@lysator.liu.edu>
-;; Andre Spiegel <spiegel@berlin.informatik.uni-stuttgart.de>
+;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
+;; Maintainer: Andre Spiegel <spiegel@inf.fu-berlin.de>
;; This file is part of GNU Emacs.
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; Paul Eggert <eggert@twinsun.com>, Sebastian Kremer <sk@thp.uni-koeln.de>,
;; and Richard Stallman contributed valuable criticism, support, and testing.
;; CVS support was added by Per Cederqvist <ceder@lysator.liu.se>
-;; in Jan-Feb 1994.
+;; in Jan-Feb 1994. Further enhancements came from ttn.netcom.com and
+;; Andre Spiegel <spiegel@inf.fu-berlin.de>.
;;
;; Supported version-control systems presently include SCCS, RCS, and CVS.
;;
;; General customization
-(defvar vc-suppress-confirm nil
- "*If non-nil, treat user as expert; suppress yes-no prompts on some things.")
-(defvar vc-initial-comment nil
- "*If non-nil, prompt for initial comment when a file is registered.")
-(defvar vc-command-messages nil
- "*If non-nil, display run messages from back-end commands.")
-(defvar vc-checkin-switches nil
- "*A string or list of strings specifying extra switches passed
-to the checkin program by \\[vc-checkin].")
-(defvar vc-checkout-switches nil
- "*A string or list of strings specifying extra switches passed
-to the checkout program by \\[vc-checkout].")
-(defvar vc-directory-exclusion-list '("SCCS" "RCS" "CVS")
- "*A list of directory names ignored by functions that recursively
-walk file trees.")
+(defgroup vc nil
+ "Version-control system in Emacs."
+ :group 'tools)
+
+(defcustom vc-suppress-confirm nil
+ "*If non-nil, treat user as expert; suppress yes-no prompts on some things."
+ :type 'boolean
+ :group 'vc)
+
+(defcustom vc-initial-comment nil
+ "*If non-nil, prompt for initial comment when a file is registered."
+ :type 'boolean
+ :group 'vc)
+
+(defcustom vc-command-messages nil
+ "*If non-nil, display run messages from back-end commands."
+ :type 'boolean
+ :group 'vc)
+
+(defcustom vc-checkin-switches nil
+ "*A string or list of strings specifying extra switches for checkin.
+These are passed to the checkin program by \\[vc-checkin]."
+ :type '(choice (const :tag "None" nil)
+ (string :tag "Argument String")
+ (repeat :tag "Argument List"
+ :value ("")
+ string))
+ :group 'vc)
+
+(defcustom vc-checkout-switches nil
+ "*A string or list of strings specifying extra switches for checkout.
+These are passed to the checkout program by \\[vc-checkout]."
+ :type '(choice (const :tag "None" nil)
+ (string :tag "Argument String")
+ (repeat :tag "Argument List"
+ :value ("")
+ string))
+ :group 'vc)
+
+(defcustom vc-register-switches nil
+ "*A string or list of strings; extra switches for registering a file.
+These are passed to the checkin program by \\[vc-register]."
+ :type '(choice (const :tag "None" nil)
+ (string :tag "Argument String")
+ (repeat :tag "Argument List"
+ :value ("")
+ string))
+ :group 'vc)
+
+(defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS")
+ "*List of directory names to be ignored while recursively walking file trees."
+ :type '(repeat string)
+ :group 'vc)
(defconst vc-maximum-comment-ring-size 32
"Maximum number of saved comments in the comment ring.")
;;; This is duplicated in diff.el.
+;;; ...and customized.
(defvar diff-switches "-c"
"*A string or list of strings specifying switches to be be passed to diff.")
;;;###autoload
-(defvar vc-checkin-hook nil
- "*List of functions called after a checkin is done. See `run-hooks'.")
+(defcustom vc-checkin-hook nil
+ "*Normal hook (List of functions) run after a checkin is done.
+See `run-hooks'."
+ :type 'hook
+ :group 'vc)
-(defvar vc-make-buffer-writable-hook nil
- "*List of functions called when a buffer is made writable. See `run-hooks.'
-This hook is only used when the version control system is CVS. It
-might be useful for sites who uses locking with CVS, or who uses link
-farms to gold trees.")
+;;;###autoload
+(defcustom vc-before-checkin-hook nil
+ "*Normal hook (list of functions) run before a file gets checked in.
+See `run-hooks'."
+ :type 'hook
+ :group 'vc)
;; Header-insertion hair
-(defvar vc-header-alist
+(defcustom vc-header-alist
'((SCCS "\%W\%") (RCS "\$Id\$") (CVS "\$Id\$"))
"*Header keywords to be inserted by `vc-insert-headers'.
Must be a list of two-element lists, the first element of each must
be `RCS', `CVS', or `SCCS'. The second element is the string to
-be inserted for this particular backend.")
-(defvar vc-static-header-alist
+be inserted for this particular backend."
+ :type '(repeat (list :format "%v"
+ (choice :tag "System"
+ (const SCCS)
+ (const RCS)
+ (const CVS))
+ (string :tag "Header")))
+ :group 'vc)
+
+(defcustom vc-static-header-alist
'(("\\.c$" .
"\n#ifndef lint\nstatic char vcid[] = \"\%s\";\n#endif /* lint */\n"))
"*Associate static header string templates with file types. A \%s in the
template is replaced with the first string associated with the file's
-version-control type in `vc-header-alist'.")
+version-control type in `vc-header-alist'."
+ :type '(repeat (cons :format "%v"
+ (regexp :tag "File Type")
+ (string :tag "Header String")))
+ :group 'vc)
-(defvar vc-comment-alist
+(defcustom vc-comment-alist
'((nroff-mode ".\\\"" ""))
"*Special comment delimiters to be used in generating vc headers only.
Add an entry in this list if you need to override the normal comment-start
and comment-end variables. This will only be necessary if the mode language
-is sensitive to blank lines.")
+is sensitive to blank lines."
+ :type '(repeat (list :format "%v"
+ (symbol :tag "Mode")
+ (string :tag "Comment Start")
+ (string :tag "Comment End")))
+ :group 'vc)
;; Default is to be extra careful for super-user.
-(defvar vc-checkout-carefully (= (user-uid) 0)
+(defcustom vc-checkout-carefully (= (user-uid) 0)
"*Non-nil means be extra-careful in checkout.
Verify that the file really is not locked
-and that its contents match what the master file says.")
+and that its contents match what the master file says."
+ :type 'boolean
+ :group 'vc)
-(defvar vc-rcs-release nil
+(defcustom vc-rcs-release nil
"*The release number of your RCS installation, as a string.
-If nil, VC itself computes this value when it is first needed.")
+If nil, VC itself computes this value when it is first needed."
+ :type '(choice (const :tag "Auto" nil)
+ string)
+ :group 'vc)
-(defvar vc-sccs-release nil
+(defcustom vc-sccs-release nil
"*The release number of your SCCS installation, as a string.
-If nil, VC itself computes this value when it is first needed.")
+If nil, VC itself computes this value when it is first needed."
+ :type '(choice (const :tag "Auto" nil)
+ string)
+ :group 'vc)
-(defvar vc-cvs-release nil
+(defcustom vc-cvs-release nil
"*The release number of your CVS installation, as a string.
-If nil, VC itself computes this value when it is first needed.")
+If nil, VC itself computes this value when it is first needed."
+ :type '(choice (const :tag "Auto" nil)
+ string)
+ :group 'vc)
;; Variables the user doesn't need to know about.
(defvar vc-log-entry-mode nil)
(defvar vc-dired-mode nil)
(make-variable-buffer-local 'vc-dired-mode)
-(defvar vc-comment-ring nil)
+(defvar vc-comment-ring (make-ring vc-maximum-comment-ring-size))
(defvar vc-comment-ring-index nil)
(defvar vc-last-comment-match nil)
(cond
((eq backend 'RCS)
(or vc-rcs-release
- (and (zerop (vc-do-command nil 2 "rcs" nil nil "-V"))
+ (and (zerop (vc-do-command nil nil "rcs" nil nil "-V"))
(save-excursion
(set-buffer (get-buffer "*vc*"))
(setq vc-rcs-release
(fillarray vc-file-prop-obarray nil)
;; 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 nil))
+ (setq vc-comment-ring (make-ring vc-maximum-comment-ring-size)))
(defun vc-file-clear-masterprops (file)
;; clear all properties of FILE that were retrieved
"Execute a version-control command, notifying user and checking for errors.
Output from COMMAND goes to BUFFER, or *vc* if BUFFER is nil.
The command is successful if its exit status does not exceed OKSTATUS.
+ (If OKSTATUS is nil, that means to ignore errors.)
The last argument of the command is the master name of FILE if LAST is
`MASTER', or the workfile of FILE if LAST is `WORKFILE'; this is appended
to an optional list of FLAGS."
(cons (concat "PATH=" (getenv "PATH")
path-separator
(mapconcat 'identity vc-path path-separator))
- process-environment)))
+ process-environment))
+ (w32-quote-process-args t))
(setq status (apply 'call-process command nil t nil squeezed)))
(goto-char (point-max))
(set-buffer-modified-p nil)
(forward-line -1)
- (if (or (not (integerp status)) (< okstatus status))
+ (if (or (not (integerp status)) (and okstatus (< okstatus status)))
(progn
(pop-to-buffer buffer)
(goto-char (point-min))
(vc-resynch-buffer file t (not (buffer-modified-p buffer)))))
(error "%s needs update" (buffer-name))))
- ;; if there is no lock on the file, assert one and get it
- ((not (setq owner (vc-locking-user file)))
+ ;; If there is no lock on the file, assert one and get it.
+ ;; (With implicit checkout, make sure not to lose unsaved changes.)
+ ((progn (and (eq (vc-checkout-model file) 'implicit)
+ (buffer-modified-p buffer)
+ (vc-buffer-sync))
+ (not (setq owner (vc-locking-user file))))
(if (and vc-checkout-carefully
(not (vc-workfile-unchanged-p file t)))
(if (save-window-excursion
;; a checked-out version exists, but the user may not own the lock
((and (not (eq vc-type 'CVS))
- (not (string-equal owner (user-login-name))))
+ (not (string-equal owner (vc-user-login-name))))
(if comment
(error "Sorry, you can't steal the lock on %s this way" file))
(and (eq vc-type 'RCS)
(dired-buffer (current-buffer))
(dired-dir default-directory))
(dired-map-over-marks
- (let ((file (dired-get-filename)) p)
+ (let ((file (dired-get-filename)) p
+ (default-directory default-directory))
(message "Processing %s..." file)
;; Adjust the default directory so that checkouts
;; go to the right place.
;; Remember the file's buffer in vc-parent-buffer (current one if no file).
;; AFTER-HOOK specifies the local value for vc-log-operation-hook.
(let ((parent (if file (find-file-noselect file) (current-buffer))))
+ (if vc-before-checkin-hook
+ (if file
+ (save-excursion
+ (set-buffer parent)
+ (run-hooks 'vc-before-checkin-hook))
+ (run-hooks 'vc-before-checkin-hook)))
(if comment
(set-buffer (get-buffer-create "*VC-log*"))
(pop-to-buffer (get-buffer-create "*VC-log*")))
(set (make-local-variable 'vc-parent-buffer-name)
(concat " from " (buffer-name vc-parent-buffer)))
(if file (vc-mode-line file))
- (vc-log-mode)
+ (vc-log-mode file)
(make-local-variable 'vc-log-after-operation-hook)
(if after-hook
(setq vc-log-after-operation-hook after-hook))
(setq vc-log-operation action)
- (setq vc-log-file file)
(setq vc-log-version rev)
(if comment
(progn
;; Comment too long?
(vc-backend-logentry-check vc-log-file)
;; Record the comment in the comment ring
- (if (null vc-comment-ring)
- (setq vc-comment-ring (make-ring vc-maximum-comment-ring-size)))
(ring-insert vc-comment-ring (buffer-string))
))
;; Sync parent buffer in case the user modified it while editing the comment.
;; Now make sure we see the expanded headers
(if buffer-file-name
(vc-resynch-window buffer-file-name vc-keep-workfiles t))
- (run-hooks after-hook)))
+ (run-hooks after-hook 'vc-finish-logentry-hook)))
;; Code for access to the comment ring
checked in version of that file. This uses no arguments.
With a prefix argument, it reads the file name to use
and two version designators specifying which versions to compare."
- (interactive "P")
+ (interactive (list current-prefix-arg t))
(if vc-dired-mode
(set-buffer (find-file-noselect (dired-get-filename))))
(while vc-parent-buffer
limit t)
(setq perm (match-string 1)
date-and-file (match-string 2))))
- (if (numberp x) (setq x (or owner (number-to-string x))))
(if x (setq x (concat "(" x ")")))
(let ((rep (substring (concat x " ") 0 10)))
(replace-match (concat perm rep date-and-file)))))
(vc-backend-print-log file)
(pop-to-buffer (get-buffer-create "*vc*"))
(setq default-directory (file-name-directory file))
+ (goto-char (point-max)) (forward-line -1)
(while (looking-at "=*\n")
(delete-char (- (match-end 0) (match-beginning 0)))
(forward-line -1))
(if (looking-at "[\b\t\n\v\f\r ]+")
(delete-char (- (match-end 0) (match-beginning 0))))
(shrink-window-if-larger-than-buffer)
+ ;; move point to the log entry for the current version
+ (and (not (eq (vc-backend file) 'SCCS))
+ (re-search-forward
+ ;; also match some context, for safety
+ (concat "----\nrevision " (vc-workfile-version file)
+ "\\(\tlocked by:.*\n\\|\n\\)date: ") nil t)
+ ;; set the display window so that
+ ;; the whole log entry is displayed
+ (let (start end lines)
+ (beginning-of-line) (forward-line -1) (setq start (point))
+ (if (not (re-search-forward "^----*\nrevision" nil t))
+ (setq end (point-max))
+ (beginning-of-line) (forward-line -1) (setq end (point)))
+ (setq lines (count-lines start end))
+ (cond
+ ;; if the global information and this log entry fit
+ ;; into the window, display from the beginning
+ ((< (count-lines (point-min) end) (window-height))
+ (goto-char (point-min))
+ (recenter 0)
+ (goto-char start))
+ ;; if the whole entry fits into the window,
+ ;; display it centered
+ ((< (1+ lines) (window-height))
+ (goto-char start)
+ (recenter (1- (- (/ (window-height) 2) (/ lines 2)))))
+ ;; otherwise (the entry is too large for the window),
+ ;; display from the start
+ (t
+ (goto-char start)
+ (recenter 0)))))
)
(vc-registration-error buffer-file-name)
)
(pop-to-buffer vc-parent-buffer))
(cond
((not (vc-registered (buffer-file-name)))
- (vc-registration-error (buffer-file-name))
- (eq (vc-backend (buffer-file-name)) 'CVS)
+ (vc-registration-error (buffer-file-name)))
+ ((eq (vc-backend (buffer-file-name)) 'CVS)
(error "Unchecking files under CVS is dangerous and not supported in VC"))
((vc-locking-user (buffer-file-name))
(error "This version is locked; use vc-revert-buffer to discard changes"))
;; Check out unlocked, and revert buffer.
(vc-checkout (buffer-file-name) nil recent))
(setq done t))
+ ;; If the checkout fails, vc-do-command signals an error.
+ ;; We catch this error, check the reason, correct the
+ ;; version number, and try a second time.
(error (set-buffer "*vc*")
(goto-char (point-min))
- (if (re-search-forward "no side branches present for" nil t)
+ (if (search-forward "no side branches present for" nil t)
(progn (setq recent (vc-branch-part recent))
+ ;; vc-do-command popped up a window with
+ ;; the error message. Get rid of it, by
+ ;; restoring the old window configuration.
(set-window-configuration config))
;; No, it was some other error: re-signal it.
(signal (car err) (cdr err))))))
(if oldbuf
(save-excursion
(set-buffer oldbuf)
- (set-visited-file-name new)
+ (let ((buffer-read-only buffer-read-only))
+ (set-visited-file-name new))
+ (vc-backend new)
+ (vc-mode-line new)
(set-buffer-modified-p nil))))
;; This had FILE, I changed it to OLD. -- rms.
(vc-backend-dispatch old
;;;###autoload
(defun vc-update-change-log (&rest args)
- "Find change log file and add entries from recent RCS logs.
+ "Find change log file and add entries from recent RCS/CVS logs.
+Normally, find log entries for all registered files in the default
+directory using `rcs2log', which finds CVS logs preferentially.
The mark is left at the end of the text prepended to the change log.
+
With prefix arg of C-u, only find log entries for the current buffer's file.
-With any numeric prefix arg, find log entries for all files currently visited.
-Otherwise, find log entries for all registered files in the default directory.
-From a program, any arguments are passed to the `rcs2log' script."
+
+With any numeric prefix arg, find log entries for all currently visited
+files that are under version control. This puts all the entries in the
+log for the default directory, which may not be appropriate.
+
+From a program, any arguments are assumed to be filenames and are
+passed to the `rcs2log' script after massaging to be relative to the
+default directory."
(interactive
(cond ((consp current-prefix-arg) ;C-u
(list buffer-file-name))
(setq buffers (cdr buffers)))
files))
(t
- (let ((RCS (concat default-directory "RCS")))
- (and (file-directory-p RCS)
- (mapcar (function
- (lambda (f)
- (if (string-match "\\(.*\\),v$" f)
- (substring f 0 (match-end 1))
- f)))
- (directory-files RCS nil "...\\|^[^.]\\|^.[^.]")))))))
- (let ((odefault default-directory))
- (find-file-other-window (find-change-log))
+ ;; `rcs2log' will find the relevant RCS or CVS files
+ ;; relative to the curent directory if none supplied.
+ nil)))
+ (let ((odefault default-directory)
+ (changelog (find-change-log))
+ ;; Presumably not portable to non-Unixy systems, along with rcs2log:
+ (tempfile (make-temp-name
+ (concat (file-name-as-directory
+ (directory-file-name (or (getenv "TMPDIR")
+ (getenv "TMP")
+ (getenv "TEMP")
+ "/tmp")))
+ "vc")))
+ (full-name (or add-log-full-name
+ (user-full-name)
+ (user-login-name)
+ (format "uid%d" (number-to-string (user-uid)))))
+ (mailing-address (or add-log-mailing-address
+ user-mail-address)))
+ (find-file-other-window changelog)
(barf-if-buffer-read-only)
(vc-buffer-sync)
(undo-boundary)
(push-mark)
(message "Computing change log entries...")
(message "Computing change log entries... %s"
- (if (or (null args)
- (eq 0 (apply 'call-process "rcs2log" nil t nil
- "-u"
- (concat (user-login-name)
- "\t"
- (user-full-name)
- "\t"
- user-mail-address)
- (mapcar (function
- (lambda (f)
- (file-relative-name
- (if (file-name-absolute-p f)
- f
- (concat odefault f)))))
- args))))
- "done" "failed"))))
+ (unwind-protect
+ (progn
+ (cd odefault)
+ (if (eq 0 (apply 'call-process "rcs2log" nil
+ (list t tempfile) nil
+ "-c" changelog
+ "-u" (concat (vc-user-login-name)
+ "\t" full-name
+ "\t" mailing-address)
+ (mapcar
+ (function
+ (lambda (f)
+ (file-relative-name
+ (if (file-name-absolute-p f)
+ f
+ (concat odefault f)))))
+ args)))
+ "done"
+ (pop-to-buffer
+ (set-buffer (get-buffer-create "*vc*")))
+ (erase-buffer)
+ (insert-file tempfile)
+ "failed"))
+ (cd (file-name-directory changelog))
+ (delete-file tempfile)))))
;; Collect back-end-dependent stuff here
(or vc-default-back-end
(setq vc-default-back-end (if (vc-find-binary "rcs") 'RCS 'SCCS)))
(message "Registering %s..." file)
- (let ((backend
+ (let ((switches
+ (if (stringp vc-register-switches)
+ (list vc-register-switches)
+ vc-register-switches))
+ (backend
(cond
((file-exists-p (vc-backend-subdirectory-name)) vc-default-back-end)
((file-exists-p "RCS") 'RCS)
((file-exists-p "CVS") 'CVS)
(t vc-default-back-end))))
(cond ((eq backend 'SCCS)
- (vc-do-command nil 0 "admin" file 'MASTER ;; SCCS
- (and rev (concat "-r" rev))
- "-fb"
- (concat "-i" file)
- (and comment (concat "-y" comment))
- (format
- (car (rassq 'SCCS vc-master-templates))
- (or (file-name-directory file) "")
- (file-name-nondirectory file)))
+ (apply 'vc-do-command nil 0 "admin" file 'MASTER ;; SCCS
+ (and rev (concat "-r" rev))
+ "-fb"
+ (concat "-i" file)
+ (and comment (concat "-y" comment))
+ (format
+ (car (rassq 'SCCS vc-master-templates))
+ (or (file-name-directory file) "")
+ (file-name-nondirectory file))
+ switches)
(delete-file file)
(if vc-keep-workfiles
(vc-do-command nil 0 "get" file 'MASTER)))
((eq backend 'RCS)
- (vc-do-command nil 0 "ci" file 'MASTER ;; RCS
- ;; if available, use the secure registering option
- (and (vc-backend-release-p 'RCS "5.6.4") "-i")
- (concat (if vc-keep-workfiles "-u" "-r") rev)
- (and comment (concat "-t-" comment))
- file))
+ (apply 'vc-do-command nil 0 "ci" file 'WORKFILE ;; RCS
+ ;; if available, use the secure registering option
+ (and (vc-backend-release-p 'RCS "5.6.4") "-i")
+ (concat (if vc-keep-workfiles "-u" "-r") rev)
+ (and comment (concat "-t-" comment))
+ switches))
((eq backend 'CVS)
- (vc-do-command nil 0 "cvs" file 'WORKFILE ;; CVS
- "add"
- (and comment (string-match "[^\t\n ]" comment)
- (concat "-m" comment)))
+ (apply 'vc-do-command nil 0 "cvs" file 'WORKFILE ;; CVS
+ "add"
+ (and comment (string-match "[^\t\n ]" comment)
+ (concat "-m" comment))
+ switches)
)))
(message "Registering %s...done" file)
)
;; Retrieve a copy of a saved version into a workfile
(let ((filename (or workfile file))
(file-buffer (get-file-buffer file))
- (old-default-dir default-directory)
switches)
(message "Checking out %s..." filename)
(save-excursion
(setq switches (if (stringp vc-checkout-switches)
(list vc-checkout-switches)
vc-checkout-switches))
- ;; Adjust the default-directory so that the check-out creates
- ;; the file in the right place. The old value is restored below.
- (setq default-directory (file-name-directory filename))
- (vc-backend-dispatch file
- (progn ;; SCCS
- (and rev (string= rev "") (setq rev nil))
- (if workfile
- ;; Some SCCS implementations allow checking out directly to a
- ;; file using the -G option, but then some don't so use the
- ;; least common denominator approach and use the -p option
- ;; ala RCS.
- (let ((vc-modes (logior (file-modes (vc-name file))
- (if writable 128 0)))
- (failed t))
- (unwind-protect
- (progn
- (apply 'vc-do-command
- nil 0 "/bin/sh" file 'MASTER "-c"
- ;; Some shells make the "" dummy argument into $0
- ;; while others use the shell's name as $0 and
- ;; use the "" as $1. The if-statement
- ;; converts the latter case to the former.
- (format "if [ x\"$1\" = x ]; then shift; fi; \
+ ;; Save this buffer's default-directory
+ ;; and use save-excursion to make sure it is restored
+ ;; in the same buffer it was saved in.
+ (let ((default-directory default-directory))
+ (save-excursion
+ ;; Adjust the default-directory so that the check-out creates
+ ;; the file in the right place.
+ (setq default-directory (file-name-directory filename))
+ (vc-backend-dispatch file
+ (progn ;; SCCS
+ (and rev (string= rev "") (setq rev nil))
+ (if workfile
+ ;; Some SCCS implementations allow checking out directly to a
+ ;; file using the -G option, but then some don't so use the
+ ;; least common denominator approach and use the -p option
+ ;; ala RCS.
+ (let ((vc-modes (logior (file-modes (vc-name file))
+ (if writable 128 0)))
+ (failed t))
+ (unwind-protect
+ (progn
+ (apply 'vc-do-command
+ nil 0 "/bin/sh" file 'MASTER "-c"
+ ;; Some shells make the "" dummy argument into $0
+ ;; while others use the shell's name as $0 and
+ ;; use the "" as $1. The if-statement
+ ;; converts the latter case to the former.
+ (format "if [ x\"$1\" = x ]; then shift; fi; \
umask %o; exec >\"$1\" || exit; \
shift; umask %o; exec get \"$@\""
- (logand 511 (lognot vc-modes))
- (logand 511 (lognot (default-file-modes))))
- "" ; dummy argument for shell's $0
- filename
- (if writable "-e")
- "-p"
- (and rev
- (concat "-r" (vc-lookup-triple file rev)))
- switches)
- (setq failed nil))
- (and failed (file-exists-p filename)
- (delete-file filename))))
- (apply 'vc-do-command nil 0 "get" file 'MASTER ;; SCCS
- (if writable "-e")
- (and rev (concat "-r" (vc-lookup-triple file rev)))
- switches)
- (vc-file-setprop file 'vc-workfile-version nil)))
- (if workfile ;; RCS
- ;; RCS doesn't let us check out into arbitrary file names directly.
- ;; Use `co -p' and make stdout point to the correct file.
- (let ((vc-modes (logior (file-modes (vc-name file))
- (if writable 128 0)))
- (failed t))
- (unwind-protect
- (progn
- (apply 'vc-do-command
- nil 0 "/bin/sh" file 'MASTER "-c"
- ;; See the SCCS case, above, regarding the
- ;; if-statement.
- (format "if [ x\"$1\" = x ]; then shift; fi; \
+ (logand 511 (lognot vc-modes))
+ (logand 511 (lognot (default-file-modes))))
+ "" ; dummy argument for shell's $0
+ filename
+ (if writable "-e")
+ "-p"
+ (and rev
+ (concat "-r" (vc-lookup-triple file rev)))
+ switches)
+ (setq failed nil))
+ (and failed (file-exists-p filename)
+ (delete-file filename))))
+ (apply 'vc-do-command nil 0 "get" file 'MASTER ;; SCCS
+ (if writable "-e")
+ (and rev (concat "-r" (vc-lookup-triple file rev)))
+ switches)
+ (vc-file-setprop file 'vc-workfile-version nil)))
+ (if workfile ;; RCS
+ ;; RCS doesn't let us check out into arbitrary file names directly.
+ ;; Use `co -p' and make stdout point to the correct file.
+ (let ((vc-modes (logior (file-modes (vc-name file))
+ (if writable 128 0)))
+ (failed t))
+ (unwind-protect
+ (progn
+ (apply 'vc-do-command
+ nil 0 "/bin/sh" file 'MASTER "-c"
+ ;; See the SCCS case, above, regarding the
+ ;; if-statement.
+ (format "if [ x\"$1\" = x ]; then shift; fi; \
umask %o; exec >\"$1\" || exit; \
shift; umask %o; exec co \"$@\""
- (logand 511 (lognot vc-modes))
- (logand 511 (lognot (default-file-modes))))
- "" ; dummy argument for shell's $0
- filename
- (if writable "-l")
- (concat "-p" rev)
- switches)
- (setq failed nil))
- (and failed (file-exists-p filename) (delete-file filename))))
- (let (new-version)
- ;; if we should go to the head of the trunk,
- ;; clear the default branch first
- (and rev (string= rev "")
- (vc-do-command nil 0 "rcs" file 'MASTER "-b"))
- ;; now do the checkout
- (apply 'vc-do-command
- nil 0 "co" file 'MASTER
- ;; If locking is not strict, force to overwrite
- ;; the writable workfile.
- (if (eq (vc-checkout-model file) 'implicit) "-f")
- (if writable "-l")
- (if rev (concat "-r" rev)
- ;; if no explicit revision was specified,
- ;; check out that of the working file
- (let ((workrev (vc-workfile-version file)))
- (if workrev (concat "-r" workrev)
- nil)))
- switches)
- ;; determine the new workfile version
- (save-excursion
- (set-buffer "*vc*")
- (goto-char (point-min))
- (setq new-version
- (if (re-search-forward "^revision \\([0-9.]+\\).*\n" nil t)
- (buffer-substring (match-beginning 1) (match-end 1)))))
- (vc-file-setprop file 'vc-workfile-version new-version)
- ;; if necessary, adjust the default branch
- (and rev (not (string= rev ""))
- (vc-do-command nil 0 "rcs" file 'MASTER
- (concat "-b" (if (vc-latest-on-branch-p file)
- (if (vc-trunk-p new-version) nil
- (vc-branch-part new-version))
- new-version))))))
- (if workfile ;; CVS
- ;; CVS is much like RCS
- (let ((failed t))
- (unwind-protect
- (progn
- (apply 'vc-do-command
- nil 0 "/bin/sh" file 'WORKFILE "-c"
- "exec >\"$1\" || exit; shift; exec cvs update \"$@\""
- "" ; dummy argument for shell's $0
- workfile
- (concat "-r" rev)
- "-p"
- switches)
- (setq failed nil))
- (and failed (file-exists-p filename) (delete-file filename))))
- ;; default for verbose checkout: clear the sticky tag
- ;; so that the actual update will get the head of the trunk
- (and rev (string= rev "")
- (vc-do-command nil 0 "cvs" file 'WORKFILE "update" "-A"))
- ;; If a revision was specified, check that out.
- (if rev
- (apply 'vc-do-command nil 0 "cvs" file 'WORKFILE
- (and writable (eq (vc-checkout-model file) 'manual) "-w")
- "update"
- (and rev (not (string= rev ""))
- (concat "-r" rev))
- switches)
- ;; If no revision was specified, simply make the file writable.
- (and writable
- (or (eq (vc-checkout-model file) 'manual)
- (zerop (logand 128 (file-modes file))))
- (set-file-modes file (logior 128 (file-modes file)))))
- (if rev (vc-file-setprop file 'vc-workfile-version nil))))
- (setq default-directory old-default-dir)
- (cond
- ((not workfile)
- (vc-file-clear-masterprops file)
- (if writable
- (vc-file-setprop file 'vc-locking-user (user-login-name)))
- (vc-file-setprop file
- 'vc-checkout-time (nth 5 (file-attributes file)))))
- (message "Checking out %s...done" filename))))
+ (logand 511 (lognot vc-modes))
+ (logand 511 (lognot (default-file-modes))))
+ "" ; dummy argument for shell's $0
+ filename
+ (if writable "-l")
+ (concat "-p" rev)
+ switches)
+ (setq failed nil))
+ (and failed (file-exists-p filename) (delete-file filename))))
+ (let (new-version)
+ ;; if we should go to the head of the trunk,
+ ;; clear the default branch first
+ (and rev (string= rev "")
+ (vc-do-command nil 0 "rcs" file 'MASTER "-b"))
+ ;; now do the checkout
+ (apply 'vc-do-command
+ nil 0 "co" file 'MASTER
+ ;; If locking is not strict, force to overwrite
+ ;; the writable workfile.
+ (if (eq (vc-checkout-model file) 'implicit) "-f")
+ (if writable "-l")
+ (if rev (concat "-r" rev)
+ ;; if no explicit revision was specified,
+ ;; check out that of the working file
+ (let ((workrev (vc-workfile-version file)))
+ (if workrev (concat "-r" workrev)
+ nil)))
+ switches)
+ ;; determine the new workfile version
+ (save-excursion
+ (set-buffer "*vc*")
+ (goto-char (point-min))
+ (setq new-version
+ (if (re-search-forward "^revision \\([0-9.]+\\).*\n" nil t)
+ (buffer-substring (match-beginning 1) (match-end 1)))))
+ (vc-file-setprop file 'vc-workfile-version new-version)
+ ;; if necessary, adjust the default branch
+ (and rev (not (string= rev ""))
+ (vc-do-command nil 0 "rcs" file 'MASTER
+ (concat "-b" (if (vc-latest-on-branch-p file)
+ (if (vc-trunk-p new-version) nil
+ (vc-branch-part new-version))
+ new-version))))))
+ (if workfile ;; CVS
+ ;; CVS is much like RCS
+ (let ((failed t))
+ (unwind-protect
+ (progn
+ (apply 'vc-do-command
+ nil 0 "/bin/sh" file 'WORKFILE "-c"
+ "exec >\"$1\" || exit; shift; exec cvs update \"$@\""
+ "" ; dummy argument for shell's $0
+ workfile
+ (concat "-r" rev)
+ "-p"
+ switches)
+ (setq failed nil))
+ (and failed (file-exists-p filename) (delete-file filename))))
+ ;; default for verbose checkout: clear the sticky tag
+ ;; so that the actual update will get the head of the trunk
+ (and rev (string= rev "")
+ (vc-do-command nil 0 "cvs" file 'WORKFILE "update" "-A"))
+ ;; If a revision was specified, check that out.
+ (if rev
+ (apply 'vc-do-command nil 0 "cvs" file 'WORKFILE
+ (and writable (eq (vc-checkout-model file) 'manual) "-w")
+ "update"
+ (and rev (not (string= rev ""))
+ (concat "-r" rev))
+ switches)
+ ;; If no revision was specified, simply make the file writable.
+ (and writable
+ (or (eq (vc-checkout-model file) 'manual)
+ (zerop (logand 128 (file-modes file))))
+ (set-file-modes file (logior 128 (file-modes file)))))
+ (if rev (vc-file-setprop file 'vc-workfile-version nil))))
+ (cond
+ ((not workfile)
+ (vc-file-clear-masterprops file)
+ (if writable
+ (vc-file-setprop file 'vc-locking-user (vc-user-login-name)))
+ (vc-file-setprop file
+ 'vc-checkout-time (nth 5 (file-attributes file)))))
+ (message "Checking out %s...done" filename))))))
(defun vc-backend-logentry-check (file)
(vc-backend-dispatch file
"-M" (concat "-u" rev) (concat "-l" rev))
(error "You cannot steal a CVS lock; there are no CVS locks to steal") ;CVS
)
- (vc-file-setprop file 'vc-locking-user (user-login-name))
+ (vc-file-setprop file 'vc-locking-user (vc-user-login-name))
(message "Stealing lock on %s...done" file)
)
file
(vc-do-command nil 0 "prs" file 'MASTER)
(vc-do-command nil 0 "rlog" file 'MASTER)
- (vc-do-command nil 0 "cvs" file 'WORKFILE "rlog")))
+ (vc-do-command nil 0 "cvs" file 'WORKFILE "log")))
(defun vc-backend-assign-name (file name)
;; Assign to a FILE's latest version a given NAME.
(defun vc-backend-diff (file &optional oldvers newvers cmp)
;; Get a difference report between two versions of FILE.
;; Get only a brief comparison report if CMP, a difference report otherwise.
- (let ((backend (vc-backend file)))
+ (let ((backend (vc-backend file)) options status
+ (diff-switches-list (if (listp diff-switches)
+ diff-switches
+ (list diff-switches))))
(cond
((eq backend 'SCCS)
(setq oldvers (vc-lookup-triple file oldvers))
- (setq newvers (vc-lookup-triple file newvers)))
+ (setq newvers (vc-lookup-triple file newvers))
+ (setq options (append (list (and cmp "--brief") "-q"
+ (and oldvers (concat "-r" oldvers))
+ (and newvers (concat "-r" newvers)))
+ (and (not cmp) diff-switches-list)))
+ (apply 'vc-do-command "*vc-diff*" 1 "vcdiff" file 'MASTER options))
((eq backend 'RCS)
(if (not oldvers) (setq oldvers (vc-workfile-version file)))
;; If we know that --brief is not supported, don't try it.
- (setq cmp (and cmp (not (eq vc-rcsdiff-knows-brief 'no))))))
- ;; SCCS and RCS shares a lot of code.
- (cond
- ((or (eq backend 'SCCS) (eq backend 'RCS))
- (let* ((command (if (eq backend 'SCCS) "vcdiff" "rcsdiff"))
- (mode (if (eq backend 'RCS) 'WORKFILE 'MASTER))
- (options (append (list (and cmp "--brief")
- "-q"
- (and oldvers (concat "-r" oldvers))
- (and newvers (concat "-r" newvers)))
- (and (not cmp)
- (if (listp diff-switches)
- diff-switches
- (list diff-switches)))))
- (status (apply 'vc-do-command "*vc-diff*" 2
- command file mode options)))
- ;; If --brief didn't work, do a double-take and remember it
- ;; for the future.
- (if (eq status 2)
- (prog1
- (apply 'vc-do-command "*vc-diff*" 1 command file 'WORKFILE
- (if cmp (cdr options) options))
- (if cmp (setq vc-rcsdiff-knows-brief 'no)))
- ;; If --brief DID work, remember that, too.
- (and cmp (not vc-rcsdiff-knows-brief)
- (setq vc-rcsdiff-knows-brief 'yes))
- status)))
+ (setq cmp (and cmp (not (eq vc-rcsdiff-knows-brief 'no))))
+ (setq options (append (list (and cmp "--brief") "-q"
+ (concat "-r" oldvers)
+ (and newvers (concat "-r" newvers)))
+ (and (not cmp) diff-switches-list)))
+ (setq status (apply 'vc-do-command "*vc-diff*" 2
+ "rcsdiff" file 'WORKFILE options))
+ ;; If --brief didn't work, do a double-take and remember it
+ ;; for the future.
+ (if (eq status 2)
+ (prog1
+ (apply 'vc-do-command "*vc-diff*" 1 "rcsdiff" file 'WORKFILE
+ (if cmp (cdr options) options))
+ (if cmp (setq vc-rcsdiff-knows-brief 'no)))
+ ;; If --brief DID work, remember that, too.
+ (and cmp (not vc-rcsdiff-knows-brief)
+ (setq vc-rcsdiff-knows-brief 'yes))
+ status))
;; CVS is different.
((eq backend 'CVS)
- (if (string= (vc-workfile-version file) "0") ;CVS
+ (if (string= (vc-workfile-version file) "0")
;; This file is added but not yet committed; there is no master file.
(if (or oldvers newvers)
(error "No revisions of %s exist" file)
;; Set up key bindings for use while editing log messages
-(defun vc-log-mode ()
+(defun vc-log-mode (&optional file)
"Minor mode for driving version-control tools.
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
(setq major-mode 'vc-log-mode)
(setq mode-name "VC-Log")
(make-local-variable 'vc-log-file)
+ (setq vc-log-file file)
(make-local-variable 'vc-log-version)
(make-local-variable 'vc-comment-ring-index)
(set-buffer-modified-p nil)