;; Modified by:
;; ttn@netcom.com
;; Per Cederqvist <ceder@lysator.liu.edu>
-;; Andre Spiegel <spiegel@bruessel.informatik.uni-stuttgart.de>
+;; Andre Spiegel <spiegel@berlin.informatik.uni-stuttgart.de>
;; This file is part of GNU Emacs.
(cons '(vc-parent-buffer vc-parent-buffer-name)
minor-mode-alist)))
+;; To implement support for a new version-control system, add another
+;; branch to the vc-backend-dispatch macro and fill it in in each
+;; call. The variable vc-master-templates in vc-hooks.el will also
+;; have to change.
+
+(defmacro vc-backend-dispatch (f s r c)
+ "Execute FORM1, FORM2 or FORM3 for SCCS, RCS or CVS respectively.
+If FORM3 is `RCS', use FORM2 for CVS as well as RCS.
+\(CVS shares some code with RCS)."
+ (list 'let (list (list 'type (list 'vc-backend f)))
+ (list 'cond
+ (list (list 'eq 'type (quote 'SCCS)) s) ;; SCCS
+ (list (list 'eq 'type (quote 'RCS)) r) ;; RCS
+ (list (list 'eq 'type (quote 'CVS)) ;; CVS
+ (if (eq c 'RCS) r c))
+ )))
+
;; General customization
-(defvar vc-default-back-end nil
- "*Back-end actually used by this interface; may be SCCS or RCS.
-The value is only computed when needed to avoid an expensive search.")
(defvar vc-suppress-confirm nil
"*If non-nil, treat user as expert; suppress yes-no prompts on some things.")
-(defvar vc-keep-workfiles t
- "*If non-nil, don't delete working files after registering changes.
-If the back-end is CVS, workfiles are always kept, regardless of the
-value of this flag.")
(defvar vc-initial-comment nil
"*Prompt for initial comment when a file is registered.")
(defvar vc-command-messages nil
"*Display run messages from back-end commands.")
-(defvar vc-consult-headers t
- "*Identify work files by searching for version headers.")
-(defvar vc-mistrust-permissions nil
- "*Don't assume that permissions and ownership track version-control status.")
(defvar vc-checkin-switches nil
"*Extra switches passed to the checkin program by \\[vc-checkin].")
(defvar vc-checkout-switches nil
"*Extra switches passed to the checkout program by \\[vc-checkout].")
-(defvar vc-path
- (if (file-directory-p "/usr/sccs")
- '("/usr/sccs")
- nil)
- "*List of extra directories to search for version control commands.")
(defvar vc-directory-exclusion-list '("SCCS" "RCS")
"*Directory names ignored by functions that recursively walk file trees.")
;; log buffer with a nonzero local value of vc-comment-ring-index.
(setq vc-comment-ring nil))
+(defun vc-file-clear-masterprops (file)
+ ;; clear all properties of FILE that were retrieved
+ ;; from the master file
+ (vc-file-setprop file 'vc-latest-version nil)
+ (vc-file-setprop file 'vc-your-latest-version nil)
+ (vc-backend-dispatch file
+ (progn ;; SCCS
+ (vc-file-setprop file 'vc-master-locks nil))
+ (progn ;; RCS
+ (vc-file-setprop file 'vc-default-branch nil)
+ (vc-file-setprop file 'vc-head-version nil)
+ (vc-file-setprop file 'vc-top-version nil)
+ (vc-file-setprop file 'vc-master-locks nil))
+ (progn
+ (vc-file-setprop file 'vc-cvs-status nil))))
+
+;;; functions that operate on RCS revision numbers
+
+(defun vc-trunk-p (rev)
+ ;; return t if REV is a revision on the trunk
+ (not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev))))
+
+(defun vc-branch-part (rev)
+ ;; return the branch part of a revision number REV
+ (substring rev 0 (string-match "\\.[0-9]+\\'" rev)))
+
;; Random helper functions
(defun vc-registration-error (file)
status)
)
-;; Everything eventually funnels through these functions. To implement
-;; support for a new version-control system, add another branch to the
-;; vc-backend-dispatch macro and fill it in in each call. The variable
-;; vc-master-templates in vc-hooks.el will also have to change.
-
-(defmacro vc-backend-dispatch (f s r c)
- "Execute FORM1, FORM2 or FORM3 depending whether we're using SCCS, RCS or CVS.
-If FORM3 is RCS, use FORM2 even if we are using CVS. (CVS shares some code
-with RCS)."
- (list 'let (list (list 'type (list 'vc-backend-deduce f)))
- (list 'cond
- (list (list 'eq 'type (quote 'SCCS)) s) ;; SCCS
- (list (list 'eq 'type (quote 'RCS)) r) ;; RCS
- (list (list 'eq 'type (quote 'CVS)) ;; CVS
- (if (eq c 'RCS) r c))
- )))
-
;;; Save a bit of the text around POSN in the current buffer, to help
;;; us find the corresponding position again later. This works even
;;; if all markers are destroyed or corrupted.
(if buffer-error-marked-p buffer))))
(buffer-list)))))))
- (let ((in-font-lock-mode (and (boundp 'font-lock-fontified)
- font-lock-fontified)))
- (if in-font-lock-mode
- (font-lock-mode 0))
-
- ;; the actual revisit
- (revert-buffer arg no-confirm)
-
- (if in-font-lock-mode
- (font-lock-mode 1)))
+ (revert-buffer arg no-confirm)
;; Reparse affected compilation buffers.
(while reparse
(defun vc-next-action-on-file (file verbose &optional comment)
;;; If comment is specified, it will be used as an admin or checkin comment.
(let ((vc-file (vc-name file))
- (vc-type (vc-backend-deduce file))
+ (vc-type (vc-backend file))
owner version)
(cond
;; make the buffer writable, and assert the user to be the locker
((and (eq vc-type 'CVS) buffer-read-only)
(if verbose
- (progn
- (setq rev (read-string "Trunk version to move to: "))
+ (let ((rev (read-string "Trunk version to move to: ")))
(if (not (string= rev ""))
(vc-checkout file nil rev)
(vc-do-command 0 "cvs" file 'WORKFILE "update" "-A")
(defun vc-register (&optional override comment)
"Register the current file into your version-control system."
(interactive "P")
+ (or buffer-file-name
+ (error "No visited file"))
(let ((master (vc-name buffer-file-name)))
(and master (file-exists-p master)
(error "This file is already registered"))
(and (string= buffer-file-name file)
(if keep
(progn
+ ;; temporarily remove vc-find-file-hook, so that
+ ;; we don't lose the properties
+ (remove-hook 'find-file-hooks 'vc-find-file-hook)
(vc-revert-buffer1 t noquery)
+ (add-hook 'find-file-hooks 'vc-find-file-hook)
(vc-mode-line buffer-file-name))
- (progn
- (delete-window)
- (kill-buffer (current-buffer))))))
+ (kill-buffer (current-buffer)))))
(defun vc-start-entry (file rev comment msg action &optional after-hook)
;; Accept a comment for an operation on FILE revision REV. If COMMENT
(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 ""))
- (hdstrings (cdr (assoc (vc-backend-deduce (buffer-file-name)) vc-header-alist))))
+ (hdstrings (cdr (assoc (vc-backend (buffer-file-name)) vc-header-alist))))
(mapcar (function (lambda (s)
(insert comment-start-vc "\t" s "\t"
comment-end-vc "\n")))
(and (>= firstchar ?0) (<= firstchar ?9)))
name)
(t
- (car (vc-master-info
- (concat (vc-backend-subdirectory-name file) "/" vc-name-assoc-file)
- (list (concat name "\t:\t" file "\t\\(.+\\)"))))
- )))
+ (save-excursion
+ (set-buffer (get-buffer-create "*vc-info*"))
+ (vc-insert-file (concat
+ (vc-backend-subdirectory-name file)
+ "/" vc-name-assoc-file))
+ (prog1
+ (car (vc-parse-buffer
+ (list (list (concat name "\t:\t" file "\t\\(.+\\)") 1))))
+ (kill-buffer "*vc-info*"))))
+ ))
;; Named-configuration entry points
(find-file-other-window (dired-get-filename)))
(while vc-parent-buffer
(pop-to-buffer vc-parent-buffer))
+ (if (eq (vc-backend (buffer-file-name)) 'CVS)
+ (error "Unchecking files under CVS is dangerous and not supported in VC"))
(let* ((target (concat (vc-latest-version (buffer-file-name))))
(yours (concat (vc-your-latest-version (buffer-file-name))))
(prompt (if (string-equal yours target)
;; consider to be wrong. When the famous, long-awaited rename database is
;; implemented things might change for the better. This is unlikely to occur
;; until CVS 2.0 is released. --ceder 1994-01-23 21:27:51
- (if (eq (vc-backend-deduce old) 'CVS)
+ (if (eq (vc-backend old) 'CVS)
(error "Renaming files under CVS is dangerous and not supported in VC."))
(let ((oldbuf (get-file-buffer old)))
(if (and oldbuf (buffer-modified-p oldbuf))
(error "This is not a safe thing to do in the presence of symbolic links"))
(rename-file
oldmaster
- (let ((backend (vc-backend-deduce old))
+ (let ((backend (vc-backend old))
(newdir (or (file-name-directory new) ""))
(newbase (file-name-nondirectory new)))
(catch 'found
file)
(while buffers
(setq file (buffer-file-name (car buffers)))
- (and file (vc-backend-deduce file)
+ (and file (vc-backend file)
(setq files (cons file files)))
(setq buffers (cdr buffers)))
files))
args))))
"done" "failed"))))
-;; Functions for querying the master and lock files.
-
-(defun vc-match-substring (bn)
- (buffer-substring (match-beginning bn) (match-end bn)))
-
-(defun vc-parse-buffer (patterns &optional file properties)
- ;; Use PATTERNS to parse information out of the current buffer
- ;; by matching each regular expression in the list and returning \\1.
- ;; If a regexp has three tag brackets, assume the third is a date
- ;; field and we want the most recent entry matching the template.
- ;; If FILE and PROPERTIES are given, the latter must be a list of
- ;; properties of the same length as PATTERNS; each property is assigned
- ;; the corresponding value.
- (mapcar (function (lambda (p)
- (goto-char (point-min))
- (if (string-match "\\\\([^(]*\\\\([^(]*\\\\(" p)
- (let ((latest-date "") (latest-val))
- (while (re-search-forward p nil t)
- (let ((date (vc-match-substring 3)))
- (if (string< latest-date date)
- (progn
- (setq latest-date date)
- (setq latest-val
- (vc-match-substring 1))))))
- (if file
- (progn (vc-file-setprop file (car properties) latest-val)
- (setq properties (cdr properties))))
- latest-val)
- (let ((value nil))
- (if (re-search-forward p nil t)
- (setq value (vc-match-substring 1)))
- (if file
- (progn (vc-file-setprop file (car properties) value)
- (setq properties (cdr properties))))
- value))))
- patterns)
- )
-
-(defun vc-master-info (file fields &optional rfile properties)
- ;; Search for information in a master file.
- (if (and file (file-exists-p file))
- (save-excursion
- (let ((buf))
- (setq buf (create-file-buffer file))
- (set-buffer buf))
- (erase-buffer)
- (insert-file-contents file)
- (set-buffer-modified-p nil)
- (auto-save-mode nil)
- (prog1
- (vc-parse-buffer fields rfile properties)
- (kill-buffer (current-buffer)))
- )
- (if rfile
- (mapcar
- (function (lambda (p) (vc-file-setprop rfile p nil)))
- properties))
- )
- )
-
-(defun vc-log-info (command file last flags patterns &optional properties)
- ;; Search for information in log program output.
- ;; If there is a string `\X' in any of the PATTERNS, replace
- ;; it with a regexp to search for a branch revision.
- (if (and file (file-exists-p file))
- (save-excursion
- ;; Don't switch to the *vc* buffer before running vc-do-command,
- ;; because that would change its default-directory.
- (apply 'vc-do-command 0 command file last flags)
- (set-buffer (get-buffer "*vc*"))
- (set-buffer-modified-p nil)
- (let ((branch
- (car (vc-parse-buffer (list "^branch:[ \t]+\\([0-9.]+\\)$")))))
- (setq patterns
- (mapcar
- (function
- (lambda (p)
- (if (string-match "\\\\X" p)
- (if branch
- (cond ((vc-branch-p branch)
- (concat
- (substring p 0 (match-beginning 0))
- (regexp-quote branch)
- "\\.[0-9]+"
- (substring p (match-end 0))))
- (t
- (concat
- (substring p 0 (match-beginning 0))
- (regexp-quote branch)
- (substring p (match-end 0)))))
- ;; if there is no current branch,
- ;; return a completely different regexp,
- ;; which searches for the *head*
- "^head:[ \t]+\\([0-9.]+\\)$")
- p)))
- patterns)))
- (prog1
- (vc-parse-buffer patterns file properties)
- (kill-buffer (current-buffer))
- )
- )
- (if file
- (mapcar
- (function (lambda (p) (vc-file-setprop file p nil)))
- properties))
- )
- )
-
-(defun vc-locking-user (file)
- "Return the name of the person currently holding a lock on FILE.
-Return nil if there is no such person.
-Under CVS, a file is considered locked if it has been modified since it
-was checked out. Under CVS, this will sometimes return the uid of
-the owner of the file (as a number) instead of a string."
- ;; The property is cached. If it is non-nil, it is simply returned.
- ;; The other routines clear it when the locking state changes.
- (setq file (expand-file-name file));; ??? Work around bug in 19.0.4
- (cond
- ((vc-file-getprop file 'vc-locking-user))
- ((eq (vc-backend-deduce file) 'CVS)
- (if (vc-workfile-unchanged-p file)
- nil
- ;; The expression below should return the username of the owner
- ;; of the file. It doesn't. It returns the username if it is
- ;; you, or otherwise the UID of the owner of the file. The
- ;; return value from this function is only used by
- ;; vc-dired-reformat-line, and it does the proper thing if a UID
- ;; is returned.
- ;;
- ;; The *proper* way to fix this would be to implement a built-in
- ;; function in Emacs, say, (username UID), that returns the
- ;; username of a given UID.
- ;;
- ;; The result of this hack is that vc-directory will print the
- ;; name of the owner of the file for any files that are
- ;; modified.
- (let ((uid (nth 2 (file-attributes file))))
- (if (= uid (user-uid))
- (vc-file-setprop file 'vc-locking-user (user-login-name))
- (vc-file-setprop file 'vc-locking-user uid)))))
- (t
- (if (and (eq (vc-backend-deduce file) 'RCS)
- (eq (vc-consult-rcs-headers file) 'rev-and-lock))
- (vc-file-getprop file 'vc-locking-user)
- (if (or (not vc-keep-workfiles)
- (eq vc-mistrust-permissions 't)
- (and vc-mistrust-permissions
- (funcall vc-mistrust-permissions (vc-backend-subdirectory-name
- file))))
- (vc-file-setprop file 'vc-locking-user (vc-true-locking-user file))
- ;; This implementation assumes that any file which is under version
- ;; control and has -rw-r--r-- is locked by its owner. This is true
- ;; for both RCS and SCCS, which keep unlocked files at -r--r--r--.
- ;; We have to be careful not to exclude files with execute bits on;
- ;; scripts can be under version control too. Also, we must ignore
- ;; the group-read and other-read bits, since paranoid users turn them off.
- ;; This hack wins because calls to the very expensive vc-fetch-properties
- ;; function only have to be made if (a) the file is locked by someone
- ;; other than the current user, or (b) some untoward manipulation
- ;; behind vc's back has changed the owner or the `group' or `other'
- ;; write bits.
- (let ((attributes (file-attributes file)))
- (cond ((string-match ".r-..-..-." (nth 8 attributes))
- nil)
- ((and (= (nth 2 attributes) (user-uid))
- (string-match ".rw..-..-." (nth 8 attributes)))
- (vc-file-setprop file 'vc-locking-user (user-login-name)))
- (t
- (vc-file-setprop file 'vc-locking-user
- (vc-true-locking-user file))))))))))
-
-(defun vc-true-locking-user (file)
- ;; The slow but reliable version
- (vc-fetch-properties file)
- (vc-file-getprop file 'vc-locking-user))
-
-(defun vc-latest-version (file)
- ;; Return version level of the latest version of FILE
- (vc-fetch-properties file)
- (vc-file-getprop file 'vc-latest-version))
-
-(defun vc-your-latest-version (file)
- ;; Return version level of the latest version of FILE checked in by you
- (vc-fetch-properties file)
- (vc-file-getprop file 'vc-your-latest-version))
-
-(defun vc-branch-version (file)
- ;; Return version level of the highest revision on the default branch
- ;; If there is no default branch, return the highest version number
- ;; on the trunk.
- ;; This property is defined for RCS only.
- (vc-fetch-properties file)
- (vc-file-getprop file 'vc-branch-version))
-
-(defun vc-workfile-version (file)
- ;; Return version level of the current workfile FILE
- ;; This is attempted by first looking at the RCS keywords.
- ;; If there are no keywords in the working file,
- ;; vc-branch-version is taken.
- ;; Note that this value is cached, that is, it is only
- ;; looked up if it is nil.
- ;; For SCCS, this property is equivalent to vc-latest-version.
- (cond ((vc-file-getprop file 'vc-workfile-version))
- (t (vc-backend-dispatch file
- (vc-latest-version file) ;; SCCS
- (if (vc-consult-rcs-headers file) ;; RCS
- (vc-file-getprop file 'vc-workfile-version)
- (let ((rev (cond ((vc-branch-version file))
- ((vc-latest-version file)))))
- (vc-file-setprop file 'vc-workfile-version rev)
- rev))
- (if (vc-consult-rcs-headers file) ;; CVS
- (vc-file-getprop file 'vc-workfile-version)
- (vc-find-cvs-master (file-name-directory file)
- (file-name-nondirectory file))
- (vc-file-getprop file 'vc-workfile-version))))))
-
-(defun vc-consult-rcs-headers (file)
- ;; Search for RCS headers in FILE, and set properties
- ;; accordingly. This function can be disabled by setting
- ;; vc-consult-headers to nil.
- ;; Returns: nil if no headers were found
- ;; (or if the feature is disabled,
- ;; or if there is currently no buffer
- ;; visiting FILE)
- ;; 'rev if a workfile revision was found
- ;; 'rev-and-lock if revision and lock info was found
- (cond
- ((or (not vc-consult-headers)
- (not (get-file-buffer file)) nil))
- ((save-excursion
- (set-buffer (get-file-buffer file))
- (goto-char (point-min))
- (cond
- ;; search for $Id or $Header
- ;; -------------------------
- ((re-search-forward "\\$\\(Id\\|Header\\): [^ ]+ \\([0-9.]+\\) "
- nil t)
- ;; if found, store the revision number ...
- (let ((rev (buffer-substring (match-beginning 2)
- (match-end 2))))
- ;; ... and check for the locking state
- (if (re-search-forward
- (concat "\\=[0-9]+/[0-9]+/[0-9]+ " ; date
- "[0-9]+:[0-9]+:[0-9]+ " ; time
- "[^ ]+ [^ ]+ ") ; author & state
- nil t)
- (cond
- ;; unlocked revision
- ((looking-at "\\$")
- (vc-file-setprop file 'vc-workfile-version rev)
- (vc-file-setprop file 'vc-locking-user nil)
- (vc-file-setprop file 'vc-locked-version nil)
- 'rev-and-lock)
- ;; revision is locked by some user
- ((looking-at "\\([^ ]+\\) \\$")
- (vc-file-setprop file 'vc-workfile-version rev)
- (vc-file-setprop file 'vc-locking-user
- (buffer-substring (match-beginning 1)
- (match-end 1)))
- (vc-file-setprop file 'vc-locked-version rev)
- 'rev-and-lock)
- ;; everything else: false
- (nil))
- ;; unexpected information in
- ;; keyword string --> quit
- nil)))
- ;; search for $Revision
- ;; --------------------
- ((re-search-forward (concat "\\$"
- "Revision: \\([0-9.]+\\) \\$")
- nil t)
- ;; if found, store the revision number ...
- (let ((rev (buffer-substring (match-beginning 1)
- (match-end 1))))
- ;; and see if there's any lock information
- (goto-char (point-min))
- (if (re-search-forward (concat "\\$" "Locker:") nil t)
- (cond ((looking-at " \\([^ ]+\\) \\$")
- (vc-file-setprop file 'vc-workfile-version rev)
- (vc-file-setprop file 'vc-locking-user
- (buffer-substring (match-beginning 1)
- (match-end 1)))
- (vc-file-setprop file 'vc-locked-version rev)
- 'rev-and-lock)
- ((looking-at " *\\$")
- (vc-file-setprop file 'vc-workfile-version rev)
- (vc-file-setprop file 'vc-locking-user nil)
- (vc-file-setprop file 'vc-locked-version nil)
- 'rev-and-lock)
- (t
- (vc-file-setprop file 'vc-workfile-version rev)
- 'rev-and-lock))
- (vc-file-setprop file 'vc-workfile-version rev)
- 'rev)))
- ;; else: nothing found
- ;; -------------------
- (t nil))))))
-
;; Collect back-end-dependent stuff here
-(defun vc-lock-file (file)
- ;; Generate lock file name corresponding to FILE
- (let ((master (vc-name file)))
- (and
- master
- (string-match "\\(.*/\\)s\\.\\(.*\\)" master)
- (concat
- (substring master (match-beginning 1) (match-end 1))
- "p."
- (substring master (match-beginning 2) (match-end 2))))))
-
-
-(defun vc-fetch-properties (file)
- ;; Re-fetch some properties associated with the given file.
- ;; Currently these properties are:
- ;; vc-locking-user
- ;; vc-locked-version
- ;; vc-latest-version
- ;; vc-your-latest-version
- ;; vc-branch-version (RCS only)
- (vc-backend-dispatch
- file
- ;; SCCS
- (progn
- (vc-master-info (vc-lock-file file)
- (list
- "^[^ ]+ [^ ]+ \\([^ ]+\\)"
- "^\\([^ ]+\\)")
- file
- '(vc-locking-user vc-locked-version))
- (vc-master-info (vc-name file)
- (list
- "^\001d D \\([^ ]+\\)"
- (concat "^\001d D \\([^ ]+\\) .* "
- (regexp-quote (user-login-name)) " ")
- )
- file
- '(vc-latest-version vc-your-latest-version))
- )
- ;; RCS
- (vc-log-info "rlog" file 'MASTER nil
- (list
- "^locks: strict\n\t\\([^:]+\\)"
- "^locks: strict\n\t[^:]+: \\(.+\\)"
- "^revision[\t ]+\\([0-9.]+\\)\\(\n\\|[ \t].*\n\\)date: \\([ /0-9:]+\\);"
- (concat
- "^revision[\t ]+\\([0-9.]+\\)\\(\n\\|[ \t].*\n\\)date: \\([ /0-9:]+\\); *author: "
- (regexp-quote (user-login-name))
- ";")
-
- ;; special regexp to search for branch revision:
- ;; \X will be replaced by vc-log-info (see there)
- "^revision[\t ]+\\(\\X\\)\\(\n\\|[ \t].*\n\\)date: \\([ /0-9:]+\\);")
-
- '(vc-locking-user
- vc-locked-version
- vc-latest-version
- vc-your-latest-version
- vc-branch-version))
- ;; CVS
- ;; Only fetch vc-latest-version here, all other properties are
- ;; computed elsehow.
- (vc-log-info
- "cvs" file 'WORKFILE '("status")
- ;; CVS 1.3 says "RCS Version:", other releases "RCS Revision:",
- ;; and CVS 1.4a1 says "Repository revision:". The regexp below
- ;; matches much more, but because of the way vc-log-info is
- ;; implemented it is impossible to use additional groups.
- '("R[eC][pS][ositry]* [VRr]e[rv][si][is]i?on:[\t ]+\\([0-9.]+\\)")
- '(vc-latest-version))
- ))
-
-(defun vc-backend-subdirectory-name (&optional file)
- ;; Where the master and lock files for the current directory are kept
- (symbol-name
- (or
- (and file (vc-backend-deduce file))
- vc-default-back-end
- (setq vc-default-back-end (if (vc-find-binary "rcs") 'RCS 'SCCS)))))
-
(defun vc-backend-admin (file &optional rev comment)
;; Register a file into the version-control system
;; Automatically retrieves a read-only version of the file with
(apply 'vc-do-command 0 "get" file 'MASTER;; SCCS
(if writable "-e")
(and rev (concat "-r" (vc-lookup-triple file rev)))
- vc-checkout-switches))
+ vc-checkout-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.
(apply 'vc-do-command 0 "cvs" file 'WORKFILE
"update"
(and rev (concat "-r" rev))
- vc-checkout-switches))
+ vc-checkout-switches)
+ (vc-file-setprop file 'vc-workfile-version nil))
))
- (or workfile
- (vc-file-setprop file
- 'vc-checkout-time (nth 5 (file-attributes file))))
+ (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))
)
;; or if the checkin creates a new branch, set the master file branch
;; accordingly.
(message "Checking in %s..." file)
+ ;; "This log message intentionally left almost blank".
+ (and (or (not comment) (string= comment ""))
+ (setq comment "*** empty log message ***"))
(save-excursion
;; Change buffers to get local value of vc-checkin-switches.
(set-buffer (or (get-file-buffer file) (current-buffer)))
(if rev (concat "-r" rev))
(concat "-y" comment)
vc-checkin-switches)
- (vc-file-setprop file 'vc-locking-user nil)
+ (vc-file-setprop file 'vc-locking-user 'none)
(vc-file-setprop file 'vc-workfile-version nil)
(if vc-keep-workfiles
(vc-do-command 0 "get" file 'MASTER))
)
;; RCS
- (let ((lock-version nil))
- ;; if this is an explicit check-in to a different branch,
- ;; remember the workfile version (in order to remove the lock later)
- (if (and rev
- (not (vc-trunk-p rev))
- (not (string= (vc-branch-part rev)
- (vc-branch-part (vc-workfile-version file)))))
- (setq lock-version (vc-workfile-version file)))
-
- (apply 'vc-do-command 0 "ci" file 'MASTER
+ (let ((old-version (vc-workfile-version file)) new-version)
+ (apply 'vc-do-command 0 "ci" file 'MASTER
(concat (if vc-keep-workfiles "-u" "-r") rev)
(concat "-m" comment)
vc-checkin-switches)
- (vc-file-setprop file 'vc-locking-user nil)
+ (vc-file-setprop file 'vc-locking-user 'none)
(vc-file-setprop file 'vc-workfile-version nil)
- ;; determine the new workfile version and
- ;; adjust the master file branch accordingly
- ;; (this currently has to be done on every check-in)
- (progn
- (set-buffer "*vc*")
- (goto-char (point-min))
- (if (re-search-forward "new revision: \\([0-9.]+\\);" nil t)
- (progn (setq rev (buffer-substring (match-beginning 1)
- (match-end 1)))
- (vc-file-setprop file 'vc-workfile-version rev)))
- (if (vc-trunk-p rev)
- (vc-do-command 0 "rcs" file 'MASTER "-b")
- (vc-do-command 0 "rcs" file 'MASTER
- (concat "-b" (vc-branch-part rev))))
- (if lock-version
- ;; exit status of 1 is also accepted.
- ;; It means that the lock was removed before.
- (vc-do-command 1 "rcs" file 'MASTER
- (concat "-u" lock-version)))))
+ ;; determine the new workfile version
+ (set-buffer "*vc*")
+ (goto-char (point-min))
+ (if (or (re-search-forward
+ "new revision: \\([0-9.]+\\);" nil t)
+ (re-search-forward
+ "reverting to previous revision \\([0-9.]+\\)" nil t))
+ (progn (setq new-version (buffer-substring (match-beginning 1)
+ (match-end 1)))
+ (vc-file-setprop file 'vc-workfile-version new-version)))
+
+ ;; if we got to a different branch, adjust the default
+ ;; branch accordingly, and remove any remaining
+ ;; lock on the old version.
+ (cond
+ ((and old-version new-version
+ (not (string= (vc-branch-part old-version)
+ (vc-branch-part new-version))))
+ (vc-do-command 0 "rcs" file 'MASTER
+ (if (vc-trunk-p new-version) "-b"
+ (concat "-b" (vc-branch-part new-version))))
+ ;; exit status of 1 is also accepted.
+ ;; It means that the lock was removed before.
+ (vc-do-command 1 "rcs" file 'MASTER
+ (concat "-u" old-version)))))
;; CVS
(progn
;; explicit check-in to the trunk requires a
vc-checkin-switches))
(apply 'vc-do-command 0 "cvs" file 'WORKFILE
"ci" (if rev (concat "-r" rev))
- (if (and comment (not (string= comment "")))
- (concat "-m" comment)
- "-m-")
+ (concat "-m" comment)
vc-checkin-switches)
;; determine and store the new workfile version
(set-buffer "*vc*")
;; if this was an explicit check-in, remove the sticky tag
(if rev
(vc-do-command 0 "cvs" file 'WORKFILE "update" "-A"))
- (vc-file-setprop file 'vc-locking-user nil)
+ (vc-file-setprop file 'vc-locking-user 'none)
(vc-file-setprop file 'vc-checkout-time
(nth 5 (file-attributes file))))))
- (message "Checking in %s...done" file)
- )
+ (vc-file-clear-masterprops file)
+ (message "Checking in %s...done" file))
(defun vc-backend-revert (file)
;; Revert file to latest checked-in version.
(progn
(delete-file file)
(vc-do-command 0 "cvs" file 'WORKFILE "update")))
- (vc-file-setprop file 'vc-locking-user nil)
+ (vc-file-setprop file 'vc-locking-user 'none)
(vc-file-setprop file 'vc-checkout-time (nth 5 (file-attributes file)))
(message "Reverting %s...done" file)
)
(vc-backend-dispatch file
(vc-do-command 0 "rmdel" file 'MASTER (concat "-r" target))
(vc-do-command 0 "rcs" file 'MASTER (concat "-o" target))
- (error "Unchecking files under CVS is dangerous and not supported in VC.")
+ nil ;; this is never reached under CVS
)
(message "Removing last change from %s...done" file)
)
(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-deduce file)))
+ (let ((backend (vc-backend file)))
(cond
((eq backend 'SCCS)
(setq oldvers (vc-lookup-triple file oldvers))
HCoop / bpt / emacs.git / blobdiff