;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Maintainer: Andre Spiegel <spiegel@inf.fu-berlin.de>
-;; $Id: vc-hooks.el,v 1.105 1998/04/05 18:44:35 spiegel Exp done $
+;; $Id: vc-hooks.el,v 1.1 2000/01/10 13:25:12 gerd Exp gerd $
;; This file is part of GNU Emacs.
;; number of the subexpression that should be returned. If there's
;; a third element (also the number of a subexpression), that
;; subexpression is assumed to be a date field and we want the most
- ;; recent entry matching the template.
+ ;; recent entry matching the template; this works for RCS format dates only.
;; 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.
(let ((latest-date "") (latest-val))
(while (re-search-forward (car p) nil t)
(let ((date (vc-match-substring (elt p 2))))
+ ;; Most (but not all) versions of RCS use two-digit years
+ ;; to represent dates in the range 1900 through 1999.
+ ;; The two-digit and four-digit notations can both appear
+ ;; in the same file. Normalize the two-digit versions.
+ (save-match-data
+ (if (string-match "\\`[0-9][0-9]\\." date)
+ (setq date (concat "19" date))))
(if (string< latest-date date)
(progn
(setq latest-date date)
(error "Couldn't find version control information")))
exec-status))
-(defun vc-parse-cvs-status (&optional file)
+(defun vc-parse-cvs-status (&optional full)
;; Parse output of "cvs status" command in the current buffer and
- ;; set file properties accordingly. If argument FILE is given, it
- ;; must be the name of the file to which the status output applies,
- ;; otherwise FILE is derived from the status output itself.
- (or file
- (progn (goto-char (point-min))
- (re-search-forward "^File: \\([^ \t]+\\)" nil t)
- (setq file (concat default-directory (match-string 1)))))
- (vc-parse-buffer
- ;; CVS 1.3 says "RCS Version:", other releases "RCS Revision:",
- ;; and CVS 1.4a1 says "Repository revision:".
- '(("\\(RCS Version\\|RCS Revision\\|Repository revision\\):[\t ]+\\([0-9.]+\\)" 2)
- ("^File: [^ \t]+[ \t]+Status: \\(.*\\)" 1))
- file
- '(vc-latest-version vc-cvs-status))
- ;; Translate those status values that we understand into symbols.
- ;; Any other value is converted to nil.
- (let ((status (vc-file-getprop file 'vc-cvs-status)))
- (cond
- ((string-match "Up-to-date" status)
- (vc-file-setprop file 'vc-cvs-status 'up-to-date)
- (vc-file-setprop file 'vc-checkout-time
- (nth 5 (file-attributes file))))
- ((vc-file-setprop file 'vc-cvs-status
- (cond
- ((string-match "Locally Modified" status) 'locally-modified)
- ((string-match "Needs Merge" status) 'needs-merge)
- ((string-match "Needs \\(Checkout\\|Patch\\)" status)
- 'needs-checkout)
- ((string-match "Unresolved Conflict" status) 'unresolved-conflict)
- ((string-match "Locally Added" status) 'locally-added)
- ((string-match "New file!" status) 'locally-added)
- (t 'unknown)))))))
+ ;; set file properties accordingly. Unless FULL is t, parse only
+ ;; essential information.
+ (let (file status)
+ (goto-char (point-min))
+ (if (re-search-forward "^File: " nil t)
+ (cond
+ ((looking-at "no file") nil)
+ ((re-search-forward "\\=\\([^ \t]+\\)" nil t)
+ (setq file (concat default-directory (match-string 1)))
+ (vc-file-setprop file 'vc-backend 'CVS)
+ (if (not (re-search-forward "\\=[ \t]+Status: \\(.*\\)" nil t))
+ (setq status "Unknown")
+ (setq status (match-string 1)))
+ (if (and full
+ (re-search-forward
+ "\\(RCS Version\\|RCS Revision\\|Repository revision\\):[\t ]+\\([0-9.]+\\)"
+ nil t))
+ (vc-file-setprop file 'vc-latest-version (match-string 2)))
+ (cond
+ ((string-match "Up-to-date" status)
+ (vc-file-setprop file 'vc-cvs-status 'up-to-date)
+ (vc-file-setprop file 'vc-checkout-time
+ (nth 5 (file-attributes file))))
+ ((vc-file-setprop file 'vc-cvs-status
+ (cond
+ ((string-match "Locally Modified" status) 'locally-modified)
+ ((string-match "Needs Merge" status) 'needs-merge)
+ ((string-match "Needs \\(Checkout\\|Patch\\)" status)
+ 'needs-checkout)
+ ((string-match "Unresolved Conflict" status)
+ 'unresolved-conflict)
+ ((string-match "File had conflicts on merge" status)
+ 'unresolved-conflict)
+ ((string-match "Locally Added" status) 'locally-added)
+ ((string-match "New file!" status) 'locally-added)
+ (t 'unknown))))))))))
(defun vc-fetch-master-properties (file)
;; Fetch those properties of FILE that are stored in the master file.
(let ((default-directory (file-name-directory file)))
(vc-simple-command 0 "cvs" (file-name-nondirectory file) "status"))
(set-buffer (get-buffer "*vc-info*"))
- (vc-parse-cvs-status file))))
+ (vc-parse-cvs-status t))))
(if (get-buffer "*vc-info*")
(kill-buffer (get-buffer "*vc-info*")))))
(cond
;; search for $Id or $Header
;; -------------------------
- ((or (and (search-forward "$Id: " nil t)
+ ;; The `\ 's below avoid an RCS 5.7 bug when checking in this file.
+ ((or (and (search-forward "$Id\ : " nil t)
(looking-at "[^ ]+ \\([0-9.]+\\) "))
(and (progn (goto-char (point-min))
- (search-forward "$Header: " nil t))
+ (search-forward "$Header\ : " nil t))
(looking-at "[^ ]+ \\([0-9.]+\\) ")))
(goto-char (match-end 0))
;; if found, store the revision number ...
(file-directory-p (concat dirname "CVS/"))
(file-readable-p (concat dirname "CVS/Entries")))
(let ((file (concat dirname basename))
- ;; make sure that the file name is searched
- ;; case-sensitively
- (case-fold-search nil)
buffer)
(unwind-protect
(save-excursion
(setq buffer (set-buffer (get-buffer-create "*vc-info*")))
(vc-insert-file (concat dirname "CVS/Entries"))
(goto-char (point-min))
+ ;; make sure that the file name is searched
+ ;; case-sensitively - case-fold-search is a buffer-local
+ ;; variable, so setting it here won't affect any other buffers
+ (setq case-fold-search nil)
(cond
;; entry for a "locally added" file (not yet committed)
((re-search-forward
"Change read-only status of current buffer, perhaps via version control.
If the buffer is visiting a file registered with version control,
then check the file in or out. Otherwise, just change the read-only flag
-of the buffer. With prefix argument, ask for version number."
+of the buffer.
+With prefix argument, ask for version number to check in or check out.
+Check-out of a specified version number does not lock the file;
+to do that, use this command a second time with no argument."
(interactive "P")
(if (or (and (boundp 'vc-dired-mode) vc-dired-mode)
;; use boundp because vc.el might not be loaded
(defun vc-file-not-found-hook ()
"When file is not found, try to check it out from RCS or SCCS.
Returns t if checkout was successful, nil otherwise."
+ ;; When a file does not exist, ignore cached info about it
+ ;; from a previous visit.
+ (vc-file-clearprops buffer-file-name)
(if (and (not vc-ignore-vc-files)
(vc-backend buffer-file-name))
(save-excursion
'("Retrieve Snapshot" . vc-retrieve-snapshot))
(define-key vc-menu-map [vc-create-snapshot]
'("Create Snapshot" . vc-create-snapshot))
- (define-key vc-menu-map [vc-directory] '("Show Locked Files" . vc-directory))
+ (define-key vc-menu-map [vc-directory] '("VC Directory Listing" . vc-directory))
(define-key vc-menu-map [separator1] '("----"))
(define-key vc-menu-map [vc-annotate] '("Annotate" . vc-annotate))
(define-key vc-menu-map [vc-rename-file] '("Rename File" . vc-rename-file))
(define-key vc-menu-map [vc-next-action] '("Check In/Out" . vc-next-action))
(define-key vc-menu-map [vc-register] '("Register" . vc-register)))
-(put 'vc-rename-file 'menu-enable 'vc-mode)
-(put 'vc-annotate 'menu-enable '(eq (vc-buffer-backend) 'CVS))
-(put 'vc-version-other-window 'menu-enable 'vc-mode)
-(put 'vc-diff 'menu-enable 'vc-mode)
-(put 'vc-update-change-log 'menu-enable
- '(eq (vc-buffer-backend) 'RCS))
-(put 'vc-print-log 'menu-enable 'vc-mode)
-(put 'vc-cancel-version 'menu-enable 'vc-mode)
-(put 'vc-revert-buffer 'menu-enable 'vc-mode)
-(put 'vc-insert-headers 'menu-enable 'vc-mode)
-(put 'vc-next-action 'menu-enable 'vc-mode)
-(put 'vc-register 'menu-enable '(and buffer-file-name (not vc-mode)))
+;;; These are not correct and it's not currently clear how doing it
+;;; better (with more complicated expressions) might slow things down
+;;; on older systems.
+
+;;;(put 'vc-rename-file 'menu-enable 'vc-mode)
+;;;(put 'vc-annotate 'menu-enable '(eq (vc-buffer-backend) 'CVS))
+;;;(put 'vc-version-other-window 'menu-enable 'vc-mode)
+;;;(put 'vc-diff 'menu-enable 'vc-mode)
+;;;(put 'vc-update-change-log 'menu-enable
+;;; '(eq (vc-buffer-backend) 'RCS))
+;;;(put 'vc-print-log 'menu-enable 'vc-mode)
+;;;(put 'vc-cancel-version 'menu-enable 'vc-mode)
+;;;(put 'vc-revert-buffer 'menu-enable 'vc-mode)
+;;;(put 'vc-insert-headers 'menu-enable 'vc-mode)
+;;;(put 'vc-next-action 'menu-enable 'vc-mode)
+;;;(put 'vc-register 'menu-enable '(and buffer-file-name (not vc-mode)))
(provide 'vc-hooks)