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

Remove assumption about what nil means as a first arument to vc-do-command.

Browse source
This commit is contained in:
Eric S. Raymond 2008-05-10 13:27:16 +00:00
parent b3fccc2715
commit 2888a97eb5
12 changed files with 65 additions and 50 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
lisp/ChangeLog
View file

@ -7,6 +7,24 @@
* vc-dispatcher.el (vc-dir-next-directory, vc-dir-prev-directory):
New functions implementing motion to next and previous directory.
* vc-arch.el (vc-arch-command),
vc-bzr.el (vc-bzr-command),
vc-cvs.el (vc-cvs-command),
vc-dispatcher.el (vc-do-command),
vc-git.el (vc-git-command),
vc-hg.el (vc-hg-command),
vc-mcvs.el (vc-mvcs-command),
vc-mtn.el (vc-mtn-command),
vc-sccs.el (vc-sccs-command, vc-sccs-workfile,
vc-sccs-workfile-unchanged-p),
vc-svn.el (vc-svn-command, vc-svn-create-repo),
vc-rcs.el (all methods):
Remove assumption about what a nil argument to vc-do-command
means. This means no buffer name needs to be hardcoded into the
dispatcher layer, and it's better to be explicit anyway.
vc-svn.el (vc-svn-dir-state-heuristic): Removed.
2008-05-10 Dan Nicolaescu <dann@ics.uci.edu>
* vc.el: Update todo.

2
lisp/vc-arch.el
View file

@ -426,7 +426,7 @@ Return non-nil if FILE is unchanged."
(defun vc-arch-command (buffer okstatus file &rest flags)
"A wrapper around `vc-do-command' for use in vc-arch.el."
(apply 'vc-do-command buffer okstatus vc-arch-command file flags))
(apply 'vc-do-command (or buffer "*vc*") okstatus vc-arch-command file flags))
(defun vc-arch-init-revision () nil)

2
lisp/vc-bzr.el
View file

@ -92,7 +92,7 @@ Invoke the bzr command adding `BZR_PROGRESS_BAR=none' and
(list* "BZR_PROGRESS_BAR=none" ; Suppress progress output (bzr >=0.9)
"LC_MESSAGES=C" ; Force English output
process-environment)))
(apply 'vc-do-command buffer okstatus vc-bzr-program
(apply 'vc-do-command (or buffer "*vc*") okstatus vc-bzr-program
file-or-list bzr-command args)))

2
lisp/vc-cvs.el
View file

@ -695,7 +695,7 @@ If UPDATE is non-nil, then update (resynch) any affected buffers."
"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" files
(apply 'vc-do-command (or buffer "*vc*") okstatus "cvs" files
(if (stringp vc-cvs-global-switches)
(cons vc-cvs-global-switches flags)
(append vc-cvs-global-switches

21
lisp/vc-dispatcher.el
View file

@ -286,15 +286,16 @@ and is passed 3 arguments: the COMMAND, the FILES and the FLAGS.")
;;;###autoload
(defun vc-do-command (buffer okstatus command file-or-list &rest flags)
"Execute a slave 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
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-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,
Output from COMMAND goes to BUFFER, or the current buffer if
BUFFER is t. If the destination buffer is not 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-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."
;; FIXME: file-relative-name can return a bogus result because
;; it doesn't look at the actual file-system to see if symlinks
@ -318,7 +319,7 @@ that is inserted into the command line before the filename."
(and (stringp buffer)
(string= (buffer-name) buffer))
(eq buffer (current-buffer)))
(vc-setup-buffer (or buffer "*vc*")))
(vc-setup-buffer buffer))
;; If there's some previous async process still running, just kill it.
(let ((oldproc (get-buffer-process (current-buffer))))
;; If we wanted to wait for oldproc to finish before doing

2
lisp/vc-git.el
View file

@ -695,7 +695,7 @@ This command shares argument histories with \\[rgrep] and \\[grep]."
(defun vc-git-command (buffer okstatus file-or-list &rest flags)
"A wrapper around `vc-do-command' for use in vc-git.el.
The difference to vc-do-command is that this function always invokes `git'."
(apply 'vc-do-command buffer okstatus "git" file-or-list flags))
(apply 'vc-do-command (or buffer "*vc*") okstatus "git" file-or-list flags))
(defun vc-git--empty-db-p ()
"Check if the git db is empty (no commit done yet)."

2
lisp/vc-hg.el
View file

@ -551,7 +551,7 @@ REV is the revision to check out into WORKFILE."
"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-or-list
(apply 'vc-do-command (or buffer "*vc*") okstatus "hg" file-or-list
(if (stringp vc-hg-global-switches)
(cons vc-hg-global-switches flags)
(append vc-hg-global-switches

4
lisp/vc-mcvs.el
View file

@ -533,13 +533,13 @@ and that it passes `vc-mcvs-global-switches' to it before FLAGS."
(append vc-mcvs-global-switches flags)))))
(if (not (member (car flags) '("diff" "log" "status")))
;; No need to filter: do it the easy way.
(apply 'vc-do-command buffer okstatus "mcvs" file args)
(apply 'vc-do-command (or buffer "*vc*") okstatus "mcvs" file args)
;; We need to filter the output.
;; The output of the filter uses filenames relative to the root,
;; so we need to change the default-directory.
;; (assert (equal default-directory (vc-mcvs-root file)))
(vc-do-command
buffer okstatus "sh" nil "-c"
(or buffer "*vc*") okstatus "sh" nil "-c"
(concat "mcvs "
(mapconcat
'shell-quote-argument

2
lisp/vc-mtn.el
View file

@ -70,7 +70,7 @@
(let ((process-environment
;; Avoid localization of messages so we can parse the output.
(cons "LC_MESSAGES=C" process-environment)))
(apply 'vc-do-command buffer okstatus vc-mtn-command files flags)))
(apply 'vc-do-command (or buffer "*vc*") okstatus vc-mtn-command files flags)))
(defun vc-mtn-state (file)
;; If `mtn' fails or returns status>0, or if the search files, just

40
lisp/vc-rcs.el
View file

@ -236,12 +236,12 @@ When VERSION is given, perform check for that version."
;; do a double take and remember the fact for the future
(let* ((version (concat "-r" (vc-working-revision file)))
(status (if (eq vc-rcsdiff-knows-brief 'no)
(vc-do-command nil 1 "rcsdiff" file version)
(vc-do-command nil 2 "rcsdiff" file "--brief" version))))
(vc-do-command "*vc*" 1 "rcsdiff" file version)
(vc-do-command "*vc*" 2 "rcsdiff" file "--brief" version))))
(if (eq status 2)
(if (not vc-rcsdiff-knows-brief)
(setq vc-rcsdiff-knows-brief 'no
status (vc-do-command nil 1 "rcsdiff" file version))
status (vc-do-command "*vc*" 1 "rcsdiff" file version))
(error "rcsdiff failed"))
(if (not vc-rcsdiff-knows-brief) (setq vc-rcsdiff-knows-brief 'yes)))
;; The workfile is unchanged if rcsdiff found no differences.
@ -284,7 +284,7 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
nil ".*,v$" t))
(yes-or-no-p "Create RCS subdirectory? ")
(make-directory subdir))
(apply 'vc-do-command nil 0 "ci" file
(apply 'vc-do-command "*vc*" 0 "ci" file
;; if available, use the secure registering option
(and (vc-rcs-release-p "5.6.4") "-i")
(concat (if vc-keep-workfiles "-u" "-r") rev)
@ -362,7 +362,7 @@ whether to remove it."
(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)
(apply 'vc-do-command "*vc*" 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)
@ -394,12 +394,12 @@ whether to remove it."
(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)
(vc-do-command "*vc*" 1 "rcs" (vc-name file)
(concat "-u" old-version)))))))))
(defun vc-rcs-find-revision (file rev buffer)
(apply 'vc-do-command
buffer 0 "co" (vc-name file)
(or buffer "*vc*") 0 "co" (vc-name file)
"-q" ;; suppress diagnostic output
(concat "-p" rev)
(vc-switches 'RCS 'checkout)))
@ -431,7 +431,7 @@ attempt the checkout for all registered files beneath it."
(vc-rcs-set-default-branch file nil))
;; now do the checkout
(apply 'vc-do-command
nil 0 "co" (vc-name file)
"*vc*" 0 "co" (vc-name file)
;; If locking is not strict, force to overwrite
;; the writable workfile.
(if (eq (vc-rcs-checkout-model (list file)) 'implicit) "-f")
@ -484,7 +484,7 @@ expanded to all regidtered subfuiles in them."
discard file)))
(error "Aborted"))
(message "Removing revision %s from %s." discard file)
(vc-do-command nil 0 "rcs" (vc-name file) (concat "-o" discard))
(vc-do-command "*vc*" 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
@ -492,7 +492,7 @@ expanded to all regidtered subfuiles in them."
(while (not done)
(condition-case err
(progn
(vc-do-command nil 0 "co" (vc-name file) "-f"
(vc-do-command "*vc*" 0 "co" (vc-name file) "-f"
(concat "-u" previous))
(setq done t))
(error (set-buffer "*vc*")
@ -512,14 +512,14 @@ expanded to all regidtered subfuiles in them."
revert all registered files beneath it."
(if (file-directory-p file)
(mapc 'vc-rcs-revert (vc-expand-dirs (list file)))
(vc-do-command nil 0 "co" (vc-name file) "-f"
(vc-do-command "*vc*" 0 "co" (vc-name file) "-f"
(concat (if (eq (vc-state file) 'edited) "-u" "-r")
(vc-working-revision file)))))
(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."
(vc-do-command nil 1 "rcsmerge" (vc-name file)
(vc-do-command "*vc*" 1 "rcsmerge" (vc-name file)
"-kk" ; ignore keyword conflicts
(concat "-r" first-version)
(if second-version (concat "-r" second-version))))
@ -530,16 +530,16 @@ If FUILEis a directory, steal the lock on all registered files beneath it.
Needs RCS 5.6.2 or later for -M."
(if (file-directory-p file)
(mapc 'vc-rcs-steal-lock (vc-expand-dirs (list file)))
(vc-do-command nil 0 "rcs" (vc-name file) "-M" (concat "-u" rev))
(vc-do-command "*vc*" 0 "rcs" (vc-name file) "-M" (concat "-u" rev))
;; Do a real checkout after stealing the lock, so that we see
;; expanded headers.
(vc-do-command nil 0 "co" (vc-name file) "-f" (concat "-l" rev))))
(vc-do-command "*vc*" 0 "co" (vc-name file) "-f" (concat "-l" rev))))
(defun vc-rcs-modify-change-comment (files rev comment)
"Modify the change comments change on FILES on a specified REV. If FILE is a
directory the operation is applied to all registered files beneath it."
(dolist (file (vc-expand-dirs files))
(vc-do-command nil 0 "rcs" (vc-name file)
(vc-do-command "*vc*" 0 "rcs" (vc-name file)
(concat "-m" rev ":" comment))))
@ -550,7 +550,7 @@ directory the operation is applied to all registered files beneath it."
(defun vc-rcs-print-log (files &optional buffer)
"Get change log associated with FILE. If FILE is a
directory the operation is applied to all registered files beneath it."
(vc-do-command buffer 0 "rlog" (mapcar 'vc-name (vc-expand-dirs files))))
(vc-do-command (or buffer "*vc*") 0 "rlog" (mapcar 'vc-name (vc-expand-dirs files))))
(defun vc-rcs-diff (files &optional oldvers newvers buffer)
"Get a difference report using RCS between two sets of files."
@ -792,7 +792,7 @@ systime, or nil if there is none. Also, reposition point."
(defun vc-rcs-assign-name (file name)
"Assign to FILE's latest version a given NAME."
(vc-do-command nil 0 "rcs" (vc-name file) (concat "-n" name ":")))
(vc-do-command "*vc*" 0 "rcs" (vc-name file) (concat "-n" name ":")))
;;;
@ -1063,18 +1063,18 @@ If the user has not set variable `vc-rcs-release' and it is nil,
variable `vc-rcs-release' is set to the returned value."
(or vc-rcs-release
(setq vc-rcs-release
(or (and (zerop (vc-do-command nil nil "rcs" nil "-V"))
(or (and (zerop (vc-do-command "*vc*" nil "rcs" nil "-V"))
(with-current-buffer (get-buffer "*vc*")
(vc-parse-buffer "^RCS version \\([0-9.]+ *.*\\)" 1)))
'unknown))))
(defun vc-rcs-set-non-strict-locking (file)
(vc-do-command nil 0 "rcs" file "-U")
(vc-do-command "*vc*" 0 "rcs" file "-U")
(vc-file-setprop file 'vc-checkout-model 'implicit)
(set-file-modes file (logior (file-modes file) 128)))
(defun vc-rcs-set-default-branch (file branch)
(vc-do-command nil 0 "rcs" (vc-name file) (concat "-b" branch))
(vc-do-command "*vc*" 0 "rcs" (vc-name file) (concat "-b" branch))
(vc-file-setprop file 'vc-rcs-default-branch branch))
(defun vc-rcs-parse (&optional buffer)

4
lisp/vc-sccs.el
View file

@ -180,7 +180,7 @@ For a description of possible values, see `vc-check-master-templates'."
(defun vc-sccs-workfile-unchanged-p (file)
"SCCS-specific implementation of `vc-workfile-unchanged-p'."
(zerop (apply 'vc-do-command nil 1 "vcdiff" (vc-name file)
(zerop (apply 'vc-do-command "*vc*" 1 "vcdiff" (vc-name file)
(list "--brief" "-q"
(concat "-r" (vc-working-revision file))))))
@ -192,7 +192,7 @@ For a description of possible values, see `vc-check-master-templates'."
(defun vc-sccs-do-command (buffer okstatus command file-or-list &rest flags)
;; (let ((load-path (append vc-sccs-path load-path)))
;; (apply 'vc-do-command buffer okstatus command file-or-list flags))
(apply 'vc-do-command buffer okstatus "sccs" file-or-list command flags))
(apply 'vc-do-command (or buffer "*vc*") okstatus "sccs" file-or-list command flags))
(defun vc-sccs-create-repo ()
"Create a new SCCS repository."

16
lisp/vc-svn.el
View file

@ -208,8 +208,8 @@ RESULT is a list of conses (FILE . STATE) for directory DIR."
(defun vc-svn-create-repo ()
"Create a new SVN repository."
(vc-do-command nil 0 "svnadmin" '("create" "SVN"))
(vc-do-command nil 0 "svn" '(".")
(vc-do-command "*vc*" 0 "svnadmin" '("create" "SVN"))
(vc-do-command "*vc*" 0 "svn" '(".")
"checkout" (concat "file://" default-directory "SVN")))
(defun vc-svn-register (files &optional rev comment)
@ -389,17 +389,17 @@ or svn+ssh://."
;; Repository Root is a local file.
(progn
(unless (vc-do-command
nil 0 "svnadmin" nil
"*vc*" 0 "svnadmin" nil
"setlog" "--bypass-hooks" directory
"-r" rev (format "%s" tempfile))
(error "Log edit failed"))
(delete-file tempfile))
;; Remote repository, using svn+ssh.
(unless (vc-do-command nil 0 "scp" nil "-q" tempfile remotefile)
(unless (vc-do-command "*vc*" 0 "scp" nil "-q" tempfile remotefile)
(error "Copy of comment to %s failed" remotefile))
(unless (vc-do-command
nil 0 "ssh" nil "-q" host
"*vc*" 0 "ssh" nil "-q" host
(format "svnadmin setlog --bypass-hooks %s -r %s %s; rm %s"
directory rev tempfile tempfile))
(error "Log edit failed")))))
@ -517,7 +517,7 @@ NAME is assumed to be a URL."
"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-or-list
(apply 'vc-do-command (or buffer "*vc*") okstatus vc-svn-program file-or-list
(if (stringp vc-svn-global-switches)
(cons vc-svn-global-switches flags)
(append vc-svn-global-switches
@ -625,10 +625,6 @@ information about FILENAME and return its status."
(t 'edited)))))
(if filename (vc-file-getprop filename 'vc-state))))
(defun vc-svn-dir-state-heuristic (dir)
"Find the SVN state of all files in DIR, using only local information."
(vc-svn-dir-state dir 'local))
(defun vc-svn-valid-symbolic-tag-name-p (tag)
"Return non-nil if TAG is a valid symbolic tag name."
;; According to the SVN manual, a valid symbolic tag must start with