;;; vc-bzr.el --- VC backend for the bzr revision control system -*- lexical-binding: t -*-
-;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2016 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Riccardo Murri <riccardo.murri@gmail.com>
;; ==========
;; When editing a symlink and *both* the symlink and its target
-;; are bzr-versioned, `vc-bzr` presently runs `bzr status` on the
+;; are bzr-versioned, `vc-bzr' presently runs `bzr status' on the
;; symlink, thereby not detecting whether the actual contents
;; (that is, the target contents) are changed.
(repeat :tag "Argument List" :value ("") string))
:group 'vc-bzr)
+(defcustom vc-bzr-annotate-switches nil
+ "String or list of strings specifying switches for bzr annotate under VC.
+If nil, use the value of `vc-annotate-switches'. If t, use no switches."
+ :type '(choice (const :tag "Unspecified" nil)
+ (const :tag "None" t)
+ (string :tag "Argument String")
+ (repeat :tag "Argument List" :value ("") string))
+ :version "25.1"
+ :group 'vc-bzr)
+
(defcustom vc-bzr-log-switches nil
"String or list of strings specifying switches for bzr log under VC."
:type '(choice (const :tag "None" nil)
(declare-function vc-set-async-update "vc-dispatcher" (process-buffer))
(declare-function vc-compilation-mode "vc-dispatcher" (backend))
-(defun vc-bzr-pull (prompt)
- "Pull changes into the current Bzr branch.
-Normally, this runs \"bzr pull\". However, if the branch is a
-bound branch, run \"bzr update\" instead. If there is no default
-location from which to pull or update, or if PROMPT is non-nil,
-prompt for the Bzr command to run."
+(defun vc-bzr--pushpull (command prompt)
+ "Run COMMAND (a string; either push or pull) on the current Bzr branch.
+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))
;; Check whether the branch is bound.
(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.
- (has-parent (unless bound
- (assoc "parent_location" branch-conf)))
- (command (if bound "update" "pull"))
+ (has-loc (assoc (if (equal command "push")
+ "push_location"
+ "parent_location")
+ branch-conf))
args)
+ (when bound
+ (if (equal command "push")
+ (user-error "Cannot push a bound branch")
+ (setq command "update")))
;; If necessary, prompt for the exact command.
- (when (or prompt (not (or bound has-parent)))
+ (when (or prompt (if (equal command "push")
+ (not has-loc)
+ (not (or bound has-loc))))
(setq args (split-string
(read-shell-command
- "Bzr pull command: "
- (concat vc-bzr-program " " command)
+ (format "Bzr %s command: " command)
+ (format "%s %s" vc-bzr-program command)
'vc-bzr-history)
" " t))
(setq vc-bzr-program (car args)
(with-current-buffer buf (vc-run-delayed (vc-compilation-mode 'bzr)))
(vc-set-async-update buf))))
+(defun vc-bzr-pull (prompt)
+ "Pull changes into the current Bzr branch.
+Normally, this runs \"bzr pull\". However, if the branch is a
+bound branch, run \"bzr update\" instead. If there is no default
+location from which to pull or update, or if PROMPT is non-nil,
+prompt for the Bzr command to run."
+ (vc-bzr--pushpull "pull" prompt))
+
+(defun vc-bzr-push (prompt)
+ "Push changes from the current Bzr branch.
+Normally, this runs \"bzr push\". If there is no push location,
+or if PROMPT is non-nil, prompt for the Bzr command to run."
+ (vc-bzr--pushpull "push" prompt))
+
(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
;; elisp function to remerge from the .BASE/OTHER/THIS files.
(smerge-start-session)
(add-hook 'after-save-hook 'vc-bzr-resolve-when-done nil t)
- (message "There are unresolved conflicts in this file")))
+ (vc-message-unresolved-conflicts buffer-file-name)))
(defun vc-bzr-version-dirstate (dir)
"Try to return as a string the bzr revision ID of directory DIR.
"" (replace-regexp-in-string
"\n[ \t]?" " " str)))))
-(defun vc-bzr-checkin (files comment)
+(defun vc-bzr-checkin (files comment &optional _rev)
"Check FILES in to bzr with log message COMMENT."
(apply 'vc-bzr-command "commit" nil 0 files
(cons "-m" (log-edit-extract-headers
Each line is tagged with the revision number, which has a `help-echo'
property containing author and date information."
(apply #'vc-bzr-command "annotate" buffer 'async file "--long" "--all"
- (if revision (list "-r" revision)))
+ (append (vc-switches 'bzr 'annotate)
+ (if revision (list "-r" revision))))
(let ((table (make-hash-table :test 'equal)))
(set-process-filter
(get-buffer-process buffer)
(move-marker (process-mark proc) (point))))
(process-put proc :vc-left-over string)))))))
-(declare-function vc-annotate-convert-time "vc-annotate" (time))
+(declare-function vc-annotate-convert-time "vc-annotate" (&optional time))
(defun vc-bzr-annotate-time ()
(when (re-search-forward "^ *[0-9.]+ +.+? +|" nil t)
(translated nil)
(result nil))
(goto-char (point-min))
+ ;; Skip a warning message that can occur in some bzr installations.
+ ;; vc-bzr-dir-extra-headers already reports it.
+ ;; Perhaps we should just discard stderr?
+ (and (looking-at "bzr: WARNING: bzrlib version doesn't match")
+ (re-search-forward "^bzr is version" nil t)
+ (forward-line 1))
(while (not (eobp))
;; Bzr 2.3.0 added this if there are shelves. (Bug#8170)
(unless (looking-at "[0-9]+ shel\\(f\\|ves\\) exists?\\.")