Mercurial > emacs

comparison lisp/vc.el @ 10537:380605821cc9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(vc-do-command): Arrange for the default-directory variable in *vc* to be re-set each time this function uses it. Discard current dir from front of FILE later on, and only if last = `WORKFILE'. Undo Dec 10 change: (vc-directory, vc-dired-reformat-line): Changed back. (vc-directory-18): Old function restored. (vc-dir-all-files): Function deleted. (vc-next-action-on-file): If file is not registered, check file out after registering it. (vc-next-action-dired): Restore the window configuration after doing vc-next-action on each file in a VC-dired buffer. (file-regular-p-18): New function. (file-regular-p): Define, if not already defined.
author Richard M. Stallman <rms@gnu.org>
date Tue, 24 Jan 1995 06:33:41 +0000
parents 2d9590603a06
children 353416feba10
comparison
equal deleted inserted replaced
10536:1722d74882df 10537:380605821cc9
1 ;;; vc.el --- drive a version-control system from within Emacs 1 ;;; vc.el --- drive a version-control system from within Emacs
2 2
3 ;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. 3 ;; Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
4 4
5 ;; Author: Eric S. Raymond <esr@snark.thyrsus.com> 5 ;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
6 ;; Maintainer: ttn@netcom.com 6 ;; Maintainer: ttn@netcom.com
7 ;; Version: 5.5 + CVS hacks by ceder@lysator.liu.se made in Jan-Feb 1994. 7 ;; Version: 5.6
8 8
9 ;; This file is part of GNU Emacs. 9 ;; This file is part of GNU Emacs.
10 10
11 ;; GNU Emacs is free software; you can redistribute it and/or modify 11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by 12 ;; it under the terms of the GNU General Public License as published by
27 ;; This mode is fully documented in the Emacs user's manual. 27 ;; This mode is fully documented in the Emacs user's manual.
28 ;; 28 ;;
29 ;; This was designed and implemented by Eric Raymond <esr@snark.thyrsus.com>. 29 ;; This was designed and implemented by Eric Raymond <esr@snark.thyrsus.com>.
30 ;; Paul Eggert <eggert@twinsun.com>, Sebastian Kremer <sk@thp.uni-koeln.de>, 30 ;; Paul Eggert <eggert@twinsun.com>, Sebastian Kremer <sk@thp.uni-koeln.de>,
31 ;; and Richard Stallman contributed valuable criticism, support, and testing. 31 ;; and Richard Stallman contributed valuable criticism, support, and testing.
32 ;; CVS support was added by Per Cederqvist <ceder@lysator.liu.se>
33 ;; in Jan-Feb 1994.
32 ;; 34 ;;
33 ;; Supported version-control systems presently include SCCS and RCS; 35 ;; Supported version-control systems presently include SCCS, RCS, and CVS.
34 ;; the RCS lock-stealing code doesn't work right unless you use RCS 5.6.2 36 ;; The RCS lock-stealing code doesn't work right unless you use RCS 5.6.2
35 ;; or newer. Currently (January 1994) that is only a beta test release. 37 ;; or newer. Currently (January 1994) that is only a beta test release.
38 ;; Even initial checkins will fail if your RCS version is so old that ci
39 ;; doesn't understand -t-; this has been known to happen to people running
40 ;; NExTSTEP 3.0.
36 ;; 41 ;;
37 ;; The RCS code assumes strict locking. You can support the RCS -x option 42 ;; The RCS code assumes strict locking. You can support the RCS -x option
38 ;; by adding pairs to the vc-master-templates list. 43 ;; by adding pairs to the vc-master-templates list.
39 ;; 44 ;;
40 ;; Proper function of the SCCS diff commands requires the shellscript vcdiff 45 ;; Proper function of the SCCS diff commands requires the shellscript vcdiff
91 "*Extra switches passed to the checkout program by \\[vc-checkout].") 96 "*Extra switches passed to the checkout program by \\[vc-checkout].")
92 (defvar vc-path 97 (defvar vc-path
93 (if (file-exists-p "/usr/sccs") 98 (if (file-exists-p "/usr/sccs")
94 '("/usr/sccs") nil) 99 '("/usr/sccs") nil)
95 "*List of extra directories to search for version control commands.") 100 "*List of extra directories to search for version control commands.")
101 (defvar vc-directory-exclusion-list '("SCCS" "RCS")
102 "*Directory names ignored by functions that recursively walk file trees.")
96 103
97 (defconst vc-maximum-comment-ring-size 32 104 (defconst vc-maximum-comment-ring-size 32
98 "Maximum number of saved comments in the comment ring.") 105 "Maximum number of saved comments in the comment ring.")
99 106
100 ;;; This is duplicated in diff.el. 107 ;;; This is duplicated in diff.el.
156 (make-variable-buffer-local 'vc-dired-mode) 163 (make-variable-buffer-local 'vc-dired-mode)
157 164
158 (defvar vc-comment-ring nil) 165 (defvar vc-comment-ring nil)
159 (defvar vc-comment-ring-index nil) 166 (defvar vc-comment-ring-index nil)
160 (defvar vc-last-comment-match nil) 167 (defvar vc-last-comment-match nil)
168
169 ;; Back-portability to Emacs 18
170
171 (defun file-executable-p-18 (f)
172 (let ((modes (file-modes f)))
173 (and modes (not (zerop (logand 292))))))
174
175 (defun file-regular-p-18 (f)
176 (let ((attributes (file-attributes f)))
177 (and attributes (not (car attributes)))))
178
179 ; Conditionally rebind some things for Emacs 18 compatibility
180 (if (not (boundp 'minor-mode-map-alist))
181 (progn
182 (setq compilation-old-error-list nil)
183 (fset 'file-executable-p 'file-executable-p-18)
184 (fset 'shrink-window-if-larger-than-buffer 'beginning-of-buffer)
185 ))
186
187 (if (not (boundp 'file-regular-p))
188 (fset 'file-regular-p 'file-regular-p-18))
161 189
162 ;; File property caching 190 ;; File property caching
163 191
164 (defun vc-file-clearprops (file) 192 (defun vc-file-clearprops (file)
165 ;; clear all properties of a given file 193 ;; clear all properties of a given file
201 229
202 (defun vc-do-command (okstatus command file last &rest flags) 230 (defun vc-do-command (okstatus command file last &rest flags)
203 "Execute a version-control command, notifying user and checking for errors. 231 "Execute a version-control command, notifying user and checking for errors.
204 The command is successful if its exit status does not exceed OKSTATUS. 232 The command is successful if its exit status does not exceed OKSTATUS.
205 Output from COMMAND goes to buffer *vc*. The last argument of the command is 233 Output from COMMAND goes to buffer *vc*. The last argument of the command is
206 the master name of FILE if LAST is 'MASTER, or the basename of FILE if LAST is 234 the master name of FILE if LAST is 'MASTER, or the workfile of FILE if LAST is
207 'BASE; this is appended to an optional list of FLAGS." 235 'WORKFILE; this is appended to an optional list of FLAGS."
208 (setq file (expand-file-name file)) 236 (setq file (expand-file-name file))
209 (if vc-command-messages 237 (if vc-command-messages
210 (message "Running %s on %s..." command file)) 238 (message "Running %s on %s..." command file))
211 (let ((obuf (current-buffer)) (camefrom (current-buffer)) 239 (let ((obuf (current-buffer)) (camefrom (current-buffer))
212 (squeezed nil) 240 (squeezed nil)
213 (vc-file (and file (vc-name file))) 241 (vc-file (and file (vc-name file)))
242 (olddir default-directory)
214 status) 243 status)
215 (set-buffer (get-buffer-create "*vc*")) 244 (set-buffer (get-buffer-create "*vc*"))
216 (set (make-local-variable 'vc-parent-buffer) camefrom) 245 (set (make-local-variable 'vc-parent-buffer) camefrom)
217 (set (make-local-variable 'vc-parent-buffer-name) 246 (set (make-local-variable 'vc-parent-buffer-name)
218 (concat " from " (buffer-name camefrom))) 247 (concat " from " (buffer-name camefrom)))
248 (setq default-directory olddir)
219 249
220 (erase-buffer) 250 (erase-buffer)
221
222 ;; This is so that command arguments typed in the *vc* buffer will
223 ;; have reasonable defaults.
224 (setq default-directory (file-name-directory file))
225 251
226 (mapcar 252 (mapcar
227 (function (lambda (s) (and s (setq squeezed (append squeezed (list s)))))) 253 (function (lambda (s) (and s (setq squeezed (append squeezed (list s))))))
228 flags) 254 flags)
229 (if (and vc-file (eq last 'MASTER)) 255 (if (and vc-file (eq last 'MASTER))
230 (setq squeezed (append squeezed (list vc-file)))) 256 (setq squeezed (append squeezed (list vc-file))))
231 (if (eq last 'BASE) 257 (if (eq last 'WORKFILE)
232 (setq squeezed (append squeezed (list (file-name-nondirectory file))))) 258 (progn
233 (let ((default-directory (file-name-directory (or file "./"))) 259 (let* ((pwd (expand-file-name default-directory))
234 (exec-path (if vc-path (append exec-path vc-path) exec-path)) 260 (preflen (length pwd)))
261 (if (string= (substring file 0 preflen) pwd)
262 (setq file (substring file preflen))))
263 (setq squeezed (append squeezed (list file)))))
264 (let ((exec-path (if vc-path (append exec-path vc-path) exec-path))
235 ;; Add vc-path to PATH for the execution of this command. 265 ;; Add vc-path to PATH for the execution of this command.
236 (process-environment 266 (process-environment
237 (cons (concat "PATH=" (getenv "PATH") 267 (cons (concat "PATH=" (getenv "PATH")
238 ":" (mapconcat 'identity vc-path ":")) 268 ":" (mapconcat 'identity vc-path ":"))
239 process-environment))) 269 process-environment)))
240 (setq status (apply 'call-process command nil t nil squeezed))) 270 (setq status (apply 'call-process command nil t nil squeezed)))
241 (goto-char (point-max)) 271 (goto-char (point-max))
272 (set-buffer-modified-p nil)
242 (forward-line -1) 273 (forward-line -1)
243 (if (or (not (integerp status)) (< okstatus status)) 274 (if (or (not (integerp status)) (< okstatus status))
244 (progn 275 (progn
245 (pop-to-buffer "*vc*") 276 (pop-to-buffer "*vc*")
246 (goto-char (point-min)) 277 (goto-char (point-min))
322 (setq buffer-error-marked-p t)) 353 (setq buffer-error-marked-p t))
323 (setq errors (cdr errors))) 354 (setq errors (cdr errors)))
324 (if buffer-error-marked-p buffer)))) 355 (if buffer-error-marked-p buffer))))
325 (buffer-list))))))) 356 (buffer-list)))))))
326 357
327 ;; the actual revisit 358 (let ((in-font-lock-mode (and (boundp 'font-lock-fontified)
328 (revert-buffer arg no-confirm) 359 font-lock-fontified)))
360 (if in-font-lock-mode
361 (font-lock-mode 0))
362
363 ;; the actual revisit
364 (revert-buffer arg no-confirm)
365
366 (if in-font-lock-mode
367 (font-lock-mode 1)))
329 368
330 ;; Reparse affected compilation buffers. 369 ;; Reparse affected compilation buffers.
331 (while reparse 370 (while reparse
332 (if (car reparse) 371 (if (car reparse)
333 (save-excursion 372 (save-excursion
385 owner version) 424 owner version)
386 (cond 425 (cond
387 426
388 ;; if there is no master file corresponding, create one 427 ;; if there is no master file corresponding, create one
389 ((not vc-file) 428 ((not vc-file)
390 (vc-register verbose comment)) 429 (vc-register verbose comment)
430 (if vc-initial-comment
431 (setq vc-log-after-operation-hook
432 'vc-checkout-writable-buffer-hook)
433 (vc-checkout-writable-buffer file)))
391 434
392 ;; if there is no lock on the file, assert one and get it 435 ;; if there is no lock on the file, assert one and get it
393 ((and (not (eq vc-type 'CVS)) ;There are no locks in CVS. 436 ((and (not (eq vc-type 'CVS)) ;There are no locks in CVS.
394 (not (setq owner (vc-locking-user file)))) 437 (not (setq owner (vc-locking-user file))))
395 (if (and vc-checkout-carefully 438 (if (and vc-checkout-carefully
489 532
490 (defun vc-next-action-dired (file rev comment) 533 (defun vc-next-action-dired (file rev comment)
491 ;; We've accepted a log comment, now do a vc-next-action using it on all 534 ;; We've accepted a log comment, now do a vc-next-action using it on all
492 ;; marked files. 535 ;; marked files.
493 (set-buffer vc-parent-buffer) 536 (set-buffer vc-parent-buffer)
494 (dired-map-over-marks 537 (let ((configuration (current-window-configuration)))
495 (save-window-excursion 538 (dired-map-over-marks
496 (let ((file (dired-get-filename))) 539 (save-window-excursion
497 (message "Processing %s..." file) 540 (let ((file (dired-get-filename)))
498 (vc-next-action-on-file file nil comment) 541 (message "Processing %s..." file)
499 (message "Processing %s...done" file))) 542 (vc-next-action-on-file file nil comment)
500 nil t) 543 (message "Processing %s...done" file)))
544 nil t)
545 (set-window-configuration configuration))
501 ) 546 )
502 547
503 ;; Here's the major entry point. 548 ;; Here's the major entry point.
504 549
505 ;;;###autoload 550 ;;;###autoload
891 ;; Unfortunately, this is just too painful to do. The basic 936 ;; Unfortunately, this is just too painful to do. The basic
892 ;; problem is that the `old' file doesn't exist to be 937 ;; problem is that the `old' file doesn't exist to be
893 ;; visited. This plays hell with numerous assumptions in 938 ;; visited. This plays hell with numerous assumptions in
894 ;; the diff.el and compile.el machinery. 939 ;; the diff.el and compile.el machinery.
895 (pop-to-buffer "*vc*") 940 (pop-to-buffer "*vc*")
896 (pop-to-buffer "*vc*") 941 (setq default-directory (file-name-directory file))
897 (if (= 0 (buffer-size)) 942 (if (= 0 (buffer-size))
898 (progn 943 (progn
899 (setq unchanged t) 944 (setq unchanged t)
900 (message "No changes to %s since latest version." file)) 945 (message "No changes to %s since latest version." file))
901 (goto-char (point-min)) 946 (goto-char (point-min))
1032 ;; This hack is used by the CVS code. See vc-locking-user. 1077 ;; This hack is used by the CVS code. See vc-locking-user.
1033 ((numberp x) 1078 ((numberp x)
1034 (cond 1079 (cond
1035 ((re-search-forward "\\([0-9]+ \\)\\([^ ]+\\)\\( .*\\)" nil 0) 1080 ((re-search-forward "\\([0-9]+ \\)\\([^ ]+\\)\\( .*\\)" nil 0)
1036 (save-excursion 1081 (save-excursion
1037 (goto-char (match-beginning 2)) 1082 (goto-char (match-beginning 2))
1038 (insert "(") 1083 (insert "(")
1039 (goto-char (1+ (match-end 2))) 1084 (goto-char (1+ (match-end 2)))
1040 (insert ")") 1085 (insert ")")
1041 (delete-char (- 17 (- (match-end 2) (match-beginning 2)))) 1086 (delete-char (- 17 (- (match-end 2) (match-beginning 2))))
1042 (insert (substring " " 0 1087 (insert (substring " " 0
1043 (- 7 (- (match-end 2) (match-beginning 2))))))))) 1088 (- 7 (- (match-end 2) (match-beginning 2)))))))))
1044 (t 1089 (t
1045 (if x (setq x (concat "(" x ")"))) 1090 (if x (setq x (concat "(" x ")")))
1046 (if (re-search-forward "\\([0-9]+ \\).................\\( .*\\)" nil 0) 1091 (if (re-search-forward "\\([0-9]+ \\).................\\( .*\\)" nil 0)
1047 (let ((rep (substring (concat x " ") 0 9))) 1092 (let ((rep (substring (concat x " ") 0 9)))
1048 (replace-match (concat "\\1" rep "\\2") t))) 1093 (replace-match (concat "\\1" rep "\\2") t)))
1049 ))) 1094 )))
1050 1095
1096 ;;; Note in Emacs 18 the following defun gets overridden
1097 ;;; with the symbol 'vc-directory-18. See below.
1051 ;;;###autoload 1098 ;;;###autoload
1052 (defun vc-directory (dir verbose &optional nested) 1099 (defun vc-directory (verbose)
1053 "Show version-control status of all files in the directory DIR. 1100 "Show version-control status of the current directory and subdirectories.
1054 If the second argument VERBOSE is non-nil, show all files; 1101 Normally it creates a Dired buffer that lists only the locked files
1055 otherwise show only files that current locked in the version control system. 1102 in all these directories. With a prefix argument, it lists all files."
1056 Interactively, supply a prefix arg to make VERBOSE non-nil. 1103 (interactive "P")
1057 1104 (let (nonempty
1058 If the optional third argument NESTED is non-nil, 1105 (dl (length default-directory))
1059 scan the entire tree of subdirectories of the current directory." 1106 (filelist nil) (userlist nil)
1060 (interactive "DVC status of directory: \nP") 1107 dired-buf
1061 (let* (nonempty 1108 dired-buf-mod-count)
1062 (dl (length dir)) 1109 (vc-file-tree-walk
1063 (filelist nil) (userlist nil) 1110 (function (lambda (f)
1064 dired-buf 1111 (if (vc-registered f)
1065 dired-buf-mod-count 1112 (let ((user (vc-locking-user f)))
1066 (subfunction 1113 (and (or verbose user)
1067 (function (lambda (f) 1114 (setq filelist (cons (substring f dl) filelist))
1068 (if (vc-registered f) 1115 (setq userlist (cons user userlist))))))))
1069 (let ((user (vc-locking-user f)))
1070 (and (or verbose user)
1071 (setq filelist (cons (substring f dl) filelist))
1072 (setq userlist (cons user userlist)))))))))
1073 (let ((default-directory dir))
1074 (if nested
1075 (vc-file-tree-walk subfunction)
1076 (vc-dir-all-files subfunction)))
1077 (save-excursion 1116 (save-excursion
1078 ;; This uses a semi-documented feature of dired; giving a switch 1117 ;; This uses a semi-documented feature of dired; giving a switch
1079 ;; argument forces the buffer to refresh each time. 1118 ;; argument forces the buffer to refresh each time.
1080 (dired 1119 (dired
1081 (cons dir (nreverse filelist)) 1120 (cons default-directory (nreverse filelist))
1082 dired-listing-switches) 1121 dired-listing-switches)
1083 (setq dired-buf (current-buffer)) 1122 (setq dired-buf (current-buffer))
1084 (setq nonempty (not (zerop (buffer-size))))) 1123 (setq nonempty (not (zerop (buffer-size)))))
1085 (if nonempty 1124 (if nonempty
1086 (progn 1125 (progn
1101 ) 1140 )
1102 (message "No files are currently %s under %s" 1141 (message "No files are currently %s under %s"
1103 (if verbose "registered" "locked") default-directory)) 1142 (if verbose "registered" "locked") default-directory))
1104 )) 1143 ))
1105 1144
1106 ; Emacs 18 also lacks these. 1145 ;; Emacs 18 version
1107 (or (boundp 'compilation-old-error-list) 1146 (defun vc-directory-18 (verbose)
1108 (setq compilation-old-error-list nil)) 1147 "Show version-control status of all files under the current directory."
1148 (interactive "P")
1149 (let (nonempty (dir default-directory))
1150 (save-excursion
1151 (set-buffer (get-buffer-create "*vc-status*"))
1152 (erase-buffer)
1153 (cd dir)
1154 (vc-file-tree-walk
1155 (function (lambda (f)
1156 (if (vc-registered f)
1157 (let ((user (vc-locking-user f)))
1158 (if (or user verbose)
1159 (insert (format
1160 "%s %s\n"
1161 (concat user) f))))))))
1162 (setq nonempty (not (zerop (buffer-size)))))
1163 (if nonempty
1164 (progn
1165 (pop-to-buffer "*vc-status*" t)
1166 (goto-char (point-min))
1167 (shrink-window-if-larger-than-buffer)))
1168 (message "No files are currently %s under %s"
1169 (if verbose "registered" "locked") default-directory))
1170 )
1171
1172 (or (boundp 'minor-mode-map-alist)
1173 (fset 'vc-directory 'vc-directory-18))
1109 1174
1110 ;; Named-configuration support for SCCS 1175 ;; Named-configuration support for SCCS
1111 1176
1112 (defun vc-add-triple (name file rev) 1177 (defun vc-add-triple (name file rev)
1113 (save-excursion 1178 (save-excursion
1196 (if vc-dired-mode 1261 (if vc-dired-mode
1197 (set-buffer (find-file-noselect (dired-get-filename)))) 1262 (set-buffer (find-file-noselect (dired-get-filename))))
1198 (while vc-parent-buffer 1263 (while vc-parent-buffer
1199 (pop-to-buffer vc-parent-buffer)) 1264 (pop-to-buffer vc-parent-buffer))
1200 (if (and buffer-file-name (vc-name buffer-file-name)) 1265 (if (and buffer-file-name (vc-name buffer-file-name))
1201 (progn 1266 (let ((file buffer-file-name))
1202 (vc-backend-print-log buffer-file-name) 1267 (vc-backend-print-log file)
1203 (pop-to-buffer (get-buffer-create "*vc*")) 1268 (pop-to-buffer (get-buffer-create "*vc*"))
1269 (setq default-directory (file-name-directory file))
1204 (while (looking-at "=*\n") 1270 (while (looking-at "=*\n")
1205 (delete-char (- (match-end 0) (match-beginning 0))) 1271 (delete-char (- (match-end 0) (match-beginning 0)))
1206 (forward-line -1)) 1272 (forward-line -1))
1207 (goto-char (point-min)) 1273 (goto-char (point-min))
1208 (if (looking-at "[\b\t\n\v\f\r ]+") 1274 (if (looking-at "[\b\t\n\v\f\r ]+")
1422 (save-excursion 1488 (save-excursion
1423 (let ((buf)) 1489 (let ((buf))
1424 (setq buf (create-file-buffer file)) 1490 (setq buf (create-file-buffer file))
1425 (set-buffer buf)) 1491 (set-buffer buf))
1426 (erase-buffer) 1492 (erase-buffer)
1427 (insert-file-contents file nil) 1493 (insert-file-contents file)
1428 (set-buffer-modified-p nil) 1494 (set-buffer-modified-p nil)
1429 (auto-save-mode nil) 1495 (auto-save-mode nil)
1430 (prog1 1496 (prog1
1431 (vc-parse-buffer fields rfile properties) 1497 (vc-parse-buffer fields rfile properties)
1432 (kill-buffer (current-buffer))) 1498 (kill-buffer (current-buffer)))
1600 ;; CVS 1666 ;; CVS
1601 ;; Don't fetch vc-locking-user and vc-locked-version here, since they 1667 ;; Don't fetch vc-locking-user and vc-locked-version here, since they
1602 ;; should always be nil anyhow. Don't fetch vc-your-latest-version, since 1668 ;; should always be nil anyhow. Don't fetch vc-your-latest-version, since
1603 ;; that is done in vc-find-cvs-master. 1669 ;; that is done in vc-find-cvs-master.
1604 (vc-log-info 1670 (vc-log-info
1605 "cvs" file 'BASE '("status") 1671 "cvs" file 'WORKFILE '("status")
1606 ;; CVS 1.3 says "RCS Version:", other releases "RCS Revision:", 1672 ;; CVS 1.3 says "RCS Version:", other releases "RCS Revision:",
1607 ;; and CVS 1.4a1 says "Repository revision:". The regexp below 1673 ;; and CVS 1.4a1 says "Repository revision:". The regexp below
1608 ;; matches much more, but because of the way vc-log-info is 1674 ;; matches much more, but because of the way vc-log-info is
1609 ;; implemented it is impossible to use additional groups. 1675 ;; implemented it is impossible to use additional groups.
1610 '("R[eC][pS][ositry]* [VRr]e[rv][si][is]i?on:[\t ]+\\([0-9.]+\\)") 1676 '("R[eC][pS][ositry]* [VRr]e[rv][si][is]i?on:[\t ]+\\([0-9.]+\\)")
1652 (vc-do-command 0 "ci" file 'MASTER ;; RCS 1718 (vc-do-command 0 "ci" file 'MASTER ;; RCS
1653 (concat (if vc-keep-workfiles "-u" "-r") rev) 1719 (concat (if vc-keep-workfiles "-u" "-r") rev)
1654 (and comment (concat "-t-" comment)) 1720 (and comment (concat "-t-" comment))
1655 file)) 1721 file))
1656 ((eq backend 'CVS) 1722 ((eq backend 'CVS)
1657 (vc-do-command 0 "cvs" file 'BASE ;; CVS 1723 (vc-do-command 0 "cvs" file 'WORKFILE ;; CVS
1658 "add" 1724 "add"
1659 (and comment (not (string= comment "")) 1725 (and comment (not (string= comment ""))
1660 (concat "-m" comment))) 1726 (concat "-m" comment)))
1661 ))) 1727 )))
1662 (message "Registering %s...done" file) 1728 (message "Registering %s...done" file)
1735 ;; CVS is much like RCS 1801 ;; CVS is much like RCS
1736 (let ((failed t)) 1802 (let ((failed t))
1737 (unwind-protect 1803 (unwind-protect
1738 (progn 1804 (progn
1739 (apply 'vc-do-command 1805 (apply 'vc-do-command
1740 0 "/bin/sh" file 'BASE "-c" 1806 0 "/bin/sh" file 'WORKFILE "-c"
1741 "exec >\"$1\" || exit; shift; exec cvs update \"$@\"" 1807 "exec >\"$1\" || exit; shift; exec cvs update \"$@\""
1742 "" ; dummy argument for shell's $0 1808 "" ; dummy argument for shell's $0
1743 workfile 1809 workfile
1744 (concat "-r" rev) 1810 (concat "-r" rev)
1745 "-p" 1811 "-p"
1746 vc-checkout-switches) 1812 vc-checkout-switches)
1747 (setq failed nil)) 1813 (setq failed nil))
1748 (and failed (file-exists-p filename) (delete-file filename)))) 1814 (and failed (file-exists-p filename) (delete-file filename))))
1749 (apply 'vc-do-command 0 "cvs" file 'BASE 1815 (apply 'vc-do-command 0 "cvs" file 'WORKFILE
1750 (and rev (concat "-r" rev)) 1816 (and rev (concat "-r" rev))
1751 file 1817 file
1752 vc-checkout-switches)) 1818 vc-checkout-switches))
1753 )) 1819 ))
1754 (or workfile 1820 (or workfile
1789 (apply 'vc-do-command 0 "ci" file 'MASTER 1855 (apply 'vc-do-command 0 "ci" file 'MASTER
1790 (concat (if vc-keep-workfiles "-u" "-r") rev) 1856 (concat (if vc-keep-workfiles "-u" "-r") rev)
1791 (concat "-m" comment) 1857 (concat "-m" comment)
1792 vc-checkin-switches) 1858 vc-checkin-switches)
1793 (progn 1859 (progn
1794 (apply 'vc-do-command 0 "cvs" file 'BASE 1860 (apply 'vc-do-command 0 "cvs" file 'WORKFILE
1795 "ci" "-m" comment 1861 "ci" "-m" comment
1796 vc-checkin-switches) 1862 vc-checkin-switches)
1797 (vc-file-setprop file 'vc-checkout-time 1863 (vc-file-setprop file 'vc-checkout-time
1798 (nth 5 (file-attributes file)))) 1864 (nth 5 (file-attributes file))))
1799 )) 1865 ))
1811 (vc-do-command 0 "get" file 'MASTER nil)) 1877 (vc-do-command 0 "get" file 'MASTER nil))
1812 (vc-do-command 0 "co" file 'MASTER ;; RCS. This deletes the work file. 1878 (vc-do-command 0 "co" file 'MASTER ;; RCS. This deletes the work file.
1813 "-f" "-u") 1879 "-f" "-u")
1814 (progn ;; CVS 1880 (progn ;; CVS
1815 (delete-file file) 1881 (delete-file file)
1816 (vc-do-command 0 "cvs" file 'BASE "update")) 1882 (vc-do-command 0 "cvs" file 'WORKFILE "update"))
1817 ) 1883 )
1818 (vc-file-setprop file 'vc-locking-user nil) 1884 (vc-file-setprop file 'vc-locking-user nil)
1819 (message "Reverting %s...done" file) 1885 (message "Reverting %s...done" file)
1820 ) 1886 )
1821 1887
1851 ;; Print change log associated with FILE to buffer *vc*. 1917 ;; Print change log associated with FILE to buffer *vc*.
1852 (vc-backend-dispatch 1918 (vc-backend-dispatch
1853 file 1919 file
1854 (vc-do-command 0 "prs" file 'MASTER) 1920 (vc-do-command 0 "prs" file 'MASTER)
1855 (vc-do-command 0 "rlog" file 'MASTER) 1921 (vc-do-command 0 "rlog" file 'MASTER)
1856 (vc-do-command 0 "cvs" file 'BASE "rlog"))) 1922 (vc-do-command 0 "cvs" file 'WORKFILE "rlog")))
1857 1923
1858 (defun vc-backend-assign-name (file name) 1924 (defun vc-backend-assign-name (file name)
1859 ;; Assign to a FILE's latest version a given NAME. 1925 ;; Assign to a FILE's latest version a given NAME.
1860 (vc-backend-dispatch file 1926 (vc-backend-dispatch file
1861 (vc-add-triple name file (vc-latest-version file)) ;; SCCS 1927 (vc-add-triple name file (vc-latest-version file)) ;; SCCS
1862 (vc-do-command 0 "rcs" file 'MASTER (concat "-n" name ":")) ;; RCS 1928 (vc-do-command 0 "rcs" file 'MASTER (concat "-n" name ":")) ;; RCS
1863 (vc-do-command 0 "cvs" file 'BASE "tag" name) ;; CVS 1929 (vc-do-command 0 "cvs" file 'WORKFILE "tag" name) ;; CVS
1864 ) 1930 )
1865 ) 1931 )
1866 1932
1867 (defun vc-backend-diff (file &optional oldvers newvers cmp) 1933 (defun vc-backend-diff (file &optional oldvers newvers cmp)
1868 ;; Get a difference report between two versions of FILE. 1934 ;; Get a difference report between two versions of FILE.
1876 ;; SCCS and RCS shares a lot of code. 1942 ;; SCCS and RCS shares a lot of code.
1877 ((or (eq backend 'SCCS) (eq backend 'RCS)) 1943 ((or (eq backend 'SCCS) (eq backend 'RCS))
1878 (let* ((command (if (eq backend 'SCCS) 1944 (let* ((command (if (eq backend 'SCCS)
1879 "vcdiff" 1945 "vcdiff"
1880 "rcsdiff")) 1946 "rcsdiff"))
1947 (mode (if (eq backend 'RCS) 'WORKFILE 'MASTER))
1881 (options (append (list (and cmp "--brief") 1948 (options (append (list (and cmp "--brief")
1882 "-q" 1949 "-q"
1883 (and oldvers (concat "-r" oldvers)) 1950 (and oldvers (concat "-r" oldvers))
1884 (and newvers (concat "-r" newvers))) 1951 (and newvers (concat "-r" newvers)))
1885 (and (not cmp) 1952 (and (not cmp)
1886 (if (listp diff-switches) 1953 (if (listp diff-switches)
1887 diff-switches 1954 diff-switches
1888 (list diff-switches))))) 1955 (list diff-switches)))))
1889 (status (apply 'vc-do-command 2 command file options))) 1956 (status (apply 'vc-do-command 2 command file mode options)))
1890 ;; Some RCS versions don't understand "--brief"; work around this. 1957 ;; Some RCS versions don't understand "--brief"; work around this.
1891 (if (eq status 2) 1958 (if (eq status 2)
1892 (apply 'vc-do-command 1 command file 'MASTER 1959 (apply 'vc-do-command 1 command file 'WORKFILE
1893 (if cmp (cdr options) options)) 1960 (if cmp (cdr options) options))
1894 status))) 1961 status)))
1895 ;; CVS is different. 1962 ;; CVS is different.
1896 ;; cmp is not yet implemented -- we always do a full diff. 1963 ;; cmp is not yet implemented -- we always do a full diff.
1897 ((eq backend 'CVS) 1964 ((eq backend 'CVS)
1899 ;; This file is added but not yet committed; there is no master file. 1966 ;; This file is added but not yet committed; there is no master file.
1900 ;; diff it against /dev/null. 1967 ;; diff it against /dev/null.
1901 (if (or oldvers newvers) 1968 (if (or oldvers newvers)
1902 (error "No revisions of %s exists" file) 1969 (error "No revisions of %s exists" file)
1903 (apply 'vc-do-command 1970 (apply 'vc-do-command
1904 1 "diff" file 'BASE "/dev/null" 1971 1 "diff" file 'WORKFILE "/dev/null"
1905 (if (listp diff-switches) 1972 (if (listp diff-switches)
1906 diff-switches 1973 diff-switches
1907 (list diff-switches)))) 1974 (list diff-switches))))
1908 (apply 'vc-do-command 1975 (apply 'vc-do-command
1909 1 "cvs" file 'BASE "diff" 1976 1 "cvs" file 'WORKFILE "diff"
1910 (and oldvers (concat "-r" oldvers)) 1977 (and oldvers (concat "-r" oldvers))
1911 (and newvers (concat "-r" newvers)) 1978 (and newvers (concat "-r" newvers))
1912 (if (listp diff-switches) 1979 (if (listp diff-switches)
1913 diff-switches 1980 diff-switches
1914 (list diff-switches))))) 1981 (list diff-switches)))))
1919 ;; Merge in any new changes made to FILE. 1986 ;; Merge in any new changes made to FILE.
1920 (vc-backend-dispatch 1987 (vc-backend-dispatch
1921 file 1988 file
1922 (error "vc-backend-merge-news not meaningful for SCCS files") ;SCCS 1989 (error "vc-backend-merge-news not meaningful for SCCS files") ;SCCS
1923 (error "vc-backend-merge-news not meaningful for RCS files") ;RCS 1990 (error "vc-backend-merge-news not meaningful for RCS files") ;RCS
1924 (vc-do-command 1 "cvs" file 'BASE "update") ;CVS 1991 (vc-do-command 1 "cvs" file 'WORKFILE "update") ;CVS
1925 )) 1992 ))
1926 1993
1927 (defun vc-check-headers () 1994 (defun vc-check-headers ()
1928 "Check if the current file has any headers in it." 1995 "Check if the current file has any headers in it."
1929 (interactive) 1996 (interactive)
2039 (mapcar 2106 (mapcar
2040 (function 2107 (function
2041 (lambda (f) (or 2108 (lambda (f) (or
2042 (string-equal f ".") 2109 (string-equal f ".")
2043 (string-equal f "..") 2110 (string-equal f "..")
2111 (member f vc-directory-exclusion-list)
2044 (let ((dirf (concat dir f))) 2112 (let ((dirf (concat dir f)))
2045 (or 2113 (or
2046 (file-symlink-p dirf) ;; Avoid possible loops 2114 (file-symlink-p dirf) ;; Avoid possible loops
2047 (vc-file-tree-walk-internal dirf func args)))))) 2115 (vc-file-tree-walk-internal dirf func args))))))
2048 (directory-files dir))))) 2116 (directory-files dir)))))
2049
2050 (defun vc-dir-all-files (func &rest args)
2051 "Invoke FUNC f ARGS on each regular file f in default directory."
2052 (let ((dir default-directory))
2053 (message "Scanning directory %s..." dir)
2054 (mapcar (function (lambda (f)
2055 (let ((dirf (expand-file-name f dir)))
2056 (if (file-regular-p dirf)
2057 (apply func dirf args)))))
2058 (directory-files dir))
2059 (message "Scanning directory %s...done" dir)))
2060 2117
2061 (provide 'vc) 2118 (provide 'vc)
2062 2119
2063 ;;; DEVELOPER'S NOTES ON CONCURRENCY PROBLEMS IN THIS CODE 2120 ;;; DEVELOPER'S NOTES ON CONCURRENCY PROBLEMS IN THIS CODE
2064 ;;; 2121 ;;;