Commit 2c28ac43 authored by Richard M. Stallman's avatar Richard M. Stallman
Browse files

Fix error message style.

(vc-backend-checkout, vc-backend-checkin):
Allow vc-checkin-switches to be a string.
parent d7993a1c
...@@ -631,7 +631,7 @@ to an optional list of FLAGS." ...@@ -631,7 +631,7 @@ to an optional list of FLAGS."
(progn (vc-backend-steal file) (progn (vc-backend-steal file)
(vc-mode-line file)) (vc-mode-line file))
(if (not (yes-or-no-p "Revert to checked-in version, instead? ")) (if (not (yes-or-no-p "Revert to checked-in version, instead? "))
(error "Checkout aborted.") (error "Checkout aborted")
(vc-revert-buffer1 t t) (vc-revert-buffer1 t t)
(vc-checkout-writable-buffer file)) (vc-checkout-writable-buffer file))
) )
...@@ -639,7 +639,7 @@ to an optional list of FLAGS." ...@@ -639,7 +639,7 @@ to an optional list of FLAGS."
(if (not (eq vc-type 'SCCS)) (if (not (eq vc-type 'SCCS))
(vc-checkout file nil (vc-checkout file nil
(read-string "Branch or version to move to: ")) (read-string "Branch or version to move to: "))
(error "Sorry, this is not implemented for SCCS.")) (error "Sorry, this is not implemented for SCCS"))
(if (vc-latest-on-branch-p file) (if (vc-latest-on-branch-p file)
(vc-checkout-writable-buffer file) (vc-checkout-writable-buffer file)
(if (yes-or-no-p (if (yes-or-no-p
...@@ -659,7 +659,7 @@ to an optional list of FLAGS." ...@@ -659,7 +659,7 @@ to an optional list of FLAGS."
(error "Sorry, you can't steal the lock on %s this way" file)) (error "Sorry, you can't steal the lock on %s this way" file))
(and (eq vc-type 'RCS) (and (eq vc-type 'RCS)
(not (vc-backend-release-p 'RCS "5.6.2")) (not (vc-backend-release-p 'RCS "5.6.2"))
(error "File is locked by %s." owner)) (error "File is locked by %s" owner))
(vc-steal-lock (vc-steal-lock
file file
(if verbose (read-string "Version to steal: ") (if verbose (read-string "Version to steal: ")
...@@ -1612,9 +1612,9 @@ A prefix argument means do not revert the buffer afterwards." ...@@ -1612,9 +1612,9 @@ A prefix argument means do not revert the buffer afterwards."
((eq (vc-backend (buffer-file-name)) 'CVS) ((eq (vc-backend (buffer-file-name)) 'CVS)
(error "Unchecking files under CVS is dangerous and not supported in VC")) (error "Unchecking files under CVS is dangerous and not supported in VC"))
((vc-locking-user (buffer-file-name)) ((vc-locking-user (buffer-file-name))
(error "This version is locked. Use vc-revert-buffer to discard changes.")) (error "This version is locked; use vc-revert-buffer to discard changes"))
((not (vc-latest-on-branch-p (buffer-file-name))) ((not (vc-latest-on-branch-p (buffer-file-name)))
(error "This is not the latest version. VC cannot cancel it."))) (error "This is not the latest version--VC cannot cancel it")))
(let ((target (vc-workfile-version (buffer-file-name)))) (let ((target (vc-workfile-version (buffer-file-name))))
(if (null (yes-or-no-p "Remove this version from master? ")) (if (null (yes-or-no-p "Remove this version from master? "))
nil nil
...@@ -1645,7 +1645,7 @@ A prefix argument means do not revert the buffer afterwards." ...@@ -1645,7 +1645,7 @@ A prefix argument means do not revert the buffer afterwards."
;; implemented things might change for the better. This is unlikely to occur ;; implemented things might change for the better. This is unlikely to occur
;; until CVS 2.0 is released. --ceder 1994-01-23 21:27:51 ;; until CVS 2.0 is released. --ceder 1994-01-23 21:27:51
(if (eq (vc-backend old) 'CVS) (if (eq (vc-backend old) 'CVS)
(error "Renaming files under CVS is dangerous and not supported in VC.")) (error "Renaming files under CVS is dangerous and not supported in VC"))
(let ((oldbuf (get-file-buffer old))) (let ((oldbuf (get-file-buffer old)))
(if (and oldbuf (buffer-modified-p oldbuf)) (if (and oldbuf (buffer-modified-p oldbuf))
(error "Please save files before moving them")) (error "Please save files before moving them"))
...@@ -1804,11 +1804,15 @@ From a program, any arguments are passed to the `rcs2log' script." ...@@ -1804,11 +1804,15 @@ From a program, any arguments are passed to the `rcs2log' script."
;; Retrieve a copy of a saved version into a workfile ;; Retrieve a copy of a saved version into a workfile
(let ((filename (or workfile file)) (let ((filename (or workfile file))
(file-buffer (get-file-buffer file)) (file-buffer (get-file-buffer file))
(old-default-dir default-directory)) (old-default-dir default-directory)
switches)
(message "Checking out %s..." filename) (message "Checking out %s..." filename)
(save-excursion (save-excursion
;; Change buffers to get local value of vc-checkin-switches. ;; Change buffers to get local value of vc-checkout-switches.
(if file-buffer (set-buffer file-buffer)) (if file-buffer (set-buffer file-buffer))
(setq switches (if (stringp vc-checkout-switches)
(list vc-checkout-switches)
vc-checkout-switches))
;; Adjust the default-directory so that the check-out creates ;; Adjust the default-directory so that the check-out creates
;; the file in the right place. The old value is restored below. ;; the file in the right place. The old value is restored below.
(setq default-directory (file-name-directory filename)) (setq default-directory (file-name-directory filename))
...@@ -1839,13 +1843,13 @@ From a program, any arguments are passed to the `rcs2log' script." ...@@ -1839,13 +1843,13 @@ From a program, any arguments are passed to the `rcs2log' script."
(if writable "-e") (if writable "-e")
"-p" (and rev "-p" (and rev
(concat "-r" (vc-lookup-triple file rev))) (concat "-r" (vc-lookup-triple file rev)))
vc-checkout-switches) switches)
(setq failed nil)) (setq failed nil))
(and failed (file-exists-p filename) (delete-file filename)))) (and failed (file-exists-p filename) (delete-file filename))))
(apply 'vc-do-command nil 0 "get" file 'MASTER ;; SCCS (apply 'vc-do-command nil 0 "get" file 'MASTER ;; SCCS
(if writable "-e") (if writable "-e")
(and rev (concat "-r" (vc-lookup-triple file rev))) (and rev (concat "-r" (vc-lookup-triple file rev)))
vc-checkout-switches) switches)
(vc-file-setprop file 'vc-workfile-version nil)) (vc-file-setprop file 'vc-workfile-version nil))
(if workfile ;; RCS (if workfile ;; RCS
;; RCS doesn't let us check out into arbitrary file names directly. ;; RCS doesn't let us check out into arbitrary file names directly.
...@@ -1868,7 +1872,7 @@ From a program, any arguments are passed to the `rcs2log' script." ...@@ -1868,7 +1872,7 @@ From a program, any arguments are passed to the `rcs2log' script."
filename filename
(if writable "-l") (if writable "-l")
(concat "-p" rev) (concat "-p" rev)
vc-checkout-switches) switches)
(setq failed nil)) (setq failed nil))
(and failed (file-exists-p filename) (delete-file filename)))) (and failed (file-exists-p filename) (delete-file filename))))
(let (new-version) (let (new-version)
...@@ -1889,7 +1893,7 @@ From a program, any arguments are passed to the `rcs2log' script." ...@@ -1889,7 +1893,7 @@ From a program, any arguments are passed to the `rcs2log' script."
(let ((workrev (vc-workfile-version file))) (let ((workrev (vc-workfile-version file)))
(if workrev (concat "-r" workrev) (if workrev (concat "-r" workrev)
nil))) nil)))
vc-checkout-switches) switches)
;; determine the new workfile version ;; determine the new workfile version
(save-excursion (save-excursion
(set-buffer "*vc*") (set-buffer "*vc*")
...@@ -1917,7 +1921,7 @@ From a program, any arguments are passed to the `rcs2log' script." ...@@ -1917,7 +1921,7 @@ From a program, any arguments are passed to the `rcs2log' script."
workfile workfile
(concat "-r" rev) (concat "-r" rev)
"-p" "-p"
vc-checkout-switches) switches)
(setq failed nil)) (setq failed nil))
(and failed (file-exists-p filename) (delete-file filename)))) (and failed (file-exists-p filename) (delete-file filename))))
;; default for verbose checkout: clear the sticky tag ;; default for verbose checkout: clear the sticky tag
...@@ -1931,7 +1935,7 @@ From a program, any arguments are passed to the `rcs2log' script." ...@@ -1931,7 +1935,7 @@ From a program, any arguments are passed to the `rcs2log' script."
"update" "update"
(and rev (not (string= rev "")) (and rev (not (string= rev ""))
(concat "-r" rev)) (concat "-r" rev))
vc-checkout-switches) switches)
;; If no revision was specified, simply make the file writable. ;; If no revision was specified, simply make the file writable.
(and writable (and writable
(or (eq (vc-checkout-model file) 'manual) (or (eq (vc-checkout-model file) 'manual)
...@@ -1975,93 +1979,97 @@ From a program, any arguments are passed to the `rcs2log' script." ...@@ -1975,93 +1979,97 @@ From a program, any arguments are passed to the `rcs2log' script."
(save-excursion (save-excursion
;; Change buffers to get local value of vc-checkin-switches. ;; Change buffers to get local value of vc-checkin-switches.
(set-buffer (or (get-file-buffer file) (current-buffer))) (set-buffer (or (get-file-buffer file) (current-buffer)))
;; Clear the master-properties. Do that here, not at the (let ((switches
;; end, because if the check-in fails we want them to get (if (stringp vc-checkout-switches)
;; re-computed before the next try. (list vc-checkout-switches)
(vc-file-clear-masterprops file) vc-checkout-switches)))
(vc-backend-dispatch file ;; Clear the master-properties. Do that here, not at the
;; SCCS ;; end, because if the check-in fails we want them to get
(progn ;; re-computed before the next try.
(apply 'vc-do-command nil 0 "delta" file 'MASTER (vc-file-clear-masterprops file)
(if rev (concat "-r" rev)) (vc-backend-dispatch file
(concat "-y" comment) ;; SCCS
vc-checkin-switches) (progn
(vc-file-setprop file 'vc-locking-user 'none) (apply 'vc-do-command nil 0 "delta" file 'MASTER
(vc-file-setprop file 'vc-workfile-version nil) (if rev (concat "-r" rev))
(if vc-keep-workfiles (concat "-y" comment)
(vc-do-command nil 0 "get" file 'MASTER)) switches)
) (vc-file-setprop file 'vc-locking-user 'none)
;; RCS (vc-file-setprop file 'vc-workfile-version nil)
(let ((old-version (vc-workfile-version file)) new-version) (if vc-keep-workfiles
(apply 'vc-do-command nil 0 "ci" file 'MASTER (vc-do-command nil 0 "get" file 'MASTER))
;; if available, use the secure check-in option )
(and (vc-backend-release-p 'RCS "5.6.4") "-j") ;; RCS
(concat (if vc-keep-workfiles "-u" "-r") rev) (let ((old-version (vc-workfile-version file)) new-version)
(concat "-m" comment) (apply 'vc-do-command nil 0 "ci" file 'MASTER
vc-checkin-switches) ;; if available, use the secure check-in option
(vc-file-setprop file 'vc-locking-user 'none) (and (vc-backend-release-p 'RCS "5.6.4") "-j")
(vc-file-setprop file 'vc-workfile-version nil) (concat (if vc-keep-workfiles "-u" "-r") rev)
(concat "-m" comment)
;; determine the new workfile version switches)
(set-buffer "*vc*") (vc-file-setprop file 'vc-locking-user 'none)
(goto-char (point-min)) (vc-file-setprop file 'vc-workfile-version nil)
(if (or (re-search-forward
"new revision: \\([0-9.]+\\);" nil t) ;; determine the new workfile version
(re-search-forward (set-buffer "*vc*")
"reverting to previous revision \\([0-9.]+\\)" nil t)) (goto-char (point-min))
(progn (setq new-version (buffer-substring (match-beginning 1) (if (or (re-search-forward
(match-end 1))) "new revision: \\([0-9.]+\\);" nil t)
(vc-file-setprop file 'vc-workfile-version new-version))) (re-search-forward
"reverting to previous revision \\([0-9.]+\\)" nil t))
;; if we got to a different branch, adjust the default (progn (setq new-version (buffer-substring (match-beginning 1)
;; branch accordingly (match-end 1)))
(cond (vc-file-setprop file 'vc-workfile-version new-version)))
((and old-version new-version
(not (string= (vc-branch-part old-version) ;; if we got to a different branch, adjust the default
(vc-branch-part new-version)))) ;; branch accordingly
(vc-do-command nil 0 "rcs" file 'MASTER (cond
(if (vc-trunk-p new-version) "-b" ((and old-version new-version
(concat "-b" (vc-branch-part new-version)))) (not (string= (vc-branch-part old-version)
;; If this is an old RCS release, we might have (vc-branch-part new-version))))
;; to remove a remaining lock. (vc-do-command nil 0 "rcs" file 'MASTER
(if (not (vc-backend-release-p 'RCS "5.6.2")) (if (vc-trunk-p new-version) "-b"
;; exit status of 1 is also accepted. (concat "-b" (vc-branch-part new-version))))
;; It means that the lock was removed before. ;; If this is an old RCS release, we might have
(vc-do-command nil 1 "rcs" file 'MASTER ;; to remove a remaining lock.
(concat "-u" old-version)))))) (if (not (vc-backend-release-p 'RCS "5.6.2"))
;; CVS ;; exit status of 1 is also accepted.
(progn ;; It means that the lock was removed before.
;; explicit check-in to the trunk requires a (vc-do-command nil 1 "rcs" file 'MASTER
;; double check-in (first unexplicit) (CVS-1.3) (concat "-u" old-version))))))
(condition-case nil ;; CVS
(progn (progn
(if (and rev (vc-trunk-p rev)) ;; explicit check-in to the trunk requires a
(apply 'vc-do-command nil 0 "cvs" file 'WORKFILE ;; double check-in (first unexplicit) (CVS-1.3)
"ci" "-m" "intermediate" (condition-case nil
vc-checkin-switches)) (progn
(apply 'vc-do-command nil 0 "cvs" file 'WORKFILE (if (and rev (vc-trunk-p rev))
"ci" (if rev (concat "-r" rev)) (apply 'vc-do-command nil 0 "cvs" file 'WORKFILE
(concat "-m" comment) "ci" "-m" "intermediate"
vc-checkin-switches)) switches))
(error (if (eq (vc-cvs-status file) 'needs-merge) (apply 'vc-do-command nil 0 "cvs" file 'WORKFILE
;; The CVS output will be on top of this message. "ci" (if rev (concat "-r" rev))
(error "Type C-x 0 C-x C-q to merge in changes.") (concat "-m" comment)
(error "Check in FAILED.")))) switches))
;; determine and store the new workfile version (error (if (eq (vc-cvs-status file) 'needs-merge)
(set-buffer "*vc*") ;; The CVS output will be on top of this message.
(goto-char (point-min)) (error "Type C-x 0 C-x C-q to merge in changes")
(if (re-search-forward (error "Check-in failed"))))
"^\\(new\\|initial\\) revision: \\([0-9.]+\\)" nil t) ;; determine and store the new workfile version
(vc-file-setprop file 'vc-workfile-version (set-buffer "*vc*")
(buffer-substring (match-beginning 2) (goto-char (point-min))
(match-end 2))) (if (re-search-forward
(vc-file-setprop file 'vc-workfile-version nil)) "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" nil t)
;; if this was an explicit check-in, remove the sticky tag (vc-file-setprop file 'vc-workfile-version
(if rev (buffer-substring (match-beginning 2)
(vc-do-command nil 0 "cvs" file 'WORKFILE "update" "-A")) (match-end 2)))
(vc-file-setprop file 'vc-locking-user 'none) (vc-file-setprop file 'vc-workfile-version nil))
(vc-file-setprop file 'vc-checkout-time ;; if this was an explicit check-in, remove the sticky tag
(nth 5 (file-attributes file)))))) (if rev
(vc-do-command nil 0 "cvs" file 'WORKFILE "update" "-A"))
(vc-file-setprop file 'vc-locking-user 'none)
(vc-file-setprop file 'vc-checkout-time
(nth 5 (file-attributes file)))))))
(message "Checking in %s...done" file)) (message "Checking in %s...done" file))
(defun vc-backend-revert (file) (defun vc-backend-revert (file)
...@@ -2097,7 +2105,7 @@ From a program, any arguments are passed to the `rcs2log' script." ...@@ -2097,7 +2105,7 @@ From a program, any arguments are passed to the `rcs2log' script."
) )
(vc-do-command nil 0 "rcs" file 'MASTER ;RCS (vc-do-command nil 0 "rcs" file 'MASTER ;RCS
"-M" (concat "-u" rev) (concat "-l" rev)) "-M" (concat "-u" rev) (concat "-l" rev))
(error "You cannot steal a CVS lock; there are no CVS locks to steal.") ;CVS (error "You cannot steal a CVS lock; there are no CVS locks to steal") ;CVS
) )
(vc-file-setprop file 'vc-locking-user (user-login-name)) (vc-file-setprop file 'vc-locking-user (user-login-name))
(message "Stealing lock on %s...done" file) (message "Stealing lock on %s...done" file)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment