Mercurial > emacs
comparison lisp/vc.el @ 104647:ef4820f099a1
(vc-read-revision): New function.
(vc-version-diff, vc-merge): Use it.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Thu, 27 Aug 2009 16:53:04 +0000 |
parents | f4a041a8c69d |
children | adeed914a5fb |
comparison
equal
deleted
inserted
replaced
104646:17ba24e6c4d0 | 104647:ef4820f099a1 |
---|---|
1513 (pop-to-buffer (current-buffer)) | 1513 (pop-to-buffer (current-buffer)) |
1514 ;; In the async case, we return t even if there are no differences | 1514 ;; In the async case, we return t even if there are no differences |
1515 ;; because we don't know that yet. | 1515 ;; because we don't know that yet. |
1516 t))) | 1516 t))) |
1517 | 1517 |
1518 (defun vc-read-revision (prompt &optional files backend default initial-input) | |
1519 (cond | |
1520 ((null files) | |
1521 (let ((vc-fileset (vc-deduce-fileset t))) ;FIXME: why t? --Stef | |
1522 (setq files (cadr vc-fileset)) | |
1523 (setq backend (car vc-fileset)))) | |
1524 ((null backend) (setq backend (vc-backend (car files))))) | |
1525 (let ((completion-table | |
1526 (vc-call-backend backend 'revision-completion-table files))) | |
1527 (if completion-table | |
1528 (completing-read prompt completion-table | |
1529 nil nil initial-input nil default) | |
1530 (read-string prompt initial-input nil default)))) | |
1531 | |
1518 ;;;###autoload | 1532 ;;;###autoload |
1519 (defun vc-version-diff (files rev1 rev2) | 1533 (defun vc-version-diff (files rev1 rev2) |
1520 "Report diffs between revisions of the fileset in the repository history." | 1534 "Report diffs between revisions of the fileset in the repository history." |
1521 (interactive | 1535 (interactive |
1522 (let* ((vc-fileset (vc-deduce-fileset t)) ;FIXME: why t? --Stef | 1536 (let* ((vc-fileset (vc-deduce-fileset t)) ;FIXME: why t? --Stef |
1523 (files (cadr vc-fileset)) | 1537 (files (cadr vc-fileset)) |
1524 (backend (car vc-fileset)) | 1538 (backend (car vc-fileset)) |
1525 (first (car files)) | 1539 (first (car files)) |
1526 (completion-table | |
1527 (vc-call-backend backend 'revision-completion-table files)) | |
1528 (rev1-default nil) | 1540 (rev1-default nil) |
1529 (rev2-default nil)) | 1541 (rev2-default nil)) |
1530 (cond | 1542 (cond |
1531 ;; someday we may be able to do revision completion on non-singleton | 1543 ;; someday we may be able to do revision completion on non-singleton |
1532 ;; filesets, but not yet. | 1544 ;; filesets, but not yet. |
1549 (concat "Older revision (default " | 1561 (concat "Older revision (default " |
1550 rev1-default "): ") | 1562 rev1-default "): ") |
1551 "Older revision: ")) | 1563 "Older revision: ")) |
1552 (rev2-prompt (concat "Newer revision (default " | 1564 (rev2-prompt (concat "Newer revision (default " |
1553 (or rev2-default "current source") "): ")) | 1565 (or rev2-default "current source") "): ")) |
1554 (rev1 (if completion-table | 1566 (rev1 (vc-read-revision rev1-prompt files backend rev1-default)) |
1555 (completing-read rev1-prompt completion-table | 1567 (rev2 (vc-read-revision rev2-prompt files backend rev2-default))) |
1556 nil nil nil nil rev1-default) | |
1557 (read-string rev1-prompt nil nil rev1-default))) | |
1558 (rev2 (if completion-table | |
1559 (completing-read rev2-prompt completion-table | |
1560 nil nil nil nil rev2-default) | |
1561 (read-string rev2-prompt nil nil rev2-default)))) | |
1562 (when (string= rev1 "") (setq rev1 nil)) | 1568 (when (string= rev1 "") (setq rev1 nil)) |
1563 (when (string= rev2 "") (setq rev2 nil)) | 1569 (when (string= rev2 "") (setq rev2 nil)) |
1564 (list files rev1 rev2)))) | 1570 (list files rev1 rev2)))) |
1565 ;; All that was just so we could do argument completion! | 1571 ;; All that was just so we could do argument completion! |
1566 (when (and (not rev1) rev2) | 1572 (when (and (not rev1) rev2) |
1596 If the current file is named `F', the revision is named `F.~REV~'. | 1602 If the current file is named `F', the revision is named `F.~REV~'. |
1597 If `F.~REV~' already exists, use it instead of checking it out again." | 1603 If `F.~REV~' already exists, use it instead of checking it out again." |
1598 (interactive | 1604 (interactive |
1599 (save-current-buffer | 1605 (save-current-buffer |
1600 (vc-ensure-vc-buffer) | 1606 (vc-ensure-vc-buffer) |
1601 (let ((completion-table | 1607 (list |
1602 (vc-call revision-completion-table (list buffer-file-name))) | 1608 (vc-read-revision "Revision to visit (default is working revision): " |
1603 (prompt "Revision to visit (default is working revision): ")) | 1609 (list buffer-file-name))))) |
1604 (list | |
1605 (if completion-table | |
1606 (completing-read prompt completion-table) | |
1607 (read-string prompt)))))) | |
1608 (vc-ensure-vc-buffer) | 1610 (vc-ensure-vc-buffer) |
1609 (let* ((file buffer-file-name) | 1611 (let* ((file buffer-file-name) |
1610 (revision (if (string-equal rev "") | 1612 (revision (if (string-equal rev "") |
1611 (vc-working-revision file) | 1613 (vc-working-revision file) |
1612 rev))) | 1614 rev))) |
1728 (if (y-or-n-p | 1730 (if (y-or-n-p |
1729 "File must be checked out for merging. Check out now? ") | 1731 "File must be checked out for merging. Check out now? ") |
1730 (vc-checkout file t) | 1732 (vc-checkout file t) |
1731 (error "Merge aborted")))) | 1733 (error "Merge aborted")))) |
1732 (setq first-revision | 1734 (setq first-revision |
1733 (read-string (concat "Branch or revision to merge from " | 1735 (vc-read-revision |
1734 "(default news on current branch): "))) | 1736 (concat "Branch or revision to merge from " |
1737 "(default news on current branch): ") | |
1738 (list file) | |
1739 backend)) | |
1735 (if (string= first-revision "") | 1740 (if (string= first-revision "") |
1736 (setq status (vc-call-backend backend 'merge-news file)) | 1741 (setq status (vc-call-backend backend 'merge-news file)) |
1737 (if (not (vc-find-backend-function backend 'merge)) | 1742 (if (not (vc-find-backend-function backend 'merge)) |
1738 (error "Sorry, merging is not implemented for %s" backend) | 1743 (error "Sorry, merging is not implemented for %s" backend) |
1739 (if (not (vc-branch-p first-revision)) | 1744 (if (not (vc-branch-p first-revision)) |
1740 (setq second-revision | 1745 (setq second-revision |
1741 (read-string "Second revision: " | 1746 (vc-read-revision |
1742 (concat (vc-branch-part first-revision) "."))) | 1747 "Second revision: " |
1748 (list file) backend nil | |
1749 ;; FIXME: This is CVS/RCS/SCCS specific. | |
1750 (concat (vc-branch-part first-revision) "."))) | |
1743 ;; We want to merge an entire branch. Set revisions | 1751 ;; We want to merge an entire branch. Set revisions |
1744 ;; accordingly, so that vc-BACKEND-merge understands us. | 1752 ;; accordingly, so that vc-BACKEND-merge understands us. |
1745 (setq second-revision first-revision) | 1753 (setq second-revision first-revision) |
1746 ;; first-revision must be the starting point of the branch | 1754 ;; first-revision must be the starting point of the branch |
1747 (setq first-revision (vc-branch-part first-revision))) | 1755 (setq first-revision (vc-branch-part first-revision))) |