diff options
| author | Eric S. Raymond | 2007-07-18 16:32:40 +0000 |
|---|---|---|
| committer | Eric S. Raymond | 2007-07-18 16:32:40 +0000 |
| commit | 8cdd17b444075b04fbe47ffd8ee4cf0e617e4f42 (patch) | |
| tree | 3cc38ed8386e7f573ec7f74801f61403ca20ae4b | |
| parent | 4e6e4fe5643a958a03f386b5c9f41ff434bbfd64 (diff) | |
| download | emacs-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.el | 39 | ||||
| -rw-r--r-- | lisp/vc-bzr.el | 24 | ||||
| -rw-r--r-- | lisp/vc-cvs.el | 88 | ||||
| -rw-r--r-- | lisp/vc-hg.el | 55 | ||||
| -rw-r--r-- | lisp/vc-mcvs.el | 87 | ||||
| -rw-r--r-- | lisp/vc-rcs.el | 218 | ||||
| -rw-r--r-- | lisp/vc-sccs.el | 79 | ||||
| -rw-r--r-- | lisp/vc-svn.el | 79 | ||||
| -rw-r--r-- | lisp/vc.el | 207 |
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. |
| 95 | Invoke the bzr command adding `BZR_PROGRESS_BAR=none' to the environment." | 95 | Invoke 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. |
| 201 | Signal an error unless REV is nil. | 201 | Signal an error unless REV is nil. |
| 202 | COMMENT is ignored." | 202 | COMMENT 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. |
| 231 | REV non-nil gets an error." | 231 | REV 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." |
| 286 | COMMENT 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. | ||
| 290 | COMMENT 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 |
| 289 | the CVS command (in that order)." | 293 | the 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. |
| 688 | The difference to vc-do-command is that this function always invokes `cvs', | 690 | The difference to vc-do-command is that this function always invokes `cvs', |
| 689 | and that it passes `vc-cvs-global-switches' to it before FLAGS." | 691 | and 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. |
| 317 | REV is ignored. | 324 | REV is ignored. |
| 318 | COMMENT is ignored." | 325 | COMMENT 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'. |
| 341 | REV is ignored." | 352 | REV 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. |
| 379 | The difference to vc-do-command is that this function always invokes `hg', | 390 | The difference to vc-do-command is that this function always invokes `hg', |
| 380 | and that it passes `vc-hg-global-switches' to it before FLAGS." | 391 | and 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. | ||
| 207 | COMMENT can be used to provide an initial description of FILE. | 216 | COMMENT 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 |
| 210 | the Meta-CVS command (in that order)." | 219 | the 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. |
| 258 | This is only possible if Meta-CVS is responsible for FILE's directory.") | 270 | This 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." |
| 235 | REV 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 |
| 236 | to 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. | ||
| 245 | REV is the optional revision number for the files. COMMENT can be used | ||
| 246 | to 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 |
| 239 | the RCS command (in that order). | 249 | the RCS command (in that order). |
| 240 | 250 | ||
| 241 | Automatically retrieve a read-only version of the file with keywords | 251 | Automatically retrieve a read-only version of the file with keywords |
| 242 | expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile." | 252 | expanded 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. | ||
| 438 | EDITABLE 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. |
| 467 | The changes are between FIRST-VERSION and SECOND-VERSION." | 487 | The 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. |
| 502 | Optional arg REVISION is a revision to annotate from." | 541 | Optional 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. | ||
| 166 | REV is the optional revision number for the file. COMMENT can be used | 176 | REV is the optional revision number for the file. COMMENT can be used |
| 167 | to provide an initial description of FILE. | 177 | to 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 |
| 170 | the SCCS command (in that order). | 180 | the SCCS command (in that order). |
| 171 | 181 | ||
| 172 | Automatically retrieve a read-only version of the file with keywords | 182 | Automatically retrieve a read-only version of the files with keywords |
| 173 | expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile." | 183 | expanded 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. | ||
| 256 | EDITABLE 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." |
| 211 | COMMENT 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. | ||
| 221 | The 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 |
| 214 | the SVN command (in that order)." | 224 | the 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. |
| 226 | This is only possible if SVN is responsible for FILE's directory.") | 236 | This 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. |
| 474 | The difference to vc-do-command is that this function always invokes `svn', | 475 | The difference to vc-do-command is that this function always invokes `svn', |
| 475 | and that it passes `vc-svn-global-switches' to it before FLAGS." | 476 | and 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." | |||
| 976 | Each function is called inside the buffer in which the command was run | 994 | Each function is called inside the buffer in which the command was run |
| 977 | and is passed 3 arguments: the COMMAND, the FILE and the FLAGS.") | 995 | and 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. |
| 983 | Output from COMMAND goes to BUFFER, or *vc* if BUFFER is nil or the | 1007 | Output from COMMAND goes to BUFFER, or *vc* if BUFFER is nil or the |
| 984 | current buffer if BUFFER is t. If the destination buffer is not | 1008 | current 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 | |||
| 986 | considered successful if its exit status does not exceed OKSTATUS (if | 1010 | considered successful if its exit status does not exceed OKSTATUS (if |
| 987 | OKSTATUS is nil, that means to ignore error status, if it is `async', that | 1011 | OKSTATUS is nil, that means to ignore error status, if it is `async', that |
| 988 | means not to wait for termination of the subprocess; if it is t it means to | 1012 | means not to wait for termination of the subprocess; if it is t it means to |
| 989 | ignore all execution errors). FILE is the | 1013 | ignore all execution errors). FILE-OR-LIST is the name of a working file; |
| 990 | name of the working file (may also be nil, to execute commands that | 1014 | it may be a list of files or be nil (to execute commands that don't expect |
| 991 | don't expect a file name). If an optional list of FLAGS is present, | 1015 | a file name or set of files). If an optional list of FLAGS is present, |
| 992 | that is inserted into the command line before the filename." | 1016 | that 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." | |||
| 1520 | The default implementation returns t for all files." | 1550 | The 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. | ||
| 1555 | Only 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. |
| 1525 | The choice between revert (to see expanded keywords) and unvisit depends on | 1563 | The 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." |
| 2664 | A 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 |