mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-28 07:45:00 +00:00
Code Issues Releases Activity

Convert vc-bzr-async-command into a general vc-do-async-command facility.

Browse Source 
* vc/vc-dispatcher.el (vc-do-async-command): New function.

* vc/vc-bzr.el (vc-bzr-async-command): Convert into a wrapper for
vc-do-async-command.

* vc/vc-bzr.el (vc-bzr-pull, vc-bzr-merge-branch): Callers changed.
This commit is contained in:
Chong Yidong 2011-01-28 18:10:55 -05:00
parent 54b6f6edb8
commit 9bfe578343
3 changed files with 57 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
lisp/ChangeLog
View File

@ -1,7 +1,17 @@
2011-01-28 Chong Yidong <cyd@stupidchicken.com>
* vc/vc-dispatcher.el (vc-do-async-command): New function.
* vc/vc-bzr.el (vc-bzr-async-command): Convert into a wrapper for
vc-do-async-command.
* vc/vc-bzr.el (vc-bzr-pull, vc-bzr-merge-branch): Callers
changed.
2011-01-28 Leo <sdl.web@gmail.com>
* emacs-lisp/advice.el (ad-make-advised-docstring): Don't apply
highlighting to the "this function is advisted" message.
highlighting to the "this function is advised" message.
* help-mode.el (help-mode-finish): Apply highlighting here, to
avoid clobbering by substitute-command-keys (Bug#6304).

47
lisp/vc/vc-bzr.el
View File

@ -94,6 +94,20 @@ Invoke the bzr command adding `BZR_PROGRESS_BAR=none' and
(apply 'vc-do-command (or buffer "*vc*") okstatus vc-bzr-program
file-or-list bzr-command args)))
(defun vc-bzr-async-command (bzr-command &rest args)
"Wrapper round `vc-do-async-command' using `vc-bzr-program' as COMMAND.
Invoke the bzr command adding `BZR_PROGRESS_BAR=none' and
`LC_MESSAGES=C' to the environment.
Use the current Bzr root directory as the ROOT argument to
`vc-do-async-command', and specify an output buffer named
\"*vc-bzr : ROOT*\"."
(let* ((process-environment
(list* "BZR_PROGRESS_BAR=none" "LC_MESSAGES=C"
process-environment))
(root (vc-bzr-root default-directory))
(buffer (format "*vc-bzr : %s*" (expand-file-name root))))
(apply 'vc-do-async-command buffer root
vc-bzr-program bzr-command args)))
;;;###autoload
(defconst vc-bzr-admin-dirname ".bzr"
@ -261,31 +275,6 @@ Invoke the bzr command adding `BZR_PROGRESS_BAR=none' and
(when rootdir
(file-relative-name filename* rootdir))))
(defun vc-bzr-async-command (command args)
"Run Bzr COMMAND asynchronously with ARGS, displaying the result.
Send the output to a buffer named \"*vc-bzr : NAME*\", where NAME
is the root of the current Bzr branch. Display the buffer in
some window, but don't select it."
;; TODO: set up hyperlinks.
(let* ((dir default-directory)
(root (vc-bzr-root default-directory))
(buffer (get-buffer-create
(format "*vc-bzr : %s*"
(expand-file-name root)))))
(with-current-buffer buffer
(setq default-directory root)
(goto-char (point-max))
(unless (eq (point) (point-min))
(insert " \n"))
(insert "Running \"" vc-bzr-program " " command)
(dolist (arg args)
(insert " " arg))
(insert "\"...\n")
;; Run bzr in the original working directory.
(let ((default-directory dir))
(apply 'vc-bzr-command command t 'async nil args)))
(display-buffer buffer)))
(defun vc-bzr-pull (prompt)
"Pull changes into the current Bzr branch.
Normally, this runs \"bzr pull\". However, if the branch is a
@ -315,7 +304,7 @@ prompt for the Bzr command to run."
(setq vc-bzr-program (car args)
command (cadr args)
args (cddr args)))
(vc-bzr-async-command command args)))
(apply 'vc-bzr-async-command command args)))
(defun vc-bzr-merge-branch ()
"Merge another Bzr branch into the current one.
@ -324,8 +313,8 @@ source (an upstream branch or a previous merge source) as a
default if it is available."
(let* ((branch-conf (vc-bzr--branch-conf default-directory))
;; "bzr merge" without an argument defaults to submit_branch,
;; then parent_location. We extract the specific location
;; and add it explicitly to the command line.
;; then parent_location. Extract the specific location and
;; add it explicitly to the command line.
(location
(cond
((string-match
@ -347,7 +336,7 @@ default if it is available."
(vc-bzr-program (car cmd))
(command (cadr cmd))
(args (cddr cmd)))
(vc-bzr-async-command command args)))
(apply 'vc-bzr-async-command command args)))
(defun vc-bzr-status (file)
"Return FILE status according to Bzr.

28
lisp/vc/vc-dispatcher.el
View File

@ -356,6 +356,34 @@ case, and the process object in the asynchronous case."
',command ',file-or-list ',flags))
status))))
(defun vc-do-async-command (buffer root command &rest args)
"Run COMMAND asynchronously with ARGS, displaying the result.
Send the output to BUFFER, which should be a buffer or the name
of a buffer, which is created.
ROOT should be the directory in which the command should be run.
Display the buffer in some window, but don't select it."
(let* ((dir default-directory)
window new-window-start)
(setq buffer (get-buffer-create buffer))
(if (get-buffer-process buffer)
(error "Another VC action on %s is running" root))
(with-current-buffer buffer
(setq default-directory root)
(goto-char (point-max))
(unless (eq (point) (point-min))
(insert " \n"))
(setq new-window-start (point))
(insert "Running \"" command " ")
(dolist (arg args)
(insert " " arg))
(insert "\"...\n")
;; Run in the original working directory.
(let ((default-directory dir))
(apply 'vc-do-command t 'async command nil args)))
(setq window (display-buffer buffer))
(if window
(set-window-start window new-window-start))))
;; These functions are used to ensure that the view the user sees is up to date
;; even if the dispatcher client mode has messed with file contents (as in,
;; for example, VCS keyword expansion).