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))) |