mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-29 07:58:28 +00:00
Improvements to vc-bzr conffile handling and pull/merge support.
* vc/vc-bzr.el (vc-bzr--branch-conf): Function deleted. (vc-bzr-branch-conf): New function, similar to vc-bzr--branch-conf but returning an alist. Ignore comments in bzr conffile. (vc-bzr-pull, vc-bzr-merge-branch): Use vc-bzr-branch-conf. (vc-bzr-error-regex-alist): New var. (vc-bzr-merge-branch): Use it to highlight the pull/merge buffer. * progmodes/compile.el (compilation--flush-directory-cache): Handle the case where cdr of compilation--flush-directory-cache points to no buffer, which can occur if we previously switched to compilation-mode in a pregenerated buffer. * vc/vc-dispatcher.el (vc-do-async-command): Bind inhibit-read-only to t.
This commit is contained in:
parent
cad7445b36
commit
3ab713fdac
@ -1,3 +1,20 @@
|
||||
2011-02-19 Chong Yidong <cyd@stupidchicken.com>
|
||||
|
||||
* vc/vc-bzr.el (vc-bzr--branch-conf): Function deleted.
|
||||
(vc-bzr-branch-conf): New function, similar to vc-bzr--branch-conf
|
||||
but returning an alist. Ignore comments in bzr conffile.
|
||||
(vc-bzr-pull, vc-bzr-merge-branch): Use vc-bzr-branch-conf.
|
||||
(vc-bzr-error-regex-alist): New var.
|
||||
(vc-bzr-merge-branch): Use it to highlight the pull/merge buffer.
|
||||
|
||||
* vc/vc-dispatcher.el (vc-do-async-command): Bind
|
||||
inhibit-read-only to t.
|
||||
|
||||
* progmodes/compile.el (compilation--flush-directory-cache):
|
||||
Handle the case where cdr of compilation--flush-directory-cache
|
||||
points to no buffer, which can occur if we previously switched to
|
||||
compilation-mode in a pregenerated buffer.
|
||||
|
||||
2011-02-19 Kenichi Handa <handa@m17n.org>
|
||||
|
||||
* mail/rmailmm.el (rmail-mime-find-header-encoding): Be sure to
|
||||
|
@ -838,6 +838,7 @@ POS and RES.")
|
||||
((or (not compilation--previous-directory-cache)
|
||||
(<= (car compilation--previous-directory-cache) start)))
|
||||
((or (not (cdr compilation--previous-directory-cache))
|
||||
(null (marker-buffer (cdr compilation--previous-directory-cache)))
|
||||
(<= (cdr compilation--previous-directory-cache) start))
|
||||
(set-marker (car compilation--previous-directory-cache) start))
|
||||
(t (setq compilation--previous-directory-cache nil))))
|
||||
|
@ -141,12 +141,20 @@ Use the current Bzr root directory as the ROOT argument to
|
||||
(let ((root (vc-find-root file vc-bzr-admin-checkout-format-file)))
|
||||
(when root (vc-file-setprop file 'bzr-root root)))))
|
||||
|
||||
(defun vc-bzr--branch-conf (file)
|
||||
"Return the Bzr branch config for file FILE, as a string."
|
||||
(with-temp-buffer
|
||||
(insert-file-contents
|
||||
(expand-file-name vc-bzr-admin-branchconf (vc-bzr-root file)))
|
||||
(buffer-string)))
|
||||
(defun vc-bzr-branch-conf (file)
|
||||
"Return the Bazaar branch settings for file FILE, as an alist.
|
||||
Each element of the returned alist has the form (NAME . VALUE),
|
||||
which are the name and value of a Bazaar setting, as strings.
|
||||
|
||||
The settings are read from the file \".bzr/branch/branch.conf\"
|
||||
in the repository root directory of FILE."
|
||||
(let (settings)
|
||||
(with-temp-buffer
|
||||
(insert-file-contents
|
||||
(expand-file-name vc-bzr-admin-branchconf (vc-bzr-root file)))
|
||||
(while (re-search-forward "^\\([^#=][^=]*?\\) *= *\\(.*\\)$" nil t)
|
||||
(push (cons (match-string 1) (match-string 2)) settings)))
|
||||
settings))
|
||||
|
||||
(require 'sha1) ;For sha1-program
|
||||
|
||||
@ -276,6 +284,13 @@ Use the current Bzr root directory as the ROOT argument to
|
||||
(when rootdir
|
||||
(file-relative-name filename* rootdir))))
|
||||
|
||||
(defvar vc-bzr-error-regex-alist
|
||||
'(("^\\( M[* ]\\|+N \\|-D \\|\\| \\*\\|R[M ] \\) \\(.+\\)" 2 nil nil 1)
|
||||
("^C \\(.+\\)" 2)
|
||||
("^Text conflict in \\(.+\\)" 1 nil nil 2)
|
||||
("^Using saved parent location: \\(.+\\)" 1 nil nil 0))
|
||||
"Value of `compilation-error-regexp-alist' in *vc-bzr* buffers.")
|
||||
|
||||
(defun vc-bzr-pull (prompt)
|
||||
"Pull changes into the current Bzr branch.
|
||||
Normally, this runs \"bzr pull\". However, if the branch is a
|
||||
@ -283,19 +298,18 @@ bound branch, run \"bzr update\" instead. If there is no default
|
||||
location from which to pull or update, or if PROMPT is non-nil,
|
||||
prompt for the Bzr command to run."
|
||||
(let* ((vc-bzr-program vc-bzr-program)
|
||||
(branch-conf (vc-bzr--branch-conf default-directory))
|
||||
(branch-conf (vc-bzr-branch-conf default-directory))
|
||||
;; Check whether the branch is bound.
|
||||
(bound (string-match "^bound\\s-*=\\s-*True" branch-conf))
|
||||
(bound (assoc "bound" branch-conf))
|
||||
(bound (and bound (equal "true" (downcase (cdr bound)))))
|
||||
;; If we need to do a "bzr pull", check for a parent. If it
|
||||
;; does not exist, bzr will need a pull location.
|
||||
(parent (unless bound
|
||||
(string-match
|
||||
"^parent_location\\s-*=\\s-*[^\n[:space:]]+"
|
||||
branch-conf)))
|
||||
(has-parent (unless bound
|
||||
(assoc "parent_location" branch-conf)))
|
||||
(command (if bound "update" "pull"))
|
||||
args)
|
||||
;; If necessary, prompt for the exact command.
|
||||
(when (or prompt (not (or bound parent)))
|
||||
(when (or prompt (not (or bound has-parent)))
|
||||
(setq args (split-string
|
||||
(read-shell-command
|
||||
"Bzr pull command: "
|
||||
@ -305,28 +319,33 @@ prompt for the Bzr command to run."
|
||||
(setq vc-bzr-program (car args)
|
||||
command (cadr args)
|
||||
args (cddr args)))
|
||||
(vc-set-async-update
|
||||
(apply 'vc-bzr-async-command command args))))
|
||||
(let ((buf (apply 'vc-bzr-async-command command args)))
|
||||
(with-current-buffer buf
|
||||
(vc-exec-after
|
||||
`(progn
|
||||
(let ((compilation-error-regexp-alist
|
||||
vc-bzr-error-regex-alist))
|
||||
(compilation-mode))
|
||||
(set (make-local-variable 'compilation-error-regexp-alist)
|
||||
vc-bzr-error-regex-alist))))
|
||||
(vc-set-async-update buf))))
|
||||
|
||||
(defun vc-bzr-merge-branch ()
|
||||
"Merge another Bzr branch into the current one.
|
||||
Prompt for the Bzr command to run, providing a pre-defined merge
|
||||
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))
|
||||
(let* ((branch-conf (vc-bzr-branch-conf default-directory))
|
||||
;; "bzr merge" without an argument defaults to submit_branch,
|
||||
;; then parent_location. Extract the specific location and
|
||||
;; add it explicitly to the command line.
|
||||
(setting nil)
|
||||
(location
|
||||
(cond
|
||||
((string-match
|
||||
"^submit_branch\\s-*=\\s-*\\(?:file://\\)?\\([^\n[:space:]]+\\)$"
|
||||
branch-conf)
|
||||
(match-string 1 branch-conf))
|
||||
((string-match
|
||||
"^parent_location\\s-*=\\s-*\\(?:file://\\)?\\([^\n[:space:]]+\\)$"
|
||||
branch-conf)
|
||||
(match-string 1 branch-conf))))
|
||||
((setq setting (assoc "submit_branch" branch-conf))
|
||||
(cdr setting))
|
||||
((setq setting (assoc "parent_location" branch-conf))
|
||||
(cdr setting))))
|
||||
(cmd
|
||||
(split-string
|
||||
(read-shell-command
|
||||
@ -338,8 +357,16 @@ default if it is available."
|
||||
(vc-bzr-program (car cmd))
|
||||
(command (cadr cmd))
|
||||
(args (cddr cmd)))
|
||||
(vc-set-async-update
|
||||
(apply 'vc-bzr-async-command command args))))
|
||||
(let ((buf (apply 'vc-bzr-async-command command args)))
|
||||
(with-current-buffer buf
|
||||
(vc-exec-after
|
||||
`(progn
|
||||
(let ((compilation-error-regexp-alist
|
||||
vc-bzr-error-regex-alist))
|
||||
(compilation-mode))
|
||||
(set (make-local-variable 'compilation-error-regexp-alist)
|
||||
vc-bzr-error-regex-alist))))
|
||||
(vc-set-async-update buf))))
|
||||
|
||||
(defun vc-bzr-status (file)
|
||||
"Return FILE status according to Bzr.
|
||||
|
@ -363,6 +363,7 @@ 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)
|
||||
(inhibit-read-only t)
|
||||
window new-window-start)
|
||||
(setq buffer (get-buffer-create buffer))
|
||||
(if (get-buffer-process buffer)
|
||||
|
Loading…
Reference in New Issue
Block a user