comparison lisp/vc.el @ 12279:de2a82180af0

Adapt to the changes in vc-hooks.el, namely, the new 'none-value of vc-locking-user, and the consistent caching of all properties. Especially, make the properties survive check-ins and check-outs. Various minor bug fixes. (vc-file-clear-masterprops): New function. (vc-backend-checkin, vc-backend-revert): Set vc-locking-user to 'none if the file is unlocked. (vc-backend-checkin, vc-backend-revert, vc-backend-checkout): Use vc-file-clear-masterprops, and adjust those properties that are not cleared. (vc-resynch-window): Temporarily remove vc-find-file-hook, so that we don't lose the file properties during check-in/out. (vc-resynch-window): Do not try to delete the current window if `vc-keep-workfiles' is nil (doesn't make sense; killing the buffer is enough.) (vc-backend-checkin): Rewrote the code that adjusts the default branch and removes any locks that might remain after check-in. (vc-cancel-version): Abort with error message in the CVS case. (The error used to be signalled in vc-backend-uncheck, which is a little too late.) (vc-minor-revision): Function removed.
author Richard M. Stallman <rms@gnu.org>
date Fri, 16 Jun 1995 18:02:51 +0000
parents a74a202e9660
children b33cc6583bb9
comparison
equal deleted inserted replaced
12278:6882fe187fa9 12279:de2a82180af0
4 4
5 ;; Author: Eric S. Raymond <esr@snark.thyrsus.com> 5 ;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
6 ;; Modified by: 6 ;; Modified by:
7 ;; ttn@netcom.com 7 ;; ttn@netcom.com
8 ;; Per Cederqvist <ceder@lysator.liu.edu> 8 ;; Per Cederqvist <ceder@lysator.liu.edu>
9 ;; Andre Spiegel <spiegel@bruessel.informatik.uni-stuttgart.de> 9 ;; Andre Spiegel <spiegel@berlin.informatik.uni-stuttgart.de>
10 10
11 ;; This file is part of GNU Emacs. 11 ;; This file is part of GNU Emacs.
12 12
13 ;; GNU Emacs is free software; you can redistribute it and/or modify 13 ;; GNU Emacs is free software; you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by 14 ;; it under the terms of the GNU General Public License as published by
184 (fillarray vc-file-prop-obarray nil) 184 (fillarray vc-file-prop-obarray nil)
185 ;; Note: there is potential for minor lossage here if there is an open 185 ;; Note: there is potential for minor lossage here if there is an open
186 ;; log buffer with a nonzero local value of vc-comment-ring-index. 186 ;; log buffer with a nonzero local value of vc-comment-ring-index.
187 (setq vc-comment-ring nil)) 187 (setq vc-comment-ring nil))
188 188
189 (defun vc-file-clear-masterprops (file)
190 ;; clear all properties of FILE that were retrieved
191 ;; from the master file
192 (vc-file-setprop file 'vc-latest-version nil)
193 (vc-file-setprop file 'vc-your-latest-version nil)
194 (vc-backend-dispatch file
195 (progn ;; SCCS
196 (vc-file-setprop file 'vc-master-locks nil))
197 (progn ;; RCS
198 (vc-file-setprop file 'vc-default-branch nil)
199 (vc-file-setprop file 'vc-head-version nil)
200 (vc-file-setprop file 'vc-top-version nil)
201 (vc-file-setprop file 'vc-master-locks nil))
202 (progn
203 (vc-file-setprop file 'vc-cvs-status nil))))
204
189 ;;; functions that operate on RCS revision numbers 205 ;;; functions that operate on RCS revision numbers
190
191 ;; vc-occurences and vc-branch-p moved to vc-hooks.el
192 206
193 (defun vc-trunk-p (rev) 207 (defun vc-trunk-p (rev)
194 ;; return t if REV is a revision on the trunk 208 ;; return t if REV is a revision on the trunk
195 (not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev)))) 209 (not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev))))
196
197 (defun vc-minor-revision (rev)
198 ;; return the minor revision number of REV,
199 ;; i.e. the number after the last dot.
200 (substring rev (1+ (string-match "\\.[0-9]+\\'" rev))))
201 210
202 (defun vc-branch-part (rev) 211 (defun vc-branch-part (rev)
203 ;; return the branch part of a revision number REV 212 ;; return the branch part of a revision number REV
204 (substring rev 0 (string-match "\\.[0-9]+\\'" rev))) 213 (substring rev 0 (string-match "\\.[0-9]+\\'" rev)))
205 214
669 ;; NOQUERY should be t *only* if it is known the only difference 678 ;; NOQUERY should be t *only* if it is known the only difference
670 ;; between the buffer and the file is due to RCS rather than user editing! 679 ;; between the buffer and the file is due to RCS rather than user editing!
671 (and (string= buffer-file-name file) 680 (and (string= buffer-file-name file)
672 (if keep 681 (if keep
673 (progn 682 (progn
683 ;; temporarily remove vc-find-file-hook, so that
684 ;; we don't lose the properties
685 (remove-hook 'find-file-hooks 'vc-find-file-hook)
674 (vc-revert-buffer1 t noquery) 686 (vc-revert-buffer1 t noquery)
687 (add-hook 'find-file-hooks 'vc-find-file-hook)
675 (vc-mode-line buffer-file-name)) 688 (vc-mode-line buffer-file-name))
676 (progn 689 (kill-buffer (current-buffer)))))
677 (delete-window)
678 (kill-buffer (current-buffer))))))
679 690
680 (defun vc-start-entry (file rev comment msg action &optional after-hook) 691 (defun vc-start-entry (file rev comment msg action &optional after-hook)
681 ;; Accept a comment for an operation on FILE revision REV. If COMMENT 692 ;; Accept a comment for an operation on FILE revision REV. If COMMENT
682 ;; is nil, pop up a VC-log buffer, emit MSG, and set the 693 ;; is nil, pop up a VC-log buffer, emit MSG, and set the
683 ;; action on close to ACTION; otherwise, do action immediately. 694 ;; action on close to ACTION; otherwise, do action immediately.
1335 (interactive "P") 1346 (interactive "P")
1336 (if vc-dired-mode 1347 (if vc-dired-mode
1337 (find-file-other-window (dired-get-filename))) 1348 (find-file-other-window (dired-get-filename)))
1338 (while vc-parent-buffer 1349 (while vc-parent-buffer
1339 (pop-to-buffer vc-parent-buffer)) 1350 (pop-to-buffer vc-parent-buffer))
1351 (if (eq (vc-backend (buffer-file-name)) 'CVS)
1352 (error "Unchecking files under CVS is dangerous and not supported in VC"))
1340 (let* ((target (concat (vc-latest-version (buffer-file-name)))) 1353 (let* ((target (concat (vc-latest-version (buffer-file-name))))
1341 (yours (concat (vc-your-latest-version (buffer-file-name)))) 1354 (yours (concat (vc-your-latest-version (buffer-file-name))))
1342 (prompt (if (string-equal yours target) 1355 (prompt (if (string-equal yours target)
1343 "Remove your version %s from master? " 1356 "Remove your version %s from master? "
1344 "Version %s was not your change. Remove it anyway? "))) 1357 "Version %s was not your change. Remove it anyway? ")))
1553 (setq failed nil)) 1566 (setq failed nil))
1554 (and failed (file-exists-p filename) (delete-file filename)))) 1567 (and failed (file-exists-p filename) (delete-file filename))))
1555 (apply 'vc-do-command 0 "get" file 'MASTER;; SCCS 1568 (apply 'vc-do-command 0 "get" file 'MASTER;; SCCS
1556 (if writable "-e") 1569 (if writable "-e")
1557 (and rev (concat "-r" (vc-lookup-triple file rev))) 1570 (and rev (concat "-r" (vc-lookup-triple file rev)))
1558 vc-checkout-switches)) 1571 vc-checkout-switches)
1572 (vc-file-setprop file 'vc-workfile-version nil))
1559 (if workfile;; RCS 1573 (if workfile;; RCS
1560 ;; RCS doesn't let us check out into arbitrary file names directly. 1574 ;; RCS doesn't let us check out into arbitrary file names directly.
1561 ;; Use `co -p' and make stdout point to the correct file. 1575 ;; Use `co -p' and make stdout point to the correct file.
1562 (let ((vc-modes (logior (file-modes (vc-name file)) 1576 (let ((vc-modes (logior (file-modes (vc-name file))
1563 (if writable 128 0))) 1577 (if writable 128 0)))
1615 (setq failed nil)) 1629 (setq failed nil))
1616 (and failed (file-exists-p filename) (delete-file filename)))) 1630 (and failed (file-exists-p filename) (delete-file filename))))
1617 (apply 'vc-do-command 0 "cvs" file 'WORKFILE 1631 (apply 'vc-do-command 0 "cvs" file 'WORKFILE
1618 "update" 1632 "update"
1619 (and rev (concat "-r" rev)) 1633 (and rev (concat "-r" rev))
1620 vc-checkout-switches)) 1634 vc-checkout-switches)
1635 (vc-file-setprop file 'vc-workfile-version nil))
1621 )) 1636 ))
1622 (or workfile 1637 (cond
1623 (vc-file-setprop file 1638 ((not workfile)
1624 'vc-checkout-time (nth 5 (file-attributes file)))) 1639 (vc-file-clear-masterprops file)
1640 (if writable
1641 (vc-file-setprop file 'vc-locking-user (user-login-name)))
1642 (vc-file-setprop file
1643 'vc-checkout-time (nth 5 (file-attributes file)))))
1625 (message "Checking out %s...done" filename)) 1644 (message "Checking out %s...done" filename))
1626 ) 1645 )
1627 1646
1628 (defun vc-backend-logentry-check (file) 1647 (defun vc-backend-logentry-check (file)
1629 (vc-backend-dispatch file 1648 (vc-backend-dispatch file
1656 (progn 1675 (progn
1657 (apply 'vc-do-command 0 "delta" file 'MASTER 1676 (apply 'vc-do-command 0 "delta" file 'MASTER
1658 (if rev (concat "-r" rev)) 1677 (if rev (concat "-r" rev))
1659 (concat "-y" comment) 1678 (concat "-y" comment)
1660 vc-checkin-switches) 1679 vc-checkin-switches)
1661 (vc-file-setprop file 'vc-locking-user nil) 1680 (vc-file-setprop file 'vc-locking-user 'none)
1662 (vc-file-setprop file 'vc-workfile-version nil) 1681 (vc-file-setprop file 'vc-workfile-version nil)
1663 (if vc-keep-workfiles 1682 (if vc-keep-workfiles
1664 (vc-do-command 0 "get" file 'MASTER)) 1683 (vc-do-command 0 "get" file 'MASTER))
1665 ) 1684 )
1666 ;; RCS 1685 ;; RCS
1667 (let ((lock-version nil)) 1686 (let ((old-version (vc-workfile-version file)) new-version)
1668 ;; if this is an explicit check-in to a different branch, 1687 (apply 'vc-do-command 0 "ci" file 'MASTER
1669 ;; remember the workfile version (in order to remove the lock later)
1670 (if (and rev
1671 (not (vc-trunk-p rev))
1672 (not (string= (vc-branch-part rev)
1673 (vc-branch-part (vc-workfile-version file)))))
1674 (setq lock-version (vc-workfile-version file)))
1675
1676 (apply 'vc-do-command 0 "ci" file 'MASTER
1677 (concat (if vc-keep-workfiles "-u" "-r") rev) 1688 (concat (if vc-keep-workfiles "-u" "-r") rev)
1678 (concat "-m" comment) 1689 (concat "-m" comment)
1679 vc-checkin-switches) 1690 vc-checkin-switches)
1680 (vc-file-setprop file 'vc-locking-user nil) 1691 (vc-file-setprop file 'vc-locking-user 'none)
1681 (vc-file-setprop file 'vc-workfile-version nil) 1692 (vc-file-setprop file 'vc-workfile-version nil)
1682 1693
1683 ;; determine the new workfile version and 1694 ;; determine the new workfile version
1684 ;; adjust the master file branch accordingly 1695 (set-buffer "*vc*")
1685 ;; (this currently has to be done on every check-in) 1696 (goto-char (point-min))
1686 (progn 1697 (if (or (re-search-forward
1687 (set-buffer "*vc*") 1698 "new revision: \\([0-9.]+\\);" nil t)
1688 (goto-char (point-min)) 1699 (re-search-forward
1689 (if (or (re-search-forward 1700 "reverting to previous revision \\([0-9.]+\\)" nil t))
1690 "new revision: \\([0-9.]+\\);" nil t) 1701 (progn (setq new-version (buffer-substring (match-beginning 1)
1691 (re-search-forward 1702 (match-end 1)))
1692 "reverting to previous revision \\([0-9.]+\\)" nil t)) 1703 (vc-file-setprop file 'vc-workfile-version new-version)))
1693 (progn (setq rev (buffer-substring (match-beginning 1) 1704
1694 (match-end 1))) 1705 ;; if we got to a different branch, adjust the default
1695 (vc-file-setprop file 'vc-workfile-version rev))) 1706 ;; branch accordingly, and remove any remaining
1696 (if rev (vc-do-command 0 "rcs" file 'MASTER 1707 ;; lock on the old version.
1697 (if (vc-trunk-p rev) "-b" 1708 (cond
1698 (concat "-b" (vc-branch-part rev))))) 1709 ((and old-version new-version
1699 (if lock-version 1710 (not (string= (vc-branch-part old-version)
1700 ;; exit status of 1 is also accepted. 1711 (vc-branch-part new-version))))
1701 ;; It means that the lock was removed before. 1712 (vc-do-command 0 "rcs" file 'MASTER
1702 (vc-do-command 1 "rcs" file 'MASTER 1713 (if (vc-trunk-p new-version) "-b"
1703 (concat "-u" lock-version))))) 1714 (concat "-b" (vc-branch-part new-version))))
1715 ;; exit status of 1 is also accepted.
1716 ;; It means that the lock was removed before.
1717 (vc-do-command 1 "rcs" file 'MASTER
1718 (concat "-u" old-version)))))
1704 ;; CVS 1719 ;; CVS
1705 (progn 1720 (progn
1706 ;; explicit check-in to the trunk requires a 1721 ;; explicit check-in to the trunk requires a
1707 ;; double check-in (first unexplicit) (CVS-1.3) 1722 ;; double check-in (first unexplicit) (CVS-1.3)
1708 (if (and rev (vc-trunk-p rev)) 1723 (if (and rev (vc-trunk-p rev))
1723 (match-end 2))) 1738 (match-end 2)))
1724 (vc-file-setprop file 'vc-workfile-version nil)) 1739 (vc-file-setprop file 'vc-workfile-version nil))
1725 ;; if this was an explicit check-in, remove the sticky tag 1740 ;; if this was an explicit check-in, remove the sticky tag
1726 (if rev 1741 (if rev
1727 (vc-do-command 0 "cvs" file 'WORKFILE "update" "-A")) 1742 (vc-do-command 0 "cvs" file 'WORKFILE "update" "-A"))
1728 (vc-file-setprop file 'vc-locking-user nil) 1743 (vc-file-setprop file 'vc-locking-user 'none)
1729 (vc-file-setprop file 'vc-checkout-time 1744 (vc-file-setprop file 'vc-checkout-time
1730 (nth 5 (file-attributes file)))))) 1745 (nth 5 (file-attributes file))))))
1731 (message "Checking in %s...done" file) 1746 (vc-file-clear-masterprops file)
1732 ) 1747 (message "Checking in %s...done" file))
1733 1748
1734 (defun vc-backend-revert (file) 1749 (defun vc-backend-revert (file)
1735 ;; Revert file to latest checked-in version. 1750 ;; Revert file to latest checked-in version.
1736 ;; (for RCS, to workfile version) 1751 ;; (for RCS, to workfile version)
1737 (message "Reverting %s..." file) 1752 (message "Reverting %s..." file)
1746 "-f" (concat "-u" (vc-workfile-version file))) 1761 "-f" (concat "-u" (vc-workfile-version file)))
1747 ;; CVS 1762 ;; CVS
1748 (progn 1763 (progn
1749 (delete-file file) 1764 (delete-file file)
1750 (vc-do-command 0 "cvs" file 'WORKFILE "update"))) 1765 (vc-do-command 0 "cvs" file 'WORKFILE "update")))
1751 (vc-file-setprop file 'vc-locking-user nil) 1766 (vc-file-setprop file 'vc-locking-user 'none)
1752 (vc-file-setprop file 'vc-checkout-time (nth 5 (file-attributes file))) 1767 (vc-file-setprop file 'vc-checkout-time (nth 5 (file-attributes file)))
1753 (message "Reverting %s...done" file) 1768 (message "Reverting %s...done" file)
1754 ) 1769 )
1755 1770
1756 (defun vc-backend-steal (file &optional rev) 1771 (defun vc-backend-steal (file &optional rev)
1774 ;; smarter when we support multiple branches. 1789 ;; smarter when we support multiple branches.
1775 (message "Removing last change from %s..." file) 1790 (message "Removing last change from %s..." file)
1776 (vc-backend-dispatch file 1791 (vc-backend-dispatch file
1777 (vc-do-command 0 "rmdel" file 'MASTER (concat "-r" target)) 1792 (vc-do-command 0 "rmdel" file 'MASTER (concat "-r" target))
1778 (vc-do-command 0 "rcs" file 'MASTER (concat "-o" target)) 1793 (vc-do-command 0 "rcs" file 'MASTER (concat "-o" target))
1779 (error "Unchecking files under CVS is dangerous and not supported in VC.") 1794 nil ;; this is never reached under CVS
1780 ) 1795 )
1781 (message "Removing last change from %s...done" file) 1796 (message "Removing last change from %s...done" file)
1782 ) 1797 )
1783 1798
1784 (defun vc-backend-print-log (file) 1799 (defun vc-backend-print-log (file)