;;; vc-bzr.el --- VC backend for the bzr revision control system
-;; Copyright (C) 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Riccardo Murri <riccardo.murri@gmail.com>
(if (file-exists-p location-fname)
(with-temp-buffer
(insert-file-contents location-fname)
- (when (re-search-forward "file://\(.+\)" nil t)
- (setq branch-format-file (match-string 1))
- (file-exists-p branch-format-file)))
+ ;; If the lightweight checkout points to a
+ ;; location in the local file system, then we can
+ ;; look there for the version information.
+ (when (re-search-forward "file://\\(.+\\)" nil t)
+ (let ((l-c-parent-dir (match-string 1)))
+ (when (and (memq system-type '(ms-dos windows-nt))
+ (string-match-p "^/[[:alpha:]]:" l-c-parent-dir))
+ ;;; The non-Windows code takes a shortcut by using the host/path
+ ;;; separator slash as the start of the absolute path. That
+ ;;; does not work on Windows, so we must remove it (bug#5345)
+ (setq l-c-parent-dir (substring l-c-parent-dir 1)))
+ (setq branch-format-file
+ (expand-file-name vc-bzr-admin-branch-format-file
+ l-c-parent-dir))
+ (setq lastrev-file
+ (expand-file-name vc-bzr-admin-lastrev l-c-parent-dir))
+ ;; FIXME: maybe it's overkill to check if both these files exist.
+ (and (file-exists-p branch-format-file)
+ (file-exists-p lastrev-file)))))
t)))
(with-temp-buffer
(insert-file-contents branch-format-file)
(set (make-local-variable 'log-view-file-re) "\\`a\\`")
(set (make-local-variable 'log-view-message-re)
(if vc-short-log
- "^ *\\([0-9.]+\\) \\(.*?\\)[ \t]+\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)\\( \\[merge\\]\\)?"
+ "^ *\\([0-9.]+\\): \\(.*?\\)[ \t]+\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)\\( \\[merge\\]\\)?"
"^ *\\(?:revno: \\([0-9.]+\\)\\|merged: .+\\)"))
(set (make-local-variable 'log-view-font-lock-keywords)
;; log-view-font-lock-keywords is careful to use the buffer-local
(4 'change-log-list nil lax))))
(append `((,log-view-message-re . 'log-view-message-face))
;; log-view-font-lock-keywords
- '(("^ *committer: \
+ '(("^ *\\(?:committer\\|author\\): \
\\([^<(]+?\\)[ ]*[(<]\\([[:alnum:]_.+-]+@[[:alnum:]_.-]+\\)[>)]"
(1 'change-log-name)
(2 'change-log-email))
(with-current-buffer buffer
(apply 'vc-bzr-command "log" buffer 'async files
(append
- (when shortlog '("--short"))
+ (when shortlog '("--line"))
(when start-revision (list (format "-r..%s" start-revision)))
(when limit (list "-l" (format "%s" limit)))
(if (stringp vc-bzr-log-switches)
(defun vc-bzr-diff (files &optional rev1 rev2 buffer)
"VC bzr backend for diff."
;; `bzr diff' exits with code 1 if diff is non-empty.
- (apply #'vc-bzr-command "diff" (or buffer "*vc-diff*") 'async files
+ (apply #'vc-bzr-command "diff" (or buffer "*vc-diff*")
+ (if vc-disable-async-diff 1 'async) files
"--diff-options" (mapconcat 'identity
(vc-switches 'bzr 'diff)
" ")
;; For conflicts, should we list the .THIS/.BASE/.OTHER?
("C " . conflict)
("? " . unregistered)
- ("? " . unregistered)
;; No such state, but we need to distinguish this case.
("R " . renamed)
+ ("RM " . renamed)
;; For a non existent file FOO, the output is:
;; bzr: ERROR: Path(s) do not exist: FOO
("bzr" . not-found)
;; FIXME: maybe this warning can be put in the vc-dir header...
("wor" . not-found)
;; Ignore "P " and "P." for pending patches.
+ ("P " . not-found)
+ ("P. " . not-found)
))
(translated nil)
(result nil))
(when entry
(setf (nth 1 entry) 'conflict))))
((eq translated 'renamed)
- (re-search-forward "R \\(.*\\) => \\(.*\\)$" (line-end-position) t)
+ (re-search-forward "R[ M] \\(.*\\) => \\(.*\\)$" (line-end-position) t)
(let ((new-name (file-relative-name (match-string 2) relative-dir))
(old-name (file-relative-name (match-string 1) relative-dir)))
(push (list new-name 'edited
(define-key map "\C-k" 'vc-bzr-shelve-delete-at-point)
;; (define-key map "=" 'vc-bzr-shelve-show-at-point)
;; (define-key map "\C-m" 'vc-bzr-shelve-show-at-point)
- (define-key map "A" 'vc-bzr-shelve-apply-at-point)
+ (define-key map "P" 'vc-bzr-shelve-apply-at-point)
map))
(defvar vc-bzr-shelve-menu-map
(define-key map [de]
'(menu-item "Delete shelf" vc-bzr-shelve-delete-at-point
:help "Delete the current shelf"))
- (define-key map [ap]
- '(menu-item "Apply shelf" vc-bzr-shelve-apply-at-point
- :help "Apply the current shelf"))
+ (define-key map [po]
+ '(menu-item "Apply and remove shelf (pop)" vc-bzr-shelve-apply-at-point
+ :help "Apply the current shelf and remove it"))
;; (define-key map [sh]
;; '(menu-item "Show shelve" vc-bzr-shelve-show-at-point
;; :help "Show the contents of the current shelve"))
(propertize x
'face 'font-lock-variable-name-face
'mouse-face 'highlight
- 'help-echo "mouse-3: Show shelve menu\nA: Apply shelf\nC-k: Delete shelf"
+ 'help-echo "mouse-3: Show shelve menu\nP: Apply and remove shelf (pop)\nC-k: Delete shelf"
'keymap vc-bzr-shelve-map))
shelve "\n"))
(concat
;; (pop-to-buffer (current-buffer)))
(defun vc-bzr-shelve-apply (name)
- "Apply shelve NAME."
- (interactive "sApply shelf: ")
+ "Apply shelve NAME and remove it afterwards."
+ (interactive "sApply (and remove) shelf: ")
(vc-bzr-command "unshelve" "*vc-bzr-shelve*" 0 nil "--apply" name)
(vc-resynch-buffer (vc-bzr-root default-directory) t t))
(interactive "e")
(vc-dir-at-event e (popup-menu vc-bzr-shelve-menu-map e)))
+(defun vc-bzr-revision-table (files)
+ (let ((vc-bzr-revisions '())
+ (default-directory (file-name-directory (car files))))
+ (with-temp-buffer
+ (vc-bzr-command "log" t 0 files "--line")
+ (let ((start (point-min))
+ (loglines (buffer-substring-no-properties (point-min) (point-max))))
+ (while (string-match "^\\([0-9]+\\):" loglines)
+ (push (match-string 1 loglines) vc-bzr-revisions)
+ (setq start (+ start (match-end 0)))
+ (setq loglines (buffer-substring-no-properties start (point-max))))))
+ vc-bzr-revisions))
+
;;; Revision completion
(eval-and-compile