pcl-cvs wants vc-workfile-version

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&gt; * 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)