diff options
| author | Chong Yidong | 2011-02-19 16:23:51 -0500 |
|---|---|---|
| committer | Chong Yidong | 2011-02-19 16:23:51 -0500 |
| commit | 3ab713fdac16ef6ae249b3da69d69e78361f6792 (patch) | |
| tree | f2a9c266e5e20e2d67269d06bc80f35348cdd24a | |
| parent | cad7445b369d55101bf94537292a1142359de60f (diff) | |
| download | emacs-3ab713fdac16ef6ae249b3da69d69e78361f6792.tar.gz emacs-3ab713fdac16ef6ae249b3da69d69e78361f6792.zip | |
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.
| -rw-r--r-- | lisp/ChangeLog | 17 | ||||
| -rw-r--r-- | lisp/progmodes/compile.el | 1 | ||||
| -rw-r--r-- | lisp/vc/vc-bzr.el | 79 | ||||
| -rw-r--r-- | lisp/vc/vc-dispatcher.el | 1 |
4 files changed, 72 insertions, 26 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 26823aa6bcb..e0255ceb90c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,20 @@ | |||
| 1 | 2011-02-19 Chong Yidong <cyd@stupidchicken.com> | ||
| 2 | |||
| 3 | * vc/vc-bzr.el (vc-bzr--branch-conf): Function deleted. | ||
| 4 | (vc-bzr-branch-conf): New function, similar to vc-bzr--branch-conf | ||
| 5 | but returning an alist. Ignore comments in bzr conffile. | ||
| 6 | (vc-bzr-pull, vc-bzr-merge-branch): Use vc-bzr-branch-conf. | ||
| 7 | (vc-bzr-error-regex-alist): New var. | ||
| 8 | (vc-bzr-merge-branch): Use it to highlight the pull/merge buffer. | ||
| 9 | |||
| 10 | * vc/vc-dispatcher.el (vc-do-async-command): Bind | ||
| 11 | inhibit-read-only to t. | ||
| 12 | |||
| 13 | * progmodes/compile.el (compilation--flush-directory-cache): | ||
| 14 | Handle the case where cdr of compilation--flush-directory-cache | ||
| 15 | points to no buffer, which can occur if we previously switched to | ||
| 16 | compilation-mode in a pregenerated buffer. | ||
| 17 | |||
| 1 | 2011-02-19 Kenichi Handa <handa@m17n.org> | 18 | 2011-02-19 Kenichi Handa <handa@m17n.org> |
| 2 | 19 | ||
| 3 | * mail/rmailmm.el (rmail-mime-find-header-encoding): Be sure to | 20 | * mail/rmailmm.el (rmail-mime-find-header-encoding): Be sure to |
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index b41eb82e27d..88f418f934a 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el | |||
| @@ -838,6 +838,7 @@ POS and RES.") | |||
| 838 | ((or (not compilation--previous-directory-cache) | 838 | ((or (not compilation--previous-directory-cache) |
| 839 | (<= (car compilation--previous-directory-cache) start))) | 839 | (<= (car compilation--previous-directory-cache) start))) |
| 840 | ((or (not (cdr compilation--previous-directory-cache)) | 840 | ((or (not (cdr compilation--previous-directory-cache)) |
| 841 | (null (marker-buffer (cdr compilation--previous-directory-cache))) | ||
| 841 | (<= (cdr compilation--previous-directory-cache) start)) | 842 | (<= (cdr compilation--previous-directory-cache) start)) |
| 842 | (set-marker (car compilation--previous-directory-cache) start)) | 843 | (set-marker (car compilation--previous-directory-cache) start)) |
| 843 | (t (setq compilation--previous-directory-cache nil)))) | 844 | (t (setq compilation--previous-directory-cache nil)))) |
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index a36fdc60d15..5e6e054924c 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el | |||
| @@ -141,12 +141,20 @@ Use the current Bzr root directory as the ROOT argument to | |||
| 141 | (let ((root (vc-find-root file vc-bzr-admin-checkout-format-file))) | 141 | (let ((root (vc-find-root file vc-bzr-admin-checkout-format-file))) |
| 142 | (when root (vc-file-setprop file 'bzr-root root))))) | 142 | (when root (vc-file-setprop file 'bzr-root root))))) |
| 143 | 143 | ||
| 144 | (defun vc-bzr--branch-conf (file) | 144 | (defun vc-bzr-branch-conf (file) |
| 145 | "Return the Bzr branch config for file FILE, as a string." | 145 | "Return the Bazaar branch settings for file FILE, as an alist. |
| 146 | (with-temp-buffer | 146 | Each element of the returned alist has the form (NAME . VALUE), |
| 147 | (insert-file-contents | 147 | which are the name and value of a Bazaar setting, as strings. |
| 148 | (expand-file-name vc-bzr-admin-branchconf (vc-bzr-root file))) | 148 | |
| 149 | (buffer-string))) | 149 | The settings are read from the file \".bzr/branch/branch.conf\" |
| 150 | in the repository root directory of FILE." | ||
| 151 | (let (settings) | ||
| 152 | (with-temp-buffer | ||
| 153 | (insert-file-contents | ||
| 154 | (expand-file-name vc-bzr-admin-branchconf (vc-bzr-root file))) | ||
| 155 | (while (re-search-forward "^\\([^#=][^=]*?\\) *= *\\(.*\\)$" nil t) | ||
| 156 | (push (cons (match-string 1) (match-string 2)) settings))) | ||
| 157 | settings)) | ||
| 150 | 158 | ||
| 151 | (require 'sha1) ;For sha1-program | 159 | (require 'sha1) ;For sha1-program |
| 152 | 160 | ||
| @@ -276,6 +284,13 @@ Use the current Bzr root directory as the ROOT argument to | |||
| 276 | (when rootdir | 284 | (when rootdir |
| 277 | (file-relative-name filename* rootdir)))) | 285 | (file-relative-name filename* rootdir)))) |
| 278 | 286 | ||
| 287 | (defvar vc-bzr-error-regex-alist | ||
| 288 | '(("^\\( M[* ]\\|+N \\|-D \\|\\| \\*\\|R[M ] \\) \\(.+\\)" 2 nil nil 1) | ||
| 289 | ("^C \\(.+\\)" 2) | ||
| 290 | ("^Text conflict in \\(.+\\)" 1 nil nil 2) | ||
| 291 | ("^Using saved parent location: \\(.+\\)" 1 nil nil 0)) | ||
| 292 | "Value of `compilation-error-regexp-alist' in *vc-bzr* buffers.") | ||
| 293 | |||
| 279 | (defun vc-bzr-pull (prompt) | 294 | (defun vc-bzr-pull (prompt) |
| 280 | "Pull changes into the current Bzr branch. | 295 | "Pull changes into the current Bzr branch. |
| 281 | Normally, this runs \"bzr pull\". However, if the branch is a | 296 | 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 | |||
| 283 | location from which to pull or update, or if PROMPT is non-nil, | 298 | location from which to pull or update, or if PROMPT is non-nil, |
| 284 | prompt for the Bzr command to run." | 299 | prompt for the Bzr command to run." |
| 285 | (let* ((vc-bzr-program vc-bzr-program) | 300 | (let* ((vc-bzr-program vc-bzr-program) |
| 286 | (branch-conf (vc-bzr--branch-conf default-directory)) | 301 | (branch-conf (vc-bzr-branch-conf default-directory)) |
| 287 | ;; Check whether the branch is bound. | 302 | ;; Check whether the branch is bound. |
| 288 | (bound (string-match "^bound\\s-*=\\s-*True" branch-conf)) | 303 | (bound (assoc "bound" branch-conf)) |
| 304 | (bound (and bound (equal "true" (downcase (cdr bound))))) | ||
| 289 | ;; If we need to do a "bzr pull", check for a parent. If it | 305 | ;; If we need to do a "bzr pull", check for a parent. If it |
| 290 | ;; does not exist, bzr will need a pull location. | 306 | ;; does not exist, bzr will need a pull location. |
| 291 | (parent (unless bound | 307 | (has-parent (unless bound |
| 292 | (string-match | 308 | (assoc "parent_location" branch-conf))) |
| 293 | "^parent_location\\s-*=\\s-*[^\n[:space:]]+" | ||
| 294 | branch-conf))) | ||
| 295 | (command (if bound "update" "pull")) | 309 | (command (if bound "update" "pull")) |
| 296 | args) | 310 | args) |
| 297 | ;; If necessary, prompt for the exact command. | 311 | ;; If necessary, prompt for the exact command. |
| 298 | (when (or prompt (not (or bound parent))) | 312 | (when (or prompt (not (or bound has-parent))) |
| 299 | (setq args (split-string | 313 | (setq args (split-string |
| 300 | (read-shell-command | 314 | (read-shell-command |
| 301 | "Bzr pull command: " | 315 | "Bzr pull command: " |
| @@ -305,28 +319,33 @@ prompt for the Bzr command to run." | |||
| 305 | (setq vc-bzr-program (car args) | 319 | (setq vc-bzr-program (car args) |
| 306 | command (cadr args) | 320 | command (cadr args) |
| 307 | args (cddr args))) | 321 | args (cddr args))) |
| 308 | (vc-set-async-update | 322 | (let ((buf (apply 'vc-bzr-async-command command args))) |
| 309 | (apply 'vc-bzr-async-command command args)))) | 323 | (with-current-buffer buf |
| 324 | (vc-exec-after | ||
| 325 | `(progn | ||
| 326 | (let ((compilation-error-regexp-alist | ||
| 327 | vc-bzr-error-regex-alist)) | ||
| 328 | (compilation-mode)) | ||
| 329 | (set (make-local-variable 'compilation-error-regexp-alist) | ||
| 330 | vc-bzr-error-regex-alist)))) | ||
| 331 | (vc-set-async-update buf)))) | ||
| 310 | 332 | ||
| 311 | (defun vc-bzr-merge-branch () | 333 | (defun vc-bzr-merge-branch () |
| 312 | "Merge another Bzr branch into the current one. | 334 | "Merge another Bzr branch into the current one. |
| 313 | Prompt for the Bzr command to run, providing a pre-defined merge | 335 | Prompt for the Bzr command to run, providing a pre-defined merge |
| 314 | source (an upstream branch or a previous merge source) as a | 336 | source (an upstream branch or a previous merge source) as a |
| 315 | default if it is available." | 337 | default if it is available." |
| 316 | (let* ((branch-conf (vc-bzr--branch-conf default-directory)) | 338 | (let* ((branch-conf (vc-bzr-branch-conf default-directory)) |
| 317 | ;; "bzr merge" without an argument defaults to submit_branch, | 339 | ;; "bzr merge" without an argument defaults to submit_branch, |
| 318 | ;; then parent_location. Extract the specific location and | 340 | ;; then parent_location. Extract the specific location and |
| 319 | ;; add it explicitly to the command line. | 341 | ;; add it explicitly to the command line. |
| 342 | (setting nil) | ||
| 320 | (location | 343 | (location |
| 321 | (cond | 344 | (cond |
| 322 | ((string-match | 345 | ((setq setting (assoc "submit_branch" branch-conf)) |
| 323 | "^submit_branch\\s-*=\\s-*\\(?:file://\\)?\\([^\n[:space:]]+\\)$" | 346 | (cdr setting)) |
| 324 | branch-conf) | 347 | ((setq setting (assoc "parent_location" branch-conf)) |
| 325 | (match-string 1 branch-conf)) | 348 | (cdr setting)))) |
| 326 | ((string-match | ||
| 327 | "^parent_location\\s-*=\\s-*\\(?:file://\\)?\\([^\n[:space:]]+\\)$" | ||
| 328 | branch-conf) | ||
| 329 | (match-string 1 branch-conf)))) | ||
| 330 | (cmd | 349 | (cmd |
| 331 | (split-string | 350 | (split-string |
| 332 | (read-shell-command | 351 | (read-shell-command |
| @@ -338,8 +357,16 @@ default if it is available." | |||
| 338 | (vc-bzr-program (car cmd)) | 357 | (vc-bzr-program (car cmd)) |
| 339 | (command (cadr cmd)) | 358 | (command (cadr cmd)) |
| 340 | (args (cddr cmd))) | 359 | (args (cddr cmd))) |
| 341 | (vc-set-async-update | 360 | (let ((buf (apply 'vc-bzr-async-command command args))) |
| 342 | (apply 'vc-bzr-async-command command args)))) | 361 | (with-current-buffer buf |
| 362 | (vc-exec-after | ||
| 363 | `(progn | ||
| 364 | (let ((compilation-error-regexp-alist | ||
| 365 | vc-bzr-error-regex-alist)) | ||
| 366 | (compilation-mode)) | ||
| 367 | (set (make-local-variable 'compilation-error-regexp-alist) | ||
| 368 | vc-bzr-error-regex-alist)))) | ||
| 369 | (vc-set-async-update buf)))) | ||
| 343 | 370 | ||
| 344 | (defun vc-bzr-status (file) | 371 | (defun vc-bzr-status (file) |
| 345 | "Return FILE status according to Bzr. | 372 | "Return FILE status according to Bzr. |
diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el index c4e0dbfadac..388d4c94a08 100644 --- a/lisp/vc/vc-dispatcher.el +++ b/lisp/vc/vc-dispatcher.el | |||
| @@ -363,6 +363,7 @@ of a buffer, which is created. | |||
| 363 | ROOT should be the directory in which the command should be run. | 363 | ROOT should be the directory in which the command should be run. |
| 364 | Display the buffer in some window, but don't select it." | 364 | Display the buffer in some window, but don't select it." |
| 365 | (let* ((dir default-directory) | 365 | (let* ((dir default-directory) |
| 366 | (inhibit-read-only t) | ||
| 366 | window new-window-start) | 367 | window new-window-start) |
| 367 | (setq buffer (get-buffer-create buffer)) | 368 | (setq buffer (get-buffer-create buffer)) |
| 368 | (if (get-buffer-process buffer) | 369 | (if (get-buffer-process buffer) |