;;; 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.
;; + working ( = packed_stat )
;; parent = common ( as above ) + history ( = rev_id )
;; kinds = (r)elocated, (a)bsent, (d)irectory, (f)ile, (l)ink
- (let ((root (vc-bzr-root file)))
- (when root ; Short cut.
- (let ((dirstate (expand-file-name vc-bzr-admin-dirstate root)))
- (condition-case nil
- (with-temp-buffer
- (insert-file-contents dirstate)
- (goto-char (point-min))
- (if (not (looking-at "#bazaar dirstate flat format 3"))
- (vc-bzr-state file) ; Some other unknown format?
- (let* ((relfile (file-relative-name file root))
- (reldir (file-name-directory relfile)))
- (if (re-search-forward
- (concat "^\0"
- (if reldir (regexp-quote
- (directory-file-name reldir)))
- "\0"
- (regexp-quote (file-name-nondirectory relfile))
- "\0"
- "[^\0]*\0" ;id?
- "\\([^\0]*\\)\0" ;"a/f/d", a=removed?
- "\\([^\0]*\\)\0" ;sha1 (empty if conflicted)?
- "\\([^\0]*\\)\0" ;size?p
- ;; y/n. Whether or not the current copy
- ;; was executable the last time bzr checked?
- "[^\0]*\0"
- "[^\0]*\0" ;?
- ;; Parent information. Absent in a new repo.
- "\\(?:\\([^\0]*\\)\0" ;"a/f/d" a=added?
- "\\([^\0]*\\)\0" ;sha1 again?
- "\\([^\0]*\\)\0" ;size again?
- ;; y/n. Whether or not the repo thinks
- ;; the file should be executable?
- "\\([^\0]*\\)\0"
- "[^\0]*\0\\)?" ;last revid?
- ;; There are more fields when merges are pending.
- )
- nil t)
- ;; Apparently the second sha1 is the one we want: when
- ;; there's a conflict, the first sha1 is absent (and the
- ;; first size seems to correspond to the file with
- ;; conflict markers).
- (cond
- ((eq (char-after (match-beginning 1)) ?a) 'removed)
- ;; If there is no parent, this must be a new repo.
- ;; If file is in dirstate, can only be added (b#8025).
- ((or (not (match-beginning 4))
- (eq (char-after (match-beginning 4)) ?a)) 'added)
- ((or (and (eq (string-to-number (match-string 3))
- (nth 7 (file-attributes file)))
- (equal (match-string 5)
- (vc-bzr-sha1 file))
- ;; For a file, does the executable state match?
- ;; (Bug#7544)
- (or (not
- (eq (char-after (match-beginning 1)) ?f))
- (let ((exe
- (memq
- ?x
- (mapcar
- 'identity
- (nth 8 (file-attributes file))))))
- (if (eq (char-after (match-beginning 7))
- ?y)
- exe
- (not exe)))))
- (and
- ;; It looks like for lightweight
- ;; checkouts \2 is empty and we need to
- ;; look for size in \6.
- (eq (match-beginning 2) (match-end 2))
- (eq (string-to-number (match-string 6))
- (nth 7 (file-attributes file)))
- (equal (match-string 5)
- (vc-bzr-sha1 file))))
- 'up-to-date)
- (t 'edited))
- 'unregistered))))
- ;; The dirstate file can't be read, or some other problem.
- (error (vc-bzr-state file)))))))
-
+ (let* ((root (vc-bzr-root file))
+ (dirstate (expand-file-name vc-bzr-admin-dirstate root)))
+ (when root ; Short cut.
+ (condition-case err
+ (with-temp-buffer
+ (insert-file-contents dirstate)
+ (goto-char (point-min))
+ (if (not (looking-at "#bazaar dirstate flat format 3"))
+ (vc-bzr-state file) ; Some other unknown format?
+ (let* ((relfile (file-relative-name file root))
+ (reldir (file-name-directory relfile)))
+ (cond
+ ((not
+ (re-search-forward
+ (concat "^\0"
+ (if reldir (regexp-quote
+ (directory-file-name reldir)))
+ "\0"
+ (regexp-quote (file-name-nondirectory relfile))
+ "\0"
+ "[^\0]*\0" ;id?
+ "\\([^\0]*\\)\0" ;"a/f/d", a=removed?
+ "\\([^\0]*\\)\0" ;sha1 (empty if conflicted)?
+ "\\([^\0]*\\)\0" ;size?p
+ ;; y/n. Whether or not the current copy
+ ;; was executable the last time bzr checked?
+ "[^\0]*\0"
+ "[^\0]*\0" ;?
+ ;; Parent information. Absent in a new repo.
+ "\\(?:\\([^\0]*\\)\0" ;"a/f/d" a=added?
+ "\\([^\0]*\\)\0" ;sha1 again?
+ "\\([^\0]*\\)\0" ;size again?
+ ;; y/n. Whether or not the repo thinks
+ ;; the file should be executable?
+ "\\([^\0]*\\)\0"
+ "[^\0]*\0\\)?" ;last revid?
+ ;; There are more fields when merges are pending.
+ )
+ nil t))
+ 'unregistered)
+ ;; Apparently the second sha1 is the one we want: when
+ ;; there's a conflict, the first sha1 is absent (and the
+ ;; first size seems to correspond to the file with
+ ;; conflict markers).
+ ((eq (char-after (match-beginning 1)) ?a) 'removed)
+ ;; If there is no parent, this must be a new repo.
+ ;; If file is in dirstate, can only be added (b#8025).
+ ((or (not (match-beginning 4))
+ (eq (char-after (match-beginning 4)) ?a)) 'added)
+ ((or (and (eq (string-to-number (match-string 3))
+ (nth 7 (file-attributes file)))
+ (equal (match-string 5)
+ (save-match-data (vc-bzr-sha1 file)))
+ ;; For a file, does the executable state match?
+ ;; (Bug#7544)
+ (or (not
+ (eq (char-after (match-beginning 1)) ?f))
+ (let ((exe
+ (memq
+ ?x
+ (mapcar
+ 'identity
+ (nth 8 (file-attributes file))))))
+ (if (eq (char-after (match-beginning 7))
+ ?y)
+ exe
+ (not exe)))))
+ (and
+ ;; It looks like for lightweight
+ ;; checkouts \2 is empty and we need to
+ ;; look for size in \6.
+ (eq (match-beginning 2) (match-end 2))
+ (eq (string-to-number (match-string 6))
+ (nth 7 (file-attributes file)))
+ (equal (match-string 5)
+ (vc-bzr-sha1 file))))
+ 'up-to-date)
+ (t 'edited)))))
+ ;; The dirstate file can't be read, or some other problem.
+ (error
+ (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."
(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->))