;;; vc-bzr.el --- VC backend for the bzr revision control system
-;; Copyright (C) 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Riccardo Murri <riccardo.murri@gmail.com>
+;; Maintainer: FSF
;; Keywords: vc tools
;; Created: Sept 2006
-;; Version: 2008-01-04
-;; URL: http://launchpad.net/vc-bzr
;; Package: vc
;; This file is part of GNU Emacs.
;;; Commentary:
-;; See <URL:http://bazaar-vcs.org/> concerning bzr. See
-;; <URL:http://launchpad.net/vc-bzr> for alternate development
-;; branches of `vc-bzr'.
+;; See <URL:http://bazaar.canonical.com/> concerning bzr.
-;; Load this library to register bzr support in VC.
+;; This library provides bzr support in VC.
;; Known bugs
;; ==========
;; (that is, the target contents) are changed.
;; See https://bugs.launchpad.net/vc-bzr/+bug/116607
-;; For an up-to-date list of bugs, please see:
-;; https://bugs.launchpad.net/vc-bzr/+bugs
-
;;; Properties of the backend
(defun vc-bzr-revision-granularity () 'repository)
(put 'Bzr 'vc-functions nil)
(defgroup vc-bzr nil
- "VC bzr backend."
+ "VC Bazaar (bzr) backend."
:version "22.2"
:group 'vc)
:group 'vc-bzr
:type 'string)
+(defcustom vc-bzr-sha1-program '("sha1sum")
+ "Name of program to compute SHA1.
+It must be a string \(program name\) or list of strings \(name and its args\)."
+ :type '(repeat string)
+ :group 'vc-bzr)
+
+(define-obsolete-variable-alias 'sha1-program 'vc-bzr-sha1-program "24.1")
+
(defcustom vc-bzr-diff-switches nil
"String or list of strings specifying switches for bzr diff under VC.
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-status-switches
+ (ignore-errors
+ (with-temp-buffer
+ (call-process vc-bzr-program nil t nil "help" "status")
+ (goto-char (point-min))
+ (if (search-forward "--no-classify")
+ "--no-classify")))
+ "String or list of strings specifying switches for bzr status under VC.
+The option \"--no-classify\" should be present if your bzr supports it."
+ :type '(choice (const :tag "None" nil)
+ (string :tag "Argument String")
+ (repeat :tag "Argument List" :value ("") string))
+ :group 'vc-bzr
+ :version "24.1")
+
;; since v0.9, bzr supports removing the progress indicators
;; by setting environment variable BZR_PROGRESS_BAR to "none".
(defun vc-bzr-command (bzr-command buffer okstatus file-or-list &rest args)
"Wrapper round `vc-do-command' using `vc-bzr-program' as COMMAND.
Invoke the bzr command adding `BZR_PROGRESS_BAR=none' and
-`LC_MESSAGES=C' to the environment."
+`LC_MESSAGES=C' to the environment. If BZR-COMMAND is \"status\",
+prepends `vc-bzr-status-switches' to ARGS."
(let ((process-environment
(list* "BZR_PROGRESS_BAR=none" ; Suppress progress output (bzr >=0.9)
"LC_MESSAGES=C" ; Force English output
process-environment)))
(apply 'vc-do-command (or buffer "*vc*") okstatus vc-bzr-program
- file-or-list bzr-command args)))
-
+ file-or-list bzr-command
+ (if (string-equal "status" bzr-command)
+ (append (if (stringp vc-bzr-status-switches)
+ (list vc-bzr-status-switches)
+ vc-bzr-status-switches)
+ args)
+ args))))
+
+(defun vc-bzr-async-command (bzr-command &rest args)
+ "Wrapper round `vc-do-async-command' using `vc-bzr-program' as COMMAND.
+Invoke the bzr command adding `BZR_PROGRESS_BAR=none' and
+`LC_MESSAGES=C' to the environment.
+Use the current Bzr root directory as the ROOT argument to
+`vc-do-async-command', and specify an output buffer named
+\"*vc-bzr : ROOT*\". Return this buffer."
+ (let* ((process-environment
+ (list* "BZR_PROGRESS_BAR=none" "LC_MESSAGES=C"
+ process-environment))
+ (root (vc-bzr-root default-directory))
+ (buffer (format "*vc-bzr : %s*" (expand-file-name root))))
+ (apply 'vc-do-async-command buffer root
+ vc-bzr-program bzr-command args)
+ buffer))
;;;###autoload
(defconst vc-bzr-admin-dirname ".bzr"
"Name of the directory containing Bzr repository status files.")
+;; Used in the autoloaded vc-bzr-registered; see below.
;;;###autoload
(defconst vc-bzr-admin-checkout-format-file
- (concat vc-bzr-admin-dirname "/checkout/format"))
+ (concat vc-bzr-admin-dirname "/checkout/format")
+ "Name of the format file in a .bzr directory.")
(defconst vc-bzr-admin-dirstate
(concat vc-bzr-admin-dirname "/checkout/dirstate"))
(defconst vc-bzr-admin-branch-format-file
(concat vc-bzr-admin-dirname "/branch/revision-history"))
(defconst vc-bzr-admin-lastrev
(concat vc-bzr-admin-dirname "/branch/last-revision"))
+(defconst vc-bzr-admin-branchconf
+ (concat vc-bzr-admin-dirname "/branch/branch.conf"))
;;;###autoload (defun vc-bzr-registered (file)
;;;###autoload (if (vc-find-root file vc-bzr-admin-checkout-format-file)
(let ((root (vc-find-root file vc-bzr-admin-checkout-format-file)))
(when root (vc-file-setprop file 'bzr-root root)))))
-(require 'sha1) ;For sha1-program
+(defun vc-bzr-branch-conf (file)
+ "Return the Bazaar branch settings for file FILE, as an alist.
+Each element of the returned alist has the form (NAME . VALUE),
+which are the name and value of a Bazaar setting, as strings.
+
+The settings are read from the file \".bzr/branch/branch.conf\"
+in the repository root directory of FILE."
+ (let (settings)
+ (with-temp-buffer
+ (insert-file-contents
+ (expand-file-name vc-bzr-admin-branchconf (vc-bzr-root file)))
+ (while (re-search-forward "^\\([^#=][^=]*?\\) *= *\\(.*\\)$" nil t)
+ (push (cons (match-string 1) (match-string 2)) settings)))
+ settings))
(defun vc-bzr-sha1 (file)
(with-temp-buffer
(set-buffer-multibyte nil)
- (let ((prog sha1-program)
+ (let ((prog vc-bzr-sha1-program)
(args nil)
process-file-side-effects)
(when (consp prog)
(defun vc-bzr-state-heuristic (file)
"Like `vc-bzr-state' but hopefully without running Bzr."
- ;; `bzr status' was excrutiatingly slow with large histories and
+ ;; `bzr status' was excruciatingly slow with large histories and
;; pending merges, so try to avoid using it until they fix their
;; performance problems.
;; This function tries first to parse Bzr internal file
;; format 3' in the first line.
;; If the `checkout/dirstate' file cannot be parsed, fall back to
;; running `vc-bzr-state'."
+ ;;
+ ;; The format of the dirstate file is explained in bzrlib/dirstate.py
+ ;; in the bzr distribution. Basically:
+ ;; header-line giving the version of the file format in use.
+ ;; a few lines of stuff
+ ;; entries, one per line, with null-separated fields. Each line:
+ ;; entry_key = dirname (may be empty), basename, file-id
+ ;; current = common ( = kind, fingerprint, size, executable )
+ ;; + working ( = packed_stat )
+ ;; parent = common ( as above ) + history ( = rev_id )
+ ;; kinds = (r)elocated, (a)bsent, (d)irectory, (f)ile, (l)ink
(lexical-let ((root (vc-bzr-root file)))
(when root ; Short cut.
- ;; This looks at internal files. May break if they change
- ;; their format.
(lexical-let ((dirstate (expand-file-name vc-bzr-admin-dirstate root)))
(condition-case nil
(with-temp-buffer
"\\([^\0]*\\)\0" ;"a/f/d", a=removed?
"\\([^\0]*\\)\0" ;sha1 (empty if conflicted)?
"\\([^\0]*\\)\0" ;size?p
- "[^\0]*\0" ;"y/n", executable?
+ ;; y/n. Whether or not the current copy
+ ;; was executable the last time bzr checked?
+ "[^\0]*\0"
"[^\0]*\0" ;?
- "\\([^\0]*\\)\0" ;"a/f/d" a=added?
+ ;; Parent information. Absent in a new repo.
+ "\\(?:\\([^\0]*\\)\0" ;"a/f/d" a=added?
"\\([^\0]*\\)\0" ;sha1 again?
"\\([^\0]*\\)\0" ;size again?
- "[^\0]*\0" ;"y/n", executable again?
- "[^\0]*\0" ;last revid?
+ ;; y/n. Whether or not the repo thinks
+ ;; the file should be executable?
+ "\\([^\0]*\\)\0"
+ "[^\0]*\0\\)?" ;last revid?
;; There are more fields when merges are pending.
)
nil t)
;; conflict markers).
(cond
((eq (char-after (match-beginning 1)) ?a) 'removed)
- ((eq (char-after (match-beginning 4)) ?a) 'added)
+ ;; If there is no parent, this must be a new repo.
+ ;; If file is in dirstate, can only be added (b#8025).
+ ((or (not (match-beginning 4))
+ (eq (char-after (match-beginning 4)) ?a)) 'added)
((or (and (eq (string-to-number (match-string 3))
(nth 7 (file-attributes file)))
- (equal (match-string 5)
- (vc-bzr-sha1 file)))
+ (equal (match-string 5)
+ (vc-bzr-sha1 file))
+ ;; For a file, does the executable state match?
+ ;; (Bug#7544)
+ (or (not
+ (eq (char-after (match-beginning 1)) ?f))
+ (let ((exe
+ (memq
+ ?x
+ (mapcar
+ 'identity
+ (nth 8 (file-attributes file))))))
+ (if (eq (char-after (match-beginning 7))
+ ?y)
+ exe
+ (not exe)))))
(and
;; It looks like for lightweight
;; checkouts \2 is empty and we need to
"added\\|ignored\\|kind changed\\|modified\\|removed\\|renamed\\|unknown"
"Regexp matching file status words as reported in `bzr' output.")
+;; History of Bzr commands.
+(defvar vc-bzr-history nil)
+
(defun vc-bzr-file-name-relative (filename)
"Return file name FILENAME stripped of the initial Bzr repository path."
(lexical-let*
(when rootdir
(file-relative-name filename* rootdir))))
+(defvar vc-bzr-error-regex-alist
+ '(("^\\( M[* ]\\|+N \\|-D \\|\\| \\*\\|R[M ] \\) \\(.+\\)" 2 nil nil 1)
+ ("^C \\(.+\\)" 2)
+ ("^Text conflict in \\(.+\\)" 1 nil nil 2)
+ ("^Using saved parent location: \\(.+\\)" 1 nil nil 0))
+ "Value of `compilation-error-regexp-alist' in *vc-bzr* buffers.")
+
+(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."
+ (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"))
+ args)
+ ;; If necessary, prompt for the exact command.
+ (when (or prompt (not (or bound has-parent)))
+ (setq args (split-string
+ (read-shell-command
+ "Bzr pull command: "
+ (concat vc-bzr-program " " command)
+ 'vc-bzr-history)
+ " " t))
+ (setq vc-bzr-program (car args)
+ command (cadr args)
+ args (cddr args)))
+ (let ((buf (apply 'vc-bzr-async-command command args)))
+ (with-current-buffer buf
+ (vc-exec-after
+ `(progn
+ (let ((compilation-error-regexp-alist
+ vc-bzr-error-regex-alist))
+ (compilation-mode))
+ (set (make-local-variable 'compilation-error-regexp-alist)
+ vc-bzr-error-regex-alist))))
+ (vc-set-async-update buf))))
+
+(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
+source (an upstream branch or a previous merge source) as a
+default if it is available."
+ (let* ((branch-conf (vc-bzr-branch-conf default-directory))
+ ;; "bzr merge" without an argument defaults to submit_branch,
+ ;; then parent_location. Extract the specific location and
+ ;; add it explicitly to the command line.
+ (setting nil)
+ (location
+ (cond
+ ((setq setting (assoc "submit_branch" branch-conf))
+ (cdr setting))
+ ((setq setting (assoc "parent_location" branch-conf))
+ (cdr setting))))
+ (cmd
+ (split-string
+ (read-shell-command
+ "Bzr merge command: "
+ (concat vc-bzr-program " merge --pull"
+ (if location (concat " " location) ""))
+ 'vc-bzr-history)
+ " " t))
+ (vc-bzr-program (car cmd))
+ (command (cadr cmd))
+ (args (cddr cmd)))
+ (let ((buf (apply 'vc-bzr-async-command command args)))
+ (with-current-buffer buf
+ (vc-exec-after
+ `(progn
+ (let ((compilation-error-regexp-alist
+ vc-bzr-error-regex-alist))
+ (compilation-mode))
+ (set (make-local-variable 'compilation-error-regexp-alist)
+ vc-bzr-error-regex-alist))))
+ (vc-set-async-update buf))))
+
(defun vc-bzr-status (file)
"Return FILE status according to Bzr.
Return value is a cons (STATUS . WARNING), where WARNING is a
(skip-chars-forward " \n\t") ;Throw away spaces.
(cons status
;; "bzr" will output warnings and informational messages to
- ;; stderr; due to Emacs' `vc-do-command' (and, it seems,
+ ;; stderr; due to Emacs's `vc-do-command' (and, it seems,
;; `start-process' itself) limitations, we cannot catch stderr
;; and stdout into different buffers. So, if there's anything
;; left in the buffer after removing the above status
(defun vc-bzr-state (file)
(lexical-let ((result (vc-bzr-status file)))
(when (consp result)
- (when (cdr result)
- (message "Warnings in `bzr' output: %s" (cdr result)))
+ (let ((warnings (cdr result)))
+ (when warnings
+ ;; bzr 2.3.0 returns info about shelves, which is not really a warning
+ (when (string-match "[0-9]+ shel\\(f\\|ves\\) exists?\\..*?\n" warnings)
+ (setq warnings (replace-match "" nil nil warnings)))
+ (unless (string= warnings "")
+ (message "Warnings in `bzr' output: %s" warnings))))
(cdr (assq (car result)
'((added . added)
(kindchanged . edited)
(error "Don't know how to compute the next revision of %s" rev)))
(defun vc-bzr-register (files &optional rev comment)
- "Register FILE under bzr.
+ "Register FILES under bzr.
Signal an error unless REV is nil.
COMMENT is ignored."
(if rev (error "Can't register explicit revision with bzr"))
(declare-function log-edit-extract-headers "log-edit" (headers string))
(defun vc-bzr-checkin (files rev comment)
- "Check FILE in to bzr with log message 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"))
(apply 'vc-bzr-command "commit" nil 0
(defvar log-view-font-lock-keywords)
(defvar log-view-current-tag-function)
(defvar log-view-per-file-logs)
+(defvar log-view-expanded-log-entry-function)
(define-derived-mode vc-bzr-log-view-mode log-view-mode "Bzr-Log-View"
(remove-hook 'log-view-mode-hook 'vc-bzr-log-view-mode) ;Deactivate the hack.
(if (eq vc-log-view-type 'short)
"^ *\\([0-9.]+\\): \\(.*?\\)[ \t]+\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)\\( \\[merge\\]\\)?"
"^ *\\(?:revno: \\([0-9.]+\\)\\|merged: .+\\)"))
+ ;; Allow expanding short log entries
+ (when (eq vc-log-view-type 'short)
+ (setq truncate-lines t)
+ (set (make-local-variable 'log-view-expanded-log-entry-function)
+ 'vc-bzr-expanded-log-entry))
(set (make-local-variable 'log-view-font-lock-keywords)
;; log-view-font-lock-keywords is careful to use the buffer-local
;; value of log-view-message-re only since Emacs-23.
(list vc-bzr-log-switches)
vc-bzr-log-switches)))))
+(defun vc-bzr-expanded-log-entry (revision)
+ (with-temp-buffer
+ (apply 'vc-bzr-command "log" t nil nil
+ (list (format "-r%s" revision)))
+ (goto-char (point-min))
+ (when (looking-at "^-+\n")
+ ;; Indent the expanded log entry.
+ (indent-region (match-end 0) (point-max) 2)
+ (buffer-substring (match-end 0) (point-max)))))
+
(defun vc-bzr-log-incoming (buffer remote-location)
(apply 'vc-bzr-command "missing" buffer 'async nil
(list "--theirs-only" (unless (string= remote-location "") remote-location))))
(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*")
- (if vc-disable-async-diff 1 'async) files
- "--diff-options" (mapconcat 'identity
- (vc-switches 'bzr 'diff)
- " ")
- ;; This `when' is just an optimization because bzr-1.2 is *much*
- ;; faster when the revision argument is not given.
- (when (or rev1 rev2)
- (list "-r" (format "%s..%s"
- (or rev1 "revno:-1")
- (or rev2 ""))))))
+ (let* ((switches (vc-switches 'bzr 'diff))
+ (args
+ (append
+ ;; Only add --diff-options if there are any diff switches.
+ (unless (zerop (length switches))
+ (list "--diff-options" (mapconcat 'identity switches " ")))
+ ;; This `when' is just an optimization because bzr-1.2 is *much*
+ ;; faster when the revision argument is not given.
+ (when (or rev1 rev2)
+ (list "-r" (format "%s..%s"
+ (or rev1 "revno:-1")
+ (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
+ args)))
;; FIXME: vc-{next,previous}-revision need fixing in vc.el to deal with
(defun vc-bzr-rename-file (old new)
"Rename file from OLD to NEW using `bzr mv'."
- (vc-bzr-command "mv" nil 0 new old))
+ (setq old (expand-file-name old))
+ (setq new (expand-file-name new))
+ (vc-bzr-command "mv" nil 0 new old)
+ (message "Renamed %s => %s" old new))
(defvar vc-bzr-annotation-table nil
"Internal use.")
(when (process-buffer proc)
(with-current-buffer (process-buffer proc)
(setq string (concat (process-get proc :vc-left-over) string))
- (while (string-match "^\\( *[0-9.]+ *\\) \\([^\n ]+\\) +\\([0-9]\\{8\\}\\)\\( |.*\n\\)" string)
+ ;; Eg: 102020 Gnus developers 20101020 | regexp."
+ ;; As of bzr 2.2.2, no email address in whoami (which can
+ ;; lead to spaces in the author field) is allowed but discouraged.
+ ;; See bug#7792.
+ (while (string-match "^\\( *[0-9.]+ *\\) \\(.+?\\) +\\([0-9]\\{8\\}\\)\\( |.*\n\\)" string)
(let* ((rev (match-string 1 string))
(author (match-string 2 string))
(date (match-string 3 string))
(declare-function vc-annotate-convert-time "vc-annotate" (time))
(defun vc-bzr-annotate-time ()
- (when (re-search-forward "^ *[0-9.]+ +[^\n ]* +|" nil t)
+ (when (re-search-forward "^ *[0-9.]+ +.+? +|" nil t)
(let ((prop (get-text-property (line-beginning-position) 'help-echo)))
(string-match "[0-9]+\\'" prop)
(let ((str (match-string-no-properties 0 prop)))
(string-to-number (substring str 0 4))))))))
(defun vc-bzr-annotate-extract-revision-at-line ()
- "Return revision for current line of annoation buffer, or nil.
+ "Return revision for current line of annotation buffer, or nil.
Return nil if current line isn't annotated."
(save-excursion
(beginning-of-line)
- (if (looking-at "^ *\\([0-9.]+\\) +[^\n ]* +|")
+ (if (looking-at "^ *\\([0-9.]+\\) +.* +|")
(match-string-no-properties 1))))
(defun vc-bzr-command-discarding-stderr (command &rest args)
(" M " . edited) ;; file text modified
(" *" . edited) ;; execute bit changed
(" M*" . edited) ;; text modified + execute bit changed
- ;; FIXME: what about ignored files?
+ ("I " . ignored)
(" D " . missing)
;; For conflicts, should we list the .THIS/.BASE/.OTHER?
("C " . conflict)
(result nil))
(goto-char (point-min))
(while (not (eobp))
- (setq status-str
- (buffer-substring-no-properties (point) (+ (point) 3)))
- (setq translated (cdr (assoc status-str translation)))
- (cond
- ((eq translated 'conflict)
- ;; For conflicts the file appears twice in the listing: once
- ;; with the M flag and once with the C flag, so take care
- ;; not to add it twice to `result'. Ugly.
- (let* ((file
- (buffer-substring-no-properties
- ;;For files with conflicts the format is:
- ;;C Text conflict in FILENAME
- ;; Bah.
- (+ (point) 21) (line-end-position)))
- (entry (assoc file result)))
- (when entry
- (setf (nth 1 entry) 'conflict))))
- ((eq translated 'renamed)
- (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
- (vc-bzr-create-extra-fileinfo old-name)) result)))
- ;; do nothing for non existent files
- ((eq translated 'not-found))
- (t
- (push (list (file-relative-name
- (buffer-substring-no-properties
- (+ (point) 4)
- (line-end-position)) relative-dir)
- translated) result)))
- (forward-line))
+ ;; Bzr 2.3.0 added this if there are shelves. (Bug#8170)
+ (unless (looking-at "[0-9]+ shel\\(f\\|ves\\) exists?\\.")
+ (setq status-str
+ (buffer-substring-no-properties (point) (+ (point) 3)))
+ (setq translated (cdr (assoc status-str translation)))
+ (cond
+ ((eq translated 'conflict)
+ ;; For conflicts the file appears twice in the listing: once
+ ;; with the M flag and once with the C flag, so take care
+ ;; not to add it twice to `result'. Ugly.
+ (let* ((file
+ (buffer-substring-no-properties
+ ;;For files with conflicts the format is:
+ ;;C Text conflict in FILENAME
+ ;; Bah.
+ (+ (point) 21) (line-end-position)))
+ (entry (assoc file result)))
+ (when entry
+ (setf (nth 1 entry) 'conflict))))
+ ((eq translated 'renamed)
+ (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
+ (vc-bzr-create-extra-fileinfo old-name)) result)))
+ ;; do nothing for non existent files
+ ((memq translated '(not-found ignored)))
+ (t
+ (push (list (file-relative-name
+ (buffer-substring-no-properties
+ (+ (point) 4)
+ (line-end-position)) relative-dir)
+ translated) result))))
+ (forward-line))
(funcall update-function result)))
(defun vc-bzr-dir-status (dir update-function)
(defvar vc-bzr-shelve-menu-map
(let ((map (make-sparse-keymap "Bzr Shelve")))
(define-key map [de]
- '(menu-item "Delete shelf" vc-bzr-shelve-delete-at-point
+ '(menu-item "Delete Shelf" vc-bzr-shelve-delete-at-point
:help "Delete the current shelf"))
(define-key map [ap]
- '(menu-item "Apply and keep shelf" vc-bzr-shelve-apply-and-keep-at-point
+ '(menu-item "Apply and Keep Shelf" vc-bzr-shelve-apply-and-keep-at-point
:help "Apply the current shelf and keep it"))
(define-key map [po]
- '(menu-item "Apply and remove shelf (pop)" vc-bzr-shelve-apply-at-point
+ '(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
+ '(menu-item "Show Shelve" vc-bzr-shelve-show-at-point
:help "Show the contents of the current shelve"))
map))
(defvar vc-bzr-extra-menu-map
(let ((map (make-sparse-keymap)))
(define-key map [bzr-sn]
- '(menu-item "Shelve a snapshot" vc-bzr-shelve-snapshot
+ '(menu-item "Shelve a Snapshot" vc-bzr-shelve-snapshot
:help "Shelve the current state of the tree and keep the current state"))
(define-key map [bzr-sh]
'(menu-item "Shelve..." vc-bzr-shelve
(defun vc-bzr-shelve-delete-at-point ()
(interactive)
(let ((shelve (vc-bzr-shelve-get-at-point (point))))
- (when (y-or-n-p (format "Remove shelf %s ?" shelve))
+ (when (y-or-n-p (format "Remove shelf %s ? " shelve))
(vc-bzr-command "unshelve" nil 0 nil "--delete-only" shelve)
(vc-dir-refresh))))
(eval-and-compile
(defconst vc-bzr-revision-keywords
- '("revno" "revid" "last" "before"
- "tag" "date" "ancestor" "branch" "submit")))
+ ;; bzr help revisionspec | sed -ne 's/^\([a-z]*\):$/"\1"/p' | sort -u
+ '("ancestor" "annotate" "before" "branch" "date" "last" "mainline" "revid"
+ "revno" "submit" "tag")))
(defun vc-bzr-revision-completion-table (files)
(lexical-let ((files files))
(push (match-string-no-properties 1) table)))
(completion-table-with-context prefix table tag pred action)))
+ ((string-match "\\`annotate:" string)
+ (completion-table-with-context
+ (substring string 0 (match-end 0))
+ (apply-partially #'completion-table-with-terminator '(":" . "\\`a\\`")
+ #'completion-file-name-table)
+ (substring string (match-end 0)) pred action))
+
+ ((string-match "\\`date:" string)
+ (completion-table-with-context
+ (substring string 0 (match-end 0))
+ '("yesterday" "today" "tomorrow")
+ (substring string (match-end 0)) pred action))
+
((string-match "\\`\\([a-z]+\\):" string)
;; no actual completion for the remaining keywords.
(completion-table-with-context (substring string 0 (match-end 0))
vc-bzr-revision-keywords))
string pred))))))
-(eval-after-load "vc"
- '(add-to-list 'vc-directory-exclusion-list vc-bzr-admin-dirname t))
-
(provide 'vc-bzr)
-;; arch-tag: 8101bad8-4e92-4e7d-85ae-d8e08b4e7c06
+
;;; vc-bzr.el ends here
HCoop / bpt / emacs.git / blobdiff