Mercurial > emacs

comparison lisp/vc-hooks.el @ 12252:e07d55d05864

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(vc-fetch-master-properties): For RCS file, don't look for vc-latest-version and vc-your-latest-version here. Read only through ^locks unless we need to find the tip of a branch. (vc-consult-rcs-headers): Use non-regexp search to find the headers. (vc-latest-version, vc-your-latest-version): Use vc-fetch-properties. (vc-fetch-properties): New function.
author Richard M. Stallman <rms@gnu.org>
date Fri, 16 Jun 1995 01:04:27 +0000
parents f2519a110e5f
children 9c8be78affe6
comparison
equal deleted inserted replaced
12251:f2519a110e5f 12252:e07d55d05864
216 (setq index (match-end 0))))) 216 (setq index (match-end 0)))))
217 (vc-file-setprop file 'vc-master-locks (or master-locks 'none))))) 217 (vc-file-setprop file 'vc-master-locks (or master-locks 'none)))))
218 218
219 (defun vc-fetch-master-properties (file) 219 (defun vc-fetch-master-properties (file)
220 ;; Fetch those properties of FILE that are stored in the master file. 220 ;; Fetch those properties of FILE that are stored in the master file.
221 ;; For an RCS file, we don't get vc-latest-version vc-your-latest-version
222 ;; here because that is slow.
223 ;; That gets done if/when the functions vc-latest-version
224 ;; and vc-your-latest-version get called.
221 (save-excursion 225 (save-excursion
222 (cond 226 (cond
223 ((eq (vc-backend file) 'SCCS) 227 ((eq (vc-backend file) 'SCCS)
224 (set-buffer (get-buffer-create "*vc-info*")) 228 (set-buffer (get-buffer-create "*vc-info*"))
225 (if (vc-insert-file (vc-lock-file file)) 229 (if (vc-insert-file (vc-lock-file file))
234 file 238 file
235 '(vc-latest-version vc-your-latest-version))) 239 '(vc-latest-version vc-your-latest-version)))
236 240
237 ((eq (vc-backend file) 'RCS) 241 ((eq (vc-backend file) 'RCS)
238 (set-buffer (get-buffer-create "*vc-info*")) 242 (set-buffer (get-buffer-create "*vc-info*"))
239 (vc-insert-file (vc-name file) "^desc") 243 (vc-insert-file (vc-name file) "^locks")
240 (vc-parse-buffer 244 (vc-parse-buffer
241 (list '("^head[ \t\n]+\\([^;]+\\);" 1) 245 (list '("^head[ \t\n]+\\([^;]+\\);" 1)
242 '("^branch[ \t\n]+\\([^;]+\\);" 1) 246 '("^branch[ \t\n]+\\([^;]+\\);" 1)
243 '("^locks\\([^;]+\\);" 1) 247 '("^locks\\([^;]+\\);" 1))
244 '("^\\([0-9]+\\.[0-9.]+\\)\ndate[ \t]+\\([0-9.]+\\);" 1 2)
245 (list (concat "^\\([0-9]+\\.[0-9.]+\\)\n"
246 "date[ \t]+\\([0-9.]+\\);[ \t]+"
247 "author[ \t]+"
248 (regexp-quote (user-login-name)) ";") 1 2))
249 file 248 file
250 '(vc-head-version 249 '(vc-head-version
251 vc-default-branch 250 vc-default-branch
252 vc-master-locks 251 vc-master-locks))
253 vc-latest-version
254 vc-your-latest-version))
255 ;; determine vc-top-version: it is either the head version, 252 ;; determine vc-top-version: it is either the head version,
256 ;; or the tip of the default branch 253 ;; or the tip of the default branch
257 (let ((default-branch (vc-file-getprop file 'vc-default-branch))) 254 (let ((default-branch (vc-file-getprop file 'vc-default-branch)))
258 (cond 255 (cond
259 ;; no default branch 256 ;; no default branch
263 ;; default branch is actually a revision 260 ;; default branch is actually a revision
264 ((string-match "^[0-9]+\\.[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*$" 261 ((string-match "^[0-9]+\\.[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*$"
265 default-branch) 262 default-branch)
266 (vc-file-setprop file 'vc-top-version default-branch)) 263 (vc-file-setprop file 'vc-top-version default-branch))
267 ;; else, search for the tip of the default branch 264 ;; else, search for the tip of the default branch
268 (t (vc-parse-buffer (list (list 265 (t (erase-buffer)
266 (vc-insert-file (vc-name file) "^desc")
267 (vc-parse-buffer (list (list
269 (concat "^\\(" 268 (concat "^\\("
270 (regexp-quote default-branch) 269 (regexp-quote default-branch)
271 "\\.[0-9]+\\)\ndate[ \t]+\\([0-9.]+\\);") 1 2)) 270 "\\.[0-9]+\\)\ndate[ \t]+\\([0-9.]+\\);") 1 2))
272 file '(vc-top-version))))) 271 file '(vc-top-version)))))
273 ;; translate the locks 272 ;; translate the locks
291 (auto-save-mode nil) 290 (auto-save-mode nil)
292 (vc-parse-buffer 291 (vc-parse-buffer
293 ;; CVS 1.3 says "RCS Version:", other releases "RCS Revision:", 292 ;; CVS 1.3 says "RCS Version:", other releases "RCS Revision:",
294 ;; and CVS 1.4a1 says "Repository revision:". 293 ;; and CVS 1.4a1 says "Repository revision:".
295 '(("\\(RCS Version\\|RCS Revision\\|Repository revision\\):[\t ]+\\([0-9.]+\\)" 2) 294 '(("\\(RCS Version\\|RCS Revision\\|Repository revision\\):[\t ]+\\([0-9.]+\\)" 2)
296 ("^File: [^ \t]+[ \t]+Status: \\(.*\\)" 1)) 295 ("^File: [^ \t]+[ \t]+Status: \\(.*\\)" 1))
297 file 296 file
298 '(vc-latest-version vc-cvs-status)) 297 '(vc-latest-version vc-cvs-status))
299 ;; Translate those status values that are needed into symbols. 298 ;; Translate those status values that are needed into symbols.
300 ;; Any other value is converted to nil. 299 ;; Any other value is converted to nil.
301 (let ((status (vc-file-getprop file 'vc-cvs-status))) 300 (let ((status (vc-file-getprop file 'vc-cvs-status)))
330 (set-buffer (get-file-buffer file)) 329 (set-buffer (get-file-buffer file))
331 (goto-char (point-min)) 330 (goto-char (point-min))
332 (cond 331 (cond
333 ;; search for $Id or $Header 332 ;; search for $Id or $Header
334 ;; ------------------------- 333 ;; -------------------------
335 ((re-search-forward "\\$\\(Id\\|Header\\): [^ ]+ \\([0-9.]+\\) " 334 ((or (and (search-forward "$Id: " nil t)
336 nil t) 335 (looking-at "[^ ]+ \\([0-9.]+\\) "))
336 (and (progn (goto-char (point-min))
337 (search-forward "$Headers: " nil t))
338 (looking-at "[^ ]+ \\([0-9.]+\\) ")))
337 ;; if found, store the revision number ... 339 ;; if found, store the revision number ...
338 (let ((rev (buffer-substring (match-beginning 2) 340 (let ((rev (buffer-substring (match-beginning 1)
339 (match-end 2)))) 341 (match-end 1))))
340 ;; ... and check for the locking state 342 ;; ... and check for the locking state
341 (if (re-search-forward 343 (if (re-search-forward
342 (concat "\\=[0-9]+/[0-9]+/[0-9]+ " ; date 344 (concat "\\=[0-9]+/[0-9]+/[0-9]+ " ; date
343 "[0-9]+:[0-9]+:[0-9]+ " ; time 345 "[0-9]+:[0-9]+:[0-9]+ " ; time
344 "[^ ]+ [^ ]+ ") ; author & state 346 "[^ ]+ [^ ]+ ") ; author & state
542 ;;; properties to store current and recent version numbers 544 ;;; properties to store current and recent version numbers
543 545
544 (defun vc-latest-version (file) 546 (defun vc-latest-version (file)
545 ;; Return version level of the latest version of FILE 547 ;; Return version level of the latest version of FILE
546 (cond ((vc-file-getprop file 'vc-latest-version)) 548 (cond ((vc-file-getprop file 'vc-latest-version))
547 (t (vc-fetch-master-properties file) 549 (t (vc-fetch-properties file)
548 (vc-file-getprop file 'vc-latest-version)))) 550 (vc-file-getprop file 'vc-latest-version))))
549 551
550 (defun vc-your-latest-version (file) 552 (defun vc-your-latest-version (file)
551 ;; Return version level of the latest version of FILE checked in by you 553 ;; Return version level of the latest version of FILE checked in by you
552 (cond ((vc-file-getprop file 'vc-your-latest-version)) 554 (cond ((vc-file-getprop file 'vc-your-latest-version))
553 (t (vc-fetch-master-properties file) 555 (t (vc-fetch-properties file)
554 (vc-file-getprop file 'vc-your-latest-version)))) 556 (vc-file-getprop file 'vc-your-latest-version))))
555 557
556 (defun vc-top-version (file) 558 (defun vc-top-version (file)
557 ;; Return version level of the highest revision on the default branch 559 ;; Return version level of the highest revision on the default branch
558 ;; If there is no default branch, return the highest version number 560 ;; If there is no default branch, return the highest version number
559 ;; on the trunk. 561 ;; on the trunk.
560 ;; This property is defined for RCS only. 562 ;; This property is defined for RCS only.
561 (cond ((vc-file-getprop file 'vc-top-version)) 563 (cond ((vc-file-getprop file 'vc-top-version))
562 (t (vc-fetch-master-properties file) 564 (t (vc-fetch-master-properties file)
563 (vc-file-getprop file 'vc-top-version)))) 565 (vc-file-getprop file 'vc-top-version))))
566
567 (defun vc-fetch-properties (file)
568 ;; Fetch vc-latest-version and vc-your-latest-version
569 ;; if that wasn't already done.
570 (vc-backend-dispatch
571 file
572 ;; SCCS
573 (vc-fetch-master-properties file)
574 ;; RCS
575 (progn
576 (set-buffer (get-buffer-create "*vc-info*"))
577 (vc-insert-file (vc-name file) "^desc")
578 (vc-parse-buffer
579 (list '("^\\([0-9]+\\.[0-9.]+\\)\ndate[ \t]+\\([0-9.]+\\);" 1 2)
580 (list (concat "^\\([0-9]+\\.[0-9.]+\\)\n"
581 "date[ \t]+\\([0-9.]+\\);[ \t]+"
582 "author[ \t]+"
583 (regexp-quote (user-login-name)) ";") 1 2))
584 file
585 '(vc-latest-version vc-your-latest-version)))
586 ;; CVS
587 (vc-fetch-master-properties file)
588 ))
564 589
565 (defun vc-workfile-version (file) 590 (defun vc-workfile-version (file)
566 ;; Return version level of the current workfile FILE 591 ;; Return version level of the current workfile FILE
567 ;; This is attempted by first looking at the RCS keywords. 592 ;; This is attempted by first looking at the RCS keywords.
568 ;; If there are no keywords in the working file, 593 ;; If there are no keywords in the working file,