procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Put the lower half (the back-end) of NewVC in place. This commit

Browse source 
makes only the minimum changes needed to get the old vc.el logic
working with the new back ends.
This commit is contained in:
Eric S. Raymond 2007-07-18 16:32:40 +00:00
parent 4e6e4fe564
commit 8cdd17b444
9 changed files with 494 additions and 374 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

39
lisp/vc-arch.el
View file

@ -198,16 +198,17 @@ Only the value `maybe' can be trusted :-(."
;; creates a {arch} directory somewhere.
file 'arch-root (vc-find-root file "{arch}/=tagging-method"))))
(defun vc-arch-register (file &optional rev comment)
(defun vc-arch-register (files &optional rev comment)
(if rev (error "Explicit initial revision not supported for Arch"))
(let ((tagmet (vc-arch-tagging-method file)))
(if (and (memq tagmet '(tagline implicit)) comment-start)
(with-current-buffer (find-file-noselect file)
(if (buffer-modified-p)
(error "Save %s first" (buffer-name)))
(vc-arch-add-tagline)
(save-buffer))
(vc-arch-command nil 0 file "add"))))
(dolist (file files)
(let ((tagmet (vc-arch-tagging-method file)))
(if (and (memq tagmet '(tagline implicit)) comment-start)
(with-current-buffer (find-file-noselect file)
(if (buffer-modified-p)
(error "Save %s first" (buffer-name)))
(vc-arch-add-tagline)
(save-buffer)))))
(vc-arch-command nil 0 files "add"))
(defun vc-arch-registered (file)
;; Don't seriously check whether it's source or not. Checking would
@ -371,22 +372,24 @@ Return non-nil if FILE is unchanged."
(defun vc-arch-checkout-model (file) 'implicit)
(defun vc-arch-checkin (file rev comment)
(defun vc-arch-checkin (files rev comment)
(if rev (error "Committing to a specific revision is unsupported"))
(let ((summary (file-relative-name file (vc-arch-root file))))
;; FIXME: This implementation probably only works for singleton filesets
(let ((summary (file-relative-name (car file) (vc-arch-root (car files)))))
;; Extract a summary from the comment.
(when (or (string-match "\\`Summary:[ \t]*\\(.*[^ \t\n]\\)\\([ \t]*\n\\)*" comment)
(string-match "\\`[ \t]*\\(.*[^ \t\n]\\)[ \t]*\\(\n?\\'\\|\n\\([ \t]*\n\\)+\\)" comment))
(setq summary (match-string 1 comment))
(setq comment (substring comment (match-end 0))))
(vc-arch-command nil 0 file "commit" "-s" summary "-L" comment "--"
(vc-arch-command nil 0 files "commit" "-s" summary "-L" comment "--"
(vc-switches 'Arch 'checkin))))
(defun vc-arch-diff (file &optional oldvers newvers buffer)
"Get a difference report using Arch between two versions of FILE."
(defun vc-arch-diff (files &optional oldvers newvers buffer)
"Get a difference report using Arch between two versions of FILES."
;; FIXME: This implementation probably only works for singleton filesets
(if (and newvers
(vc-up-to-date-p file)
(equal newvers (vc-workfile-version file)))
(equal newvers (vc-workfile-version (car files))))
;; Newvers is the base revision and the current file is unchanged,
;; so we can diff with the current file.
(setq newvers nil))
@ -394,7 +397,7 @@ Return non-nil if FILE is unchanged."
(error "Diffing specific revisions not implemented")
(let* ((async (and (not vc-disable-async-diff) (fboundp 'start-process)))
;; Run the command from the root dir.
(default-directory (vc-arch-root file))
(default-directory (vc-arch-root (car files)))
(status
(vc-arch-command
(or buffer "*vc-diff*")
@ -402,8 +405,8 @@ Return non-nil if FILE is unchanged."
nil "file-diffs"
;; Arch does not support the typical flags.
;; (vc-switches 'Arch 'diff)
(file-relative-name file)
(if (equal oldvers (vc-workfile-version file))
(mapcar 'file-relative-name files)
(if (equal oldvers (vc-workfile-version (car files)))
nil
oldvers))))
(if async 1 status)))) ; async diff, pessimistic assumption.

24
lisp/vc-bzr.el
View file

@ -90,7 +90,7 @@
;; since v0.9, bzr supports removing the progress indicators
;; by setting environment variable BZR_PROGRESS_BAR to "none".
(defun vc-bzr-command (bzr-command buffer okstatus file &rest args)
(defun vc-bzr-command (bzr-command buffer okstatus file-or-list &rest args)
"Wrapper round `vc-do-command' using `vc-bzr-program' as COMMAND.
Invoke the bzr command adding `BZR_PROGRESS_BAR=none' to the environment."
(let ((process-environment
@ -103,7 +103,7 @@ Invoke the bzr command adding `BZR_PROGRESS_BAR=none' to the environment."
;; This is redundant because vc-do-command does it already. --Stef
(process-connection-type nil))
(apply 'vc-do-command buffer okstatus vc-bzr-program
file bzr-command (append vc-bzr-program-args args))))
file-or-list bzr-command (append vc-bzr-program-args args))))
;;;###autoload
@ -196,12 +196,12 @@ Return nil if there isn't one."
(defun vc-bzr-checkout-model (file)
'implicit)
(defun vc-bzr-register (file &optional rev comment)
(defun vc-bzr-register (files &optional rev comment)
"Register FILE under bzr.
Signal an error unless REV is nil.
COMMENT is ignored."
(if rev (error "Can't register explicit version with bzr"))
(vc-bzr-command "add" nil 0 file))
(vc-bzr-command "add" nil 0 files))
;; Could run `bzr status' in the directory and see if it succeeds, but
;; that's relatively expensive.
@ -226,11 +226,11 @@ or a superior directory.")
"Unregister FILE from bzr."
(vc-bzr-command "remove" nil 0 file))
(defun vc-bzr-checkin (file rev comment)
(defun vc-bzr-checkin (files rev comment)
"Check FILE in to bzr with log message COMMENT.
REV non-nil gets an error."
(if rev (error "Can't check in a specific version with bzr"))
(vc-bzr-command "commit" nil 0 file "-m" comment))
(vc-bzr-command "commit" nil 0 files "-m" comment))
(defun vc-bzr-checkout (file &optional editable rev destfile)
"Checkout revision REV of FILE from bzr to DESTFILE.
@ -271,12 +271,12 @@ EDITABLE is ignored."
(2 'change-log-email))
("^ *timestamp: \\(.*\\)" (1 'change-log-date-face))))))
(defun vc-bzr-print-log (file &optional buffer) ; get buffer arg in Emacs 22
"Get bzr change log for FILE into specified BUFFER."
(defun vc-bzr-print-log (files &optional buffer) ; get buffer arg in Emacs 22
"Get bzr change log for FILES into specified BUFFER."
;; Fixme: This might need the locale fixing up if things like `revno'
;; got localized, but certainly it shouldn't use LC_ALL=C.
;; NB. Can't be async -- see `vc-bzr-post-command-function'.
(vc-bzr-command "log" buffer 0 file)
(vc-bzr-command "log" buffer 0 files)
;; FIXME: Until Emacs-23, VC was missing a hook to sort out the mode for
;; the buffer, or at least set the regexps right.
(unless (fboundp 'vc-default-log-view-mode)
@ -294,16 +294,16 @@ EDITABLE is ignored."
(autoload 'vc-diff-switches-list "vc" nil nil t)
(defun vc-bzr-diff (file &optional rev1 rev2 buffer)
(defun vc-bzr-diff (files &optional rev1 rev2 buffer)
"VC bzr backend for diff."
(let ((working (vc-workfile-version file)))
(let ((working (vc-workfile-version (car files))))
(if (and (equal rev1 working) (not rev2))
(setq rev1 nil))
(if (and (not rev1) rev2)
(setq rev1 working))
;; NB. Can't be async -- see `vc-bzr-post-command-function'.
;; bzr diff produces condition code 1 for some reason.
(apply #'vc-bzr-command "diff" (or buffer "*vc-diff*") 1 file
(apply #'vc-bzr-command "diff" (or buffer "*vc-diff*") 1 files
"--diff-options" (mapconcat 'identity (vc-diff-switches-list bzr)
" ")
(when rev1

88
lisp/vc-cvs.el
View file

@ -281,21 +281,25 @@ committed and support display of sticky tags."
;;; State-changing functions
;;;
(defun vc-cvs-register (file &optional rev comment)
"Register FILE into the CVS version-control system.
COMMENT can be used to provide an initial description of FILE.
(defun vc-cvs-create-repo ()
"Create a new CVS repository."
(error "Creation of CVS repositories is not supported."))
(defun vc-cvs-register (files &optional rev comment)
"Register FILES into the CVS version-control system.
COMMENT can be used to provide an initial description of FILES.
`vc-register-switches' and `vc-cvs-register-switches' are passed to
the CVS command (in that order)."
(when (and (not (vc-cvs-responsible-p file))
(vc-cvs-could-register file))
;; Register the directory if needed.
(vc-cvs-register (directory-file-name (file-name-directory file))))
(apply 'vc-cvs-command nil 0 file
"add"
(and comment (string-match "[^\t\n ]" comment)
(concat "-m" comment))
(vc-switches 'CVS 'register)))
(vc-cvs-could-register file))
;; Register the directory if needed.
(vc-cvs-register (directory-file-name (file-name-directory file))))
(apply 'vc-cvs-command nil 0 files
"add"
(and comment (string-match "[^\t\n ]" comment)
(concat "-m" comment))
(vc-switches 'CVS 'register)))
(defun vc-cvs-responsible-p (file)
"Return non-nil if CVS thinks it is responsible for FILE."
@ -317,15 +321,15 @@ its parents."
t (directory-file-name dir))))
(eq dir t)))
(defun vc-cvs-checkin (file rev comment)
(defun vc-cvs-checkin (files rev comment)
"CVS-specific version of `vc-backend-checkin'."
(unless (or (not rev) (vc-cvs-valid-version-number-p rev))
(if (not (vc-cvs-valid-symbolic-tag-name-p rev))
(error "%s is not a valid symbolic tag name" rev)
;; If the input revison is a valid symbolic tag name, we create it
;; as a branch, commit and switch to it.
(apply 'vc-cvs-command nil 0 file "tag" "-b" (list rev))
(apply 'vc-cvs-command nil 0 file "update" "-r" (list rev))
(apply 'vc-cvs-command nil 0 files "tag" "-b" (list rev))
(apply 'vc-cvs-command nil 0 files "update" "-r" (list rev))
(vc-file-setprop file 'vc-cvs-sticky-tag rev)))
(let ((status (apply 'vc-cvs-command nil 1 file
"ci" (if rev (concat "-r" rev))
@ -346,20 +350,25 @@ its parents."
(goto-char (point-min))
(shrink-window-if-larger-than-buffer)
(error "Check-in failed"))))
;; Update file properties
(vc-file-setprop
file 'vc-workfile-version
(vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2))
;; Forget the checkout model of the file, because we might have
;; Single-file commit? Then update the version by parsing the buffer.
;; Otherwise we can't necessarily tell what goes with what; clear
;; its properties so they have to be refetched.
(if (= (length files) 1)
(vc-file-setprop
(car files) 'vc-workfile-version
(vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2))
(mapc (lambda (file) (vc-file-clearprops file)) files))
;; Anyway, forget the checkout model of the file, because we might have
;; guessed wrong when we found the file. After commit, we can
;; tell it from the permissions of the file (see
;; vc-cvs-checkout-model).
(vc-file-setprop file 'vc-checkout-model nil)
(mapc (lambda (file) (vc-file-setprop file 'vc-checkout-model nil))
files)
;; if this was an explicit check-in (does not include creation of
;; a branch), remove the sticky tag.
(if (and rev (not (vc-cvs-valid-symbolic-tag-name-p rev)))
(vc-cvs-command nil 0 file "update" "-A"))))
(vc-cvs-command nil 0 files "update" "-A"))))
(defun vc-cvs-find-version (file rev buffer)
(apply 'vc-cvs-command
@ -481,37 +490,30 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
;;; History functions
;;;
(defun vc-cvs-print-log (file &optional buffer)
(defun vc-cvs-print-log (files &optional buffer)
"Get change log associated with FILE."
(vc-cvs-command
buffer
(if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0)
file "log"))
(if (and (vc-stay-local-p files) (fboundp 'start-process)) 'async 0)
files "log"))
(defun vc-cvs-diff (file &optional oldvers newvers buffer)
(defun vc-cvs-wash-log ()
"Remove all non-comment information from log output."
(vc-call-backend 'RCS 'wash-log)
nil)
(defun vc-cvs-diff (files &optional oldvers newvers buffer)
"Get a difference report using CVS between two versions of FILE."
(if (string= (vc-workfile-version file) "0")
;; This file is added but not yet committed; there is no master file.
(if (or oldvers newvers)
(error "No revisions of %s exist" file)
;; We regard this as "changed".
;; Diff it against /dev/null.
;; Note: this is NOT a "cvs diff".
(apply 'vc-do-command (or buffer "*vc-diff*")
1 "diff" file
(append (vc-switches nil 'diff) '("/dev/null")))
;; Even if it's empty, it's locally modified.
1)
(let* ((async (and (not vc-disable-async-diff)
(vc-stay-local-p file)
(fboundp 'start-process)))
(let* ((async (and (not vc-disable-async-diff)
(vc-stay-local-p files)
(fboundp 'start-process)))
(status (apply 'vc-cvs-command (or buffer "*vc-diff*")
(if async 'async 1)
file "diff"
(and oldvers (concat "-r" oldvers))
(and newvers (concat "-r" newvers))
(vc-switches 'CVS 'diff))))
(if async 1 status)))) ; async diff, pessimistic assumption
(if async 1 status))) ; async diff, pessimistic assumption
(defun vc-cvs-diff-tree (dir &optional rev1 rev2)
"Diff all files at and below DIR."
@ -683,11 +685,11 @@ If UPDATE is non-nil, then update (resynch) any affected buffers."
;;; Internal functions
;;;
(defun vc-cvs-command (buffer okstatus file &rest flags)
(defun vc-cvs-command (buffer okstatus files &rest flags)
"A wrapper around `vc-do-command' for use in vc-cvs.el.
The difference to vc-do-command is that this function always invokes `cvs',
and that it passes `vc-cvs-global-switches' to it before FLAGS."
(apply 'vc-do-command buffer okstatus "cvs" file
(apply 'vc-do-command buffer okstatus "cvs" files
(if (stringp vc-cvs-global-switches)
(cons vc-cvs-global-switches flags)
(append vc-cvs-global-switches

55
lisp/vc-hg.el
View file

@ -50,29 +50,29 @@
;; - mode-line-string (file) NOT NEEDED
;; - dired-state-info (file) NEEDED
;; STATE-CHANGING FUNCTIONS
;; * register (file &optional rev comment) OK
;; * register (files &optional rev comment) OK
;; - init-version () NOT NEEDED
;; - responsible-p (file) OK
;; - could-register (file) OK
;; - receive-file (file rev) ?? PROBABLY NOT NEEDED
;; - unregister (file) COMMENTED OUT, MAY BE INCORRECT
;; * checkin (file rev comment) OK
;; * checkin (files rev comment) OK
;; * find-version (file rev buffer) OK
;; * checkout (file &optional editable rev) NOT NEEDED, COMMENTED OUT
;; * revert (file &optional contents-done) OK
;; - cancel-version (file editable) ?? PROBABLY NOT NEEDED
;; - rollback (files) ?? PROBABLY NOT NEEDED
;; - merge (file rev1 rev2) NEEDED
;; - merge-news (file) NEEDED
;; - steal-lock (file &optional version) NOT NEEDED
;; HISTORY FUNCTIONS
;; * print-log (file &optional buffer) OK
;; * print-log (files &optional buffer) OK
;; - log-view-mode () OK
;; - show-log-entry (version) NOT NEEDED, DEFAULT IS GOOD
;; - wash-log (file) ??
;; - logentry-check () NOT NEEDED
;; - comment-history (file) NOT NEEDED
;; - update-changelog (files) NOT NEEDED
;; * diff (file &optional rev1 rev2 buffer) OK
;; * diff (files &optional rev1 rev2 buffer) OK
;; - revision-completion-table (file) ??
;; - diff-tree (dir &optional rev1 rev2) TEST IT
;; - annotate-command (file buf &optional rev) OK
@ -125,6 +125,12 @@
:version "22.2"
:group 'vc)
;;; Properties of the backend
(defun vc-hg-revision-granularity ()
'repository)
;;; State querying functions
;;;###autoload (defun vc-hg-registered (file)
@ -191,8 +197,8 @@
;;; History functions
(defun vc-hg-print-log(file &optional buffer)
"Get change log associated with FILE."
(defun vc-hg-print-log(files &optional buffer)
"Get change log associated with FILES."
;; `log-view-mode' needs to have the file name in order to function
;; correctly. "hg log" does not print it, so we insert it here by
;; hand.
@ -205,11 +211,11 @@
(let ((inhibit-read-only t))
(with-current-buffer
buffer
(insert "File: " (file-name-nondirectory file) "\n")))
(insert "File: " (vc-delistify (mapcar (lambda (file) (file-name-nondirectory file)) files)) "\n")))
(vc-hg-command
buffer
(if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0)
file "log"))
files "log"))
(defvar log-view-message-re)
(defvar log-view-file-re)
@ -236,24 +242,25 @@
("^date: \\(.+\\)" (1 'change-log-date))
("^summary:[ \t]+\\(.+\\)" (1 'log-view-message))))))
(defun vc-hg-diff (file &optional oldvers newvers buffer)
"Get a difference report using hg between two versions of FILE."
(let ((working (vc-workfile-version file)))
(defun vc-hg-diff (files &optional oldvers newvers buffer)
"Get a difference report using hg between two versions of FILES."
(let ((working (vc-workfile-version (car files))))
(if (and (equal oldvers working) (not newvers))
(setq oldvers nil))
(if (and (not oldvers) newvers)
(setq oldvers working))
(apply 'call-process "hg" nil (or buffer "*vc-diff*") nil
"--cwd" (file-name-directory file) "diff"
"--cwd" (file-name-directory (car files)) "diff"
(append
(if oldvers
(if newvers
(list "-r" oldvers "-r" newvers)
(list "-r" oldvers))
(list ""))
(list (file-name-nondirectory file))))))
(mapcar (lambda (file) (file-name-nondirectory file)) files)))))
(defalias 'vc-hg-diff-tree 'vc-hg-diff)
(defun vc-hg-diff-tree (file &optional oldvers newvers buffer)
(vc-hg-diff (list file) oldvers newvers buffer))
(defun vc-hg-annotate-command (file buffer &optional version)
"Execute \"hg annotate\" on FILE, inserting the contents in BUFFER.
@ -312,11 +319,15 @@ Optional arg VERSION is a version to annotate from."
"Rename file from OLD to NEW using `hg mv'."
(vc-hg-command nil nil new old "mv"))
(defun vc-hg-register (file &optional rev comment)
"Register FILE under hg.
(defun vc-hg-register (files &optional rev comment)
"Register FILES under hg.
REV is ignored.
COMMENT is ignored."
(vc-hg-command nil nil file "add"))
(vc-hg-command nil nil files "add"))
(defun vc-hg-create-repo ()
"Create a new Mercurial repository."
(vc-do-command nil 0 "svn" '("init")))
(defalias 'vc-hg-responsible-p 'vc-hg-root)
@ -336,10 +347,10 @@ COMMENT is ignored."
;; "Unregister FILE from hg."
;; (vc-hg-command nil nil file "remove"))
(defun vc-hg-checkin (file rev comment)
(defun vc-hg-checkin (files rev comment)
"HG-specific version of `vc-backend-checkin'.
REV is ignored."
(vc-hg-command nil nil file "commit" "-m" comment))
(vc-hg-command nil nil files "commit" "-m" comment))
(defun vc-hg-find-version (file rev buffer)
(let ((coding-system-for-read 'binary)
@ -374,11 +385,11 @@ REV is ignored."
;;; Internal functions
(defun vc-hg-command (buffer okstatus file &rest flags)
(defun vc-hg-command (buffer okstatus file-or-list &rest flags)
"A wrapper around `vc-do-command' for use in vc-hg.el.
The difference to vc-do-command is that this function always invokes `hg',
and that it passes `vc-hg-global-switches' to it before FLAGS."
(apply 'vc-do-command buffer okstatus "hg" file
(apply 'vc-do-command buffer okstatus "hg" file-or-list
(if (stringp vc-hg-global-switches)
(cons vc-hg-global-switches flags)
(append vc-hg-global-switches

85
lisp/vc-mcvs.el
View file

@ -109,6 +109,11 @@ This is only meaningful if you don't use the implicit checkout model
:version "22.1"
:group 'vc)
;;; Properties of the backend
(defun vc-mcvs-revision-granularity ()
'file)
;;;
;;; State-querying functions
;;;
@ -202,13 +207,20 @@ This is only meaningful if you don't use the implicit checkout model
;;; State-changing functions
;;;
(defun vc-mcvs-register (file &optional rev comment)
"Register FILE into the Meta-CVS version-control system.
(defun vc-cvs-create-repo ()
"Create a new CVS repository."
(error "Creation of CVS repositories is not supported."))
(defun vc-mcvs-register (files &optional rev comment)
"Register FILES into the Meta-CVS version-control system.
COMMENT can be used to provide an initial description of FILE.
`vc-register-switches' and `vc-mcvs-register-switches' are passed to
the Meta-CVS command (in that order)."
(let* ((filename (file-name-nondirectory file))
;; FIXME: multiple-file case should be made to work
(if (> (length files) 1) (error "Registering filesets is not yet supported."))
(let* ((file (car files))
(filename (file-name-nondirectory file))
(extpos (string-match "\\." filename))
(ext (if extpos (substring filename (1+ extpos))))
(root (vc-mcvs-root file))
@ -257,7 +269,7 @@ the Meta-CVS command (in that order)."
"Return non-nil if FILE could be registered in Meta-CVS.
This is only possible if Meta-CVS is responsible for FILE's directory.")
(defun vc-mcvs-checkin (file rev comment)
(defun vc-mcvs-checkin (files rev comment)
"Meta-CVS-specific version of `vc-backend-checkin'."
(unless (or (not rev) (vc-mcvs-valid-version-number-p rev))
(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.")
;; This file-specific form of branching is deprecated.
;; We can't use `mcvs branch' and `mcvs switch' because they cannot
;; be applied just to this one file.
(apply 'vc-mcvs-command nil 0 file "tag" "-b" (list rev))
(apply 'vc-mcvs-command nil 0 file "update" "-r" (list rev))
(vc-file-setprop file 'vc-mcvs-sticky-tag rev)
(apply 'vc-mcvs-command nil 0 files "tag" "-b" (list rev))
(apply 'vc-mcvs-command nil 0 files "update" "-r" (list rev))
(mapcar (lambda (file) (vc-file-setprop file 'vc-mcvs-sticky-tag rev))
files)
(setq rev nil)))
;; This commit might cvs-commit several files (e.g. MAP and TYPES)
;; so using numbered revs here is dangerous and somewhat meaningless.
(when rev (error "Cannot commit to a specific revision number"))
(let ((status (apply 'vc-mcvs-command nil 1 file
(let ((status (apply 'vc-mcvs-command nil 1 files
"ci" "-m" comment
(vc-switches 'MCVS 'checkin))))
(set-buffer "*vc*")
@ -283,7 +296,8 @@ This is only possible if Meta-CVS is responsible for FILE's directory.")
;; Check checkin problem.
(cond
((re-search-forward "Up-to-date check failed" nil t)
(vc-file-setprop file 'vc-state 'needs-merge)
(mapcar (lambda (file) (vc-file-setprop file 'vc-state 'needs-merge))
files)
(error (substitute-command-keys
(concat "Up-to-date check failed: "
"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.")
(goto-char (point-min))
(shrink-window-if-larger-than-buffer)
(error "Check-in failed"))))
;; Update file properties
(vc-file-setprop
file 'vc-workfile-version
(vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2))
;; Forget the checkout model of the file, because we might have
;; Single-file commit? Then update the version by parsing the buffer.
;; Otherwise we can't necessarily tell what goes with what; clear
;; its properties so they have to be refetched.
(if (= (length files) 1)
(vc-file-setprop
(car files) 'vc-workfile-version
(vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2))
(mapc (lambda (file) (vc-file-clearprops file)) files))
;; Anyway, forget the checkout model of the file, because we might have
;; guessed wrong when we found the file. After commit, we can
;; tell it from the permissions of the file (see
;; vc-mcvs-checkout-model).
(vc-file-setprop file 'vc-checkout-model nil)
(mapc (lambda (file) (vc-file-setprop file 'vc-checkout-model nil))
files)
;; if this was an explicit check-in (does not include creation of
;; a branch), remove the sticky tag.
(if (and rev (not (vc-mcvs-valid-symbolic-tag-name-p rev)))
(vc-mcvs-command nil 0 file "update" "-A"))))
(vc-mcvs-command nil 0 files "update" "-A"))))
(defun vc-mcvs-find-version (file rev buffer)
(apply 'vc-mcvs-command
@ -421,44 +440,32 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
;;; History functions
;;;
(defun vc-mcvs-print-log (file &optional buffer)
"Get change log associated with FILE."
(let ((default-directory (vc-mcvs-root file)))
(defun vc-mcvs-print-log (files &optional buffer)
"Get change log associated with FILES."
(let ((default-directory (vc-mcvs-root (car files))))
;; Run the command from the root dir so that `mcvs filt' returns
;; valid relative names.
(vc-mcvs-command
buffer
(if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0)
file "log")))
(if (and (vc-stay-local-p files) (fboundp 'start-process)) 'async 0)
files "log")))
(defun vc-mcvs-diff (file &optional oldvers newvers buffer)
"Get a difference report using Meta-CVS between two versions of FILE."
(if (string= (vc-workfile-version file) "0")
;; This file is added but not yet committed; there is no master file.
(if (or oldvers newvers)
(error "No revisions of %s exist" file)
;; We regard this as "changed".
;; Diff it against /dev/null.
;; Note: this is NOT a "mcvs diff".
(apply 'vc-do-command (or buffer "*vc-diff*")
1 "diff" file
(append (vc-switches nil 'diff) '("/dev/null")))
;; Even if it's empty, it's locally modified.
1)
(defun vc-mcvs-diff (files &optional oldvers newvers buffer)
"Get a difference report using Meta-CVS between two versions of FILES."
(let* ((async (and (not vc-disable-async-diff)
(vc-stay-local-p file)
(vc-stay-local-p files)
(fboundp 'start-process)))
;; Run the command from the root dir so that `mcvs filt' returns
;; valid relative names.
(default-directory (vc-mcvs-root file))
(default-directory (vc-mcvs-root (car files)))
(status
(apply 'vc-mcvs-command (or buffer "*vc-diff*")
(if async 'async 1)
file "diff"
files "diff"
(and oldvers (concat "-r" oldvers))
(and newvers (concat "-r" newvers))
(vc-switches 'MCVS 'diff))))
(if async 1 status)))) ; async diff, pessimistic assumption.
(if async 1 status))) ; async diff, pessimistic assumption.
(defun vc-mcvs-diff-tree (dir &optional rev1 rev2)
"Diff all files at and below DIR."

214
lisp/vc-rcs.el
View file

@ -96,6 +96,11 @@ For a description of possible values, see `vc-check-master-templates'."
:group 'vc)
;;; Properties of the backend
(defun vc-rcs-revision-granularity ()
'file)
;;;
;;; State-querying functions
;;;
@ -230,17 +235,23 @@ When VERSION is given, perform check for that version."
;;; State-changing functions
;;;
(defun vc-rcs-register (file &optional rev comment)
"Register FILE into the RCS version-control system.
REV is the optional revision number for the file. COMMENT can be used
to provide an initial description of FILE.
(defun vc-rcs-create-repo ()
"Create a new RCS repository."
;; RCS is totally file-oriented, so all we have to do is make the directory
(make-directory "RCS"))
(defun vc-rcs-register (files &optional rev comment)
"Register FILES into the RCS version-control system.
REV is the optional revision number for the files. COMMENT can be used
to provide an initial description for each FILES.
`vc-register-switches' and `vc-rcs-register-switches' are passed to
the RCS command (in that order).
Automatically retrieve a read-only version of the file with keywords
expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
(let ((subdir (expand-file-name "RCS" (file-name-directory file))))
(let ((subdir (expand-file-name "RCS" (file-name-directory file))))
(dolist (file files)
(and (not (file-exists-p subdir))
(not (directory-files (file-name-directory file)
nil ".*,v$" t))
@ -273,7 +284,7 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
(if (re-search-forward
"^initial revision: \\([0-9.]+\\).*\n"
nil t)
(match-string 1))))))
(match-string 1)))))))
(defun vc-rcs-responsible-p (file)
"Return non-nil if RCS thinks it would be responsible for registering FILE."
@ -307,55 +318,57 @@ whether to remove it."
(yes-or-no-p (format "Directory %s is empty; remove it? " dir))
(delete-directory dir))))
(defun vc-rcs-checkin (file rev comment)
(defun vc-rcs-checkin (files rev comment)
"RCS-specific version of `vc-backend-checkin'."
(let ((switches (vc-switches 'RCS 'checkin)))
(let ((old-version (vc-workfile-version file)) new-version
(default-branch (vc-file-getprop file 'vc-rcs-default-branch)))
;; Force branch creation if an appropriate
;; default branch has been set.
(and (not rev)
default-branch
(string-match (concat "^" (regexp-quote old-version) "\\.")
default-branch)
(setq rev default-branch)
(setq switches (cons "-f" switches)))
(if (and (not rev) old-version)
(setq rev (vc-branch-part old-version)))
(apply 'vc-do-command nil 0 "ci" (vc-name file)
;; if available, use the secure check-in option
(and (vc-rcs-release-p "5.6.4") "-j")
(concat (if vc-keep-workfiles "-u" "-r") rev)
(concat "-m" comment)
switches)
(vc-file-setprop file 'vc-workfile-version nil)
;; Now operate on the files
(dolist (file files)
(let ((old-version (vc-workfile-version file)) new-version
(default-branch (vc-file-getprop file 'vc-rcs-default-branch)))
;; Force branch creation if an appropriate
;; default branch has been set.
(and (not rev)
default-branch
(string-match (concat "^" (regexp-quote old-version) "\\.")
default-branch)
(setq rev default-branch)
(setq switches (cons "-f" switches)))
(if (and (not rev) old-version)
(setq rev (vc-branch-part old-version)))
(apply 'vc-do-command nil 0 "ci" (vc-name file)
;; if available, use the secure check-in option
(and (vc-rcs-release-p "5.6.4") "-j")
(concat (if vc-keep-workfiles "-u" "-r") rev)
(concat "-m" comment)
switches)
(vc-file-setprop file 'vc-workfile-version nil)
;; determine the new workfile version
(set-buffer "*vc*")
(goto-char (point-min))
(when (or (re-search-forward
"new revision: \\([0-9.]+\\);" nil t)
(re-search-forward
"reverting to previous revision \\([0-9.]+\\)" nil t))
(setq new-version (match-string 1))
(vc-file-setprop file 'vc-workfile-version new-version))
;; determine the new workfile version
(set-buffer "*vc*")
(goto-char (point-min))
(when (or (re-search-forward
"new revision: \\([0-9.]+\\);" nil t)
(re-search-forward
"reverting to previous revision \\([0-9.]+\\)" nil t))
(setq new-version (match-string 1))
(vc-file-setprop file 'vc-workfile-version new-version))
;; if we got to a different branch, adjust the default
;; branch accordingly
(cond
((and old-version new-version
(not (string= (vc-branch-part old-version)
(vc-branch-part new-version))))
(vc-rcs-set-default-branch file
(if (vc-trunk-p new-version) nil
(vc-branch-part new-version)))
;; If this is an old RCS release, we might have
;; to remove a remaining lock.
(if (not (vc-rcs-release-p "5.6.2"))
;; exit status of 1 is also accepted.
;; It means that the lock was removed before.
(vc-do-command nil 1 "rcs" (vc-name file)
(concat "-u" old-version))))))))
;; if we got to a different branch, adjust the default
;; branch accordingly
(cond
((and old-version new-version
(not (string= (vc-branch-part old-version)
(vc-branch-part new-version))))
(vc-rcs-set-default-branch file
(if (vc-trunk-p new-version) nil
(vc-branch-part new-version)))
;; If this is an old RCS release, we might have
;; to remove a remaining lock.
(if (not (vc-rcs-release-p "5.6.2"))
;; exit status of 1 is also accepted.
;; It means that the lock was removed before.
(vc-do-command nil 1 "rcs" (vc-name file)
(concat "-u" old-version)))))))))
(defun vc-rcs-find-version (file rev buffer)
(apply 'vc-do-command
@ -427,41 +440,48 @@ whether to remove it."
new-version)))))
(message "Checking out %s...done" file)))))
(defun vc-rcs-rollback (files)
"Roll back, undoing the most recent checkins of FILES."
(if (not files)
(error "RCS backend doesn't support directory-level rollback."))
(dolist (file files)
(let* ((discard (vc-workfile-version file))
(previous (if (vc-trunk-p discard) "" (vc-branch-part discard)))
(config (current-window-configuration))
(done nil))
(if (null (yes-or-no-p (format "Remove version %s from %s history? "
discard file)))
(error "Aborted"))
(message "Removing revision %s from %s." discard file)
(vc-do-command nil 0 "rcs" (vc-name file) (concat "-o" discard))
;; Check out the most recent remaining version. If it
;; fails, because the whole branch got deleted, do a
;; double-take and check out the version where the branch
;; started.
(while (not done)
(condition-case err
(progn
(vc-do-command nil 0 "co" (vc-name file) "-f"
(concat "-u" previous))
(setq done t))
(error (set-buffer "*vc*")
(goto-char (point-min))
(if (search-forward "no side branches present for" nil t)
(progn (setq previous (vc-branch-part previous))
(vc-rcs-set-default-branch file previous)
;; vc-do-command popped up a window with
;; the error message. Get rid of it, by
;; restoring the old window configuration.
(set-window-configuration config))
;; No, it was some other error: re-signal it.
(signal (car err) (cdr err)))))))))
(defun vc-rcs-revert (file &optional contents-done)
"Revert FILE to the version it was based on."
(vc-do-command nil 0 "co" (vc-name file) "-f"
(concat (if (eq (vc-state file) 'edited) "-u" "-r")
(vc-workfile-version file))))
(defun vc-rcs-cancel-version (file editable)
"Undo the most recent checkin of FILE.
EDITABLE non-nil means previous version should be locked."
(let* ((target (vc-workfile-version file))
(previous (if (vc-trunk-p target) "" (vc-branch-part target)))
(config (current-window-configuration))
(done nil))
(vc-do-command nil 0 "rcs" (vc-name file) (concat "-o" target))
;; Check out the most recent remaining version. If it fails, because
;; the whole branch got deleted, do a double-take and check out the
;; version where the branch started.
(while (not done)
(condition-case err
(progn
(vc-do-command nil 0 "co" (vc-name file) "-f"
(concat (if editable "-l" "-u") previous))
(setq done t))
(error (set-buffer "*vc*")
(goto-char (point-min))
(if (search-forward "no side branches present for" nil t)
(progn (setq previous (vc-branch-part previous))
(vc-rcs-set-default-branch file previous)
;; vc-do-command popped up a window with
;; the error message. Get rid of it, by
;; restoring the old window configuration.
(set-window-configuration config))
;; No, it was some other error: re-signal it.
(signal (car err) (cdr err))))))))
(defun vc-rcs-merge (file first-version &optional second-version)
"Merge changes into current working copy of FILE.
The changes are between FIRST-VERSION and SECOND-VERSION."
@ -484,19 +504,38 @@ Needs RCS 5.6.2 or later for -M."
;;; History functions
;;;
(defun vc-rcs-print-log (file &optional buffer)
(defun vc-rcs-print-log (files &optional buffer)
"Get change log associated with FILE."
(vc-do-command buffer 0 "rlog" (vc-name file)))
(vc-do-command buffer 0 "rlog" (mapcar 'vc-name files)))
(defun vc-rcs-diff (file &optional oldvers newvers buffer)
"Get a difference report using RCS between two versions of FILE."
(if (not oldvers) (setq oldvers (vc-workfile-version file)))
(apply 'vc-do-command (or buffer "*vc-diff*") 1 "rcsdiff" file
(defun vc-rcs-diff (files &optional oldvers newvers buffer)
"Get a difference report using RCS between two sets of files."
(apply 'vc-do-command (or buffer "*vc-diff*")
1 ;; Always go synchronous, the repo is local
"rcsdiff" (vc-expand-dirs files)
(append (list "-q"
(concat "-r" oldvers)
(and oldvers (concat "-r" oldvers))
(and newvers (concat "-r" newvers)))
(vc-switches 'RCS 'diff))))
(defun vc-rcs-wash-log ()
"Remove all non-comment information from log output."
(let ((separator (concat "^-+\nrevision [0-9.]+\ndate: .*\n"
"\\(branches: .*;\n\\)?"
"\\(\\*\\*\\* empty log message \\*\\*\\*\n\\)?")))
(goto-char (point-max)) (forward-line -1)
(while (looking-at "=*\n")
(delete-char (- (match-end 0) (match-beginning 0)))
(forward-line -1))
(goto-char (point-min))
(if (looking-at "[\b\t\n\v\f\r ]+")
(delete-char (- (match-end 0) (match-beginning 0))))
(goto-char (point-min))
(re-search-forward separator nil t)
(delete-region (point-min) (point))
(while (re-search-forward separator nil t)
(delete-region (match-beginning 0) (match-end 0)))))
(defun vc-rcs-annotate-command (file buffer &optional revision)
"Annotate FILE, inserting the results in BUFFER.
Optional arg REVISION is a revision to annotate from."
@ -666,7 +705,6 @@ Optional arg REVISION is a revision to annotate from."
" "
(aref rda 0)
ls)
:vc-annotate-prefix t
:vc-rcs-r/d/a rda)))
(maphash
(if all-me

79
lisp/vc-sccs.el
View file

@ -85,6 +85,11 @@ For a description of possible values, see `vc-check-master-templates'."
(defconst vc-sccs-name-assoc-file "VC-names")
;;; Properties of the backend
(defun vc-sccs-revision-granularity ()
'file)
;;;
;;; State-querying functions
;;;
@ -161,16 +166,22 @@ For a description of possible values, see `vc-check-master-templates'."
;;; State-changing functions
;;;
(defun vc-sccs-register (file &optional rev comment)
"Register FILE into the SCCS version-control system.
(defun vc-sccs-create-repo ()
"Create a new SCCS repository."
;; SCCS is totally file-oriented, so all we have to do is make the directory
(make-directory "SCCS"))
(defun vc-sccs-register (files &optional rev comment)
"Register FILES into the SCCS version-control system.
REV is the optional revision number for the file. COMMENT can be used
to provide an initial description of FILE.
to provide an initial description of FILES.
`vc-register-switches' and `vc-sccs-register-switches' are passed to
the SCCS command (in that order).
Automatically retrieve a read-only version of the file with keywords
Automatically retrieve a read-only version of the files with keywords
expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
(dolist (file files)
(let* ((dirname (or (file-name-directory file) ""))
(basename (file-name-nondirectory file))
(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."
(or project-file
(format (car vc-sccs-master-templates) dirname basename))))
(apply 'vc-do-command nil 0 "admin" vc-name
(and rev (concat "-r" rev))
(and rev (not (string= rev "")) (concat "-r" rev))
"-fb"
(concat "-i" (file-relative-name file))
(and comment (concat "-y" comment))
(vc-switches 'SCCS 'register)))
(delete-file file)
(if vc-keep-workfiles
(vc-do-command nil 0 "get" (vc-name file)))))
(vc-do-command nil 0 "get" (vc-name file))))))
(defun vc-sccs-responsible-p (file)
"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."
(stringp (vc-sccs-search-project-dir (or (file-name-directory file) "")
(file-name-nondirectory file)))))
(defun vc-sccs-checkin (file rev comment)
(defun vc-sccs-checkin (files rev comment)
"SCCS-specific version of `vc-backend-checkin'."
(apply 'vc-do-command nil 0 "delta" (vc-name file)
(if rev (concat "-r" rev))
(concat "-y" comment)
(vc-switches 'SCCS 'checkin))
(if vc-keep-workfiles
(vc-do-command nil 0 "get" (vc-name file))))
(dolist (file files)
(apply 'vc-do-command nil 0 "delta" (vc-name file)
(if rev (concat "-r" rev))
(concat "-y" comment)
(vc-switches 'SCCS 'checkin))
(if vc-keep-workfiles
(vc-do-command nil 0 "get" (vc-name file)))))
(defun vc-sccs-find-version (file rev buffer)
(apply 'vc-do-command
@ -242,6 +254,19 @@ locked. REV is the revision to check out."
switches))))
(message "Checking out %s...done" file)))
(defun vc-sccs-cancel-version (files)
"Roll back, undoing the most recent checkins of FILES."
(if (not files)
(error "SCCS backend doesn't support directory-level rollback."))
(dolist (file files)
(let ((discard (vc-workfile-version file)))
(if (null (yes-or-no-p (format "Remove version %s from %s history? "
discard file)))
(error "Aborted"))
(message "Removing revision %s from %s..." discard file)
(vc-do-command nil 0 "rmdel" (vc-name file) (concat "-r" discard))
(vc-do-command nil 0 "get" (vc-name file) nil))))
(defun vc-sccs-revert (file &optional contents-done)
"Revert FILE to the version it was based on."
(vc-do-command nil 0 "unget" (vc-name file))
@ -251,16 +276,6 @@ locked. REV is the revision to check out."
;; vc-workfile-version is cleared here so that it gets recomputed.
(vc-file-setprop file 'vc-workfile-version nil))
(defun vc-sccs-cancel-version (file editable)
"Undo the most recent checkin of FILE.
EDITABLE non-nil means previous version should be locked."
(vc-do-command nil 0 "rmdel"
(vc-name file)
(concat "-r" (vc-workfile-version file)))
(vc-do-command nil 0 "get"
(vc-name file)
(if editable "-e")))
(defun vc-sccs-steal-lock (file &optional rev)
"Steal the lock on the current workfile for FILE and revision REV."
(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."
;;; History functions
;;;
(defun vc-sccs-print-log (file &optional buffer)
"Get change log associated with FILE."
(vc-do-command buffer 0 "prs" (vc-name file)))
(defun vc-sccs-print-log (files &optional buffer)
"Get change log associated with FILES."
(vc-do-command buffer 0 "prs" (mapcar 'vc-name files)))
(defun vc-sccs-wash-log ()
"Remove all non-comment information from log output."
;; FIXME: not implemented for SCCS
nil)
(defun vc-sccs-logentry-check ()
"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."
(goto-char 512)
(error "Log must be less than 512 characters; point is now at pos 512")))
(defun vc-sccs-diff (file &optional oldvers newvers buffer)
"Get a difference report using SCCS between two versions of FILE."
(defun vc-sccs-diff (files &optional oldvers newvers buffer)
"Get a difference report using SCCS between two filesets."
(setq oldvers (vc-sccs-lookup-triple file oldvers))
(setq newvers (vc-sccs-lookup-triple file newvers))
(apply 'vc-do-command (or buffer "*vc-diff*") 1 "vcdiff" (vc-name file)
(apply 'vc-do-command (or buffer "*vc-diff*")
1 "vcdiff" (mapcar 'vc-name (vc-expand-dirs files))
(append (list "-q"
(and oldvers (concat "-r" oldvers))
(and newvers (concat "-r" newvers)))

77
lisp/vc-svn.el
View file

@ -96,6 +96,10 @@ If you want to force an empty list of arguments, use t."
(t ".svn"))
"The name of the \".svn\" subdirectory or its equivalent.")
;;; Properties of the backend
(defun vc-svn-revision-granularity ()
'repository)
;;;
;;; State-querying functions
;;;
@ -206,13 +210,19 @@ If you want to force an empty list of arguments, use t."
;;; State-changing functions
;;;
(defun vc-svn-register (file &optional rev comment)
"Register FILE into the SVN version-control system.
COMMENT can be used to provide an initial description of FILE.
(defun vc-svn-create-repo ()
"Create a new SVN repository."
(vc-do-command nil 0 "svnadmin" '("create" "SVN"))
(vc-do-command nil 0 "svn" '(".")
"checkout" (concat "file://" default-directory "SVN")))
(defun vc-svn-register (files &optional rev comment)
"Register FILES into the SVN version-control system.
The COMMENT argument is ignored This does an add but not a commit.
`vc-register-switches' and `vc-svn-register-switches' are passed to
the SVN command (in that order)."
(apply 'vc-svn-command nil 0 file "add" (vc-switches 'SVN 'register)))
(apply 'vc-svn-command nil 0 files "add" (vc-switches 'SVN 'register)))
(defun vc-svn-responsible-p (file)
"Return non-nil if SVN thinks it is responsible for FILE."
@ -225,10 +235,11 @@ the SVN command (in that order)."
"Return non-nil if FILE could be registered in SVN.
This is only possible if SVN is responsible for FILE's directory.")
(defun vc-svn-checkin (file rev comment)
(defun vc-svn-checkin (files rev comment)
"SVN-specific version of `vc-backend-checkin'."
(if rev (error "Committing to a specific revision is unsupported in SVN."))
(let ((status (apply
'vc-svn-command nil 1 file "ci"
'vc-svn-command nil 1 files "ci"
(nconc (list "-m" comment) (vc-switches 'SVN 'checkin)))))
(set-buffer "*vc*")
(goto-char (point-min))
@ -236,7 +247,8 @@ This is only possible if SVN is responsible for FILE's directory.")
;; Check checkin problem.
(cond
((search-forward "Transaction is out of date" nil t)
(vc-file-setprop file 'vc-state 'needs-merge)
(mapc (lambda (file) (vc-file-setprop file 'vc-state 'needs-merge))
files)
(error (substitute-command-keys
(concat "Up-to-date check failed: "
"type \\[vc-next-action] to merge in changes"))))
@ -252,6 +264,7 @@ This is only possible if SVN is responsible for FILE's directory.")
))
(defun vc-svn-find-version (file rev buffer)
"SVN-specific retrieval of a specified version into a buffer."
(apply 'vc-svn-command
buffer 0 file
"cat"
@ -362,53 +375,41 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
;;; History functions
;;;
(defun vc-svn-print-log (file &optional buffer)
"Get change log associated with FILE."
(defun vc-svn-print-log (files &optional buffer)
"Get change log(s) associated with FILES."
(save-current-buffer
(vc-setup-buffer buffer)
(let ((inhibit-read-only t))
(goto-char (point-min))
;; Add a line to tell log-view-mode what file this is.
(insert "Working file: " (file-relative-name file) "\n"))
(insert "Working file(s): " (vc-delistify (mapcar 'file-relative-name files)) "\n"))
(vc-svn-command
buffer
(if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0)
file "log"
(if (and (= (length files) 1) (vc-stay-local-p (car files)) (fboundp 'start-process)) 'async 0)
files "log"
;; By default Subversion only shows the log upto the working version,
;; whereas we also want the log of the subsequent commits. At least
;; that's what the vc-cvs.el code does.
"-rHEAD:0")))
"-rHEAD:0"))))
(defun vc-svn-diff (file &optional oldvers newvers buffer)
"Get a difference report using SVN between two versions of FILE."
(unless buffer (setq buffer "*vc-diff*"))
(if (and oldvers (equal oldvers (vc-workfile-version file)))
;; Use nil rather than the current revision because svn handles it
;; better (i.e. locally).
(setq oldvers nil))
(if (string= (vc-workfile-version file) "0")
;; This file is added but not yet committed; there is no master file.
(if (or oldvers newvers)
(error "No revisions of %s exist" file)
;; We regard this as "changed".
;; Diff it against /dev/null.
;; Note: this is NOT a "svn diff".
(apply 'vc-do-command buffer
1 "diff" file
(append (vc-switches nil 'diff) '("/dev/null")))
;; Even if it's empty, it's locally modified.
1)
(let* ((switches
(defun vc-svn-wash-log ()
"Remove all non-comment information from log output."
;; FIXME: not implemented for SVN
nil)
(defun vc-svn-diff (files &optional oldvers newvers buffer)
"Get a difference report using SVN between two versions of fileset FILES."
(let* ((switches
(if vc-svn-diff-switches
(vc-switches 'SVN 'diff)
(list "-x" (mapconcat 'identity (vc-switches nil 'diff) " "))))
(async (and (not vc-disable-async-diff)
(vc-stay-local-p file)
(vc-stay-local-p files)
(or oldvers newvers) ; Svn diffs those locally.
(fboundp 'start-process))))
(apply 'vc-svn-command buffer
(if async 'async 0)
file "diff"
files "diff"
(append
switches
(when oldvers
@ -417,7 +418,7 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
(if async 1 ; async diff => pessimistic assumption
;; For some reason `svn diff' does not return a useful
;; status w.r.t whether the diff was empty or not.
(buffer-size (get-buffer buffer))))))
(buffer-size (get-buffer buffer)))))
(defun vc-svn-diff-tree (dir &optional rev1 rev2)
"Diff all files at and below DIR."
@ -469,11 +470,11 @@ NAME is assumed to be a URL."
:type 'string
:group 'vc)
(defun vc-svn-command (buffer okstatus file &rest flags)
(defun vc-svn-command (buffer okstatus file-or-list &rest flags)
"A wrapper around `vc-do-command' for use in vc-svn.el.
The difference to vc-do-command is that this function always invokes `svn',
and that it passes `vc-svn-global-switches' to it before FLAGS."
(apply 'vc-do-command buffer okstatus vc-svn-program file
(apply 'vc-do-command buffer okstatus vc-svn-program file-or-list
(if (stringp vc-svn-global-switches)
(cons vc-svn-global-switches flags)
(append vc-svn-global-switches

207
lisp/vc.el
View file

@ -101,6 +101,12 @@
;; with `vc-sys-'. Some of the functions are mandatory (marked with a
;; `*'), others are optional (`-').
;;
;; BACKEND PROPERTIES
;;
;; * revision-granularity
;;
;; Takes no arguments. Returns either 'file or 'repository.
;;
;; STATE-QUERYING FUNCTIONS
;;
;; * registered (file)
@ -171,12 +177,20 @@
;;
;; STATE-CHANGING FUNCTIONS
;;
;; * register (file &optional rev comment)
;; * create-repo (backend)
;;
;; Register FILE in this backend. Optionally, an initial revision REV
;; and an initial description of the file, COMMENT, may be specified.
;; Create an empty repository in the current directory and initialize
;; it so VC mode can add files to it. For file-oriented systems, this
;; need do no more than create a subdirectory with the right name.
;;
;; * register (files &optional rev comment)
;;
;; Register FILES in this backend. Optionally, an initial revision REV
;; and an initial description of the file, COMMENT, may be specified,
;; but it is not guaranteed that the backend will do anything with this.
;; The implementation should pass the value of vc-register-switches
;; to the backend command.
;; to the backend command. (Note: in older versions of VC, this
;; command took a single file argument and not a list.)
;;
;; - init-version (file)
;;
@ -210,12 +224,14 @@
;; Unregister FILE from this backend. This is only needed if this
;; backend may be used as a "more local" backend for temporary editing.
;;
;; * checkin (file rev comment)
;; * checkin (files rev comment)
;;
;; Commit changes in FILE to this backend. If REV is non-nil, that
;; should become the new revision number. COMMENT is used as a
;; check-in comment. The implementation should pass the value of
;; vc-checkin-switches to the backend command.
;; Commit changes in FILES to this backend. If REV is non-nil, that
;; should become the new revision number (not all backends do
;; anything with it). COMMENT is used as a check-in comment. The
;; implementation should pass the value of vc-checkin-switches to
;; the backend command. (Note: in older versions of VC, this
;; command took a single file argument and not a list.)
;;
;; * find-version (file rev buffer)
;;
@ -242,13 +258,14 @@
;; already been reverted from a version backup, and this function
;; only needs to update the status of FILE within the backend.
;;
;; - rollback (file editable)
;; - rollback (files)
;;
;; Cancel the current workfile version of FILE, i.e. remove it from the
;; master. EDITABLE non-nil means that FILE should be writable
;; afterwards, and if locking is used for FILE, then a lock should also
;; be set. If this function is not provided, trying to cancel a
;; version is caught as an error.
;; Remove the tip version of each of FILES from the repository. If
;; this function is not provided, trying to cancel a version is
;; caught as an error. (Most backends don't provide it.) (Also
;; note that older versions of this backend command were called
;; 'cancel-version' and took a single file arg, not a list of
;; files.)
;;
;; - merge (file rev1 rev2)
;;
@ -267,10 +284,11 @@
;;
;; HISTORY FUNCTIONS
;;
;; * print-log (file &optional buffer)
;; * print-log (files &optional buffer)
;;
;; Insert the revision log of FILE into BUFFER, or the *vc* buffer
;; if BUFFER is nil.
;; Insert the revision log for FILES into BUFFER, or the *vc* buffer
;; if BUFFER is nil. (Note: older versions of this function expected
;; only a single file argument.)
;;
;; - log-view-mode ()
;;
@ -976,9 +994,15 @@ Else, add CODE to the process' sentinel."
Each function is called inside the buffer in which the command was run
and is passed 3 arguments: the COMMAND, the FILE and the FLAGS.")
(defun vc-delistify (filelist)
"Smash a FILELIST into a file list string suitable for info messages."
(cond ((not filelist) ".")
((= (length filelist) 1) (car filelist))
(t (concat (car filelist) " " (vc-delistify (cdr filelist))))))
(defvar w32-quote-process-args)
;;;###autoload
(defun vc-do-command (buffer okstatus command file &rest flags)
(defun vc-do-command (buffer okstatus command file-or-list &rest flags)
"Execute a VC command, notifying user and checking for errors.
Output from COMMAND goes to BUFFER, or *vc* if BUFFER is nil or the
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
considered successful if its exit status does not exceed OKSTATUS (if
OKSTATUS is nil, that means to ignore error status, if it is `async', that
means not to wait for termination of the subprocess; if it is t it means to
ignore all execution errors). FILE is the
name of the working file (may also be nil, to execute commands that
don't expect a file name). If an optional list of FLAGS is present,
ignore all execution errors). FILE-OR-LIST is the name of a working file;
it may be a list of files or be nil (to execute commands that don't expect
a file name or set of files). If an optional list of FLAGS is present,
that is inserted into the command line before the filename."
(and file (setq file (expand-file-name file)))
(if vc-command-messages
(message "Running %s on %s..." command file))
(save-current-buffer
(unless (or (eq buffer t)
(and (stringp buffer)
(string= (buffer-name) buffer))
(eq buffer (current-buffer)))
(vc-setup-buffer buffer))
(let ((squeezed (remq nil flags))
(inhibit-read-only t)
(status 0))
(when file
;; FIXME: file-relative-name can return a bogus result because
;; it doesn't look at the actual file-system to see if symlinks
;; come into play.
(setq squeezed (append squeezed (list (file-relative-name file)))))
(let ((exec-path (append vc-path exec-path))
;; Add vc-path to PATH for the execution of this command.
(process-environment
(cons (concat "PATH=" (getenv "PATH")
path-separator
(mapconcat 'identity vc-path path-separator))
process-environment))
(w32-quote-process-args t))
(if (and (eq okstatus 'async) (file-remote-p default-directory))
;; start-process does not support remote execution
(setq okstatus nil))
(if (eq okstatus 'async)
(let ((proc
(let ((process-connection-type nil))
(apply 'start-process command (current-buffer) command
squeezed))))
(unless (active-minibuffer-window)
(message "Running %s in the background..." command))
;;(set-process-sentinel proc (lambda (p msg) (delete-process p)))
(set-process-filter proc 'vc-process-filter)
(vc-exec-after
`(unless (active-minibuffer-window)
(message "Running %s in the background... done" ',command))))
(let ((buffer-undo-list t))
(setq status (apply 'process-file command nil t nil squeezed)))
(when (and (not (eq t okstatus))
(or (not (integerp status))
(and okstatus (< okstatus status))))
(pop-to-buffer (current-buffer))
(goto-char (point-min))
(shrink-window-if-larger-than-buffer)
(error "Running %s...FAILED (%s)" command
(if (integerp status) (format "status %d" status) status))))
(if vc-command-messages
(message "Running %s...OK" command)))
(vc-exec-after
`(run-hook-with-args 'vc-post-command-functions ',command ',file ',flags))
status)))
;; FIXME: file-relative-name can return a bogus result because
;; it doesn't look at the actual file-system to see if symlinks
;; come into play.
(let* ((files
(mapcar 'file-relative-name
(cond ((not file-or-list) '())
((listp file-or-list) (mapcar 'expand-file-name file-or-list))
(t (list (expand-file-name file-or-list))))))
(full-command
(concat command " " (vc-delistify flags) " " (vc-delistify files))))
(if vc-command-messages
(message "Running %s..." full-command))
(save-current-buffer
(unless (or (eq buffer t)
(and (stringp buffer)
(string= (buffer-name) buffer))
(eq buffer (current-buffer)))
(vc-setup-buffer buffer))
(let ((squeezed (remq nil flags))
(inhibit-read-only t)
(status 0))
(when files
(setq squeezed (nconc squeezed files)))
(let ((exec-path (append vc-path exec-path))
;; Add vc-path to PATH for the execution of this command.
(process-environment
(cons (concat "PATH=" (getenv "PATH")
path-separator
(mapconcat 'identity vc-path path-separator))
process-environment))
(w32-quote-process-args t))
(if (and (eq okstatus 'async) (file-remote-p default-directory))
;; start-process does not support remote execution
(setq okstatus nil))
(if (eq okstatus 'async)
(let ((proc
(let ((process-connection-type nil))
(apply 'start-process command (current-buffer) command
squeezed))))
(unless (active-minibuffer-window)
(message "Running %s in the background..." full-command))
;;(set-process-sentinel proc (lambda (p msg) (delete-process p)))
(set-process-filter proc 'vc-process-filter)
(vc-exec-after
`(unless (active-minibuffer-window)
(message "Running %s in the background... done" ',full-command))))
(let ((buffer-undo-list t))
(setq status (apply 'process-file command nil t nil squeezed)))
(when (and (not (eq t okstatus))
(or (not (integerp status))
(and okstatus (< okstatus status))))
(pop-to-buffer (current-buffer))
(goto-char (point-min))
(shrink-window-if-larger-than-buffer)
(error "Running %s...FAILED (%s)" full-command
(if (integerp status) (format "status %d" status) status))))
(if vc-command-messages
(message "Running %s...OK" full-command)))
(vc-exec-after
`(run-hook-with-args 'vc-post-command-functions ',command ',file-or-list ',flags))
status))))
(defun vc-position-context (posn)
"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."
(message "Registering %s... " file)
(let ((backend (vc-responsible-backend file t)))
(vc-file-clearprops file)
(vc-call-backend backend 'register file rev comment)
(vc-call-backend backend 'register (list file) rev comment)
(vc-file-setprop file 'vc-backend backend)
(unless vc-make-backup-files
(make-local-variable 'backup-inhibited)
@ -1520,6 +1550,14 @@ The default is to return nil always."
The default implementation returns t for all files."
t)
(defun vc-expand-dirs (file-or-dir-list)
"Expands directories in a file list specification.
Only files already under version control are noticed."
(let ((flattened '()))
(dolist (node file-or-dir-list)
(vc-file-tree-walk node (lambda (f) (if (vc-backend f) (setq flattened (cons f flattened))))))
(nreverse flattened)))
(defun vc-resynch-window (file &optional keep noquery)
"If FILE is in the current buffer, either revert or unvisit it.
The choice between revert (to see expanded keywords) and unvisit depends on
@ -1676,7 +1714,7 @@ Runs the normal hook `vc-checkin-hook'."
;; Change buffers to get local value of vc-checkin-switches.
(with-current-buffer (or (get-file-buffer file) (current-buffer))
(progn
(vc-call checkin file rev comment)
(vc-call checkin (list file) rev comment)
(vc-delete-automatic-version-backups file)))
`((vc-state . up-to-date)
(vc-checkout-time . ,(nth 5 (file-attributes file)))
@ -1896,7 +1934,7 @@ actually call the backend, but performs a local diff."
(error "diff failed"))
(if (not vc-diff-knows-L) (setq vc-diff-knows-L 'yes)))
status)
(vc-call diff file rev1 rev2))))
(vc-call diff (list file) rev1 rev2))))
(defun vc-switches (backend op)
(let ((switches
@ -2480,7 +2518,7 @@ If FOCUS-REV is non-nil, leave the point at that revision."
(not (eq (caddr err) 2)))
(signal (car err) (cdr err))
;; for backward compatibility
(vc-call print-log file)
(vc-call print-log (list file))
(set-buffer "*vc*"))))
(pop-to-buffer (current-buffer))
(vc-exec-after
@ -2659,9 +2697,8 @@ return its name; otherwise return nil."
(vc-resynch-buffer file t t))
;;;###autoload
(defun vc-rollback (norevert)
"Get rid of most recently checked in version of this file.
A prefix argument NOREVERT means do not revert the buffer afterwards."
(defun vc-rollback ()
"Get rid of most recently checked in version of this file."
(interactive "P")
(vc-ensure-vc-buffer)
(let* ((file buffer-file-name)
@ -2682,7 +2719,7 @@ A prefix argument NOREVERT means do not revert the buffer afterwards."
(message "Removing last change from %s..." file)
(with-vc-properties
file
(vc-call rollback file norevert)
(vc-call rollback (list file))
`((vc-state . ,(if norevert 'edited 'up-to-date))
(vc-checkout-time . ,(if norevert
0