(vc-name): Moved from vc.el; vc-rcs-status now uses it.

(vc-name, vc-backend-deduce): Set both vc-name and vc-backend
properties, to avoid calling vc-registered unnecessarily when
the other property is needed.
(vc-rcs-status): Yield only status of locks; do not try to yield " REV"
if there are no locks, since this cannot be done easily if there are
branches.  Use vc-name instead of duplicating its function incorrectly.
Fix off-by-one bug when inserting master header pieces.  Read headers
8192 bytes at a time instead of 100.  Don't bother to expand-file-name.
(vc-rcs-glean-field): Removed.

diff --git a/lisp/vc-hooks.el b/lisp/vc-hooks.el
index 211dab8..101f8d3 100644 (file)
--- a/lisp/vc-hooks.el
+++ b/lisp/vc-hooks.el
@@ -106,11 +106,24 @@ Otherwise, not displayed.")
           vc-master-templates)
          nil)))))
 
+(defun vc-name (file)
+  "Return the master name of a file, nil if it is not registered."
+  (or (vc-file-getprop file 'vc-name)
+      (let ((name-and-type (vc-registered file)))
+       (if name-and-type
+           (progn
+             (vc-file-setprop file 'vc-backend (cdr name-and-type))
+             (vc-file-setprop file 'vc-name (car name-and-type)))))))
+
 (defun vc-backend-deduce (file)
-  "Return the version-control type of a file, nil if it is not registered"
+  "Return the version-control type of a file, nil if it is not registered."
   (and file
        (or (vc-file-getprop file 'vc-backend)
-          (vc-file-setprop file 'vc-backend (cdr (vc-registered file))))))
+          (let ((name-and-type (vc-registered file)))
+            (if name-and-type
+                (progn
+                  (vc-file-setprop file 'vc-name (car name-and-type))
+                  (vc-file-setprop file 'vc-backend (cdr name-and-type))))))))
 
 (defun vc-toggle-read-only ()
   "Change read-only status of current buffer, perhaps via version control.
@@ -139,59 +152,40 @@ visiting FILE."
     vc-type))
 
 (defun vc-rcs-status (file)
-  ;; Return string " [LOCKERS:]REV" if FILE under RCS control, otherwise nil,
+  ;; Return string " [LOCKER:REV]" if FILE under RCS control, otherwise nil,
   ;; for placement in modeline by `vc-mode-line'.
 
-  ;; If FILE is not locked then return just " REV", where
-  ;; REV is the number of last revision checked in.  If the FILE is locked
+  ;; If FILE is not locked then return just "".  If the FILE is locked
   ;; then return *all* the locks currently set, in a single string of the
-  ;; form " LOCKER1:REV1 LOCKER2:REV2 ..."
+  ;; form " LOCKER1:REV1 LOCKER2:REV2 ...".
 
   ;; Algorithm: 
 
-  ;; 1. Check for master file corresponding to FILE being visited in
-  ;; subdirectory RCS of current directory and then, if not found there, in
-  ;; the current directory.  some of the vc-hooks machinery could be used
-  ;; here.
+  ;; 1. Check for master file corresponding to FILE being visited.
   ;; 
-  ;; 2. Insert the header, first 200 characters, of master file into a work
+  ;; 2. Insert the first few characters of the master file into a work
   ;; buffer.
   ;;  
   ;; 3. Search work buffer for line starting with "date" indicating enough
-  ;; of header was included; if not found, then successive increments of 100
-  ;; characters are inserted until "date" is located or 1000 characters is
-  ;; reached.
+  ;; of header was included; if not found, then keep inserting characters
+  ;; until "date" is located.
   ;; 
-  ;; 4. Search work buffer for line starting with "locks" and *not* followed
-  ;; immediately by a semi-colon; this indicates that locks exist; it extracts
-  ;; all the locks currently enabled and removes controls characters
+  ;; 4. Search work buffer for line starting with "locks", extract
+  ;; all the locks currently enabled, and remove control characters
   ;; separating them, like newlines; the string " user1:revision1
   ;; user2:revision2 ..." is returned.
-  ;; 
-  ;; 5. If "locks;" is found instead, indicating no locks, then search work
-  ;; buffer for lines starting with string "head" and "branch" and parses
-  ;; their contents; if contents of branch is non-nil then it is returned
-  ;; otherwise the contents of head is returned either as string " revision".
 
   ;; Limitations:
 
   ;; The output doesn't show which version you are actually looking at.
   ;; The modeline can get quite cluttered when there are multiple locks.
 
-  ;; Make sure name is expanded -- not needed?
-  (setq file (expand-file-name file))
-
-  (let (master found locks head branch status (eof 200))
-
-    ;; Find the name of the master file -- perhaps use `vc-name'?
-    (setq master (concat (file-name-directory file) "RCS/"
-                         (file-name-nondirectory file) ",v"))
+  (let ((master (vc-name file))
+       found status)
 
     ;; If master file exists, then parse its contents, otherwise we return the 
     ;; nil value of this if form.
-    (if (or (file-readable-p master)
-            (file-readable-p (setq master (concat file ",v")))) ; current dir?
-
+    (if master
         (save-excursion
 
           ;; Create work buffer.
@@ -200,68 +194,30 @@ visiting FILE."
                 default-directory (file-name-directory master))
           (erase-buffer)
 
-          ;; Limit search to header.
-          (insert-file-contents master nil 0 eof)
-          (goto-char (point-min))
-
-          ;; Check if we have enough of the header.  If not, then keep
-          ;; including more until enough or until 1000 chars is reached.
-          (setq found (re-search-forward "^date" nil t))
+          ;; Check if we have enough of the header.
+         ;; If not, then keep including more.
+          (while
+             (not (or found
+                      (let ((s (buffer-size)))
+                        (goto-char (1+ s))
+                        (zerop (car (cdr (insert-file-contents
+                                          master nil s (+ s 8192))))))))
+           (beginning-of-line)
+           (setq found (re-search-forward "^locks\\([^;]*\\);" nil t)))
 
-          (while (and (not found) (<= eof 1000))
-            (goto-char (point-max))
-            (insert-file-contents master nil (+ eof 1) (setq eof (+ eof 100)))
-            (goto-char (point-min))
-            (setq found (re-search-forward "^date" nil t)))
-
-          ;; If we located "^date" we can extract the status information, 
-          ;; otherwise we return `status' which was initialized to nil.
           (if found
-              (progn
-                (goto-char (point-min))
-
-                ;; First see if any revisions have any locks on them.
-                (if (re-search-forward "^locks[ \t\n\r\f]+\\([^;]*\\)" nil t)
-
-                    ;; At least one lock - clean controls characters from text.
-                    (save-restriction
-                      (narrow-to-region (match-beginning 1) (match-end 1))
-                      (goto-char (point-min))
-                      (while (re-search-forward "[ \t\n\r\f]+" nil t)
-                        (replace-match " " t t))
-                      (setq locks (buffer-string)))
-
-                  ;; Not locked - find head and branch.
-                  ;; ...more information could be extracted here.
-                  (setq locks ""
-                        head (vc-rcs-glean-field "head")
-                        branch (vc-rcs-glean-field "branch")))
-
-                ;; In case of RCS unlocked files: if non-nil branch is
-                ;; displayed, else if non-nil head is displayed.  if both nil,
-                ;; nothing is displayed.  In case of RCS locked files: locks
-                ;; is displayed.
-
-                (setq status (concat " " (or branch head locks)))))
-
-          ;; Clean work buffer.
-          (erase-buffer)
-          (set-buffer-modified-p nil)
-
-          ;; Return status, which is nil if "^date" was not located.
-          status))))
-
-(defun vc-rcs-glean-field (field)
-  ;; Parse ,v file in current buffer and return contents of FIELD,
-  ;; which should be a field like "head" or "branch", with a
-  ;; revision number as value.
-  ;; Returns nil if FIELD is not found.
-  (goto-char (point-min))
-  (if (re-search-forward
-       (concat "^" (regexp-quote field) "[ \t\n\r\f]+\\([0-9.]+\\)")
-       nil t)
-      (buffer-substring (match-beginning 1)
-                        (match-end 1))))
+             ;; Clean control characters from text.
+             (let ((status
+                    (save-restriction
+                      (narrow-to-region (match-beginning 1) (match-end 1))
+                      (goto-char (point-min))
+                      (while (re-search-forward "[ \b\t\n\v\f\r]+" nil t)
+                        (replace-match " " t t))
+                      (buffer-string))))
+               ;; Clean work buffer.
+               (erase-buffer)
+               (set-buffer-modified-p nil)
+               status))))))
 
 ;;; install a call to the above as a find-file hook
 (defun vc-find-file-hook ()