]> code.delx.au - gnu-emacs/blobdiff - lisp/vc/vc-bzr.el
Merge from emacs-24; up to 2012-12-17T11:17:34Z!rgm@gnu.org
[gnu-emacs] / lisp / vc / vc-bzr.el
index ce4d76dc5f2da599161bcffef1f44429efca0694..d0912cb719cf69111455fa1a938e3a08b173f8cb 100644 (file)
@@ -1,6 +1,6 @@
 ;;; vc-bzr.el --- VC backend for the bzr revision control system  -*- lexical-binding: t -*-
 
-;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
 
 ;; Author: Dave Love <fx@gnu.org>
 ;;        Riccardo Murri <riccardo.murri@gmail.com>
@@ -150,12 +150,6 @@ Use the current Bzr root directory as the ROOT argument to
 (defconst vc-bzr-admin-branchconf
   (concat vc-bzr-admin-dirname "/branch/branch.conf"))
 
-;;;###autoload (defun vc-bzr-registered (file)
-;;;###autoload   (if (vc-find-root file vc-bzr-admin-checkout-format-file)
-;;;###autoload       (progn
-;;;###autoload         (load "vc-bzr")
-;;;###autoload         (vc-bzr-registered file))))
-
 (defun vc-bzr-root (file)
   "Return the root directory of the bzr repository containing FILE."
   ;; Cache technique copied from vc-arch.el.
@@ -291,6 +285,14 @@ in the repository root directory of FILE."
          (message "Falling back on \"slow\" status detection (%S)" err)
          (vc-bzr-state file))))))
 
+;; This is a cheap approximation that is autoloaded.  If it finds a
+;; possible match it loads this file and runs the real function.
+;; It requires vc-bzr-admin-checkout-format-file to be autoloaded too.
+;;;###autoload (defun vc-bzr-registered (file)
+;;;###autoload   (if (vc-find-root file vc-bzr-admin-checkout-format-file)
+;;;###autoload       (progn
+;;;###autoload         (load "vc-bzr" nil t)
+;;;###autoload         (vc-bzr-registered file))))
 
 (defun vc-bzr-registered (file)
   "Return non-nil if FILE is registered with bzr."
@@ -311,7 +313,7 @@ in the repository root directory of FILE."
     (when rootdir
          (file-relative-name filename* rootdir))))
 
-(defvar vc-bzr-error-regex-alist
+(defvar vc-bzr-error-regexp-alist
   '(("^\\( M[* ]\\|+N \\|-D \\|\\|  \\*\\|R[M ] \\) \\(.+\\)" 2 nil nil 1)
     ("^C  \\(.+\\)" 2)
     ("^Text conflict in \\(.+\\)" 1 nil nil 2)
@@ -347,14 +349,7 @@ prompt for the Bzr command to run."
            command        (cadr args)
            args           (cddr 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))))
+      (with-current-buffer buf (vc-exec-after '(vc-compilation-mode 'bzr)))
       (vc-set-async-update buf))))
 
 (defun vc-bzr-merge-branch ()
@@ -385,14 +380,7 @@ default if it is available."
         (command        (cadr cmd))
         (args           (cddr cmd)))
     (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))))
+      (with-current-buffer buf (vc-exec-after '(vc-compilation-mode 'bzr)))
       (vc-set-async-update buf))))
 
 (defun vc-bzr-status (file)
@@ -548,7 +536,9 @@ in the branch repository (or whose status not be determined)."
                         ;; FIXME: maybe it's overkill to check if both these
                         ;; files exist.
                         (and (file-exists-p branch-format-file)
-                             (file-exists-p lastrev-file)))))
+                             (file-exists-p lastrev-file)
+                             (equal (emacs-bzr-version-dirstate l-c-parent-dir)
+                                    (emacs-bzr-version-dirstate rootdir))))))
                 t)))
         (with-temp-buffer
           (insert-file-contents branch-format-file)
@@ -567,13 +557,17 @@ in the branch repository (or whose status not be determined)."
             (insert-file-contents lastrev-file)
             (when (re-search-forward "[0-9]+" nil t)
              (buffer-substring (match-beginning 0) (match-end 0))))))
-      ;; fallback to calling "bzr revno"
+      ;; Fallback to calling "bzr revno --tree".
+      ;; The "--tree" matters for lightweight checkouts not on the same
+      ;; revision as the parent.
       (let* ((result (vc-bzr-command-discarding-stderr
-                      vc-bzr-program "revno" (file-relative-name file)))
+                      vc-bzr-program "revno" "--tree"
+                      (file-relative-name file)))
              (exitcode (car result))
              (output (cdr result)))
         (cond
-         ((eq exitcode 0) (substring output 0 -1))
+         ((and (eq exitcode 0) (not (zerop (length output))))
+          (substring output 0 -1))
          (t nil))))))
 
 (defun vc-bzr-create-repo ()
@@ -626,15 +620,24 @@ or a superior directory.")
 
 (declare-function log-edit-extract-headers "log-edit" (headers string))
 
+(defun vc-bzr--sanitize-header (arg)
+  ;; Newlines in --fixes (and probably other fields as well) trigger a nasty
+  ;; Bazaar bug; see https://bugs.launchpad.net/bzr/+bug/1094180.
+  (lambda (str) (list arg
+                 (replace-regexp-in-string "\\`[ \t]+\\|[ \t]+\\'"
+                                           "" (replace-regexp-in-string
+                                               "\n[ \t]?" " " str)))))
+
 (defun vc-bzr-checkin (files rev comment)
   "Check FILES in to bzr with log message COMMENT.
 REV non-nil gets an error."
   (if rev (error "Can't check in a specific revision with bzr"))
-  (apply 'vc-bzr-command "commit" nil 0
-         files (cons "-m" (log-edit-extract-headers '(("Author" . "--author")
-                                                     ("Date" . "--commit-time")
-                                                      ("Fixes" . "--fixes"))
-                                                    comment))))
+  (apply 'vc-bzr-command "commit" nil 0 files
+         (cons "-m" (log-edit-extract-headers
+                     `(("Author" . ,(vc-bzr--sanitize-header "--author"))
+                       ("Date" . ,(vc-bzr--sanitize-header "--commit-time"))
+                       ("Fixes" . ,(vc-bzr--sanitize-header "--fixes")))
+                     comment))))
 
 (defun vc-bzr-find-revision (file rev buffer)
   "Fetch revision REV of file FILE and put it into BUFFER."