Mercurial > emacs
comparison lisp/vc-hooks.el @ 3900:c6f3d2af0df7
(vc-rcs-status): New variable.
(vc-mode-line): Display the lock status and head version.
(vc-rcs-status, vc-rcs-glean-field): New function.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Sat, 26 Jun 1993 04:01:50 +0000 |
parents | 763bc1ba714e |
children | cd0cc37be860 |
comparison
equal
deleted
inserted
replaced
3899:a0655a72182b | 3900:c6f3d2af0df7 |
---|---|
35 when creating new masters.") | 35 when creating new masters.") |
36 | 36 |
37 (defvar vc-make-backup-files nil | 37 (defvar vc-make-backup-files nil |
38 "*If non-nil, backups of registered files are made according to | 38 "*If non-nil, backups of registered files are made according to |
39 the make-backup-files variable. Otherwise, prevents backups being made.") | 39 the make-backup-files variable. Otherwise, prevents backups being made.") |
40 | |
41 (defvar vc-rcs-status t | |
42 "*If non-nil, revision and locks on RCS working file displayed in modeline. | |
43 Otherwise, not displayed.") | |
40 | 44 |
41 ;; Tell Emacs about this new kind of minor mode | 45 ;; Tell Emacs about this new kind of minor mode |
42 (if (not (assoc 'vc-mode minor-mode-alist)) | 46 (if (not (assoc 'vc-mode minor-mode-alist)) |
43 (setq minor-mode-alist (cons '(vc-mode vc-mode) | 47 (setq minor-mode-alist (cons '(vc-mode vc-mode) |
44 minor-mode-alist))) | 48 minor-mode-alist))) |
124 The value is set in the current buffer, which should be the buffer | 128 The value is set in the current buffer, which should be the buffer |
125 visiting FILE." | 129 visiting FILE." |
126 (interactive (list buffer-file-name nil)) | 130 (interactive (list buffer-file-name nil)) |
127 (let ((vc-type (vc-backend-deduce file))) | 131 (let ((vc-type (vc-backend-deduce file))) |
128 (if vc-type | 132 (if vc-type |
129 (progn | 133 (setq vc-mode |
130 (setq vc-mode | 134 (concat (if (and vc-rcs-status (eq vc-type 'RCS)) |
131 (concat " " (or label (symbol-name vc-type)))))) | 135 (vc-rcs-status file)) |
136 " " (or label (symbol-name vc-type))))) | |
132 ;; force update of mode line | 137 ;; force update of mode line |
133 (set-buffer-modified-p (buffer-modified-p)) | 138 (set-buffer-modified-p (buffer-modified-p)) |
134 vc-type)) | 139 vc-type)) |
140 | |
141 (defun vc-rcs-status (file) | |
142 ;; Return string " [LOCKERS:]REV" if FILE under RCS control, otherwise nil, | |
143 ;; for placement in modeline by `vc-mode-line'. | |
144 | |
145 ;; If FILE is not locked then return just " REV", where | |
146 ;; REV is the number of last revision checked in. If the FILE is locked | |
147 ;; then return *all* the locks currently set, in a single string of the | |
148 ;; form " LOCKER1:REV1 LOCKER2:REV2 ..." | |
149 | |
150 ;; Algorithm: | |
151 | |
152 ;; 1. Check for master file corresponding to FILE being visited in | |
153 ;; subdirectory RCS of current directory and then, if not found there, in | |
154 ;; the current directory. some of the vc-hooks machinery could be used | |
155 ;; here. | |
156 ;; | |
157 ;; 2. Insert the header, first 200 characters, of master file into a work | |
158 ;; buffer. | |
159 ;; | |
160 ;; 3. Search work buffer for line starting with "date" indicating enough | |
161 ;; of header was included; if not found, then successive increments of 100 | |
162 ;; characters are inserted until "date" is located or 1000 characters is | |
163 ;; reached. | |
164 ;; | |
165 ;; 4. Search work buffer for line starting with "locks" and *not* followed | |
166 ;; immediately by a semi-colon; this indicates that locks exist; it extracts | |
167 ;; all the locks currently enabled and removes controls characters | |
168 ;; separating them, like newlines; the string " user1:revision1 | |
169 ;; user2:revision2 ..." is returned. | |
170 ;; | |
171 ;; 5. If "locks;" is found instead, indicating no locks, then search work | |
172 ;; buffer for lines starting with string "head" and "branch" and parses | |
173 ;; their contents; if contents of branch is non-nil then it is returned | |
174 ;; otherwise the contents of head is returned either as string " revision". | |
175 | |
176 ;; Limitations: | |
177 | |
178 ;; The output doesn't show which version you are actually looking at. | |
179 ;; The modeline can get quite cluttered when there are multiple locks. | |
180 | |
181 ;; Make sure name is expanded -- not needed? | |
182 (setq file (expand-file-name file)) | |
183 | |
184 (let (master found locks head branch status (eof 200)) | |
185 | |
186 ;; Find the name of the master file -- perhaps use `vc-name'? | |
187 (setq master (concat (file-name-directory file) "RCS/" | |
188 (file-name-nondirectory file) ",v")) | |
189 | |
190 ;; If master file exists, then parse its contents, otherwise we return the | |
191 ;; nil value of this if form. | |
192 (if (or (file-readable-p master) | |
193 (file-readable-p (setq master (concat file ",v")))) ; current dir? | |
194 | |
195 (save-excursion | |
196 | |
197 ;; Create work buffer. | |
198 (set-buffer (get-buffer-create "*vc-rcs-status*")) | |
199 (setq buffer-read-only nil | |
200 default-directory (file-name-directory master)) | |
201 (erase-buffer) | |
202 | |
203 ;; Limit search to header. | |
204 (insert-file-contents master nil 0 eof) | |
205 (goto-char (point-min)) | |
206 | |
207 ;; Check if we have enough of the header. If not, then keep | |
208 ;; including more until enough or until 1000 chars is reached. | |
209 (setq found (re-search-forward "^date" nil t)) | |
210 | |
211 (while (and (not found) (<= eof 1000)) | |
212 (goto-char (point-max)) | |
213 (insert-file-contents master nil (+ eof 1) (setq eof (+ eof 100))) | |
214 (goto-char (point-min)) | |
215 (setq found (re-search-forward "^date" nil t))) | |
216 | |
217 ;; If we located "^date" we can extract the status information, | |
218 ;; otherwise we return `status' which was initialized to nil. | |
219 (if found | |
220 (progn | |
221 (goto-char (point-min)) | |
222 | |
223 ;; First see if any revisions have any locks on them. | |
224 (if (re-search-forward "^locks[ \t\n\r\f]+\\([^;]*\\)" nil t) | |
225 | |
226 ;; At least one lock - clean controls characters from text. | |
227 (save-restriction | |
228 (narrow-to-region (match-beginning 1) (match-end 1)) | |
229 (goto-char (point-min)) | |
230 (while (re-search-forward "[ \t\n\r\f]+" nil t) | |
231 (replace-match " " t t)) | |
232 (setq locks (buffer-string))) | |
233 | |
234 ;; Not locked - find head and branch. | |
235 ;; ...more information could be extracted here. | |
236 (setq locks "" | |
237 head (vc-rcs-glean-field "head") | |
238 branch (vc-rcs-glean-field "branch"))) | |
239 | |
240 ;; In case of RCS unlocked files: if non-nil branch is | |
241 ;; displayed, else if non-nil head is displayed. if both nil, | |
242 ;; nothing is displayed. In case of RCS locked files: locks | |
243 ;; is displayed. | |
244 | |
245 (setq status (concat " " (or branch head locks))))) | |
246 | |
247 ;; Clean work buffer. | |
248 (erase-buffer) | |
249 (set-buffer-modified-p nil) | |
250 | |
251 ;; Return status, which is nil if "^date" was not located. | |
252 status)))) | |
253 | |
254 (defun vc-rcs-glean-field (field) | |
255 ;; Parse ,v file in current buffer and return contents of FIELD, | |
256 ;; which should be a field like "head" or "branch", with a | |
257 ;; revision number as value. | |
258 ;; Returns nil if FIELD is not found. | |
259 (goto-char (point-min)) | |
260 (if (re-search-forward | |
261 (concat "^" (regexp-quote field) "[ \t\n\r\f]+\\([0-9.]+\\)") | |
262 nil t) | |
263 (buffer-substring (match-beginning 1) | |
264 (match-end 1)))) | |
135 | 265 |
136 ;;; install a call to the above as a find-file hook | 266 ;;; install a call to the above as a find-file hook |
137 (defun vc-find-file-hook () | 267 (defun vc-find-file-hook () |
138 ;; Recompute whether file is version controlled, | 268 ;; Recompute whether file is version controlled, |
139 ;; if user has killed the buffer and revisited. | 269 ;; if user has killed the buffer and revisited. |