[Emacs-diffs] /srv/bzr/emacs/trunk r103355: Improvements to vc-bzr conffile handling and pull/merge support.

[Chong Yidong]

------------------------------------------------------------
revno: 103355
committer: Chong Yidong <address@hidden>
branch nick: trunk
timestamp: Sat 2011-02-19 16:23:51 -0500
message:
  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.
modified:
  lisp/ChangeLog
  lisp/progmodes/compile.el
  lisp/vc/vc-bzr.el
  lisp/vc/vc-dispatcher.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2011-02-19 20:44:34 +0000
+++ b/lisp/ChangeLog    2011-02-19 21:23:51 +0000
@@ -1,3 +1,20 @@
+2011-02-19  Chong Yidong  <address@hidden>
+
+       * 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  <address@hidden>
 
        * mail/rmailmm.el (rmail-mime-find-header-encoding): Be sure to

=== modified file 'lisp/progmodes/compile.el'
--- a/lisp/progmodes/compile.el 2011-02-02 17:14:49 +0000
+++ b/lisp/progmodes/compile.el 2011-02-19 21:23:51 +0000
@@ -838,6 +838,7 @@
    ((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))))

=== modified file 'lisp/vc/vc-bzr.el'
--- a/lisp/vc/vc-bzr.el 2011-02-14 01:49:24 +0000
+++ b/lisp/vc/vc-bzr.el 2011-02-19 21:23:51 +0000
@@ -141,12 +141,20 @@
       (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 @@
     (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 @@
 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 @@
       (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 @@
         (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.

=== modified file 'lisp/vc/vc-dispatcher.el'
--- a/lisp/vc/vc-dispatcher.el  2011-01-29 21:19:21 +0000
+++ b/lisp/vc/vc-dispatcher.el  2011-02-19 21:23:51 +0000
@@ -363,6 +363,7 @@
 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)