mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-28 07:45:00 +00:00
Code Issues Releases Activity

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

Browse Source 
(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.
This commit is contained in:
Paul Eggert 1993-07-05 03:20:12 +00:00
parent 2bd5041b8e
commit a03140c851
1 changed files with 49 additions and 93 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

142
lisp/vc-hooks.el
View File

@ -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.
(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)))
;; 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))))
;; 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 ()