From a03140c8518c8105422e3e395747fb9e267e3b3d Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 5 Jul 1993 03:20:12 +0000 Subject: [PATCH] (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. --- lisp/vc-hooks.el | 142 ++++++++++++++++------------------------------- 1 file changed, 49 insertions(+), 93 deletions(-) diff --git a/lisp/vc-hooks.el b/lisp/vc-hooks.el index 211dab8e5a0..101f8d3db7e 100644 --- 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 () -- 2.39.5