;;; vc.el --- drive a version-control system from within Emacs
-;; Copyright (C) 1992, 93, 94, 95, 96 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.
;; 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-register-switches nil
- "*A string or list of strings specifying extra switches passed
-to the register program by \\[vc-register].")
-(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)
(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
"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."
path-separator
(mapconcat 'identity vc-path path-separator))
process-environment))
- (win32-quote-process-args t))
+ (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)
;; 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
;; 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
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)
)
;; 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-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 (find-change-log))
+ (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 (eq 0 (apply 'call-process "rcs2log" nil '(t nil) nil
- "-u"
- (concat (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" "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
((not workfile)
(vc-file-clear-masterprops file)
(if writable
- (vc-file-setprop file 'vc-locking-user (user-login-name)))
+ (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))))))
"-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)