In pcl-cvs version v2_9_9, when I save a file under CVS control, it
calls vc-workfile-version. However, I'm using vc-cc instead of vc,
and this function doesn't exist there.
One solution is to modify pcl-cvs.el so that it doesn't call
vc-workfile-version, a simple one-line change. However, if that's
done, pcl-cvs won't know the version of the file being changed and
cvs-mark-buffer-changed becomes a nop.
Instead, I stole the corresponding functions from vc and added them to
vc-cc. The following patch adds this functionality.
Ray
Changlog entry:
2000-06-20 Raymond Toy <toy(a)rtp.ericsson.se>
* vc-hooks.el (vc-consult-headers): Add new defvar.
(vc-consult-rcs-headers): Add new function, stolen from
vc/vc-hooks.el, and changed vc-backend to vc-backend-deduce for
vc-cc.
(vc-workfile-version): Add new function, stolen from
vc/vc-hooks.el, and changed vc-backend to vc-backend-deduce for
vc-cc.
Patch to vc-cc/vc-hooks.el:
--- vc-hooks.el~ Thu Dec 10 09:49:58 1998
+++ vc-hooks.el Tue Jun 20 13:11:28 2000
@@ -86,6 +86,9 @@
"The ClearCase present working view for the current buffer.")
(make-variable-buffer-local 'vc-cc-pwv)
+(defvar vc-consult-headers t
+ "*If non-nil, identify work files by searching for version headers.")
+
(defconst vc-elucidated (string-match "Lucid" emacs-version))
;; Tell Emacs about this new kind of minor mode
@@ -913,6 +916,130 @@
(format glue-fmt element version)
element)
))
+
+;; These stolen from vc. pcl-cvs wants to call these in
+;; cvs-mark-buffer-changed. (Basically only changed vc-backend to
+;; vc-backend-deduce.)
+
+(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)
+ ((let (status version locking-user)
+ (save-excursion
+ (set-buffer (get-file-buffer file))
+ (goto-char (point-min))
+ (cond
+ ;; search for $Id or $Header
+ ;; -------------------------
+ ((or (and (search-forward "$Id: " nil t)
+ (looking-at "[^ ]+ \\([0-9.]+\\) "))
+ (and (progn (goto-char (point-min))
+ (search-forward "$Header: " nil t))
+ (looking-at "[^ ]+ \\([0-9.]+\\) ")))
+ (goto-char (match-end 0))
+ ;; if found, store the revision number ...
+ (setq version (buffer-substring-no-properties (match-beginning 1)
+ (match-end 1)))
+ ;; ... and check for the locking state
+ (cond
+ ((looking-at
+ (concat "[0-9]+[/-][01][0-9][/-][0-3][0-9] " ; date
+ "[0-2][0-9]:[0-5][0-9]+:[0-6][0-9]+\\([+-][0-9:]+\\)? " ; time
+ "[^ ]+ [^ ]+ ")) ; author & state
+ (goto-char (match-end 0)) ; [0-6] in regexp handles leap seconds
+ (cond
+ ;; unlocked revision
+ ((looking-at "\\$")
+ (setq locking-user 'none)
+ (setq status 'rev-and-lock))
+ ;; revision is locked by some user
+ ((looking-at "\\([^ ]+\\) \\$")
+ (setq locking-user
+ (buffer-substring-no-properties (match-beginning 1)
+ (match-end 1)))
+ (setq status '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 ...
+ (setq version (buffer-substring-no-properties (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 " \\([^ ]+\\) \\$")
+ (setq locking-user (buffer-substring-no-properties
+ (match-beginning 1)
+ (match-end 1)))
+ (setq status 'rev-and-lock))
+ ((looking-at " *\\$")
+ (setq locking-user 'none)
+ (setq status 'rev-and-lock))
+ (t
+ (setq locking-user 'none)
+ (setq status 'rev-and-lock)))
+ (setq status 'rev)))
+ ;; else: nothing found
+ ;; -------------------
+ (t nil)))
+ (if status (vc-file-setprop file 'vc-workfile-version version))
+ (and (eq status 'rev-and-lock)
+ (eq (vc-backend-deduce file) 'RCS)
+ (vc-file-setprop file 'vc-locking-user locking-user)
+ ;; If the file has headers, we don't want to query the master file,
+ ;; because that would eliminate all the performance gain the headers
+ ;; brought us. We therefore use a heuristic for the checkout model
+ ;; now: If we trust the file permissions, and the file is not
+ ;; locked, then if the file is read-only the checkout model is
+ ;; `manual', otherwise `implicit'.
+ (not (vc-mistrust-permissions file))
+ (not (vc-locking-user file))
+ (if (string-match ".r-..-..-." (nth 8 (file-attributes file)))
+ (vc-file-setprop file 'vc-checkout-model 'manual)
+ (vc-file-setprop file 'vc-checkout-model 'implicit)))
+ status))))
+
+(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-master-workfile-version is taken.
+ ;; Note that this property 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))
+ ((eq (vc-backend-deduce file) 'SCCS) (vc-latest-version file))
+ ((eq (vc-backend-deduce file) 'RCS)
+ (if (vc-consult-rcs-headers file)
+ (vc-file-getprop file 'vc-workfile-version)
+ (let ((rev (cond ((vc-master-workfile-version file))
+ ((vc-latest-version file)))))
+ (vc-file-setprop file 'vc-workfile-version rev)
+ rev)))
+ ((eq (vc-backend-deduce file) 'CVS)
+ (if (vc-consult-rcs-headers file) ;; CVS
+ (vc-file-getprop file 'vc-workfile-version)
+ (catch 'found
+ (vc-find-cvs-master (file-name-directory file)
+ (file-name-nondirectory file)))
+ (vc-file-getprop file 'vc-workfile-version)))))
(provide 'vc-hooks)
Show replies by date
Raymond Toy <toy(a)rtp.ericsson.se> writes:
2000-06-20 Raymond Toy <toy(a)rtp.ericsson.se>
* vc-hooks.el (vc-consult-headers): Add new defvar.
(vc-consult-rcs-headers): Add new function, stolen from
vc/vc-hooks.el, and changed vc-backend to vc-backend-deduce for
vc-cc.
(vc-workfile-version): Add new function, stolen from
vc/vc-hooks.el, and changed vc-backend to vc-backend-deduce for
vc-cc.
Thanks for the patch.
Reviewd, approved and applied.
--
Yoshiki Hayashi