Mercurial > emacs
comparison lisp/vc-rcs.el @ 94809:76b523d99056
Teach the RCS back end to do directories.
author | Eric S. Raymond <esr@snark.thyrsus.com> |
---|---|
date | Fri, 09 May 2008 17:51:39 +0000 |
parents | eedf64b515f0 |
children | 0f7a18ff94d6 |
comparison
equal
deleted
inserted
replaced
94808:8b60ad9b42c3 | 94809:76b523d99056 |
---|---|
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | 24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
25 | 25 |
26 ;;; Commentary: | 26 ;;; Commentary: |
27 | 27 |
28 ;; See vc.el | 28 ;; See vc.el |
29 | |
30 ;; TODO: | |
31 ;; - remove call to vc-expand-dirs by implementing our own (which can just | |
32 ;; list the RCS subdir instead). | |
33 | 29 |
34 ;;; Code: | 30 ;;; Code: |
35 | 31 |
36 ;;; | 32 ;;; |
37 ;;; Customization options | 33 ;;; Customization options |
344 | 340 |
345 (defun vc-rcs-checkin (files rev comment) | 341 (defun vc-rcs-checkin (files rev comment) |
346 "RCS-specific version of `vc-backend-checkin'." | 342 "RCS-specific version of `vc-backend-checkin'." |
347 (let ((switches (vc-switches 'RCS 'checkin))) | 343 (let ((switches (vc-switches 'RCS 'checkin))) |
348 ;; Now operate on the files | 344 ;; Now operate on the files |
349 (dolist (file files) | 345 (dolist (file (vc-expand-dirs files)) |
350 (let ((old-version (vc-working-revision file)) new-version | 346 (let ((old-version (vc-working-revision file)) new-version |
351 (default-branch (vc-file-getprop file 'vc-rcs-default-branch))) | 347 (default-branch (vc-file-getprop file 'vc-rcs-default-branch))) |
352 ;; Force branch creation if an appropriate | 348 ;; Force branch creation if an appropriate |
353 ;; default branch has been set. | 349 ;; default branch has been set. |
354 (and (not rev) | 350 (and (not rev) |
400 "-q" ;; suppress diagnostic output | 396 "-q" ;; suppress diagnostic output |
401 (concat "-p" rev) | 397 (concat "-p" rev) |
402 (vc-switches 'RCS 'checkout))) | 398 (vc-switches 'RCS 'checkout))) |
403 | 399 |
404 (defun vc-rcs-checkout (file &optional editable rev) | 400 (defun vc-rcs-checkout (file &optional editable rev) |
405 "Retrieve a copy of a saved version of FILE." | 401 "Retrieve a copy of a saved version of FILE. If FILE is a directory, |
406 (let ((file-buffer (get-file-buffer file)) | 402 attempt the checkout for all registered files beneath it." |
407 switches) | 403 (if (file-directory-p file) |
408 (message "Checking out %s..." file) | 404 (mapc 'vc-rcs-checkout (vc-expand-dirs (list file))) |
409 (save-excursion | 405 (let ((file-buffer (get-file-buffer file)) |
410 ;; Change buffers to get local value of vc-checkout-switches. | 406 switches) |
411 (if file-buffer (set-buffer file-buffer)) | 407 (message "Checking out %s..." file) |
412 (setq switches (vc-switches 'RCS 'checkout)) | 408 (save-excursion |
413 ;; Save this buffer's default-directory | 409 ;; Change buffers to get local value of vc-checkout-switches. |
414 ;; and use save-excursion to make sure it is restored | 410 (if file-buffer (set-buffer file-buffer)) |
415 ;; in the same buffer it was saved in. | 411 (setq switches (vc-switches 'RCS 'checkout)) |
416 (let ((default-directory default-directory)) | 412 ;; Save this buffer's default-directory |
417 (save-excursion | 413 ;; and use save-excursion to make sure it is restored |
418 ;; Adjust the default-directory so that the check-out creates | 414 ;; in the same buffer it was saved in. |
419 ;; the file in the right place. | 415 (let ((default-directory default-directory)) |
420 (setq default-directory (file-name-directory file)) | 416 (save-excursion |
421 (let (new-version) | 417 ;; Adjust the default-directory so that the check-out creates |
422 ;; if we should go to the head of the trunk, | 418 ;; the file in the right place. |
423 ;; clear the default branch first | 419 (setq default-directory (file-name-directory file)) |
424 (and rev (string= rev "") | 420 (let (new-version) |
425 (vc-rcs-set-default-branch file nil)) | 421 ;; if we should go to the head of the trunk, |
426 ;; now do the checkout | 422 ;; clear the default branch first |
427 (apply 'vc-do-command | 423 (and rev (string= rev "") |
428 nil 0 "co" (vc-name file) | 424 (vc-rcs-set-default-branch file nil)) |
429 ;; If locking is not strict, force to overwrite | 425 ;; now do the checkout |
430 ;; the writable workfile. | 426 (apply 'vc-do-command |
431 (if (eq (vc-rcs-checkout-model (list file)) 'implicit) "-f") | 427 nil 0 "co" (vc-name file) |
432 (if editable "-l") | 428 ;; If locking is not strict, force to overwrite |
433 (if (stringp rev) | 429 ;; the writable workfile. |
434 ;; a literal revision was specified | 430 (if (eq (vc-rcs-checkout-model (list file)) 'implicit) "-f") |
435 (concat "-r" rev) | 431 (if editable "-l") |
436 (let ((workrev (vc-working-revision file))) | 432 (if (stringp rev) |
437 (if workrev | 433 ;; a literal revision was specified |
438 (concat "-r" | 434 (concat "-r" rev) |
439 (if (not rev) | 435 (let ((workrev (vc-working-revision file))) |
440 ;; no revision specified: | 436 (if workrev |
441 ;; use current workfile version | 437 (concat "-r" |
442 workrev | 438 (if (not rev) |
443 ;; REV is t ... | 439 ;; no revision specified: |
444 (if (not (vc-trunk-p workrev)) | 440 ;; use current workfile version |
445 ;; ... go to head of current branch | 441 workrev |
446 (vc-branch-part workrev) | 442 ;; REV is t ... |
447 ;; ... go to head of trunk | 443 (if (not (vc-trunk-p workrev)) |
448 (vc-rcs-set-default-branch file | 444 ;; ... go to head of current branch |
445 (vc-branch-part workrev) | |
446 ;; ... go to head of trunk | |
447 (vc-rcs-set-default-branch file | |
449 nil) | 448 nil) |
450 "")))))) | 449 "")))))) |
451 switches) | 450 switches) |
452 ;; determine the new workfile version | 451 ;; determine the new workfile version |
453 (with-current-buffer "*vc*" | 452 (with-current-buffer "*vc*" |
460 file | 459 file |
461 (if (vc-rcs-latest-on-branch-p file new-version) | 460 (if (vc-rcs-latest-on-branch-p file new-version) |
462 (if (vc-trunk-p new-version) nil | 461 (if (vc-trunk-p new-version) nil |
463 (vc-branch-part new-version)) | 462 (vc-branch-part new-version)) |
464 new-version))))) | 463 new-version))))) |
465 (message "Checking out %s...done" file))))) | 464 (message "Checking out %s...done" file)))))) |
466 | 465 |
467 (defun vc-rcs-rollback (files) | 466 (defun vc-rcs-rollback (files) |
468 "Roll back, undoing the most recent checkins of FILES." | 467 "Roll back, undoing the most recent checkins of FILES. Directories are |
468 expanded to all regidtered subfuiles in them." | |
469 (if (not files) | 469 (if (not files) |
470 (error "RCS backend doesn't support directory-level rollback.")) | 470 (error "RCS backend doesn't support directory-level rollback.")) |
471 (dolist (file files) | 471 (dolist (file (vc-expand-dirs files)) |
472 (let* ((discard (vc-working-revision file)) | 472 (let* ((discard (vc-working-revision file)) |
473 (previous (if (vc-trunk-p discard) "" (vc-branch-part discard))) | 473 (previous (if (vc-trunk-p discard) "" (vc-branch-part discard))) |
474 (config (current-window-configuration)) | 474 (config (current-window-configuration)) |
475 (done nil)) | 475 (done nil)) |
476 (if (null (yes-or-no-p (format "Remove version %s from %s history? " | 476 (if (null (yes-or-no-p (format "Remove version %s from %s history? " |
499 (set-window-configuration config)) | 499 (set-window-configuration config)) |
500 ;; No, it was some other error: re-signal it. | 500 ;; No, it was some other error: re-signal it. |
501 (signal (car err) (cdr err))))))))) | 501 (signal (car err) (cdr err))))))))) |
502 | 502 |
503 (defun vc-rcs-revert (file &optional contents-done) | 503 (defun vc-rcs-revert (file &optional contents-done) |
504 "Revert FILE to the version it was based on." | 504 "Revert FILE to the version it was based on. If FILE is a directory, |
505 (vc-do-command nil 0 "co" (vc-name file) "-f" | 505 revert all registered files beneath it." |
506 (concat (if (eq (vc-state file) 'edited) "-u" "-r") | 506 (if (file-directory-p file) |
507 (vc-working-revision file)))) | 507 (mapc 'vc-rcs-revert (vc-expand-dirs (list file))) |
508 (vc-do-command nil 0 "co" (vc-name file) "-f" | |
509 (concat (if (eq (vc-state file) 'edited) "-u" "-r") | |
510 (vc-working-revision file))))) | |
508 | 511 |
509 (defun vc-rcs-merge (file first-version &optional second-version) | 512 (defun vc-rcs-merge (file first-version &optional second-version) |
510 "Merge changes into current working copy of FILE. | 513 "Merge changes into current working copy of FILE. |
511 The changes are between FIRST-VERSION and SECOND-VERSION." | 514 The changes are between FIRST-VERSION and SECOND-VERSION." |
512 (vc-do-command nil 1 "rcsmerge" (vc-name file) | 515 (vc-do-command nil 1 "rcsmerge" (vc-name file) |
514 (concat "-r" first-version) | 517 (concat "-r" first-version) |
515 (if second-version (concat "-r" second-version)))) | 518 (if second-version (concat "-r" second-version)))) |
516 | 519 |
517 (defun vc-rcs-steal-lock (file &optional rev) | 520 (defun vc-rcs-steal-lock (file &optional rev) |
518 "Steal the lock on the current workfile for FILE and revision REV. | 521 "Steal the lock on the current workfile for FILE and revision REV. |
522 If FUILEis a directory, steal the lock on all registered files beneath it. | |
519 Needs RCS 5.6.2 or later for -M." | 523 Needs RCS 5.6.2 or later for -M." |
520 (vc-do-command nil 0 "rcs" (vc-name file) "-M" (concat "-u" rev)) | 524 (if (file-directory-p file) |
521 ;; Do a real checkout after stealing the lock, so that we see | 525 (mapc 'vc-rcs-steal-lock (vc-expand-dirs (list file))) |
522 ;; expanded headers. | 526 (vc-do-command nil 0 "rcs" (vc-name file) "-M" (concat "-u" rev)) |
523 (vc-do-command nil 0 "co" (vc-name file) "-f" (concat "-l" rev))) | 527 ;; Do a real checkout after stealing the lock, so that we see |
528 ;; expanded headers. | |
529 (vc-do-command nil 0 "co" (vc-name file) "-f" (concat "-l" rev)))) | |
524 | 530 |
525 (defun vc-rcs-modify-change-comment (files rev comment) | 531 (defun vc-rcs-modify-change-comment (files rev comment) |
526 "Modify the change comments change on FILES on a specified REV." | 532 "Modify the change comments change on FILES on a specified REV. If FILE is a |
527 (dolist (file files) | 533 directory the operation is applied to all registered files beneath it." |
534 (dolist (file (vc-expand-dirs files)) | |
528 (vc-do-command nil 0 "rcs" (vc-name file) | 535 (vc-do-command nil 0 "rcs" (vc-name file) |
529 (concat "-m" rev ":" comment)))) | 536 (concat "-m" rev ":" comment)))) |
530 | 537 |
531 | 538 |
532 ;;; | 539 ;;; |
533 ;;; History functions | 540 ;;; History functions |
534 ;;; | 541 ;;; |
535 | 542 |
536 (defun vc-rcs-print-log (files &optional buffer) | 543 (defun vc-rcs-print-log (files &optional buffer) |
537 "Get change log associated with FILE." | 544 "Get change log associated with FILE. If FILE is a |
538 (vc-do-command buffer 0 "rlog" (mapcar 'vc-name files))) | 545 directory the operation is applied to all registered files beneath it." |
546 (vc-do-command buffer 0 "rlog" (mapcar 'vc-name (vc-expand-dirs files)))) | |
539 | 547 |
540 (defun vc-rcs-diff (files &optional oldvers newvers buffer) | 548 (defun vc-rcs-diff (files &optional oldvers newvers buffer) |
541 "Get a difference report using RCS between two sets of files." | 549 "Get a difference report using RCS between two sets of files." |
542 (apply 'vc-do-command (or buffer "*vc-diff*") | 550 (apply 'vc-do-command (or buffer "*vc-diff*") |
543 1 ;; Always go synchronous, the repo is local | 551 1 ;; Always go synchronous, the repo is local |