From: Richard M. Stallman Date: Sat, 26 Jun 1993 04:01:50 +0000 (+0000) Subject: (vc-rcs-status): New variable. X-Git-Tag: emacs-19.34~11951 X-Git-Url: https://code.delx.au/gnu-emacs/commitdiff_plain/198d5c0098044d63124902ad8b1b617b5af59e04 (vc-rcs-status): New variable. (vc-mode-line): Display the lock status and head version. (vc-rcs-status, vc-rcs-glean-field): New function. --- diff --git a/lisp/vc-hooks.el b/lisp/vc-hooks.el index 83588dcb4f..e5d71471a2 100644 --- a/lisp/vc-hooks.el +++ b/lisp/vc-hooks.el @@ -38,6 +38,10 @@ when creating new masters.") "*If non-nil, backups of registered files are made according to the make-backup-files variable. Otherwise, prevents backups being made.") +(defvar vc-rcs-status t + "*If non-nil, revision and locks on RCS working file displayed in modeline. +Otherwise, not displayed.") + ;; Tell Emacs about this new kind of minor mode (if (not (assoc 'vc-mode minor-mode-alist)) (setq minor-mode-alist (cons '(vc-mode vc-mode) @@ -126,13 +130,139 @@ visiting FILE." (interactive (list buffer-file-name nil)) (let ((vc-type (vc-backend-deduce file))) (if vc-type - (progn - (setq vc-mode - (concat " " (or label (symbol-name vc-type)))))) + (setq vc-mode + (concat (if (and vc-rcs-status (eq vc-type 'RCS)) + (vc-rcs-status file)) + " " (or label (symbol-name vc-type))))) ;; force update of mode line (set-buffer-modified-p (buffer-modified-p)) vc-type)) +(defun vc-rcs-status (file) + ;; Return string " [LOCKERS:]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 + ;; then return *all* the locks currently set, in a single string of the + ;; 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. + ;; + ;; 2. Insert the header, first 200 characters, of 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. + ;; + ;; 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 + ;; 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")) + + ;; 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? + + (save-excursion + + ;; Create work buffer. + (set-buffer (get-buffer-create "*vc-rcs-status*")) + (setq buffer-read-only nil + 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))) + + ;; 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)))) + ;;; install a call to the above as a find-file hook (defun vc-find-file-hook () ;; Recompute whether file is version controlled,