99 |
;;; State-querying functions |
;;; State-querying functions |
100 |
;;; |
;;; |
101 |
|
|
102 |
;;;###autoload |
;;; The autoload cookie below places vc-rcs-registered directly into |
103 |
(progn (defun vc-rcs-registered (f) (vc-default-registered 'RCS f))) |
;;; loaddefs.el, so that vc-rcs.el does not need to be loaded for |
104 |
|
;;; every file that is visited. The definition is repeated below |
105 |
|
;;; so that Help and etags can find it. |
106 |
|
|
107 |
|
;;;###autoload (defun vc-rcs-registered (f) (vc-default-registered 'RCS f)) |
108 |
|
(defun vc-rcs-registered (f) (vc-default-registered 'RCS f)) |
109 |
|
|
110 |
(defun vc-rcs-state (file) |
(defun vc-rcs-state (file) |
111 |
"Implementation of `vc-state' for RCS." |
"Implementation of `vc-state' for RCS." |
121 |
'vc-workfile-version)))) |
'vc-workfile-version)))) |
122 |
(if (not (eq state 'up-to-date)) |
(if (not (eq state 'up-to-date)) |
123 |
state |
state |
|
(require 'vc) |
|
124 |
(if (vc-workfile-unchanged-p file) |
(if (vc-workfile-unchanged-p file) |
125 |
'up-to-date |
'up-to-date |
126 |
(if (eq (vc-checkout-model file) 'locking) |
(if (eq (vc-checkout-model file) 'locking) |
143 |
(cond |
(cond |
144 |
((string-match ".rw..-..-." (nth 8 (file-attributes file))) |
((string-match ".rw..-..-." (nth 8 (file-attributes file))) |
145 |
(vc-file-setprop file 'vc-checkout-model 'implicit) |
(vc-file-setprop file 'vc-checkout-model 'implicit) |
146 |
(setq state |
(setq state |
147 |
(if (vc-rcs-workfile-is-newer file) |
(if (vc-rcs-workfile-is-newer file) |
148 |
'edited |
'edited |
149 |
'up-to-date))) |
'up-to-date))) |
150 |
((string-match ".r-..-..-." (nth 8 (file-attributes file))) |
((string-match ".r-..-..-." (nth 8 (file-attributes file))) |
151 |
(vc-file-setprop file 'vc-checkout-model 'locking)))) |
(vc-file-setprop file 'vc-checkout-model 'locking)))) |
162 |
(if (file-ownership-preserved-p file) |
(if (file-ownership-preserved-p file) |
163 |
'edited |
'edited |
164 |
(vc-user-login-name owner-uid)) |
(vc-user-login-name owner-uid)) |
165 |
(if (vc-rcs-workfile-is-newer file) |
(if (vc-rcs-workfile-is-newer file) |
166 |
'edited |
'edited |
167 |
'up-to-date))) |
'up-to-date))) |
168 |
(t |
(t |
243 |
(if (stringp vc-rcs-register-switches) |
(if (stringp vc-rcs-register-switches) |
244 |
(list vc-rcs-register-switches) |
(list vc-rcs-register-switches) |
245 |
vc-rcs-register-switches)))) |
vc-rcs-register-switches)))) |
246 |
|
|
247 |
(and (not (file-exists-p subdir)) |
(and (not (file-exists-p subdir)) |
248 |
(not (directory-files (file-name-directory file) |
(not (directory-files (file-name-directory file) |
249 |
nil ".*,v$" t)) |
nil ".*,v$" t)) |
305 |
(and (string= (file-name-nondirectory (directory-file-name dir)) "RCS") |
(and (string= (file-name-nondirectory (directory-file-name dir)) "RCS") |
306 |
;; check whether RCS dir is empty, i.e. it does not |
;; check whether RCS dir is empty, i.e. it does not |
307 |
;; contain any files except "." and ".." |
;; contain any files except "." and ".." |
308 |
(not (directory-files dir nil |
(not (directory-files dir nil |
309 |
"^\\([^.]\\|\\.[^.]\\|\\.\\.[^.]\\).*")) |
"^\\([^.]\\|\\.[^.]\\|\\.\\.[^.]\\).*")) |
310 |
(yes-or-no-p (format "Directory %s is empty; remove it? " dir)) |
(yes-or-no-p (format "Directory %s is empty; remove it? " dir)) |
311 |
(delete-directory dir)))) |
(delete-directory dir)))) |
317 |
vc-checkin-switches))) |
vc-checkin-switches))) |
318 |
(let ((old-version (vc-workfile-version file)) new-version |
(let ((old-version (vc-workfile-version file)) new-version |
319 |
(default-branch (vc-file-getprop file 'vc-rcs-default-branch))) |
(default-branch (vc-file-getprop file 'vc-rcs-default-branch))) |
320 |
;; Force branch creation if an appropriate |
;; Force branch creation if an appropriate |
321 |
;; default branch has been set. |
;; default branch has been set. |
322 |
(and (not rev) |
(and (not rev) |
323 |
default-branch |
default-branch |
325 |
default-branch) |
default-branch) |
326 |
(setq rev default-branch) |
(setq rev default-branch) |
327 |
(setq switches (cons "-f" switches))) |
(setq switches (cons "-f" switches))) |
328 |
|
(if (and (not rev) old-version) |
329 |
|
(setq rev (vc-branch-part old-version))) |
330 |
(apply 'vc-do-command nil 0 "ci" (vc-name file) |
(apply 'vc-do-command nil 0 "ci" (vc-name file) |
331 |
;; if available, use the secure check-in option |
;; if available, use the secure check-in option |
332 |
(and (vc-rcs-release-p "5.6.4") "-j") |
(and (vc-rcs-release-p "5.6.4") "-j") |
351 |
((and old-version new-version |
((and old-version new-version |
352 |
(not (string= (vc-branch-part old-version) |
(not (string= (vc-branch-part old-version) |
353 |
(vc-branch-part new-version)))) |
(vc-branch-part new-version)))) |
354 |
(vc-rcs-set-default-branch file |
(vc-rcs-set-default-branch file |
355 |
(if (vc-trunk-p new-version) nil |
(if (vc-trunk-p new-version) nil |
356 |
(vc-branch-part new-version))) |
(vc-branch-part new-version))) |
357 |
;; If this is an old RCS release, we might have |
;; If this is an old RCS release, we might have |
362 |
(vc-do-command nil 1 "rcs" (vc-name file) |
(vc-do-command nil 1 "rcs" (vc-name file) |
363 |
(concat "-u" old-version)))))))) |
(concat "-u" old-version)))))))) |
364 |
|
|
365 |
(defun vc-rcs-checkout (file &optional editable rev workfile) |
(defun vc-rcs-find-version (file rev buffer) |
366 |
"Retrieve a copy of a saved version of FILE into a workfile." |
(apply 'vc-do-command |
367 |
(let ((filename (or workfile file)) |
buffer 0 "co" (vc-name file) |
368 |
(file-buffer (get-file-buffer file)) |
"-q" ;; suppress diagnostic output |
369 |
|
(concat "-p" rev) |
370 |
|
(if (stringp vc-checkout-switches) |
371 |
|
(list vc-checkout-switches) |
372 |
|
vc-checkout-switches))) |
373 |
|
|
374 |
|
(defun vc-rcs-checkout (file &optional editable rev) |
375 |
|
"Retrieve a copy of a saved version of FILE." |
376 |
|
(let ((file-buffer (get-file-buffer file)) |
377 |
switches) |
switches) |
378 |
(message "Checking out %s..." filename) |
(message "Checking out %s..." file) |
379 |
(save-excursion |
(save-excursion |
380 |
;; Change buffers to get local value of vc-checkout-switches. |
;; Change buffers to get local value of vc-checkout-switches. |
381 |
(if file-buffer (set-buffer file-buffer)) |
(if file-buffer (set-buffer file-buffer)) |
389 |
(save-excursion |
(save-excursion |
390 |
;; Adjust the default-directory so that the check-out creates |
;; Adjust the default-directory so that the check-out creates |
391 |
;; the file in the right place. |
;; the file in the right place. |
392 |
(setq default-directory (file-name-directory filename)) |
(setq default-directory (file-name-directory file)) |
393 |
(if workfile ;; RCS |
(let (new-version) |
394 |
;; RCS can't check out into arbitrary file names directly. |
;; if we should go to the head of the trunk, |
395 |
;; Use `co -p' and make stdout point to the correct file. |
;; clear the default branch first |
396 |
(let ((vc-modes (logior (file-modes (vc-name file)) |
(and rev (string= rev "") |
397 |
(if editable 128 0))) |
(vc-rcs-set-default-branch file nil)) |
398 |
(failed t)) |
;; now do the checkout |
399 |
(unwind-protect |
(apply 'vc-do-command |
400 |
(progn |
nil 0 "co" (vc-name file) |
401 |
(let ((coding-system-for-read 'no-conversion) |
;; If locking is not strict, force to overwrite |
402 |
(coding-system-for-write 'no-conversion)) |
;; the writable workfile. |
403 |
(with-temp-file filename |
(if (eq (vc-checkout-model file) 'implicit) "-f") |
404 |
(apply 'vc-do-command |
(if editable "-l") |
405 |
(current-buffer) 0 "co" (vc-name file) |
(if (stringp rev) |
406 |
"-q" ;; suppress diagnostic output |
;; a literal revision was specified |
407 |
(if editable "-l") |
(concat "-r" rev) |
408 |
(concat "-p" rev) |
(let ((workrev (vc-workfile-version file))) |
409 |
switches))) |
(if workrev |
410 |
(set-file-modes filename |
(concat "-r" |
411 |
(logior (file-modes (vc-name file)) |
(if (not rev) |
412 |
(if editable 128 0))) |
;; no revision specified: |
413 |
(setq failed nil)) |
;; use current workfile version |
414 |
(and failed (file-exists-p filename) |
workrev |
415 |
(delete-file filename)))) |
;; REV is t ... |
416 |
(let (new-version) |
(if (not (vc-trunk-p workrev)) |
417 |
;; if we should go to the head of the trunk, |
;; ... go to head of current branch |
418 |
;; clear the default branch first |
(vc-branch-part workrev) |
419 |
(and rev (string= rev "") |
;; ... go to head of trunk |
420 |
(vc-rcs-set-default-branch file nil)) |
(vc-rcs-set-default-branch file |
421 |
;; now do the checkout |
nil) |
422 |
(apply 'vc-do-command |
"")))))) |
423 |
nil 0 "co" (vc-name file) |
switches) |
424 |
;; If locking is not strict, force to overwrite |
;; determine the new workfile version |
425 |
;; the writable workfile. |
(with-current-buffer "*vc*" |
426 |
(if (eq (vc-checkout-model file) 'implicit) "-f") |
(setq new-version |
427 |
(if editable "-l") |
(vc-parse-buffer "^revision \\([0-9.]+\\).*\n" 1))) |
428 |
(if rev (concat "-r" rev) |
(vc-file-setprop file 'vc-workfile-version new-version) |
429 |
;; if no explicit revision was specified, |
;; if necessary, adjust the default branch |
430 |
;; check out that of the working file |
(and rev (not (string= rev "")) |
431 |
(let ((workrev (vc-workfile-version file))) |
(vc-rcs-set-default-branch |
432 |
(if workrev (concat "-r" workrev) |
file |
433 |
nil))) |
(if (vc-rcs-latest-on-branch-p file new-version) |
434 |
switches) |
(if (vc-trunk-p new-version) nil |
435 |
;; determine the new workfile version |
(vc-branch-part new-version)) |
436 |
(with-current-buffer "*vc*" |
new-version))))) |
437 |
(setq new-version |
(message "Checking out %s...done" file))))) |
|
(vc-parse-buffer "^revision \\([0-9.]+\\).*\n" 1))) |
|
|
(vc-file-setprop file 'vc-workfile-version new-version) |
|
|
;; if necessary, adjust the default branch |
|
|
(and rev (not (string= rev "")) |
|
|
(vc-rcs-set-default-branch |
|
|
file |
|
|
(if (vc-rcs-latest-on-branch-p file new-version) |
|
|
(if (vc-trunk-p new-version) nil |
|
|
(vc-branch-part new-version)) |
|
|
new-version)))))) |
|
|
(message "Checking out %s...done" filename))))) |
|
438 |
|
|
439 |
(defun vc-rcs-revert (file &optional contents-done) |
(defun vc-rcs-revert (file &optional contents-done) |
440 |
"Revert FILE to the version it was based on." |
"Revert FILE to the version it was based on." |
441 |
(vc-do-command nil 0 "co" (vc-name file) "-f" |
(vc-do-command nil 0 "co" (vc-name file) "-f" |
442 |
(concat "-u" (vc-workfile-version file)))) |
(concat (if (eq (vc-state file) 'edited) "-u" "-r") |
443 |
|
(vc-workfile-version file)))) |
444 |
|
|
445 |
(defun vc-rcs-cancel-version (file editable) |
(defun vc-rcs-cancel-version (file editable) |
446 |
"Undo the most recent checkin of FILE. |
"Undo the most recent checkin of FILE. |
483 |
"Steal the lock on the current workfile for FILE and revision REV. |
"Steal the lock on the current workfile for FILE and revision REV. |
484 |
Needs RCS 5.6.2 or later for -M." |
Needs RCS 5.6.2 or later for -M." |
485 |
(vc-do-command nil 0 "rcs" (vc-name file) "-M" (concat "-u" rev)) |
(vc-do-command nil 0 "rcs" (vc-name file) "-M" (concat "-u" rev)) |
486 |
;; Do a real checkout after stealing the lock, so that we see |
;; Do a real checkout after stealing the lock, so that we see |
487 |
;; expanded headers. |
;; expanded headers. |
488 |
(vc-do-command nil 0 "co" (vc-name file) "-f" (concat "-l" rev))) |
(vc-do-command nil 0 "co" (vc-name file) "-f" (concat "-l" rev))) |
489 |
|
|
497 |
"Get change log associated with FILE." |
"Get change log associated with FILE." |
498 |
(vc-do-command nil 0 "rlog" (vc-name file))) |
(vc-do-command nil 0 "rlog" (vc-name file))) |
499 |
|
|
|
(defun vc-rcs-show-log-entry (version) |
|
|
(when (re-search-forward |
|
|
;; also match some context, for safety |
|
|
(concat "----\nrevision " version |
|
|
"\\(\tlocked by:.*\n\\|\n\\)date: ") nil t) |
|
|
;; set the display window so that |
|
|
;; the whole log entry is displayed |
|
|
(let (start end lines) |
|
|
(beginning-of-line) (forward-line -1) (setq start (point)) |
|
|
(if (not (re-search-forward "^----*\nrevision" nil t)) |
|
|
(setq end (point-max)) |
|
|
(beginning-of-line) (forward-line -1) (setq end (point))) |
|
|
(setq lines (count-lines start end)) |
|
|
(cond |
|
|
;; if the global information and this log entry fit |
|
|
;; into the window, display from the beginning |
|
|
((< (count-lines (point-min) end) (window-height)) |
|
|
(goto-char (point-min)) |
|
|
(recenter 0) |
|
|
(goto-char start)) |
|
|
;; if the whole entry fits into the window, |
|
|
;; display it centered |
|
|
((< (1+ lines) (window-height)) |
|
|
(goto-char start) |
|
|
(recenter (1- (- (/ (window-height) 2) (/ lines 2))))) |
|
|
;; otherwise (the entry is too large for the window), |
|
|
;; display from the start |
|
|
(t |
|
|
(goto-char start) |
|
|
(recenter 0)))))) |
|
|
|
|
500 |
(defun vc-rcs-diff (file &optional oldvers newvers) |
(defun vc-rcs-diff (file &optional oldvers newvers) |
501 |
"Get a difference report using RCS between two versions of FILE." |
"Get a difference report using RCS between two versions of FILE." |
502 |
(if (not oldvers) (setq oldvers (vc-workfile-version file))) |
(if (not oldvers) (setq oldvers (vc-workfile-version file))) |
578 |
`vc-checkout-model' to their correct values, based on the master |
`vc-checkout-model' to their correct values, based on the master |
579 |
file." |
file." |
580 |
(with-temp-buffer |
(with-temp-buffer |
581 |
(vc-insert-file (vc-name file) "^[0-9]") |
(if (or (not (vc-insert-file (vc-name file) "^[0-9]")) |
582 |
|
(progn (goto-char (point-min)) |
583 |
|
(not (looking-at "^head[ \t\n]+[^;]+;$")))) |
584 |
|
(error "File %s is not an RCS master file" (vc-name file))) |
585 |
(let ((workfile-is-latest nil) |
(let ((workfile-is-latest nil) |
586 |
(default-branch (vc-parse-buffer "^branch[ \t\n]+\\([^;]*\\);" 1))) |
(default-branch (vc-parse-buffer "^branch[ \t\n]+\\([^;]*\\);" 1))) |
587 |
(vc-file-setprop file 'vc-rcs-default-branch default-branch) |
(vc-file-setprop file 'vc-rcs-default-branch default-branch) |