;;; vc-bzr.el --- VC backend for the bzr revision control system -*- lexical-binding: t -*-
-;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Riccardo Murri <riccardo.murri@gmail.com>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: vc tools
;; Created: Sept 2006
;; Package: vc
(eval-when-compile
(require 'cl-lib)
+ (require 'vc-dispatcher)
(require 'vc-dir)) ; vc-dir-at-event
;; Clear up the cache to force vc-call to check again and discover
("^Using saved parent location: \\(.+\\)" 1 nil nil 0))
"Value of `compilation-error-regexp-alist' in *vc-bzr* buffers.")
-;; Follows vc-bzr-(async-)command, which uses vc-do-(async-)command
-;; from vc-dispatcher.
+;; To be called via vc-pull from vc.el, which requires vc-dispatcher.
(declare-function vc-exec-after "vc-dispatcher" (code))
-;; Follows vc-exec-after.
(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.
(setq vc-bzr-program (car args)
command (cadr args)
args (cddr args)))
+ (require 'vc-dispatcher)
(let ((buf (apply 'vc-bzr-async-command command args)))
- (with-current-buffer buf (vc-exec-after '(vc-compilation-mode 'bzr)))
+ (with-current-buffer buf (vc-run-delayed (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 '(vc-compilation-mode 'bzr)))
+ (with-current-buffer buf (vc-run-delayed (vc-compilation-mode 'bzr)))
(vc-set-async-update buf))))
(defun vc-bzr-status (file)
(add-hook 'after-save-hook 'vc-bzr-resolve-when-done nil t)
(message "There are unresolved conflicts in this file")))
-(defun vc-bzr-workfile-unchanged-p (file)
- (eq 'unchanged (car (vc-bzr-status file))))
-
(defun vc-bzr-working-revision (file)
- ;; Together with the code in vc-state-heuristic, this makes it possible
- ;; to get the initial VC state of a Bzr file even if Bzr is not installed.
(let* ((rootdir (vc-bzr-root file))
(branch-format-file (expand-file-name vc-bzr-admin-branch-format-file
rootdir))
"Create a new Bzr repository."
(vc-bzr-command "init" nil 0 nil))
-(defun vc-bzr-init-revision (&optional _file)
- "Always return nil, as Bzr cannot register explicit versions."
- nil)
-
(defun vc-bzr-previous-revision (_file rev)
(if (string-match "\\`[0-9]+\\'" rev)
(number-to-string (1- (string-to-number rev)))
(number-to-string (1+ (string-to-number rev)))
(error "Don't know how to compute the next revision of %s" rev)))
-(defun vc-bzr-register (files &optional rev _comment)
- "Register FILES under bzr.
-Signal an error unless REV is nil.
-COMMENT is ignored."
- (if rev (error "Can't register explicit revision with bzr"))
+(defun vc-bzr-register (files &optional _comment)
+ "Register FILES under bzr. COMMENT is ignored."
(vc-bzr-command "add" nil 0 files))
;; Could run `bzr status' in the directory and see if it succeeds, but
The criterion is that there is a `.bzr' directory in the same
or a superior directory.")
-(defun vc-bzr-could-register (file)
- "Return non-nil if FILE could be registered under bzr."
- (and (vc-bzr-responsible-p file) ; shortcut
- (condition-case ()
- (with-temp-buffer
- (vc-bzr-command "add" t 0 file "--dry-run")
- ;; The command succeeds with no output if file is
- ;; registered (in bzr 0.8).
- (goto-char (point-min))
- (looking-at "added "))
- (error))))
-
(defun vc-bzr-unregister (file)
"Unregister FILE from bzr."
(vc-bzr-command "remove" nil 0 file "--keep"))
"" (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"))
+(defun vc-bzr-checkin (files comment)
+ "Check FILES in to bzr with log message COMMENT."
(apply 'vc-bzr-command "commit" nil 0 files
(cons "-m" (log-edit-extract-headers
`(("Author" . ,(vc-bzr--sanitize-header "--author"))
(vc-bzr-command "cat" t 0 file "-r" rev)
(vc-bzr-command "cat" t 0 file))))
-(defun vc-bzr-ignore (file &optional directory remove)
- "Ignore FILE under Bazaar.
-If DIRECTORY is non-nil, the repository to use will be deduced by
-DIRECTORY; if REMOVE is non-nil, remove FILE from ignored files."
- (if remove
- (if directory
- (vc--remove-regexp file (vc-bzr-find-ignore-file directory))
- (vc--remove-regexp file
- (vc-bzr-find-ignore-file default-directory)))
- (vc-bzr-command "ignore" t 0 file)))
-
-(defun vc-bzr-ignore-completion-table (file)
- "Return the list of ignored files."
- (vc--read-lines (vc-bzr-find-ignore-file file)))
-
(defun vc-bzr-find-ignore-file (file)
"Return the root directory of the repository of FILE."
(expand-file-name ".bzrignore"
(vc-bzr-root file)))
-(defun vc-bzr-checkout (_file &optional _editable rev)
+(defun vc-bzr-checkout (_file &optional rev)
(if rev (error "Operation not supported")
;; Else, there's nothing to do.
nil))
(with-current-buffer buffer
(apply 'vc-bzr-command "log" buffer 'async files
(append
- (when shortlog '("--line"))
+ (if shortlog '("--line") '("--long"))
;; The extra complications here when start-revision and limit
;; are set are due to bzr log's --forward argument, which
;; could be enabled via an alias in bazaar.conf.
(defun vc-bzr-expanded-log-entry (revision)
(with-temp-buffer
(apply 'vc-bzr-command "log" t nil nil
- (list (format "-r%s" revision)))
+ (list "--long" (format "-r%s" revision)))
(goto-char (point-min))
(when (looking-at "^-+\n")
;; Indent the expanded log entry.
(autoload 'vc-switches "vc")
-(defun vc-bzr-diff (files &optional rev1 rev2 buffer)
+(defun vc-bzr-diff (files &optional rev1 rev2 buffer async)
"VC bzr backend for diff."
(let* ((switches (vc-switches 'bzr 'diff))
(args
(or rev2 "")))))))
;; `bzr diff' exits with code 1 if diff is non-empty.
(apply #'vc-bzr-command "diff" (or buffer "*vc-diff*")
- (if vc-disable-async-diff 1 'async) files
+ (if async 1 'async) files
args)))
(push (list new-name 'edited
(vc-bzr-create-extra-fileinfo old-name)) result)))
;; do nothing for non existent files
- ((memq translated '(not-found ignored)))
+ ((eq translated 'not-found))
(t
(push (list (file-relative-name
(buffer-substring-no-properties
(forward-line))
(funcall update-function result)))
-(defun vc-bzr-dir-status (dir update-function)
- "Return a list of conses (file . state) for DIR."
- (vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S")
- (vc-exec-after
- `(vc-bzr-after-dir-status (quote ,update-function)
- ;; "bzr status" results are relative to
- ;; the bzr root directory, NOT to the
- ;; directory "bzr status" was invoked in.
- ;; Ugh.
- ;; We pass the relative directory here so
- ;; that `vc-bzr-after-dir-status' can
- ;; frob the results accordingly.
- (file-relative-name ,dir (vc-bzr-root ,dir)))))
-
-(defun vc-bzr-dir-status-files (dir files _default-state update-function)
+(defun vc-bzr-dir-status-files (dir files update-function)
"Return a list of conses (file . state) for DIR."
(apply 'vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S" files)
- (vc-exec-after
- `(vc-bzr-after-dir-status (quote ,update-function)
- (file-relative-name ,dir (vc-bzr-root ,dir)))))
+ (vc-run-delayed
+ (vc-bzr-after-dir-status update-function
+ ;; "bzr status" results are relative to
+ ;; the bzr root directory, NOT to the
+ ;; directory "bzr status" was invoked in.
+ ;; Ugh.
+ ;; We pass the relative directory here so
+ ;; that `vc-bzr-after-dir-status' can
+ ;; frob the results accordingly.
+ (file-relative-name dir (vc-bzr-root dir)))))
(defvar vc-bzr-shelve-map
(let ((map (make-sparse-keymap)))
(file &optional keep noquery reset-vc-info))
(defun vc-bzr-shelve (name)
- "Create a shelve."
+ "Shelve the changes of the selected files."
(interactive "sShelf name: ")
- (let ((root (vc-bzr-root default-directory)))
+ (let ((root (vc-bzr-root default-directory))
+ (fileset (vc-deduce-fileset)))
(when root
- (vc-bzr-command "shelve" nil 0 nil "--all" "-m" name)
+ (vc-bzr-command "shelve" nil 0 (nth 1 fileset) "--all" "-m" name)
(vc-resynch-buffer root t t))))
(defun vc-bzr-shelve-show (name)
"Create a stash with the current tree state."
(interactive)
(vc-bzr-command "shelve" nil 0 nil "--all" "-m"
- (let ((ct (current-time)))
- (concat
- (format-time-string "Snapshot on %Y-%m-%d" ct)
- (format-time-string " at %H:%M" ct))))
+ (format-time-string "Snapshot on %Y-%m-%d at %H:%M"))
(vc-bzr-command "unshelve" nil 0 nil "--apply" "--keep")
(vc-resynch-buffer (vc-bzr-root default-directory) t t))