aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorAndré Spiegel1996-01-04 16:00:05 +0000
committerAndré Spiegel1996-01-04 16:00:05 +0000
commit7e48e09205d7d7bf1bfa14158cfef49a10128201 (patch)
tree2d223c78e1db3c43fd5f3e207f60ac2526e02608
parenta5f6b207ff9be0e40261e498457a1c88945bd006 (diff)
downloademacs-7e48e09205d7d7bf1bfa14158cfef49a10128201.tar.gz
emacs-7e48e09205d7d7bf1bfa14158cfef49a10128201.zip
(vc-cancel-version): Handle versions that start a new branch.
(vc-backend-checkout): SCCS case: handle empty revision number. (vc-diff): Don't pop to the *vc-diff* buffer if file is unchanged. Better doc strings for a few variables.
-rw-r--r--lisp/vc.el147
1 files changed, 92 insertions, 55 deletions
diff --git a/lisp/vc.el b/lisp/vc.el
index 64fa052e073..0454701a605 100644
--- a/lisp/vc.el
+++ b/lisp/vc.el
@@ -100,15 +100,18 @@ If FORM3 is `RCS', use FORM2 for CVS as well as RCS.
100(defvar vc-suppress-confirm nil 100(defvar vc-suppress-confirm nil
101 "*If non-nil, treat user as expert; suppress yes-no prompts on some things.") 101 "*If non-nil, treat user as expert; suppress yes-no prompts on some things.")
102(defvar vc-initial-comment nil 102(defvar vc-initial-comment nil
103 "*Prompt for initial comment when a file is registered.") 103 "*If non-nil, prompt for initial comment when a file is registered.")
104(defvar vc-command-messages nil 104(defvar vc-command-messages nil
105 "*Display run messages from back-end commands.") 105 "*If non-nil, display run messages from back-end commands.")
106(defvar vc-checkin-switches nil 106(defvar vc-checkin-switches nil
107 "*Extra switches passed to the checkin program by \\[vc-checkin].") 107 "*A string or list of strings specifying extra switches passed
108to the checkin program by \\[vc-checkin].")
108(defvar vc-checkout-switches nil 109(defvar vc-checkout-switches nil
109 "*Extra switches passed to the checkout program by \\[vc-checkout].") 110 "*A string or list of strings specifying extra switches passed
111to the checkout program by \\[vc-checkout].")
110(defvar vc-directory-exclusion-list '("SCCS" "RCS" "CVS") 112(defvar vc-directory-exclusion-list '("SCCS" "RCS" "CVS")
111 "*Directory names ignored by functions that recursively walk file trees.") 113 "*A list of directory names ignored by functions that recursively
114walk file trees.")
112 115
113(defconst vc-maximum-comment-ring-size 32 116(defconst vc-maximum-comment-ring-size 32
114 "Maximum number of saved comments in the comment ring.") 117 "Maximum number of saved comments in the comment ring.")
@@ -131,7 +134,10 @@ farms to gold trees.")
131 134
132(defvar vc-header-alist 135(defvar vc-header-alist
133 '((SCCS "\%W\%") (RCS "\$Id\$") (CVS "\$Id\$")) 136 '((SCCS "\%W\%") (RCS "\$Id\$") (CVS "\$Id\$"))
134 "*Header keywords to be inserted when `vc-insert-headers' is executed.") 137 "*Header keywords to be inserted by `vc-insert-headers'.
138Must be a list of two-element lists, the first element of each must
139be `RCS', `CVS', or `SCCS'. The second element is the string to
140be inserted for this particular backend.")
135(defvar vc-static-header-alist 141(defvar vc-static-header-alist
136 '(("\\.c$" . 142 '(("\\.c$" .
137 "\n#ifndef lint\nstatic char vcid[] = \"\%s\";\n#endif /* lint */\n")) 143 "\n#ifndef lint\nstatic char vcid[] = \"\%s\";\n#endif /* lint */\n"))
@@ -161,7 +167,7 @@ If nil, VC itself computes this value when it is first needed.")
161If nil, VC itself computes this value when it is first needed.") 167If nil, VC itself computes this value when it is first needed.")
162 168
163(defvar vc-cvs-release nil 169(defvar vc-cvs-release nil
164 "*The release number of your SCCS installation, as a string. 170 "*The release number of your CVS installation, as a string.
165If nil, VC itself computes this value when it is first needed.") 171If nil, VC itself computes this value when it is first needed.")
166 172
167;; Variables the user doesn't need to know about. 173;; Variables the user doesn't need to know about.
@@ -1119,7 +1125,7 @@ and two version designators specifying which versions to compare."
1119 (vc-buffer-sync not-urgent) 1125 (vc-buffer-sync not-urgent)
1120 (setq unchanged (vc-workfile-unchanged-p buffer-file-name)) 1126 (setq unchanged (vc-workfile-unchanged-p buffer-file-name))
1121 (if unchanged 1127 (if unchanged
1122 (message "No changes to %s since latest version." file) 1128 (message "No changes to %s since latest version" file)
1123 (vc-backend-diff file) 1129 (vc-backend-diff file)
1124 ;; Ideally, we'd like at this point to parse the diff so that 1130 ;; Ideally, we'd like at this point to parse the diff so that
1125 ;; the buffer effectively goes into compilation mode and we 1131 ;; the buffer effectively goes into compilation mode and we
@@ -1128,12 +1134,13 @@ and two version designators specifying which versions to compare."
1128 ;; problem is that the `old' file doesn't exist to be 1134 ;; problem is that the `old' file doesn't exist to be
1129 ;; visited. This plays hell with numerous assumptions in 1135 ;; visited. This plays hell with numerous assumptions in
1130 ;; the diff.el and compile.el machinery. 1136 ;; the diff.el and compile.el machinery.
1131 (pop-to-buffer "*vc-diff*") 1137 (set-buffer "*vc-diff*")
1132 (setq default-directory (file-name-directory file)) 1138 (setq default-directory (file-name-directory file))
1133 (if (= 0 (buffer-size)) 1139 (if (= 0 (buffer-size))
1134 (progn 1140 (progn
1135 (setq unchanged t) 1141 (setq unchanged t)
1136 (message "No changes to %s since latest version." file)) 1142 (message "No changes to %s since latest version" file))
1143 (pop-to-buffer "*vc-diff*")
1137 (goto-char (point-min)) 1144 (goto-char (point-min))
1138 (shrink-window-if-larger-than-buffer))) 1145 (shrink-window-if-larger-than-buffer)))
1139 (not unchanged)))) 1146 (not unchanged))))
@@ -1610,29 +1617,55 @@ A prefix argument means do not revert the buffer afterwards."
1610 (while vc-parent-buffer 1617 (while vc-parent-buffer
1611 (pop-to-buffer vc-parent-buffer)) 1618 (pop-to-buffer vc-parent-buffer))
1612 (cond 1619 (cond
1613 ((eq (vc-backend (buffer-file-name)) 'CVS) 1620 ((not (vc-registered (buffer-file-name)))
1621 (vc-registration-error (buffer-file-name))
1622 (eq (vc-backend (buffer-file-name)) 'CVS)
1614 (error "Unchecking files under CVS is dangerous and not supported in VC")) 1623 (error "Unchecking files under CVS is dangerous and not supported in VC"))
1615 ((vc-locking-user (buffer-file-name)) 1624 ((vc-locking-user (buffer-file-name))
1616 (error "This version is locked; use vc-revert-buffer to discard changes")) 1625 (error "This version is locked; use vc-revert-buffer to discard changes"))
1617 ((not (vc-latest-on-branch-p (buffer-file-name))) 1626 ((not (vc-latest-on-branch-p (buffer-file-name)))
1618 (error "This is not the latest version--VC cannot cancel it"))) 1627 (error "This is not the latest version--VC cannot cancel it")))
1619 (let ((target (vc-workfile-version (buffer-file-name)))) 1628 (let* ((target (vc-workfile-version (buffer-file-name)))
1620 (if (null (yes-or-no-p "Remove this version from master? ")) 1629 (recent (if (vc-trunk-p target) "" (vc-branch-part target)))
1630 (config (current-window-configuration)) done)
1631 (if (null (yes-or-no-p (format "Remove version %s from master? " target)))
1621 nil 1632 nil
1622 (setq norevert (or norevert (not 1633 (setq norevert (or norevert (not
1623 (yes-or-no-p "Revert buffer to most recent remaining version? ")))) 1634 (yes-or-no-p "Revert buffer to most recent remaining version? "))))
1624 (vc-backend-uncheck (buffer-file-name) target) 1635 (vc-backend-uncheck (buffer-file-name) target)
1625 (if (not norevert) 1636 ;; Check out the most recent remaining version. If it fails, because
1626 (vc-checkout (buffer-file-name) nil) 1637 ;; the whole branch got deleted, do a double-take and check out the
1627 ;; If norevert, lock the most recent remaining version, 1638 ;; version where the branch started.
1628 ;; and mark the buffer modified. 1639 (while (not done)
1629 (if (eq (vc-backend (buffer-file-name)) 'RCS) 1640 (condition-case err
1630 (progn (setq buffer-read-only nil) 1641 (progn
1631 (vc-clear-headers))) 1642 (if norevert
1632 (vc-backend-checkout (buffer-file-name) t (vc-branch-part target)) 1643 ;; Check out locked, but only to disc, and keep
1633 (set-visited-file-name (buffer-file-name)) 1644 ;; modifications in the buffer.
1634 (vc-mode-line (buffer-file-name))) 1645 (vc-backend-checkout (buffer-file-name) t recent)
1635 (message "Version %s has been removed from the master." target) 1646 ;; Check out unlocked, and revert buffer.
1647 (vc-checkout (buffer-file-name) nil recent))
1648 (setq done t))
1649 (error (set-buffer "*vc*")
1650 (goto-char (point-min))
1651 (if (re-search-forward "no side branches present for" nil t)
1652 (progn (setq recent (vc-branch-part recent))
1653 (set-window-configuration config))
1654 ;; No, it was some other error: re-signal it.
1655 (signal (car err) (cdr err))))))
1656 ;; If norevert, clear version headers and mark the buffer modified.
1657 (if norevert
1658 (progn
1659 (set-visited-file-name (buffer-file-name))
1660 (if (not vc-make-backup-files)
1661 ;; inhibit backup for this buffer
1662 (progn (make-local-variable 'backup-inhibited)
1663 (setq backup-inhibited t)))
1664 (if (eq (vc-backend (buffer-file-name)) 'RCS)
1665 (progn (setq buffer-read-only nil)
1666 (vc-clear-headers)))
1667 (vc-mode-line (buffer-file-name))))
1668 (message "Version %s has been removed from the master" target)
1636 ))) 1669 )))
1637 1670
1638;;;###autoload 1671;;;###autoload
@@ -1818,41 +1851,45 @@ From a program, any arguments are passed to the `rcs2log' script."
1818 ;; the file in the right place. The old value is restored below. 1851 ;; the file in the right place. The old value is restored below.
1819 (setq default-directory (file-name-directory filename)) 1852 (setq default-directory (file-name-directory filename))
1820 (vc-backend-dispatch file 1853 (vc-backend-dispatch file
1821 (if workfile;; SCCS 1854 (progn ;; SCCS
1822 ;; Some SCCS implementations allow checking out directly to a 1855 (and rev (string= rev "") (setq rev nil))
1823 ;; file using the -G option, but then some don't so use the 1856 (if workfile
1824 ;; least common denominator approach and use the -p option 1857 ;; Some SCCS implementations allow checking out directly to a
1825 ;; ala RCS. 1858 ;; file using the -G option, but then some don't so use the
1826 (let ((vc-modes (logior (file-modes (vc-name file)) 1859 ;; least common denominator approach and use the -p option
1827 (if writable 128 0))) 1860 ;; ala RCS.
1828 (failed t)) 1861 (let ((vc-modes (logior (file-modes (vc-name file))
1829 (unwind-protect 1862 (if writable 128 0)))
1830 (progn 1863 (failed t))
1831 (apply 'vc-do-command 1864 (unwind-protect
1832 nil 0 "/bin/sh" file 'MASTER "-c" 1865 (progn
1833 ;; Some shells make the "" dummy argument into $0 1866 (apply 'vc-do-command
1834 ;; while others use the shell's name as $0 and 1867 nil 0 "/bin/sh" file 'MASTER "-c"
1835 ;; use the "" as $1. The if-statement 1868 ;; Some shells make the "" dummy argument into $0
1836 ;; converts the latter case to the former. 1869 ;; while others use the shell's name as $0 and
1837 (format "if [ x\"$1\" = x ]; then shift; fi; \ 1870 ;; use the "" as $1. The if-statement
1871 ;; converts the latter case to the former.
1872 (format "if [ x\"$1\" = x ]; then shift; fi; \
1838 umask %o; exec >\"$1\" || exit; \ 1873 umask %o; exec >\"$1\" || exit; \
1839 shift; umask %o; exec get \"$@\"" 1874 shift; umask %o; exec get \"$@\""
1840 (logand 511 (lognot vc-modes)) 1875 (logand 511 (lognot vc-modes))
1841 (logand 511 (lognot (default-file-modes)))) 1876 (logand 511 (lognot (default-file-modes))))
1842 "" ; dummy argument for shell's $0 1877 "" ; dummy argument for shell's $0
1843 filename 1878 filename
1844 (if writable "-e") 1879 (if writable "-e")
1845 "-p" (and rev 1880 "-p"
1846 (concat "-r" (vc-lookup-triple file rev))) 1881 (and rev
1847 switches) 1882 (concat "-r" (vc-lookup-triple file rev)))
1848 (setq failed nil)) 1883 switches)
1849 (and failed (file-exists-p filename) (delete-file filename)))) 1884 (setq failed nil))
1850 (apply 'vc-do-command nil 0 "get" file 'MASTER ;; SCCS 1885 (and failed (file-exists-p filename)
1851 (if writable "-e") 1886 (delete-file filename))))
1852 (and rev (concat "-r" (vc-lookup-triple file rev))) 1887 (apply 'vc-do-command nil 0 "get" file 'MASTER ;; SCCS
1853 switches) 1888 (if writable "-e")
1854 (vc-file-setprop file 'vc-workfile-version nil)) 1889 (and rev (concat "-r" (vc-lookup-triple file rev)))
1855 (if workfile ;; RCS 1890 switches)
1891 (vc-file-setprop file 'vc-workfile-version nil)))
1892 (if workfile ;; RCS
1856 ;; RCS doesn't let us check out into arbitrary file names directly. 1893 ;; RCS doesn't let us check out into arbitrary file names directly.
1857 ;; Use `co -p' and make stdout point to the correct file. 1894 ;; Use `co -p' and make stdout point to the correct file.
1858 (let ((vc-modes (logior (file-modes (vc-name file)) 1895 (let ((vc-modes (logior (file-modes (vc-name file))