Mercurial > emacs

--- a/lisp/vc-hooks.el	Mon Jul 05 03:20:12 1993 +0000
+++ b/lisp/vc-hooks.el	Mon Jul 05 03:20:12 1993 +0000
@@ -106,11 +106,24 @@
 	   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 @@
     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 @@
                 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))
-
-          (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)))
+          ;; 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)))

-                  ;; 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))))
+          (if found
+	      ;; 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 ()