X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ac5475dacb20d240db27d56199910d8a6fcc90e8..0e963201d03d9229bb8ac4323291d2b0119526ed:/lisp/vc/vc-bzr.el diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index 96d6d1da48..03c134a100 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -1,6 +1,6 @@ ;;; 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 ;; Riccardo Murri @@ -34,7 +34,7 @@ ;; ========== ;; 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. @@ -73,6 +73,16 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (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) @@ -325,29 +335,31 @@ in the repository root directory of FILE." (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) @@ -358,6 +370,20 @@ prompt for the Bzr command to run." (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 @@ -491,7 +517,7 @@ in the branch repository (or whose status not be determined)." ;; 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. @@ -623,7 +649,7 @@ or a superior directory.") "" (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 @@ -826,7 +852,8 @@ If LIMIT is non-nil, show no more than this many entries." 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) @@ -862,7 +889,7 @@ property containing author and date information." (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) @@ -943,6 +970,12 @@ stream. Standard error output is discarded." (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?\\.")