;;; 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>
;;; Code:
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'vc) ;; for vc-exec-after
(require 'vc-dir))
`LC_MESSAGES=C' to the environment. If BZR-COMMAND is \"status\",
prepends `vc-bzr-status-switches' to ARGS."
(let ((process-environment
- (list* "BZR_PROGRESS_BAR=none" ; Suppress progress output (bzr >=0.9)
- "LC_MESSAGES=C" ; Force English output
- process-environment)))
+ `("BZR_PROGRESS_BAR=none" ; Suppress progress output (bzr >=0.9)
+ "LC_MESSAGES=C" ; Force English output
+ ,@process-environment)))
(apply 'vc-do-command (or buffer "*vc*") okstatus vc-bzr-program
file-or-list bzr-command
(if (and (string-equal "status" bzr-command)
`vc-do-async-command', and specify an output buffer named
\"*vc-bzr : ROOT*\". Return this buffer."
(let* ((process-environment
- (list* "BZR_PROGRESS_BAR=none" "LC_MESSAGES=C"
- process-environment))
+ `("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
(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.
(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")
+;;;###autoload (vc-bzr-registered file))))
(defun vc-bzr-registered (file)
"Return non-nil if FILE is registered with bzr."
(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)
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 ()
(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)
;; 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)
(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 ()
(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."
(apply #'process-file command nil (list (current-buffer) nil) nil args)
(buffer-substring (point-min) (point-max)))))
-(defstruct (vc-bzr-extra-fileinfo
+(cl-defstruct (vc-bzr-extra-fileinfo
(:copier nil)
(:constructor vc-bzr-create-extra-fileinfo (extra-name))
(:conc-name vc-bzr-extra-fileinfo->))
HCoop / bpt / emacs.git / blobdiff