aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorEric S. Raymond2007-07-18 16:32:40 +0000
committerEric S. Raymond2007-07-18 16:32:40 +0000
commit8cdd17b444075b04fbe47ffd8ee4cf0e617e4f42 (patch)
tree3cc38ed8386e7f573ec7f74801f61403ca20ae4b
parent4e6e4fe5643a958a03f386b5c9f41ff434bbfd64 (diff)
downloademacs-8cdd17b444075b04fbe47ffd8ee4cf0e617e4f42.tar.gz
emacs-8cdd17b444075b04fbe47ffd8ee4cf0e617e4f42.zip
Put the lower half (the back-end) of NewVC in place. This commit
makes only the minimum changes needed to get the old vc.el logic working with the new back ends.
-rw-r--r--lisp/vc-arch.el39
-rw-r--r--lisp/vc-bzr.el24
-rw-r--r--lisp/vc-cvs.el88
-rw-r--r--lisp/vc-hg.el55
-rw-r--r--lisp/vc-mcvs.el87
-rw-r--r--lisp/vc-rcs.el218
-rw-r--r--lisp/vc-sccs.el79
-rw-r--r--lisp/vc-svn.el79
-rw-r--r--lisp/vc.el207
9 files changed, 498 insertions, 378 deletions
diff --git a/lisp/vc-arch.el b/lisp/vc-arch.el
index c6aaa6c8c0b..7f673e935f3 100644
--- a/lisp/vc-arch.el
+++ b/lisp/vc-arch.el
@@ -198,16 +198,17 @@ Only the value `maybe' can be trusted :-(."
198 ;; creates a {arch} directory somewhere. 198 ;; creates a {arch} directory somewhere.
199 file 'arch-root (vc-find-root file "{arch}/=tagging-method")))) 199 file 'arch-root (vc-find-root file "{arch}/=tagging-method"))))
200 200
201(defun vc-arch-register (file &optional rev comment) 201(defun vc-arch-register (files &optional rev comment)
202 (if rev (error "Explicit initial revision not supported for Arch")) 202 (if rev (error "Explicit initial revision not supported for Arch"))
203 (let ((tagmet (vc-arch-tagging-method file))) 203 (dolist (file files)
204 (if (and (memq tagmet '(tagline implicit)) comment-start) 204 (let ((tagmet (vc-arch-tagging-method file)))
205 (with-current-buffer (find-file-noselect file) 205 (if (and (memq tagmet '(tagline implicit)) comment-start)
206 (if (buffer-modified-p) 206 (with-current-buffer (find-file-noselect file)
207 (error "Save %s first" (buffer-name))) 207 (if (buffer-modified-p)
208 (vc-arch-add-tagline) 208 (error "Save %s first" (buffer-name)))
209 (save-buffer)) 209 (vc-arch-add-tagline)
210 (vc-arch-command nil 0 file "add")))) 210 (save-buffer)))))
211 (vc-arch-command nil 0 files "add"))
211 212
212(defun vc-arch-registered (file) 213(defun vc-arch-registered (file)
213 ;; Don't seriously check whether it's source or not. Checking would 214 ;; Don't seriously check whether it's source or not. Checking would
@@ -371,22 +372,24 @@ Return non-nil if FILE is unchanged."
371 372
372(defun vc-arch-checkout-model (file) 'implicit) 373(defun vc-arch-checkout-model (file) 'implicit)
373 374
374(defun vc-arch-checkin (file rev comment) 375(defun vc-arch-checkin (files rev comment)
375 (if rev (error "Committing to a specific revision is unsupported")) 376 (if rev (error "Committing to a specific revision is unsupported"))
376 (let ((summary (file-relative-name file (vc-arch-root file)))) 377 ;; FIXME: This implementation probably only works for singleton filesets
378 (let ((summary (file-relative-name (car file) (vc-arch-root (car files)))))
377 ;; Extract a summary from the comment. 379 ;; Extract a summary from the comment.
378 (when (or (string-match "\\`Summary:[ \t]*\\(.*[^ \t\n]\\)\\([ \t]*\n\\)*" comment) 380 (when (or (string-match "\\`Summary:[ \t]*\\(.*[^ \t\n]\\)\\([ \t]*\n\\)*" comment)
379 (string-match "\\`[ \t]*\\(.*[^ \t\n]\\)[ \t]*\\(\n?\\'\\|\n\\([ \t]*\n\\)+\\)" comment)) 381 (string-match "\\`[ \t]*\\(.*[^ \t\n]\\)[ \t]*\\(\n?\\'\\|\n\\([ \t]*\n\\)+\\)" comment))
380 (setq summary (match-string 1 comment)) 382 (setq summary (match-string 1 comment))
381 (setq comment (substring comment (match-end 0)))) 383 (setq comment (substring comment (match-end 0))))
382 (vc-arch-command nil 0 file "commit" "-s" summary "-L" comment "--" 384 (vc-arch-command nil 0 files "commit" "-s" summary "-L" comment "--"
383 (vc-switches 'Arch 'checkin)))) 385 (vc-switches 'Arch 'checkin))))
384 386
385(defun vc-arch-diff (file &optional oldvers newvers buffer) 387(defun vc-arch-diff (files &optional oldvers newvers buffer)
386 "Get a difference report using Arch between two versions of FILE." 388 "Get a difference report using Arch between two versions of FILES."
389 ;; FIXME: This implementation probably only works for singleton filesets
387 (if (and newvers 390 (if (and newvers
388 (vc-up-to-date-p file) 391 (vc-up-to-date-p file)
389 (equal newvers (vc-workfile-version file))) 392 (equal newvers (vc-workfile-version (car files))))
390 ;; Newvers is the base revision and the current file is unchanged, 393 ;; Newvers is the base revision and the current file is unchanged,
391 ;; so we can diff with the current file. 394 ;; so we can diff with the current file.
392 (setq newvers nil)) 395 (setq newvers nil))
@@ -394,7 +397,7 @@ Return non-nil if FILE is unchanged."
394 (error "Diffing specific revisions not implemented") 397 (error "Diffing specific revisions not implemented")
395 (let* ((async (and (not vc-disable-async-diff) (fboundp 'start-process))) 398 (let* ((async (and (not vc-disable-async-diff) (fboundp 'start-process)))
396 ;; Run the command from the root dir. 399 ;; Run the command from the root dir.
397 (default-directory (vc-arch-root file)) 400 (default-directory (vc-arch-root (car files)))
398 (status 401 (status
399 (vc-arch-command 402 (vc-arch-command
400 (or buffer "*vc-diff*") 403 (or buffer "*vc-diff*")
@@ -402,8 +405,8 @@ Return non-nil if FILE is unchanged."
402 nil "file-diffs" 405 nil "file-diffs"
403 ;; Arch does not support the typical flags. 406 ;; Arch does not support the typical flags.
404 ;; (vc-switches 'Arch 'diff) 407 ;; (vc-switches 'Arch 'diff)
405 (file-relative-name file) 408 (mapcar 'file-relative-name files)
406 (if (equal oldvers (vc-workfile-version file)) 409 (if (equal oldvers (vc-workfile-version (car files)))
407 nil 410 nil
408 oldvers)))) 411 oldvers))))
409 (if async 1 status)))) ; async diff, pessimistic assumption. 412 (if async 1 status)))) ; async diff, pessimistic assumption.
diff --git a/lisp/vc-bzr.el b/lisp/vc-bzr.el
index 583816c4cf5..e7a09450fd9 100644
--- a/lisp/vc-bzr.el
+++ b/lisp/vc-bzr.el
@@ -90,7 +90,7 @@
90 90
91;; since v0.9, bzr supports removing the progress indicators 91;; since v0.9, bzr supports removing the progress indicators
92;; by setting environment variable BZR_PROGRESS_BAR to "none". 92;; by setting environment variable BZR_PROGRESS_BAR to "none".
93(defun vc-bzr-command (bzr-command buffer okstatus file &rest args) 93(defun vc-bzr-command (bzr-command buffer okstatus file-or-list &rest args)
94 "Wrapper round `vc-do-command' using `vc-bzr-program' as COMMAND. 94 "Wrapper round `vc-do-command' using `vc-bzr-program' as COMMAND.
95Invoke the bzr command adding `BZR_PROGRESS_BAR=none' to the environment." 95Invoke the bzr command adding `BZR_PROGRESS_BAR=none' to the environment."
96 (let ((process-environment 96 (let ((process-environment
@@ -103,7 +103,7 @@ Invoke the bzr command adding `BZR_PROGRESS_BAR=none' to the environment."
103 ;; This is redundant because vc-do-command does it already. --Stef 103 ;; This is redundant because vc-do-command does it already. --Stef
104 (process-connection-type nil)) 104 (process-connection-type nil))
105 (apply 'vc-do-command buffer okstatus vc-bzr-program 105 (apply 'vc-do-command buffer okstatus vc-bzr-program
106 file bzr-command (append vc-bzr-program-args args)))) 106 file-or-list bzr-command (append vc-bzr-program-args args))))
107 107
108 108
109;;;###autoload 109;;;###autoload
@@ -196,12 +196,12 @@ Return nil if there isn't one."
196(defun vc-bzr-checkout-model (file) 196(defun vc-bzr-checkout-model (file)
197 'implicit) 197 'implicit)
198 198
199(defun vc-bzr-register (file &optional rev comment) 199(defun vc-bzr-register (files &optional rev comment)
200 "Register FILE under bzr. 200 "Register FILE under bzr.
201Signal an error unless REV is nil. 201Signal an error unless REV is nil.
202COMMENT is ignored." 202COMMENT is ignored."
203 (if rev (error "Can't register explicit version with bzr")) 203 (if rev (error "Can't register explicit version with bzr"))
204 (vc-bzr-command "add" nil 0 file)) 204 (vc-bzr-command "add" nil 0 files))
205 205
206;; Could run `bzr status' in the directory and see if it succeeds, but 206;; Could run `bzr status' in the directory and see if it succeeds, but
207;; that's relatively expensive. 207;; that's relatively expensive.
@@ -226,11 +226,11 @@ or a superior directory.")
226 "Unregister FILE from bzr." 226 "Unregister FILE from bzr."
227 (vc-bzr-command "remove" nil 0 file)) 227 (vc-bzr-command "remove" nil 0 file))
228 228
229(defun vc-bzr-checkin (file rev comment) 229(defun vc-bzr-checkin (files rev comment)
230 "Check FILE in to bzr with log message COMMENT. 230 "Check FILE in to bzr with log message COMMENT.
231REV non-nil gets an error." 231REV non-nil gets an error."
232 (if rev (error "Can't check in a specific version with bzr")) 232 (if rev (error "Can't check in a specific version with bzr"))
233 (vc-bzr-command "commit" nil 0 file "-m" comment)) 233 (vc-bzr-command "commit" nil 0 files "-m" comment))
234 234
235(defun vc-bzr-checkout (file &optional editable rev destfile) 235(defun vc-bzr-checkout (file &optional editable rev destfile)
236 "Checkout revision REV of FILE from bzr to DESTFILE. 236 "Checkout revision REV of FILE from bzr to DESTFILE.
@@ -271,12 +271,12 @@ EDITABLE is ignored."
271 (2 'change-log-email)) 271 (2 'change-log-email))
272 ("^ *timestamp: \\(.*\\)" (1 'change-log-date-face)))))) 272 ("^ *timestamp: \\(.*\\)" (1 'change-log-date-face))))))
273 273
274(defun vc-bzr-print-log (file &optional buffer) ; get buffer arg in Emacs 22 274(defun vc-bzr-print-log (files &optional buffer) ; get buffer arg in Emacs 22
275 "Get bzr change log for FILE into specified BUFFER." 275 "Get bzr change log for FILES into specified BUFFER."
276 ;; Fixme: This might need the locale fixing up if things like `revno' 276 ;; Fixme: This might need the locale fixing up if things like `revno'
277 ;; got localized, but certainly it shouldn't use LC_ALL=C. 277 ;; got localized, but certainly it shouldn't use LC_ALL=C.
278 ;; NB. Can't be async -- see `vc-bzr-post-command-function'. 278 ;; NB. Can't be async -- see `vc-bzr-post-command-function'.
279 (vc-bzr-command "log" buffer 0 file) 279 (vc-bzr-command "log" buffer 0 files)
280 ;; FIXME: Until Emacs-23, VC was missing a hook to sort out the mode for 280 ;; FIXME: Until Emacs-23, VC was missing a hook to sort out the mode for
281 ;; the buffer, or at least set the regexps right. 281 ;; the buffer, or at least set the regexps right.
282 (unless (fboundp 'vc-default-log-view-mode) 282 (unless (fboundp 'vc-default-log-view-mode)
@@ -294,16 +294,16 @@ EDITABLE is ignored."
294 294
295(autoload 'vc-diff-switches-list "vc" nil nil t) 295(autoload 'vc-diff-switches-list "vc" nil nil t)
296 296
297(defun vc-bzr-diff (file &optional rev1 rev2 buffer) 297(defun vc-bzr-diff (files &optional rev1 rev2 buffer)
298 "VC bzr backend for diff." 298 "VC bzr backend for diff."
299 (let ((working (vc-workfile-version file))) 299 (let ((working (vc-workfile-version (car files))))
300 (if (and (equal rev1 working) (not rev2)) 300 (if (and (equal rev1 working) (not rev2))
301 (setq rev1 nil)) 301 (setq rev1 nil))
302 (if (and (not rev1) rev2) 302 (if (and (not rev1) rev2)
303 (setq rev1 working)) 303 (setq rev1 working))
304 ;; NB. Can't be async -- see `vc-bzr-post-command-function'. 304 ;; NB. Can't be async -- see `vc-bzr-post-command-function'.
305 ;; bzr diff produces condition code 1 for some reason. 305 ;; bzr diff produces condition code 1 for some reason.
306 (apply #'vc-bzr-command "diff" (or buffer "*vc-diff*") 1 file 306 (apply #'vc-bzr-command "diff" (or buffer "*vc-diff*") 1 files
307 "--diff-options" (mapconcat 'identity (vc-diff-switches-list bzr) 307 "--diff-options" (mapconcat 'identity (vc-diff-switches-list bzr)
308 " ") 308 " ")
309 (when rev1 309 (when rev1
diff --git a/lisp/vc-cvs.el b/lisp/vc-cvs.el
index 22ed10d1286..3712dcd8999 100644
--- a/lisp/vc-cvs.el
+++ b/lisp/vc-cvs.el
@@ -281,21 +281,25 @@ committed and support display of sticky tags."
281;;; State-changing functions 281;;; State-changing functions
282;;; 282;;;
283 283
284(defun vc-cvs-register (file &optional rev comment) 284(defun vc-cvs-create-repo ()
285 "Register FILE into the CVS version-control system. 285 "Create a new CVS repository."
286COMMENT can be used to provide an initial description of FILE. 286 (error "Creation of CVS repositories is not supported."))
287
288(defun vc-cvs-register (files &optional rev comment)
289 "Register FILES into the CVS version-control system.
290COMMENT can be used to provide an initial description of FILES.
287 291
288`vc-register-switches' and `vc-cvs-register-switches' are passed to 292`vc-register-switches' and `vc-cvs-register-switches' are passed to
289the CVS command (in that order)." 293the CVS command (in that order)."
290 (when (and (not (vc-cvs-responsible-p file)) 294 (when (and (not (vc-cvs-responsible-p file))
291 (vc-cvs-could-register file)) 295 (vc-cvs-could-register file))
292 ;; Register the directory if needed. 296 ;; Register the directory if needed.
293 (vc-cvs-register (directory-file-name (file-name-directory file)))) 297 (vc-cvs-register (directory-file-name (file-name-directory file))))
294 (apply 'vc-cvs-command nil 0 file 298 (apply 'vc-cvs-command nil 0 files
295 "add" 299 "add"
296 (and comment (string-match "[^\t\n ]" comment) 300 (and comment (string-match "[^\t\n ]" comment)
297 (concat "-m" comment)) 301 (concat "-m" comment))
298 (vc-switches 'CVS 'register))) 302 (vc-switches 'CVS 'register)))
299 303
300(defun vc-cvs-responsible-p (file) 304(defun vc-cvs-responsible-p (file)
301 "Return non-nil if CVS thinks it is responsible for FILE." 305 "Return non-nil if CVS thinks it is responsible for FILE."
@@ -317,15 +321,15 @@ its parents."
317 t (directory-file-name dir)))) 321 t (directory-file-name dir))))
318 (eq dir t))) 322 (eq dir t)))
319 323
320(defun vc-cvs-checkin (file rev comment) 324(defun vc-cvs-checkin (files rev comment)
321 "CVS-specific version of `vc-backend-checkin'." 325 "CVS-specific version of `vc-backend-checkin'."
322 (unless (or (not rev) (vc-cvs-valid-version-number-p rev)) 326 (unless (or (not rev) (vc-cvs-valid-version-number-p rev))
323 (if (not (vc-cvs-valid-symbolic-tag-name-p rev)) 327 (if (not (vc-cvs-valid-symbolic-tag-name-p rev))
324 (error "%s is not a valid symbolic tag name" rev) 328 (error "%s is not a valid symbolic tag name" rev)
325 ;; If the input revison is a valid symbolic tag name, we create it 329 ;; If the input revison is a valid symbolic tag name, we create it
326 ;; as a branch, commit and switch to it. 330 ;; as a branch, commit and switch to it.
327 (apply 'vc-cvs-command nil 0 file "tag" "-b" (list rev)) 331 (apply 'vc-cvs-command nil 0 files "tag" "-b" (list rev))
328 (apply 'vc-cvs-command nil 0 file "update" "-r" (list rev)) 332 (apply 'vc-cvs-command nil 0 files "update" "-r" (list rev))
329 (vc-file-setprop file 'vc-cvs-sticky-tag rev))) 333 (vc-file-setprop file 'vc-cvs-sticky-tag rev)))
330 (let ((status (apply 'vc-cvs-command nil 1 file 334 (let ((status (apply 'vc-cvs-command nil 1 file
331 "ci" (if rev (concat "-r" rev)) 335 "ci" (if rev (concat "-r" rev))
@@ -346,20 +350,25 @@ its parents."
346 (goto-char (point-min)) 350 (goto-char (point-min))
347 (shrink-window-if-larger-than-buffer) 351 (shrink-window-if-larger-than-buffer)
348 (error "Check-in failed")))) 352 (error "Check-in failed"))))
349 ;; Update file properties 353 ;; Single-file commit? Then update the version by parsing the buffer.
350 (vc-file-setprop 354 ;; Otherwise we can't necessarily tell what goes with what; clear
351 file 'vc-workfile-version 355 ;; its properties so they have to be refetched.
352 (vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2)) 356 (if (= (length files) 1)
353 ;; Forget the checkout model of the file, because we might have 357 (vc-file-setprop
358 (car files) 'vc-workfile-version
359 (vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2))
360 (mapc (lambda (file) (vc-file-clearprops file)) files))
361 ;; Anyway, forget the checkout model of the file, because we might have
354 ;; guessed wrong when we found the file. After commit, we can 362 ;; guessed wrong when we found the file. After commit, we can
355 ;; tell it from the permissions of the file (see 363 ;; tell it from the permissions of the file (see
356 ;; vc-cvs-checkout-model). 364 ;; vc-cvs-checkout-model).
357 (vc-file-setprop file 'vc-checkout-model nil) 365 (mapc (lambda (file) (vc-file-setprop file 'vc-checkout-model nil))
366 files)
358 367
359 ;; if this was an explicit check-in (does not include creation of 368 ;; if this was an explicit check-in (does not include creation of
360 ;; a branch), remove the sticky tag. 369 ;; a branch), remove the sticky tag.
361 (if (and rev (not (vc-cvs-valid-symbolic-tag-name-p rev))) 370 (if (and rev (not (vc-cvs-valid-symbolic-tag-name-p rev)))
362 (vc-cvs-command nil 0 file "update" "-A")))) 371 (vc-cvs-command nil 0 files "update" "-A"))))
363 372
364(defun vc-cvs-find-version (file rev buffer) 373(defun vc-cvs-find-version (file rev buffer)
365 (apply 'vc-cvs-command 374 (apply 'vc-cvs-command
@@ -481,37 +490,30 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
481;;; History functions 490;;; History functions
482;;; 491;;;
483 492
484(defun vc-cvs-print-log (file &optional buffer) 493(defun vc-cvs-print-log (files &optional buffer)
485 "Get change log associated with FILE." 494 "Get change log associated with FILE."
486 (vc-cvs-command 495 (vc-cvs-command
487 buffer 496 buffer
488 (if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0) 497 (if (and (vc-stay-local-p files) (fboundp 'start-process)) 'async 0)
489 file "log")) 498 files "log"))
499
500(defun vc-cvs-wash-log ()
501 "Remove all non-comment information from log output."
502 (vc-call-backend 'RCS 'wash-log)
503 nil)
490 504
491(defun vc-cvs-diff (file &optional oldvers newvers buffer) 505(defun vc-cvs-diff (files &optional oldvers newvers buffer)
492 "Get a difference report using CVS between two versions of FILE." 506 "Get a difference report using CVS between two versions of FILE."
493 (if (string= (vc-workfile-version file) "0") 507 (let* ((async (and (not vc-disable-async-diff)
494 ;; This file is added but not yet committed; there is no master file. 508 (vc-stay-local-p files)
495 (if (or oldvers newvers) 509 (fboundp 'start-process)))
496 (error "No revisions of %s exist" file)
497 ;; We regard this as "changed".
498 ;; Diff it against /dev/null.
499 ;; Note: this is NOT a "cvs diff".
500 (apply 'vc-do-command (or buffer "*vc-diff*")
501 1 "diff" file
502 (append (vc-switches nil 'diff) '("/dev/null")))
503 ;; Even if it's empty, it's locally modified.
504 1)
505 (let* ((async (and (not vc-disable-async-diff)
506 (vc-stay-local-p file)
507 (fboundp 'start-process)))
508 (status (apply 'vc-cvs-command (or buffer "*vc-diff*") 510 (status (apply 'vc-cvs-command (or buffer "*vc-diff*")
509 (if async 'async 1) 511 (if async 'async 1)
510 file "diff" 512 file "diff"
511 (and oldvers (concat "-r" oldvers)) 513 (and oldvers (concat "-r" oldvers))
512 (and newvers (concat "-r" newvers)) 514 (and newvers (concat "-r" newvers))
513 (vc-switches 'CVS 'diff)))) 515 (vc-switches 'CVS 'diff))))
514 (if async 1 status)))) ; async diff, pessimistic assumption 516 (if async 1 status))) ; async diff, pessimistic assumption
515 517
516(defun vc-cvs-diff-tree (dir &optional rev1 rev2) 518(defun vc-cvs-diff-tree (dir &optional rev1 rev2)
517 "Diff all files at and below DIR." 519 "Diff all files at and below DIR."
@@ -683,11 +685,11 @@ If UPDATE is non-nil, then update (resynch) any affected buffers."
683;;; Internal functions 685;;; Internal functions
684;;; 686;;;
685 687
686(defun vc-cvs-command (buffer okstatus file &rest flags) 688(defun vc-cvs-command (buffer okstatus files &rest flags)
687 "A wrapper around `vc-do-command' for use in vc-cvs.el. 689 "A wrapper around `vc-do-command' for use in vc-cvs.el.
688The difference to vc-do-command is that this function always invokes `cvs', 690The difference to vc-do-command is that this function always invokes `cvs',
689and that it passes `vc-cvs-global-switches' to it before FLAGS." 691and that it passes `vc-cvs-global-switches' to it before FLAGS."
690 (apply 'vc-do-command buffer okstatus "cvs" file 692 (apply 'vc-do-command buffer okstatus "cvs" files
691 (if (stringp vc-cvs-global-switches) 693 (if (stringp vc-cvs-global-switches)
692 (cons vc-cvs-global-switches flags) 694 (cons vc-cvs-global-switches flags)
693 (append vc-cvs-global-switches 695 (append vc-cvs-global-switches
diff --git a/lisp/vc-hg.el b/lisp/vc-hg.el
index 416c08ae4ca..8003f347756 100644
--- a/lisp/vc-hg.el
+++ b/lisp/vc-hg.el
@@ -50,29 +50,29 @@
50;; - mode-line-string (file) NOT NEEDED 50;; - mode-line-string (file) NOT NEEDED
51;; - dired-state-info (file) NEEDED 51;; - dired-state-info (file) NEEDED
52;; STATE-CHANGING FUNCTIONS 52;; STATE-CHANGING FUNCTIONS
53;; * register (file &optional rev comment) OK 53;; * register (files &optional rev comment) OK
54;; - init-version () NOT NEEDED 54;; - init-version () NOT NEEDED
55;; - responsible-p (file) OK 55;; - responsible-p (file) OK
56;; - could-register (file) OK 56;; - could-register (file) OK
57;; - receive-file (file rev) ?? PROBABLY NOT NEEDED 57;; - receive-file (file rev) ?? PROBABLY NOT NEEDED
58;; - unregister (file) COMMENTED OUT, MAY BE INCORRECT 58;; - unregister (file) COMMENTED OUT, MAY BE INCORRECT
59;; * checkin (file rev comment) OK 59;; * checkin (files rev comment) OK
60;; * find-version (file rev buffer) OK 60;; * find-version (file rev buffer) OK
61;; * checkout (file &optional editable rev) NOT NEEDED, COMMENTED OUT 61;; * checkout (file &optional editable rev) NOT NEEDED, COMMENTED OUT
62;; * revert (file &optional contents-done) OK 62;; * revert (file &optional contents-done) OK
63;; - cancel-version (file editable) ?? PROBABLY NOT NEEDED 63;; - rollback (files) ?? PROBABLY NOT NEEDED
64;; - merge (file rev1 rev2) NEEDED 64;; - merge (file rev1 rev2) NEEDED
65;; - merge-news (file) NEEDED 65;; - merge-news (file) NEEDED
66;; - steal-lock (file &optional version) NOT NEEDED 66;; - steal-lock (file &optional version) NOT NEEDED
67;; HISTORY FUNCTIONS 67;; HISTORY FUNCTIONS
68;; * print-log (file &optional buffer) OK 68;; * print-log (files &optional buffer) OK
69;; - log-view-mode () OK 69;; - log-view-mode () OK
70;; - show-log-entry (version) NOT NEEDED, DEFAULT IS GOOD 70;; - show-log-entry (version) NOT NEEDED, DEFAULT IS GOOD
71;; - wash-log (file) ?? 71;; - wash-log (file) ??
72;; - logentry-check () NOT NEEDED 72;; - logentry-check () NOT NEEDED
73;; - comment-history (file) NOT NEEDED 73;; - comment-history (file) NOT NEEDED
74;; - update-changelog (files) NOT NEEDED 74;; - update-changelog (files) NOT NEEDED
75;; * diff (file &optional rev1 rev2 buffer) OK 75;; * diff (files &optional rev1 rev2 buffer) OK
76;; - revision-completion-table (file) ?? 76;; - revision-completion-table (file) ??
77;; - diff-tree (dir &optional rev1 rev2) TEST IT 77;; - diff-tree (dir &optional rev1 rev2) TEST IT
78;; - annotate-command (file buf &optional rev) OK 78;; - annotate-command (file buf &optional rev) OK
@@ -125,6 +125,12 @@
125 :version "22.2" 125 :version "22.2"
126 :group 'vc) 126 :group 'vc)
127 127
128
129;;; Properties of the backend
130
131(defun vc-hg-revision-granularity ()
132 'repository)
133
128;;; State querying functions 134;;; State querying functions
129 135
130;;;###autoload (defun vc-hg-registered (file) 136;;;###autoload (defun vc-hg-registered (file)
@@ -191,8 +197,8 @@
191 197
192;;; History functions 198;;; History functions
193 199
194(defun vc-hg-print-log(file &optional buffer) 200(defun vc-hg-print-log(files &optional buffer)
195 "Get change log associated with FILE." 201 "Get change log associated with FILES."
196 ;; `log-view-mode' needs to have the file name in order to function 202 ;; `log-view-mode' needs to have the file name in order to function
197 ;; correctly. "hg log" does not print it, so we insert it here by 203 ;; correctly. "hg log" does not print it, so we insert it here by
198 ;; hand. 204 ;; hand.
@@ -205,11 +211,11 @@
205 (let ((inhibit-read-only t)) 211 (let ((inhibit-read-only t))
206 (with-current-buffer 212 (with-current-buffer
207 buffer 213 buffer
208 (insert "File: " (file-name-nondirectory file) "\n"))) 214 (insert "File: " (vc-delistify (mapcar (lambda (file) (file-name-nondirectory file)) files)) "\n")))
209 (vc-hg-command 215 (vc-hg-command
210 buffer 216 buffer
211 (if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0) 217 (if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0)
212 file "log")) 218 files "log"))
213 219
214(defvar log-view-message-re) 220(defvar log-view-message-re)
215(defvar log-view-file-re) 221(defvar log-view-file-re)
@@ -236,24 +242,25 @@
236 ("^date: \\(.+\\)" (1 'change-log-date)) 242 ("^date: \\(.+\\)" (1 'change-log-date))
237 ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))) 243 ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message))))))
238 244
239(defun vc-hg-diff (file &optional oldvers newvers buffer) 245(defun vc-hg-diff (files &optional oldvers newvers buffer)
240 "Get a difference report using hg between two versions of FILE." 246 "Get a difference report using hg between two versions of FILES."
241 (let ((working (vc-workfile-version file))) 247 (let ((working (vc-workfile-version (car files))))
242 (if (and (equal oldvers working) (not newvers)) 248 (if (and (equal oldvers working) (not newvers))
243 (setq oldvers nil)) 249 (setq oldvers nil))
244 (if (and (not oldvers) newvers) 250 (if (and (not oldvers) newvers)
245 (setq oldvers working)) 251 (setq oldvers working))
246 (apply 'call-process "hg" nil (or buffer "*vc-diff*") nil 252 (apply 'call-process "hg" nil (or buffer "*vc-diff*") nil
247 "--cwd" (file-name-directory file) "diff" 253 "--cwd" (file-name-directory (car files)) "diff"
248 (append 254 (append
249 (if oldvers 255 (if oldvers
250 (if newvers 256 (if newvers
251 (list "-r" oldvers "-r" newvers) 257 (list "-r" oldvers "-r" newvers)
252 (list "-r" oldvers)) 258 (list "-r" oldvers))
253 (list "")) 259 (list ""))
254 (list (file-name-nondirectory file)))))) 260 (mapcar (lambda (file) (file-name-nondirectory file)) files)))))
255 261
256(defalias 'vc-hg-diff-tree 'vc-hg-diff) 262(defun vc-hg-diff-tree (file &optional oldvers newvers buffer)
263 (vc-hg-diff (list file) oldvers newvers buffer))
257 264
258(defun vc-hg-annotate-command (file buffer &optional version) 265(defun vc-hg-annotate-command (file buffer &optional version)
259 "Execute \"hg annotate\" on FILE, inserting the contents in BUFFER. 266 "Execute \"hg annotate\" on FILE, inserting the contents in BUFFER.
@@ -312,11 +319,15 @@ Optional arg VERSION is a version to annotate from."
312 "Rename file from OLD to NEW using `hg mv'." 319 "Rename file from OLD to NEW using `hg mv'."
313 (vc-hg-command nil nil new old "mv")) 320 (vc-hg-command nil nil new old "mv"))
314 321
315(defun vc-hg-register (file &optional rev comment) 322(defun vc-hg-register (files &optional rev comment)
316 "Register FILE under hg. 323 "Register FILES under hg.
317REV is ignored. 324REV is ignored.
318COMMENT is ignored." 325COMMENT is ignored."
319 (vc-hg-command nil nil file "add")) 326 (vc-hg-command nil nil files "add"))
327
328(defun vc-hg-create-repo ()
329 "Create a new Mercurial repository."
330 (vc-do-command nil 0 "svn" '("init")))
320 331
321(defalias 'vc-hg-responsible-p 'vc-hg-root) 332(defalias 'vc-hg-responsible-p 'vc-hg-root)
322 333
@@ -336,10 +347,10 @@ COMMENT is ignored."
336;; "Unregister FILE from hg." 347;; "Unregister FILE from hg."
337;; (vc-hg-command nil nil file "remove")) 348;; (vc-hg-command nil nil file "remove"))
338 349
339(defun vc-hg-checkin (file rev comment) 350(defun vc-hg-checkin (files rev comment)
340 "HG-specific version of `vc-backend-checkin'. 351 "HG-specific version of `vc-backend-checkin'.
341REV is ignored." 352REV is ignored."
342 (vc-hg-command nil nil file "commit" "-m" comment)) 353 (vc-hg-command nil nil files "commit" "-m" comment))
343 354
344(defun vc-hg-find-version (file rev buffer) 355(defun vc-hg-find-version (file rev buffer)
345 (let ((coding-system-for-read 'binary) 356 (let ((coding-system-for-read 'binary)
@@ -374,11 +385,11 @@ REV is ignored."
374 385
375;;; Internal functions 386;;; Internal functions
376 387
377(defun vc-hg-command (buffer okstatus file &rest flags) 388(defun vc-hg-command (buffer okstatus file-or-list &rest flags)
378 "A wrapper around `vc-do-command' for use in vc-hg.el. 389 "A wrapper around `vc-do-command' for use in vc-hg.el.
379The difference to vc-do-command is that this function always invokes `hg', 390The difference to vc-do-command is that this function always invokes `hg',
380and that it passes `vc-hg-global-switches' to it before FLAGS." 391and that it passes `vc-hg-global-switches' to it before FLAGS."
381 (apply 'vc-do-command buffer okstatus "hg" file 392 (apply 'vc-do-command buffer okstatus "hg" file-or-list
382 (if (stringp vc-hg-global-switches) 393 (if (stringp vc-hg-global-switches)
383 (cons vc-hg-global-switches flags) 394 (cons vc-hg-global-switches flags)
384 (append vc-hg-global-switches 395 (append vc-hg-global-switches
diff --git a/lisp/vc-mcvs.el b/lisp/vc-mcvs.el
index 7e5dbd47a70..30ec751c69c 100644
--- a/lisp/vc-mcvs.el
+++ b/lisp/vc-mcvs.el
@@ -109,6 +109,11 @@ This is only meaningful if you don't use the implicit checkout model
109 :version "22.1" 109 :version "22.1"
110 :group 'vc) 110 :group 'vc)
111 111
112;;; Properties of the backend
113
114(defun vc-mcvs-revision-granularity ()
115 'file)
116
112;;; 117;;;
113;;; State-querying functions 118;;; State-querying functions
114;;; 119;;;
@@ -202,13 +207,20 @@ This is only meaningful if you don't use the implicit checkout model
202;;; State-changing functions 207;;; State-changing functions
203;;; 208;;;
204 209
205(defun vc-mcvs-register (file &optional rev comment) 210(defun vc-cvs-create-repo ()
206 "Register FILE into the Meta-CVS version-control system. 211 "Create a new CVS repository."
212 (error "Creation of CVS repositories is not supported."))
213
214(defun vc-mcvs-register (files &optional rev comment)
215 "Register FILES into the Meta-CVS version-control system.
207COMMENT can be used to provide an initial description of FILE. 216COMMENT can be used to provide an initial description of FILE.
208 217
209`vc-register-switches' and `vc-mcvs-register-switches' are passed to 218`vc-register-switches' and `vc-mcvs-register-switches' are passed to
210the Meta-CVS command (in that order)." 219the Meta-CVS command (in that order)."
211 (let* ((filename (file-name-nondirectory file)) 220 ;; FIXME: multiple-file case should be made to work
221 (if (> (length files) 1) (error "Registering filesets is not yet supported."))
222 (let* ((file (car files))
223 (filename (file-name-nondirectory file))
212 (extpos (string-match "\\." filename)) 224 (extpos (string-match "\\." filename))
213 (ext (if extpos (substring filename (1+ extpos)))) 225 (ext (if extpos (substring filename (1+ extpos))))
214 (root (vc-mcvs-root file)) 226 (root (vc-mcvs-root file))
@@ -257,7 +269,7 @@ the Meta-CVS command (in that order)."
257 "Return non-nil if FILE could be registered in Meta-CVS. 269 "Return non-nil if FILE could be registered in Meta-CVS.
258This is only possible if Meta-CVS is responsible for FILE's directory.") 270This is only possible if Meta-CVS is responsible for FILE's directory.")
259 271
260(defun vc-mcvs-checkin (file rev comment) 272(defun vc-mcvs-checkin (files rev comment)
261 "Meta-CVS-specific version of `vc-backend-checkin'." 273 "Meta-CVS-specific version of `vc-backend-checkin'."
262 (unless (or (not rev) (vc-mcvs-valid-version-number-p rev)) 274 (unless (or (not rev) (vc-mcvs-valid-version-number-p rev))
263 (if (not (vc-mcvs-valid-symbolic-tag-name-p rev)) 275 (if (not (vc-mcvs-valid-symbolic-tag-name-p rev))
@@ -267,14 +279,15 @@ This is only possible if Meta-CVS is responsible for FILE's directory.")
267 ;; This file-specific form of branching is deprecated. 279 ;; This file-specific form of branching is deprecated.
268 ;; We can't use `mcvs branch' and `mcvs switch' because they cannot 280 ;; We can't use `mcvs branch' and `mcvs switch' because they cannot
269 ;; be applied just to this one file. 281 ;; be applied just to this one file.
270 (apply 'vc-mcvs-command nil 0 file "tag" "-b" (list rev)) 282 (apply 'vc-mcvs-command nil 0 files "tag" "-b" (list rev))
271 (apply 'vc-mcvs-command nil 0 file "update" "-r" (list rev)) 283 (apply 'vc-mcvs-command nil 0 files "update" "-r" (list rev))
272 (vc-file-setprop file 'vc-mcvs-sticky-tag rev) 284 (mapcar (lambda (file) (vc-file-setprop file 'vc-mcvs-sticky-tag rev))
285 files)
273 (setq rev nil))) 286 (setq rev nil)))
274 ;; This commit might cvs-commit several files (e.g. MAP and TYPES) 287 ;; This commit might cvs-commit several files (e.g. MAP and TYPES)
275 ;; so using numbered revs here is dangerous and somewhat meaningless. 288 ;; so using numbered revs here is dangerous and somewhat meaningless.
276 (when rev (error "Cannot commit to a specific revision number")) 289 (when rev (error "Cannot commit to a specific revision number"))
277 (let ((status (apply 'vc-mcvs-command nil 1 file 290 (let ((status (apply 'vc-mcvs-command nil 1 files
278 "ci" "-m" comment 291 "ci" "-m" comment
279 (vc-switches 'MCVS 'checkin)))) 292 (vc-switches 'MCVS 'checkin))))
280 (set-buffer "*vc*") 293 (set-buffer "*vc*")
@@ -283,7 +296,8 @@ This is only possible if Meta-CVS is responsible for FILE's directory.")
283 ;; Check checkin problem. 296 ;; Check checkin problem.
284 (cond 297 (cond
285 ((re-search-forward "Up-to-date check failed" nil t) 298 ((re-search-forward "Up-to-date check failed" nil t)
286 (vc-file-setprop file 'vc-state 'needs-merge) 299 (mapcar (lambda (file) (vc-file-setprop file 'vc-state 'needs-merge))
300 files)
287 (error (substitute-command-keys 301 (error (substitute-command-keys
288 (concat "Up-to-date check failed: " 302 (concat "Up-to-date check failed: "
289 "type \\[vc-next-action] to merge in changes")))) 303 "type \\[vc-next-action] to merge in changes"))))
@@ -292,20 +306,25 @@ This is only possible if Meta-CVS is responsible for FILE's directory.")
292 (goto-char (point-min)) 306 (goto-char (point-min))
293 (shrink-window-if-larger-than-buffer) 307 (shrink-window-if-larger-than-buffer)
294 (error "Check-in failed")))) 308 (error "Check-in failed"))))
295 ;; Update file properties 309 ;; Single-file commit? Then update the version by parsing the buffer.
296 (vc-file-setprop 310 ;; Otherwise we can't necessarily tell what goes with what; clear
297 file 'vc-workfile-version 311 ;; its properties so they have to be refetched.
298 (vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2)) 312 (if (= (length files) 1)
299 ;; Forget the checkout model of the file, because we might have 313 (vc-file-setprop
314 (car files) 'vc-workfile-version
315 (vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2))
316 (mapc (lambda (file) (vc-file-clearprops file)) files))
317 ;; Anyway, forget the checkout model of the file, because we might have
300 ;; guessed wrong when we found the file. After commit, we can 318 ;; guessed wrong when we found the file. After commit, we can
301 ;; tell it from the permissions of the file (see 319 ;; tell it from the permissions of the file (see
302 ;; vc-mcvs-checkout-model). 320 ;; vc-mcvs-checkout-model).
303 (vc-file-setprop file 'vc-checkout-model nil) 321 (mapc (lambda (file) (vc-file-setprop file 'vc-checkout-model nil))
322 files)
304 323
305 ;; if this was an explicit check-in (does not include creation of 324 ;; if this was an explicit check-in (does not include creation of
306 ;; a branch), remove the sticky tag. 325 ;; a branch), remove the sticky tag.
307 (if (and rev (not (vc-mcvs-valid-symbolic-tag-name-p rev))) 326 (if (and rev (not (vc-mcvs-valid-symbolic-tag-name-p rev)))
308 (vc-mcvs-command nil 0 file "update" "-A")))) 327 (vc-mcvs-command nil 0 files "update" "-A"))))
309 328
310(defun vc-mcvs-find-version (file rev buffer) 329(defun vc-mcvs-find-version (file rev buffer)
311 (apply 'vc-mcvs-command 330 (apply 'vc-mcvs-command
@@ -421,44 +440,32 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
421;;; History functions 440;;; History functions
422;;; 441;;;
423 442
424(defun vc-mcvs-print-log (file &optional buffer) 443(defun vc-mcvs-print-log (files &optional buffer)
425 "Get change log associated with FILE." 444 "Get change log associated with FILES."
426 (let ((default-directory (vc-mcvs-root file))) 445 (let ((default-directory (vc-mcvs-root (car files))))
427 ;; Run the command from the root dir so that `mcvs filt' returns 446 ;; Run the command from the root dir so that `mcvs filt' returns
428 ;; valid relative names. 447 ;; valid relative names.
429 (vc-mcvs-command 448 (vc-mcvs-command
430 buffer 449 buffer
431 (if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0) 450 (if (and (vc-stay-local-p files) (fboundp 'start-process)) 'async 0)
432 file "log"))) 451 files "log")))
433 452
434(defun vc-mcvs-diff (file &optional oldvers newvers buffer) 453(defun vc-mcvs-diff (files &optional oldvers newvers buffer)
435 "Get a difference report using Meta-CVS between two versions of FILE." 454 "Get a difference report using Meta-CVS between two versions of FILES."
436 (if (string= (vc-workfile-version file) "0")
437 ;; This file is added but not yet committed; there is no master file.
438 (if (or oldvers newvers)
439 (error "No revisions of %s exist" file)
440 ;; We regard this as "changed".
441 ;; Diff it against /dev/null.
442 ;; Note: this is NOT a "mcvs diff".
443 (apply 'vc-do-command (or buffer "*vc-diff*")
444 1 "diff" file
445 (append (vc-switches nil 'diff) '("/dev/null")))
446 ;; Even if it's empty, it's locally modified.
447 1)
448 (let* ((async (and (not vc-disable-async-diff) 455 (let* ((async (and (not vc-disable-async-diff)
449 (vc-stay-local-p file) 456 (vc-stay-local-p files)
450 (fboundp 'start-process))) 457 (fboundp 'start-process)))
451 ;; Run the command from the root dir so that `mcvs filt' returns 458 ;; Run the command from the root dir so that `mcvs filt' returns
452 ;; valid relative names. 459 ;; valid relative names.
453 (default-directory (vc-mcvs-root file)) 460 (default-directory (vc-mcvs-root (car files)))
454 (status 461 (status
455 (apply 'vc-mcvs-command (or buffer "*vc-diff*") 462 (apply 'vc-mcvs-command (or buffer "*vc-diff*")
456 (if async 'async 1) 463 (if async 'async 1)
457 file "diff" 464 files "diff"
458 (and oldvers (concat "-r" oldvers)) 465 (and oldvers (concat "-r" oldvers))
459 (and newvers (concat "-r" newvers)) 466 (and newvers (concat "-r" newvers))
460 (vc-switches 'MCVS 'diff)))) 467 (vc-switches 'MCVS 'diff))))
461 (if async 1 status)))) ; async diff, pessimistic assumption. 468 (if async 1 status))) ; async diff, pessimistic assumption.
462 469
463(defun vc-mcvs-diff-tree (dir &optional rev1 rev2) 470(defun vc-mcvs-diff-tree (dir &optional rev1 rev2)
464 "Diff all files at and below DIR." 471 "Diff all files at and below DIR."
diff --git a/lisp/vc-rcs.el b/lisp/vc-rcs.el
index a4b3b11301e..f068a187fce 100644
--- a/lisp/vc-rcs.el
+++ b/lisp/vc-rcs.el
@@ -96,6 +96,11 @@ For a description of possible values, see `vc-check-master-templates'."
96 :group 'vc) 96 :group 'vc)
97 97
98 98
99;;; Properties of the backend
100
101(defun vc-rcs-revision-granularity ()
102 'file)
103
99;;; 104;;;
100;;; State-querying functions 105;;; State-querying functions
101;;; 106;;;
@@ -230,17 +235,23 @@ When VERSION is given, perform check for that version."
230;;; State-changing functions 235;;; State-changing functions
231;;; 236;;;
232 237
233(defun vc-rcs-register (file &optional rev comment) 238(defun vc-rcs-create-repo ()
234 "Register FILE into the RCS version-control system. 239 "Create a new RCS repository."
235REV is the optional revision number for the file. COMMENT can be used 240 ;; RCS is totally file-oriented, so all we have to do is make the directory
236to provide an initial description of FILE. 241 (make-directory "RCS"))
242
243(defun vc-rcs-register (files &optional rev comment)
244 "Register FILES into the RCS version-control system.
245REV is the optional revision number for the files. COMMENT can be used
246to provide an initial description for each FILES.
237 247
238`vc-register-switches' and `vc-rcs-register-switches' are passed to 248`vc-register-switches' and `vc-rcs-register-switches' are passed to
239the RCS command (in that order). 249the RCS command (in that order).
240 250
241Automatically retrieve a read-only version of the file with keywords 251Automatically retrieve a read-only version of the file with keywords
242expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile." 252expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
243 (let ((subdir (expand-file-name "RCS" (file-name-directory file)))) 253 (let ((subdir (expand-file-name "RCS" (file-name-directory file))))
254 (dolist (file files)
244 (and (not (file-exists-p subdir)) 255 (and (not (file-exists-p subdir))
245 (not (directory-files (file-name-directory file) 256 (not (directory-files (file-name-directory file)
246 nil ".*,v$" t)) 257 nil ".*,v$" t))
@@ -273,7 +284,7 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
273 (if (re-search-forward 284 (if (re-search-forward
274 "^initial revision: \\([0-9.]+\\).*\n" 285 "^initial revision: \\([0-9.]+\\).*\n"
275 nil t) 286 nil t)
276 (match-string 1)))))) 287 (match-string 1)))))))
277 288
278(defun vc-rcs-responsible-p (file) 289(defun vc-rcs-responsible-p (file)
279 "Return non-nil if RCS thinks it would be responsible for registering FILE." 290 "Return non-nil if RCS thinks it would be responsible for registering FILE."
@@ -307,55 +318,57 @@ whether to remove it."
307 (yes-or-no-p (format "Directory %s is empty; remove it? " dir)) 318 (yes-or-no-p (format "Directory %s is empty; remove it? " dir))
308 (delete-directory dir)))) 319 (delete-directory dir))))
309 320
310(defun vc-rcs-checkin (file rev comment) 321(defun vc-rcs-checkin (files rev comment)
311 "RCS-specific version of `vc-backend-checkin'." 322 "RCS-specific version of `vc-backend-checkin'."
312 (let ((switches (vc-switches 'RCS 'checkin))) 323 (let ((switches (vc-switches 'RCS 'checkin)))
313 (let ((old-version (vc-workfile-version file)) new-version 324 ;; Now operate on the files
314 (default-branch (vc-file-getprop file 'vc-rcs-default-branch))) 325 (dolist (file files)
315 ;; Force branch creation if an appropriate 326 (let ((old-version (vc-workfile-version file)) new-version
316 ;; default branch has been set. 327 (default-branch (vc-file-getprop file 'vc-rcs-default-branch)))
317 (and (not rev) 328 ;; Force branch creation if an appropriate
318 default-branch 329 ;; default branch has been set.
319 (string-match (concat "^" (regexp-quote old-version) "\\.") 330 (and (not rev)
320 default-branch) 331 default-branch
321 (setq rev default-branch) 332 (string-match (concat "^" (regexp-quote old-version) "\\.")
322 (setq switches (cons "-f" switches))) 333 default-branch)
323 (if (and (not rev) old-version) 334 (setq rev default-branch)
324 (setq rev (vc-branch-part old-version))) 335 (setq switches (cons "-f" switches)))
325 (apply 'vc-do-command nil 0 "ci" (vc-name file) 336 (if (and (not rev) old-version)
326 ;; if available, use the secure check-in option 337 (setq rev (vc-branch-part old-version)))
327 (and (vc-rcs-release-p "5.6.4") "-j") 338 (apply 'vc-do-command nil 0 "ci" (vc-name file)
328 (concat (if vc-keep-workfiles "-u" "-r") rev) 339 ;; if available, use the secure check-in option
329 (concat "-m" comment) 340 (and (vc-rcs-release-p "5.6.4") "-j")
330 switches) 341 (concat (if vc-keep-workfiles "-u" "-r") rev)
331 (vc-file-setprop file 'vc-workfile-version nil) 342 (concat "-m" comment)
332 343 switches)
333 ;; determine the new workfile version 344 (vc-file-setprop file 'vc-workfile-version nil)
334 (set-buffer "*vc*") 345
335 (goto-char (point-min)) 346 ;; determine the new workfile version
336 (when (or (re-search-forward 347 (set-buffer "*vc*")
337 "new revision: \\([0-9.]+\\);" nil t) 348 (goto-char (point-min))
338 (re-search-forward 349 (when (or (re-search-forward
339 "reverting to previous revision \\([0-9.]+\\)" nil t)) 350 "new revision: \\([0-9.]+\\);" nil t)
340 (setq new-version (match-string 1)) 351 (re-search-forward
341 (vc-file-setprop file 'vc-workfile-version new-version)) 352 "reverting to previous revision \\([0-9.]+\\)" nil t))
342 353 (setq new-version (match-string 1))
343 ;; if we got to a different branch, adjust the default 354 (vc-file-setprop file 'vc-workfile-version new-version))
344 ;; branch accordingly 355
345 (cond 356 ;; if we got to a different branch, adjust the default
346 ((and old-version new-version 357 ;; branch accordingly
347 (not (string= (vc-branch-part old-version) 358 (cond
348 (vc-branch-part new-version)))) 359 ((and old-version new-version
349 (vc-rcs-set-default-branch file 360 (not (string= (vc-branch-part old-version)
350 (if (vc-trunk-p new-version) nil 361 (vc-branch-part new-version))))
351 (vc-branch-part new-version))) 362 (vc-rcs-set-default-branch file
352 ;; If this is an old RCS release, we might have 363 (if (vc-trunk-p new-version) nil
353 ;; to remove a remaining lock. 364 (vc-branch-part new-version)))
354 (if (not (vc-rcs-release-p "5.6.2")) 365 ;; If this is an old RCS release, we might have
355 ;; exit status of 1 is also accepted. 366 ;; to remove a remaining lock.
356 ;; It means that the lock was removed before. 367 (if (not (vc-rcs-release-p "5.6.2"))
357 (vc-do-command nil 1 "rcs" (vc-name file) 368 ;; exit status of 1 is also accepted.
358 (concat "-u" old-version)))))))) 369 ;; It means that the lock was removed before.
370 (vc-do-command nil 1 "rcs" (vc-name file)
371 (concat "-u" old-version)))))))))
359 372
360(defun vc-rcs-find-version (file rev buffer) 373(defun vc-rcs-find-version (file rev buffer)
361 (apply 'vc-do-command 374 (apply 'vc-do-command
@@ -427,41 +440,48 @@ whether to remove it."
427 new-version))))) 440 new-version)))))
428 (message "Checking out %s...done" file))))) 441 (message "Checking out %s...done" file)))))
429 442
443(defun vc-rcs-rollback (files)
444 "Roll back, undoing the most recent checkins of FILES."
445 (if (not files)
446 (error "RCS backend doesn't support directory-level rollback."))
447 (dolist (file files)
448 (let* ((discard (vc-workfile-version file))
449 (previous (if (vc-trunk-p discard) "" (vc-branch-part discard)))
450 (config (current-window-configuration))
451 (done nil))
452 (if (null (yes-or-no-p (format "Remove version %s from %s history? "
453 discard file)))
454 (error "Aborted"))
455 (message "Removing revision %s from %s." discard file)
456 (vc-do-command nil 0 "rcs" (vc-name file) (concat "-o" discard))
457 ;; Check out the most recent remaining version. If it
458 ;; fails, because the whole branch got deleted, do a
459 ;; double-take and check out the version where the branch
460 ;; started.
461 (while (not done)
462 (condition-case err
463 (progn
464 (vc-do-command nil 0 "co" (vc-name file) "-f"
465 (concat "-u" previous))
466 (setq done t))
467 (error (set-buffer "*vc*")
468 (goto-char (point-min))
469 (if (search-forward "no side branches present for" nil t)
470 (progn (setq previous (vc-branch-part previous))
471 (vc-rcs-set-default-branch file previous)
472 ;; vc-do-command popped up a window with
473 ;; the error message. Get rid of it, by
474 ;; restoring the old window configuration.
475 (set-window-configuration config))
476 ;; No, it was some other error: re-signal it.
477 (signal (car err) (cdr err)))))))))
478
430(defun vc-rcs-revert (file &optional contents-done) 479(defun vc-rcs-revert (file &optional contents-done)
431 "Revert FILE to the version it was based on." 480 "Revert FILE to the version it was based on."
432 (vc-do-command nil 0 "co" (vc-name file) "-f" 481 (vc-do-command nil 0 "co" (vc-name file) "-f"
433 (concat (if (eq (vc-state file) 'edited) "-u" "-r") 482 (concat (if (eq (vc-state file) 'edited) "-u" "-r")
434 (vc-workfile-version file)))) 483 (vc-workfile-version file))))
435 484
436(defun vc-rcs-cancel-version (file editable)
437 "Undo the most recent checkin of FILE.
438EDITABLE non-nil means previous version should be locked."
439 (let* ((target (vc-workfile-version file))
440 (previous (if (vc-trunk-p target) "" (vc-branch-part target)))
441 (config (current-window-configuration))
442 (done nil))
443 (vc-do-command nil 0 "rcs" (vc-name file) (concat "-o" target))
444 ;; Check out the most recent remaining version. If it fails, because
445 ;; the whole branch got deleted, do a double-take and check out the
446 ;; version where the branch started.
447 (while (not done)
448 (condition-case err
449 (progn
450 (vc-do-command nil 0 "co" (vc-name file) "-f"
451 (concat (if editable "-l" "-u") previous))
452 (setq done t))
453 (error (set-buffer "*vc*")
454 (goto-char (point-min))
455 (if (search-forward "no side branches present for" nil t)
456 (progn (setq previous (vc-branch-part previous))
457 (vc-rcs-set-default-branch file previous)
458 ;; vc-do-command popped up a window with
459 ;; the error message. Get rid of it, by
460 ;; restoring the old window configuration.
461 (set-window-configuration config))
462 ;; No, it was some other error: re-signal it.
463 (signal (car err) (cdr err))))))))
464
465(defun vc-rcs-merge (file first-version &optional second-version) 485(defun vc-rcs-merge (file first-version &optional second-version)
466 "Merge changes into current working copy of FILE. 486 "Merge changes into current working copy of FILE.
467The changes are between FIRST-VERSION and SECOND-VERSION." 487The changes are between FIRST-VERSION and SECOND-VERSION."
@@ -484,19 +504,38 @@ Needs RCS 5.6.2 or later for -M."
484;;; History functions 504;;; History functions
485;;; 505;;;
486 506
487(defun vc-rcs-print-log (file &optional buffer) 507(defun vc-rcs-print-log (files &optional buffer)
488 "Get change log associated with FILE." 508 "Get change log associated with FILE."
489 (vc-do-command buffer 0 "rlog" (vc-name file))) 509 (vc-do-command buffer 0 "rlog" (mapcar 'vc-name files)))
490 510
491(defun vc-rcs-diff (file &optional oldvers newvers buffer) 511(defun vc-rcs-diff (files &optional oldvers newvers buffer)
492 "Get a difference report using RCS between two versions of FILE." 512 "Get a difference report using RCS between two sets of files."
493 (if (not oldvers) (setq oldvers (vc-workfile-version file))) 513 (apply 'vc-do-command (or buffer "*vc-diff*")
494 (apply 'vc-do-command (or buffer "*vc-diff*") 1 "rcsdiff" file 514 1 ;; Always go synchronous, the repo is local
515 "rcsdiff" (vc-expand-dirs files)
495 (append (list "-q" 516 (append (list "-q"
496 (concat "-r" oldvers) 517 (and oldvers (concat "-r" oldvers))
497 (and newvers (concat "-r" newvers))) 518 (and newvers (concat "-r" newvers)))
498 (vc-switches 'RCS 'diff)))) 519 (vc-switches 'RCS 'diff))))
499 520
521(defun vc-rcs-wash-log ()
522 "Remove all non-comment information from log output."
523 (let ((separator (concat "^-+\nrevision [0-9.]+\ndate: .*\n"
524 "\\(branches: .*;\n\\)?"
525 "\\(\\*\\*\\* empty log message \\*\\*\\*\n\\)?")))
526 (goto-char (point-max)) (forward-line -1)
527 (while (looking-at "=*\n")
528 (delete-char (- (match-end 0) (match-beginning 0)))
529 (forward-line -1))
530 (goto-char (point-min))
531 (if (looking-at "[\b\t\n\v\f\r ]+")
532 (delete-char (- (match-end 0) (match-beginning 0))))
533 (goto-char (point-min))
534 (re-search-forward separator nil t)
535 (delete-region (point-min) (point))
536 (while (re-search-forward separator nil t)
537 (delete-region (match-beginning 0) (match-end 0)))))
538
500(defun vc-rcs-annotate-command (file buffer &optional revision) 539(defun vc-rcs-annotate-command (file buffer &optional revision)
501 "Annotate FILE, inserting the results in BUFFER. 540 "Annotate FILE, inserting the results in BUFFER.
502Optional arg REVISION is a revision to annotate from." 541Optional arg REVISION is a revision to annotate from."
@@ -666,7 +705,6 @@ Optional arg REVISION is a revision to annotate from."
666 " " 705 " "
667 (aref rda 0) 706 (aref rda 0)
668 ls) 707 ls)
669 :vc-annotate-prefix t
670 :vc-rcs-r/d/a rda))) 708 :vc-rcs-r/d/a rda)))
671 (maphash 709 (maphash
672 (if all-me 710 (if all-me
diff --git a/lisp/vc-sccs.el b/lisp/vc-sccs.el
index bad1c2b3099..0163e283128 100644
--- a/lisp/vc-sccs.el
+++ b/lisp/vc-sccs.el
@@ -85,6 +85,11 @@ For a description of possible values, see `vc-check-master-templates'."
85(defconst vc-sccs-name-assoc-file "VC-names") 85(defconst vc-sccs-name-assoc-file "VC-names")
86 86
87 87
88;;; Properties of the backend
89
90(defun vc-sccs-revision-granularity ()
91 'file)
92
88;;; 93;;;
89;;; State-querying functions 94;;; State-querying functions
90;;; 95;;;
@@ -161,16 +166,22 @@ For a description of possible values, see `vc-check-master-templates'."
161;;; State-changing functions 166;;; State-changing functions
162;;; 167;;;
163 168
164(defun vc-sccs-register (file &optional rev comment) 169(defun vc-sccs-create-repo ()
165 "Register FILE into the SCCS version-control system. 170 "Create a new SCCS repository."
171 ;; SCCS is totally file-oriented, so all we have to do is make the directory
172 (make-directory "SCCS"))
173
174(defun vc-sccs-register (files &optional rev comment)
175 "Register FILES into the SCCS version-control system.
166REV is the optional revision number for the file. COMMENT can be used 176REV is the optional revision number for the file. COMMENT can be used
167to provide an initial description of FILE. 177to provide an initial description of FILES.
168 178
169`vc-register-switches' and `vc-sccs-register-switches' are passed to 179`vc-register-switches' and `vc-sccs-register-switches' are passed to
170the SCCS command (in that order). 180the SCCS command (in that order).
171 181
172Automatically retrieve a read-only version of the file with keywords 182Automatically retrieve a read-only version of the files with keywords
173expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile." 183expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
184 (dolist (file files)
174 (let* ((dirname (or (file-name-directory file) "")) 185 (let* ((dirname (or (file-name-directory file) ""))
175 (basename (file-name-nondirectory file)) 186 (basename (file-name-nondirectory file))
176 (project-file (vc-sccs-search-project-dir dirname basename))) 187 (project-file (vc-sccs-search-project-dir dirname basename)))
@@ -178,14 +189,14 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
178 (or project-file 189 (or project-file
179 (format (car vc-sccs-master-templates) dirname basename)))) 190 (format (car vc-sccs-master-templates) dirname basename))))
180 (apply 'vc-do-command nil 0 "admin" vc-name 191 (apply 'vc-do-command nil 0 "admin" vc-name
181 (and rev (concat "-r" rev)) 192 (and rev (not (string= rev "")) (concat "-r" rev))
182 "-fb" 193 "-fb"
183 (concat "-i" (file-relative-name file)) 194 (concat "-i" (file-relative-name file))
184 (and comment (concat "-y" comment)) 195 (and comment (concat "-y" comment))
185 (vc-switches 'SCCS 'register))) 196 (vc-switches 'SCCS 'register)))
186 (delete-file file) 197 (delete-file file)
187 (if vc-keep-workfiles 198 (if vc-keep-workfiles
188 (vc-do-command nil 0 "get" (vc-name file))))) 199 (vc-do-command nil 0 "get" (vc-name file))))))
189 200
190(defun vc-sccs-responsible-p (file) 201(defun vc-sccs-responsible-p (file)
191 "Return non-nil if SCCS thinks it would be responsible for registering FILE." 202 "Return non-nil if SCCS thinks it would be responsible for registering FILE."
@@ -194,14 +205,15 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
194 (stringp (vc-sccs-search-project-dir (or (file-name-directory file) "") 205 (stringp (vc-sccs-search-project-dir (or (file-name-directory file) "")
195 (file-name-nondirectory file))))) 206 (file-name-nondirectory file)))))
196 207
197(defun vc-sccs-checkin (file rev comment) 208(defun vc-sccs-checkin (files rev comment)
198 "SCCS-specific version of `vc-backend-checkin'." 209 "SCCS-specific version of `vc-backend-checkin'."
199 (apply 'vc-do-command nil 0 "delta" (vc-name file) 210 (dolist (file files)
200 (if rev (concat "-r" rev)) 211 (apply 'vc-do-command nil 0 "delta" (vc-name file)
201 (concat "-y" comment) 212 (if rev (concat "-r" rev))
202 (vc-switches 'SCCS 'checkin)) 213 (concat "-y" comment)
203 (if vc-keep-workfiles 214 (vc-switches 'SCCS 'checkin))
204 (vc-do-command nil 0 "get" (vc-name file)))) 215 (if vc-keep-workfiles
216 (vc-do-command nil 0 "get" (vc-name file)))))
205 217
206(defun vc-sccs-find-version (file rev buffer) 218(defun vc-sccs-find-version (file rev buffer)
207 (apply 'vc-do-command 219 (apply 'vc-do-command
@@ -242,6 +254,19 @@ locked. REV is the revision to check out."
242 switches)))) 254 switches))))
243 (message "Checking out %s...done" file))) 255 (message "Checking out %s...done" file)))
244 256
257(defun vc-sccs-cancel-version (files)
258 "Roll back, undoing the most recent checkins of FILES."
259 (if (not files)
260 (error "SCCS backend doesn't support directory-level rollback."))
261 (dolist (file files)
262 (let ((discard (vc-workfile-version file)))
263 (if (null (yes-or-no-p (format "Remove version %s from %s history? "
264 discard file)))
265 (error "Aborted"))
266 (message "Removing revision %s from %s..." discard file)
267 (vc-do-command nil 0 "rmdel" (vc-name file) (concat "-r" discard))
268 (vc-do-command nil 0 "get" (vc-name file) nil))))
269
245(defun vc-sccs-revert (file &optional contents-done) 270(defun vc-sccs-revert (file &optional contents-done)
246 "Revert FILE to the version it was based on." 271 "Revert FILE to the version it was based on."
247 (vc-do-command nil 0 "unget" (vc-name file)) 272 (vc-do-command nil 0 "unget" (vc-name file))
@@ -251,16 +276,6 @@ locked. REV is the revision to check out."
251 ;; vc-workfile-version is cleared here so that it gets recomputed. 276 ;; vc-workfile-version is cleared here so that it gets recomputed.
252 (vc-file-setprop file 'vc-workfile-version nil)) 277 (vc-file-setprop file 'vc-workfile-version nil))
253 278
254(defun vc-sccs-cancel-version (file editable)
255 "Undo the most recent checkin of FILE.
256EDITABLE non-nil means previous version should be locked."
257 (vc-do-command nil 0 "rmdel"
258 (vc-name file)
259 (concat "-r" (vc-workfile-version file)))
260 (vc-do-command nil 0 "get"
261 (vc-name file)
262 (if editable "-e")))
263
264(defun vc-sccs-steal-lock (file &optional rev) 279(defun vc-sccs-steal-lock (file &optional rev)
265 "Steal the lock on the current workfile for FILE and revision REV." 280 "Steal the lock on the current workfile for FILE and revision REV."
266 (vc-do-command nil 0 "unget" (vc-name file) "-n" (if rev (concat "-r" rev))) 281 (vc-do-command nil 0 "unget" (vc-name file) "-n" (if rev (concat "-r" rev)))
@@ -271,9 +286,14 @@ EDITABLE non-nil means previous version should be locked."
271;;; History functions 286;;; History functions
272;;; 287;;;
273 288
274(defun vc-sccs-print-log (file &optional buffer) 289(defun vc-sccs-print-log (files &optional buffer)
275 "Get change log associated with FILE." 290 "Get change log associated with FILES."
276 (vc-do-command buffer 0 "prs" (vc-name file))) 291 (vc-do-command buffer 0 "prs" (mapcar 'vc-name files)))
292
293(defun vc-sccs-wash-log ()
294 "Remove all non-comment information from log output."
295 ;; FIXME: not implemented for SCCS
296 nil)
277 297
278(defun vc-sccs-logentry-check () 298(defun vc-sccs-logentry-check ()
279 "Check that the log entry in the current buffer is acceptable for SCCS." 299 "Check that the log entry in the current buffer is acceptable for SCCS."
@@ -281,11 +301,12 @@ EDITABLE non-nil means previous version should be locked."
281 (goto-char 512) 301 (goto-char 512)
282 (error "Log must be less than 512 characters; point is now at pos 512"))) 302 (error "Log must be less than 512 characters; point is now at pos 512")))
283 303
284(defun vc-sccs-diff (file &optional oldvers newvers buffer) 304(defun vc-sccs-diff (files &optional oldvers newvers buffer)
285 "Get a difference report using SCCS between two versions of FILE." 305 "Get a difference report using SCCS between two filesets."
286 (setq oldvers (vc-sccs-lookup-triple file oldvers)) 306 (setq oldvers (vc-sccs-lookup-triple file oldvers))
287 (setq newvers (vc-sccs-lookup-triple file newvers)) 307 (setq newvers (vc-sccs-lookup-triple file newvers))
288 (apply 'vc-do-command (or buffer "*vc-diff*") 1 "vcdiff" (vc-name file) 308 (apply 'vc-do-command (or buffer "*vc-diff*")
309 1 "vcdiff" (mapcar 'vc-name (vc-expand-dirs files))
289 (append (list "-q" 310 (append (list "-q"
290 (and oldvers (concat "-r" oldvers)) 311 (and oldvers (concat "-r" oldvers))
291 (and newvers (concat "-r" newvers))) 312 (and newvers (concat "-r" newvers)))
diff --git a/lisp/vc-svn.el b/lisp/vc-svn.el
index 2c6046cab36..57bf5828a3f 100644
--- a/lisp/vc-svn.el
+++ b/lisp/vc-svn.el
@@ -96,6 +96,10 @@ If you want to force an empty list of arguments, use t."
96 (t ".svn")) 96 (t ".svn"))
97 "The name of the \".svn\" subdirectory or its equivalent.") 97 "The name of the \".svn\" subdirectory or its equivalent.")
98 98
99;;; Properties of the backend
100
101(defun vc-svn-revision-granularity ()
102 'repository)
99;;; 103;;;
100;;; State-querying functions 104;;; State-querying functions
101;;; 105;;;
@@ -206,13 +210,19 @@ If you want to force an empty list of arguments, use t."
206;;; State-changing functions 210;;; State-changing functions
207;;; 211;;;
208 212
209(defun vc-svn-register (file &optional rev comment) 213(defun vc-svn-create-repo ()
210 "Register FILE into the SVN version-control system. 214 "Create a new SVN repository."
211COMMENT can be used to provide an initial description of FILE. 215 (vc-do-command nil 0 "svnadmin" '("create" "SVN"))
216 (vc-do-command nil 0 "svn" '(".")
217 "checkout" (concat "file://" default-directory "SVN")))
218
219(defun vc-svn-register (files &optional rev comment)
220 "Register FILES into the SVN version-control system.
221The COMMENT argument is ignored This does an add but not a commit.
212 222
213`vc-register-switches' and `vc-svn-register-switches' are passed to 223`vc-register-switches' and `vc-svn-register-switches' are passed to
214the SVN command (in that order)." 224the SVN command (in that order)."
215 (apply 'vc-svn-command nil 0 file "add" (vc-switches 'SVN 'register))) 225 (apply 'vc-svn-command nil 0 files "add" (vc-switches 'SVN 'register)))
216 226
217(defun vc-svn-responsible-p (file) 227(defun vc-svn-responsible-p (file)
218 "Return non-nil if SVN thinks it is responsible for FILE." 228 "Return non-nil if SVN thinks it is responsible for FILE."
@@ -225,10 +235,11 @@ the SVN command (in that order)."
225 "Return non-nil if FILE could be registered in SVN. 235 "Return non-nil if FILE could be registered in SVN.
226This is only possible if SVN is responsible for FILE's directory.") 236This is only possible if SVN is responsible for FILE's directory.")
227 237
228(defun vc-svn-checkin (file rev comment) 238(defun vc-svn-checkin (files rev comment)
229 "SVN-specific version of `vc-backend-checkin'." 239 "SVN-specific version of `vc-backend-checkin'."
240 (if rev (error "Committing to a specific revision is unsupported in SVN."))
230 (let ((status (apply 241 (let ((status (apply
231 'vc-svn-command nil 1 file "ci" 242 'vc-svn-command nil 1 files "ci"
232 (nconc (list "-m" comment) (vc-switches 'SVN 'checkin))))) 243 (nconc (list "-m" comment) (vc-switches 'SVN 'checkin)))))
233 (set-buffer "*vc*") 244 (set-buffer "*vc*")
234 (goto-char (point-min)) 245 (goto-char (point-min))
@@ -236,7 +247,8 @@ This is only possible if SVN is responsible for FILE's directory.")
236 ;; Check checkin problem. 247 ;; Check checkin problem.
237 (cond 248 (cond
238 ((search-forward "Transaction is out of date" nil t) 249 ((search-forward "Transaction is out of date" nil t)
239 (vc-file-setprop file 'vc-state 'needs-merge) 250 (mapc (lambda (file) (vc-file-setprop file 'vc-state 'needs-merge))
251 files)
240 (error (substitute-command-keys 252 (error (substitute-command-keys
241 (concat "Up-to-date check failed: " 253 (concat "Up-to-date check failed: "
242 "type \\[vc-next-action] to merge in changes")))) 254 "type \\[vc-next-action] to merge in changes"))))
@@ -252,6 +264,7 @@ This is only possible if SVN is responsible for FILE's directory.")
252 )) 264 ))
253 265
254(defun vc-svn-find-version (file rev buffer) 266(defun vc-svn-find-version (file rev buffer)
267 "SVN-specific retrieval of a specified version into a buffer."
255 (apply 'vc-svn-command 268 (apply 'vc-svn-command
256 buffer 0 file 269 buffer 0 file
257 "cat" 270 "cat"
@@ -362,53 +375,41 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
362;;; History functions 375;;; History functions
363;;; 376;;;
364 377
365(defun vc-svn-print-log (file &optional buffer) 378(defun vc-svn-print-log (files &optional buffer)
366 "Get change log associated with FILE." 379 "Get change log(s) associated with FILES."
367 (save-current-buffer 380 (save-current-buffer
368 (vc-setup-buffer buffer) 381 (vc-setup-buffer buffer)
369 (let ((inhibit-read-only t)) 382 (let ((inhibit-read-only t))
370 (goto-char (point-min)) 383 (goto-char (point-min))
371 ;; Add a line to tell log-view-mode what file this is. 384 ;; Add a line to tell log-view-mode what file this is.
372 (insert "Working file: " (file-relative-name file) "\n")) 385 (insert "Working file(s): " (vc-delistify (mapcar 'file-relative-name files)) "\n"))
373 (vc-svn-command 386 (vc-svn-command
374 buffer 387 buffer
375 (if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0) 388 (if (and (= (length files) 1) (vc-stay-local-p (car files)) (fboundp 'start-process)) 'async 0)
376 file "log" 389 files "log"
377 ;; By default Subversion only shows the log upto the working version, 390 ;; By default Subversion only shows the log upto the working version,
378 ;; whereas we also want the log of the subsequent commits. At least 391 ;; whereas we also want the log of the subsequent commits. At least
379 ;; that's what the vc-cvs.el code does. 392 ;; that's what the vc-cvs.el code does.
380 "-rHEAD:0"))) 393 "-rHEAD:0"))))
381 394
382(defun vc-svn-diff (file &optional oldvers newvers buffer) 395(defun vc-svn-wash-log ()
383 "Get a difference report using SVN between two versions of FILE." 396 "Remove all non-comment information from log output."
384 (unless buffer (setq buffer "*vc-diff*")) 397 ;; FIXME: not implemented for SVN
385 (if (and oldvers (equal oldvers (vc-workfile-version file))) 398 nil)
386 ;; Use nil rather than the current revision because svn handles it 399
387 ;; better (i.e. locally). 400(defun vc-svn-diff (files &optional oldvers newvers buffer)
388 (setq oldvers nil)) 401 "Get a difference report using SVN between two versions of fileset FILES."
389 (if (string= (vc-workfile-version file) "0") 402 (let* ((switches
390 ;; This file is added but not yet committed; there is no master file.
391 (if (or oldvers newvers)
392 (error "No revisions of %s exist" file)
393 ;; We regard this as "changed".
394 ;; Diff it against /dev/null.
395 ;; Note: this is NOT a "svn diff".
396 (apply 'vc-do-command buffer
397 1 "diff" file
398 (append (vc-switches nil 'diff) '("/dev/null")))
399 ;; Even if it's empty, it's locally modified.
400 1)
401 (let* ((switches
402 (if vc-svn-diff-switches 403 (if vc-svn-diff-switches
403 (vc-switches 'SVN 'diff) 404 (vc-switches 'SVN 'diff)
404 (list "-x" (mapconcat 'identity (vc-switches nil 'diff) " ")))) 405 (list "-x" (mapconcat 'identity (vc-switches nil 'diff) " "))))
405 (async (and (not vc-disable-async-diff) 406 (async (and (not vc-disable-async-diff)
406 (vc-stay-local-p file) 407 (vc-stay-local-p files)
407 (or oldvers newvers) ; Svn diffs those locally. 408 (or oldvers newvers) ; Svn diffs those locally.
408 (fboundp 'start-process)))) 409 (fboundp 'start-process))))
409 (apply 'vc-svn-command buffer 410 (apply 'vc-svn-command buffer
410 (if async 'async 0) 411 (if async 'async 0)
411 file "diff" 412 files "diff"
412 (append 413 (append
413 switches 414 switches
414 (when oldvers 415 (when oldvers
@@ -417,7 +418,7 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
417 (if async 1 ; async diff => pessimistic assumption 418 (if async 1 ; async diff => pessimistic assumption
418 ;; For some reason `svn diff' does not return a useful 419 ;; For some reason `svn diff' does not return a useful
419 ;; status w.r.t whether the diff was empty or not. 420 ;; status w.r.t whether the diff was empty or not.
420 (buffer-size (get-buffer buffer)))))) 421 (buffer-size (get-buffer buffer)))))
421 422
422(defun vc-svn-diff-tree (dir &optional rev1 rev2) 423(defun vc-svn-diff-tree (dir &optional rev1 rev2)
423 "Diff all files at and below DIR." 424 "Diff all files at and below DIR."
@@ -469,11 +470,11 @@ NAME is assumed to be a URL."
469 :type 'string 470 :type 'string
470 :group 'vc) 471 :group 'vc)
471 472
472(defun vc-svn-command (buffer okstatus file &rest flags) 473(defun vc-svn-command (buffer okstatus file-or-list &rest flags)
473 "A wrapper around `vc-do-command' for use in vc-svn.el. 474 "A wrapper around `vc-do-command' for use in vc-svn.el.
474The difference to vc-do-command is that this function always invokes `svn', 475The difference to vc-do-command is that this function always invokes `svn',
475and that it passes `vc-svn-global-switches' to it before FLAGS." 476and that it passes `vc-svn-global-switches' to it before FLAGS."
476 (apply 'vc-do-command buffer okstatus vc-svn-program file 477 (apply 'vc-do-command buffer okstatus vc-svn-program file-or-list
477 (if (stringp vc-svn-global-switches) 478 (if (stringp vc-svn-global-switches)
478 (cons vc-svn-global-switches flags) 479 (cons vc-svn-global-switches flags)
479 (append vc-svn-global-switches 480 (append vc-svn-global-switches
diff --git a/lisp/vc.el b/lisp/vc.el
index 9377c9b8026..c644a161008 100644
--- a/lisp/vc.el
+++ b/lisp/vc.el
@@ -101,6 +101,12 @@
101;; with `vc-sys-'. Some of the functions are mandatory (marked with a 101;; with `vc-sys-'. Some of the functions are mandatory (marked with a
102;; `*'), others are optional (`-'). 102;; `*'), others are optional (`-').
103;; 103;;
104;; BACKEND PROPERTIES
105;;
106;; * revision-granularity
107;;
108;; Takes no arguments. Returns either 'file or 'repository.
109;;
104;; STATE-QUERYING FUNCTIONS 110;; STATE-QUERYING FUNCTIONS
105;; 111;;
106;; * registered (file) 112;; * registered (file)
@@ -171,12 +177,20 @@
171;; 177;;
172;; STATE-CHANGING FUNCTIONS 178;; STATE-CHANGING FUNCTIONS
173;; 179;;
174;; * register (file &optional rev comment) 180;; * create-repo (backend)
181;;
182;; Create an empty repository in the current directory and initialize
183;; it so VC mode can add files to it. For file-oriented systems, this
184;; need do no more than create a subdirectory with the right name.
185;;
186;; * register (files &optional rev comment)
175;; 187;;
176;; Register FILE in this backend. Optionally, an initial revision REV 188;; Register FILES in this backend. Optionally, an initial revision REV
177;; and an initial description of the file, COMMENT, may be specified. 189;; and an initial description of the file, COMMENT, may be specified,
190;; but it is not guaranteed that the backend will do anything with this.
178;; The implementation should pass the value of vc-register-switches 191;; The implementation should pass the value of vc-register-switches
179;; to the backend command. 192;; to the backend command. (Note: in older versions of VC, this
193;; command took a single file argument and not a list.)
180;; 194;;
181;; - init-version (file) 195;; - init-version (file)
182;; 196;;
@@ -210,12 +224,14 @@
210;; Unregister FILE from this backend. This is only needed if this 224;; Unregister FILE from this backend. This is only needed if this
211;; backend may be used as a "more local" backend for temporary editing. 225;; backend may be used as a "more local" backend for temporary editing.
212;; 226;;
213;; * checkin (file rev comment) 227;; * checkin (files rev comment)
214;; 228;;
215;; Commit changes in FILE to this backend. If REV is non-nil, that 229;; Commit changes in FILES to this backend. If REV is non-nil, that
216;; should become the new revision number. COMMENT is used as a 230;; should become the new revision number (not all backends do
217;; check-in comment. The implementation should pass the value of 231;; anything with it). COMMENT is used as a check-in comment. The
218;; vc-checkin-switches to the backend command. 232;; implementation should pass the value of vc-checkin-switches to
233;; the backend command. (Note: in older versions of VC, this
234;; command took a single file argument and not a list.)
219;; 235;;
220;; * find-version (file rev buffer) 236;; * find-version (file rev buffer)
221;; 237;;
@@ -242,13 +258,14 @@
242;; already been reverted from a version backup, and this function 258;; already been reverted from a version backup, and this function
243;; only needs to update the status of FILE within the backend. 259;; only needs to update the status of FILE within the backend.
244;; 260;;
245;; - rollback (file editable) 261;; - rollback (files)
246;; 262;;
247;; Cancel the current workfile version of FILE, i.e. remove it from the 263;; Remove the tip version of each of FILES from the repository. If
248;; master. EDITABLE non-nil means that FILE should be writable 264;; this function is not provided, trying to cancel a version is
249;; afterwards, and if locking is used for FILE, then a lock should also 265;; caught as an error. (Most backends don't provide it.) (Also
250;; be set. If this function is not provided, trying to cancel a 266;; note that older versions of this backend command were called
251;; version is caught as an error. 267;; 'cancel-version' and took a single file arg, not a list of
268;; files.)
252;; 269;;
253;; - merge (file rev1 rev2) 270;; - merge (file rev1 rev2)
254;; 271;;
@@ -267,10 +284,11 @@
267;; 284;;
268;; HISTORY FUNCTIONS 285;; HISTORY FUNCTIONS
269;; 286;;
270;; * print-log (file &optional buffer) 287;; * print-log (files &optional buffer)
271;; 288;;
272;; Insert the revision log of FILE into BUFFER, or the *vc* buffer 289;; Insert the revision log for FILES into BUFFER, or the *vc* buffer
273;; if BUFFER is nil. 290;; if BUFFER is nil. (Note: older versions of this function expected
291;; only a single file argument.)
274;; 292;;
275;; - log-view-mode () 293;; - log-view-mode ()
276;; 294;;
@@ -976,9 +994,15 @@ Else, add CODE to the process' sentinel."
976Each function is called inside the buffer in which the command was run 994Each function is called inside the buffer in which the command was run
977and is passed 3 arguments: the COMMAND, the FILE and the FLAGS.") 995and is passed 3 arguments: the COMMAND, the FILE and the FLAGS.")
978 996
997(defun vc-delistify (filelist)
998 "Smash a FILELIST into a file list string suitable for info messages."
999 (cond ((not filelist) ".")
1000 ((= (length filelist) 1) (car filelist))
1001 (t (concat (car filelist) " " (vc-delistify (cdr filelist))))))
1002
979(defvar w32-quote-process-args) 1003(defvar w32-quote-process-args)
980;;;###autoload 1004;;;###autoload
981(defun vc-do-command (buffer okstatus command file &rest flags) 1005(defun vc-do-command (buffer okstatus command file-or-list &rest flags)
982 "Execute a VC command, notifying user and checking for errors. 1006 "Execute a VC command, notifying user and checking for errors.
983Output from COMMAND goes to BUFFER, or *vc* if BUFFER is nil or the 1007Output from COMMAND goes to BUFFER, or *vc* if BUFFER is nil or the
984current buffer if BUFFER is t. If the destination buffer is not 1008current buffer if BUFFER is t. If the destination buffer is not
@@ -986,65 +1010,71 @@ already current, set it up properly and erase it. The command is
986considered successful if its exit status does not exceed OKSTATUS (if 1010considered successful if its exit status does not exceed OKSTATUS (if
987OKSTATUS is nil, that means to ignore error status, if it is `async', that 1011OKSTATUS is nil, that means to ignore error status, if it is `async', that
988means not to wait for termination of the subprocess; if it is t it means to 1012means not to wait for termination of the subprocess; if it is t it means to
989ignore all execution errors). FILE is the 1013ignore all execution errors). FILE-OR-LIST is the name of a working file;
990name of the working file (may also be nil, to execute commands that 1014it may be a list of files or be nil (to execute commands that don't expect
991don't expect a file name). If an optional list of FLAGS is present, 1015a file name or set of files). If an optional list of FLAGS is present,
992that is inserted into the command line before the filename." 1016that is inserted into the command line before the filename."
993 (and file (setq file (expand-file-name file))) 1017 ;; FIXME: file-relative-name can return a bogus result because
994 (if vc-command-messages 1018 ;; it doesn't look at the actual file-system to see if symlinks
995 (message "Running %s on %s..." command file)) 1019 ;; come into play.
996 (save-current-buffer 1020 (let* ((files
997 (unless (or (eq buffer t) 1021 (mapcar 'file-relative-name
998 (and (stringp buffer) 1022 (cond ((not file-or-list) '())
999 (string= (buffer-name) buffer)) 1023 ((listp file-or-list) (mapcar 'expand-file-name file-or-list))
1000 (eq buffer (current-buffer))) 1024 (t (list (expand-file-name file-or-list))))))
1001 (vc-setup-buffer buffer)) 1025 (full-command
1002 (let ((squeezed (remq nil flags)) 1026 (concat command " " (vc-delistify flags) " " (vc-delistify files))))
1003 (inhibit-read-only t) 1027 (if vc-command-messages
1004 (status 0)) 1028 (message "Running %s..." full-command))
1005 (when file 1029 (save-current-buffer
1006 ;; FIXME: file-relative-name can return a bogus result because 1030 (unless (or (eq buffer t)
1007 ;; it doesn't look at the actual file-system to see if symlinks 1031 (and (stringp buffer)
1008 ;; come into play. 1032 (string= (buffer-name) buffer))
1009 (setq squeezed (append squeezed (list (file-relative-name file))))) 1033 (eq buffer (current-buffer)))
1010 (let ((exec-path (append vc-path exec-path)) 1034 (vc-setup-buffer buffer))
1011 ;; Add vc-path to PATH for the execution of this command. 1035 (let ((squeezed (remq nil flags))
1012 (process-environment 1036 (inhibit-read-only t)
1013 (cons (concat "PATH=" (getenv "PATH") 1037 (status 0))
1014 path-separator 1038 (when files
1015 (mapconcat 'identity vc-path path-separator)) 1039 (setq squeezed (nconc squeezed files)))
1016 process-environment)) 1040 (let ((exec-path (append vc-path exec-path))
1017 (w32-quote-process-args t)) 1041 ;; Add vc-path to PATH for the execution of this command.
1018 (if (and (eq okstatus 'async) (file-remote-p default-directory)) 1042 (process-environment
1019 ;; start-process does not support remote execution 1043 (cons (concat "PATH=" (getenv "PATH")
1020 (setq okstatus nil)) 1044 path-separator
1021 (if (eq okstatus 'async) 1045 (mapconcat 'identity vc-path path-separator))
1022 (let ((proc 1046 process-environment))
1023 (let ((process-connection-type nil)) 1047 (w32-quote-process-args t))
1024 (apply 'start-process command (current-buffer) command 1048 (if (and (eq okstatus 'async) (file-remote-p default-directory))
1025 squeezed)))) 1049 ;; start-process does not support remote execution
1026 (unless (active-minibuffer-window) 1050 (setq okstatus nil))
1027 (message "Running %s in the background..." command)) 1051 (if (eq okstatus 'async)
1028 ;;(set-process-sentinel proc (lambda (p msg) (delete-process p))) 1052 (let ((proc
1029 (set-process-filter proc 'vc-process-filter) 1053 (let ((process-connection-type nil))
1030 (vc-exec-after 1054 (apply 'start-process command (current-buffer) command
1031 `(unless (active-minibuffer-window) 1055 squeezed))))
1032 (message "Running %s in the background... done" ',command)))) 1056 (unless (active-minibuffer-window)
1033 (let ((buffer-undo-list t)) 1057 (message "Running %s in the background..." full-command))
1034 (setq status (apply 'process-file command nil t nil squeezed))) 1058 ;;(set-process-sentinel proc (lambda (p msg) (delete-process p)))
1035 (when (and (not (eq t okstatus)) 1059 (set-process-filter proc 'vc-process-filter)
1036 (or (not (integerp status)) 1060 (vc-exec-after
1037 (and okstatus (< okstatus status)))) 1061 `(unless (active-minibuffer-window)
1038 (pop-to-buffer (current-buffer)) 1062 (message "Running %s in the background... done" ',full-command))))
1039 (goto-char (point-min)) 1063 (let ((buffer-undo-list t))
1040 (shrink-window-if-larger-than-buffer) 1064 (setq status (apply 'process-file command nil t nil squeezed)))
1041 (error "Running %s...FAILED (%s)" command 1065 (when (and (not (eq t okstatus))
1042 (if (integerp status) (format "status %d" status) status)))) 1066 (or (not (integerp status))
1043 (if vc-command-messages 1067 (and okstatus (< okstatus status))))
1044 (message "Running %s...OK" command))) 1068 (pop-to-buffer (current-buffer))
1045 (vc-exec-after 1069 (goto-char (point-min))
1046 `(run-hook-with-args 'vc-post-command-functions ',command ',file ',flags)) 1070 (shrink-window-if-larger-than-buffer)
1047 status))) 1071 (error "Running %s...FAILED (%s)" full-command
1072 (if (integerp status) (format "status %d" status) status))))
1073 (if vc-command-messages
1074 (message "Running %s...OK" full-command)))
1075 (vc-exec-after
1076 `(run-hook-with-args 'vc-post-command-functions ',command ',file-or-list ',flags))
1077 status))))
1048 1078
1049(defun vc-position-context (posn) 1079(defun vc-position-context (posn)
1050 "Save a bit of the text around POSN in the current buffer. 1080 "Save a bit of the text around POSN in the current buffer.
@@ -1464,7 +1494,7 @@ first backend that could register the file is used."
1464 (message "Registering %s... " file) 1494 (message "Registering %s... " file)
1465 (let ((backend (vc-responsible-backend file t))) 1495 (let ((backend (vc-responsible-backend file t)))
1466 (vc-file-clearprops file) 1496 (vc-file-clearprops file)
1467 (vc-call-backend backend 'register file rev comment) 1497 (vc-call-backend backend 'register (list file) rev comment)
1468 (vc-file-setprop file 'vc-backend backend) 1498 (vc-file-setprop file 'vc-backend backend)
1469 (unless vc-make-backup-files 1499 (unless vc-make-backup-files
1470 (make-local-variable 'backup-inhibited) 1500 (make-local-variable 'backup-inhibited)
@@ -1520,6 +1550,14 @@ The default is to return nil always."
1520The default implementation returns t for all files." 1550The default implementation returns t for all files."
1521 t) 1551 t)
1522 1552
1553(defun vc-expand-dirs (file-or-dir-list)
1554 "Expands directories in a file list specification.
1555Only files already under version control are noticed."
1556 (let ((flattened '()))
1557 (dolist (node file-or-dir-list)
1558 (vc-file-tree-walk node (lambda (f) (if (vc-backend f) (setq flattened (cons f flattened))))))
1559 (nreverse flattened)))
1560
1523(defun vc-resynch-window (file &optional keep noquery) 1561(defun vc-resynch-window (file &optional keep noquery)
1524 "If FILE is in the current buffer, either revert or unvisit it. 1562 "If FILE is in the current buffer, either revert or unvisit it.
1525The choice between revert (to see expanded keywords) and unvisit depends on 1563The choice between revert (to see expanded keywords) and unvisit depends on
@@ -1676,7 +1714,7 @@ Runs the normal hook `vc-checkin-hook'."
1676 ;; Change buffers to get local value of vc-checkin-switches. 1714 ;; Change buffers to get local value of vc-checkin-switches.
1677 (with-current-buffer (or (get-file-buffer file) (current-buffer)) 1715 (with-current-buffer (or (get-file-buffer file) (current-buffer))
1678 (progn 1716 (progn
1679 (vc-call checkin file rev comment) 1717 (vc-call checkin (list file) rev comment)
1680 (vc-delete-automatic-version-backups file))) 1718 (vc-delete-automatic-version-backups file)))
1681 `((vc-state . up-to-date) 1719 `((vc-state . up-to-date)
1682 (vc-checkout-time . ,(nth 5 (file-attributes file))) 1720 (vc-checkout-time . ,(nth 5 (file-attributes file)))
@@ -1896,7 +1934,7 @@ actually call the backend, but performs a local diff."
1896 (error "diff failed")) 1934 (error "diff failed"))
1897 (if (not vc-diff-knows-L) (setq vc-diff-knows-L 'yes))) 1935 (if (not vc-diff-knows-L) (setq vc-diff-knows-L 'yes)))
1898 status) 1936 status)
1899 (vc-call diff file rev1 rev2)))) 1937 (vc-call diff (list file) rev1 rev2))))
1900 1938
1901(defun vc-switches (backend op) 1939(defun vc-switches (backend op)
1902 (let ((switches 1940 (let ((switches
@@ -2480,7 +2518,7 @@ If FOCUS-REV is non-nil, leave the point at that revision."
2480 (not (eq (caddr err) 2))) 2518 (not (eq (caddr err) 2)))
2481 (signal (car err) (cdr err)) 2519 (signal (car err) (cdr err))
2482 ;; for backward compatibility 2520 ;; for backward compatibility
2483 (vc-call print-log file) 2521 (vc-call print-log (list file))
2484 (set-buffer "*vc*")))) 2522 (set-buffer "*vc*"))))
2485 (pop-to-buffer (current-buffer)) 2523 (pop-to-buffer (current-buffer))
2486 (vc-exec-after 2524 (vc-exec-after
@@ -2659,9 +2697,8 @@ return its name; otherwise return nil."
2659 (vc-resynch-buffer file t t)) 2697 (vc-resynch-buffer file t t))
2660 2698
2661;;;###autoload 2699;;;###autoload
2662(defun vc-rollback (norevert) 2700(defun vc-rollback ()
2663 "Get rid of most recently checked in version of this file. 2701 "Get rid of most recently checked in version of this file."
2664A prefix argument NOREVERT means do not revert the buffer afterwards."
2665 (interactive "P") 2702 (interactive "P")
2666 (vc-ensure-vc-buffer) 2703 (vc-ensure-vc-buffer)
2667 (let* ((file buffer-file-name) 2704 (let* ((file buffer-file-name)
@@ -2682,7 +2719,7 @@ A prefix argument NOREVERT means do not revert the buffer afterwards."
2682 (message "Removing last change from %s..." file) 2719 (message "Removing last change from %s..." file)
2683 (with-vc-properties 2720 (with-vc-properties
2684 file 2721 file
2685 (vc-call rollback file norevert) 2722 (vc-call rollback (list file))
2686 `((vc-state . ,(if norevert 'edited 'up-to-date)) 2723 `((vc-state . ,(if norevert 'edited 'up-to-date))
2687 (vc-checkout-time . ,(if norevert 2724 (vc-checkout-time . ,(if norevert
2688 0 2725 0