;;; 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>
;; Known bugs
;; ==========
-;; When edititing a symlink and *both* the symlink and its target
+;; When editing a symlink and *both* the symlink and its target
;; 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.
;; 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))
(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
(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)
;; 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
(buffer-string)))
(shelve (vc-bzr-shelve-list))
(shelve-help-echo "Use M-x vc-bzr-shelve to create shelves")
+ (root-dir (vc-bzr-root dir))
+ (pending-merge
+ ;; FIXME: looking for .bzr/checkout/merge-hashes is not a
+ ;; reliable method to detect pending merges, disable this
+ ;; until a proper solution is implemented.
+ (and nil
+ (file-exists-p
+ (expand-file-name ".bzr/checkout/merge-hashes" root-dir))))
+ (pending-merge-help-echo
+ (format "A merge has been performed.\nA commit from the top-level directory (%s)\nis required before being able to check in anything else" root-dir))
(light-checkout
(when (string-match ".+light checkout root: \\(.+\\)$" str)
(match-string 1 str)))
(propertize "Checkout of branch : " 'face 'font-lock-type-face)
(propertize light-checkout-branch 'face 'font-lock-variable-name-face)
"\n"))
- (if shelve
- (concat
- (propertize "Shelves :\n" 'face 'font-lock-type-face
- 'help-echo shelve-help-echo)
- (mapconcat
- (lambda (x)
- (propertize x
- 'face 'font-lock-variable-name-face
- 'mouse-face 'highlight
- '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
- (propertize "Shelves : " 'face 'font-lock-type-face
- 'help-echo shelve-help-echo)
- (propertize "No shelved changes"
- 'help-echo shelve-help-echo
- 'face 'font-lock-variable-name-face))))))
+ (when pending-merge
+ (concat
+ (propertize "Warning : " 'face 'font-lock-warning-face
+ 'help-echo pending-merge-help-echo)
+ (propertize "Pending merges, commit recommended before any other action"
+ 'help-echo pending-merge-help-echo
+ 'face 'font-lock-warning-face)
+ "\n"))
+ (if shelve
+ (concat
+ (propertize "Shelves :\n" 'face 'font-lock-type-face
+ 'help-echo shelve-help-echo)
+ (mapconcat
+ (lambda (x)
+ (propertize x
+ 'face 'font-lock-variable-name-face
+ 'mouse-face 'highlight
+ 'help-echo "mouse-3: Show shelve menu\nA: Apply and keep shelf\nP: Apply and remove shelf (pop)\nS: Snapshot to a shelf\nC-k: Delete shelf"
+ 'keymap vc-bzr-shelve-map))
+ shelve "\n"))
+ (concat
+ (propertize "Shelves : " 'face 'font-lock-type-face
+ 'help-echo shelve-help-echo)
+ (propertize "No shelved changes"
+ 'help-echo shelve-help-echo
+ 'face 'font-lock-variable-name-face))))))
(defun vc-bzr-shelve (name)
"Create a shelve."
(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
((string-match "\\`\\(ancestor\\|branch\\|\\(revno:\\)?[-0-9]+:\\):"
string)
(completion-table-with-context (substring string 0 (match-end 0))
- 'completion-file-name-table
+ (apply-partially
+ 'completion-table-with-predicate
+ 'completion-file-name-table
+ 'file-directory-p t)
(substring string (match-end 0))
- ;; Dropping `pred' for no good reason.
- 'file-directory-p
+ pred
action))
((string-match "\\`\\(before\\):" string)
(completion-table-with-context (substring string 0 (match-end 0))