;;; vc-bzr.el --- VC backend for the bzr revision control system
-;; Copyright (C) 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Riccardo Murri <riccardo.murri@gmail.com>
(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.
;; 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
(push (cons (match-string 1) (match-string 2)) settings)))
settings))
-(require 'sha1) ;For sha1-program
-
(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)
;; 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
;; 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?
;; y/n. Whether or not the repo thinks
;; the file should be executable?
"\\([^\0]*\\)\0"
- "[^\0]*\0" ;last revid?
+ "[^\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)
(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)
(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.")
(" 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
(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))
HCoop / bpt / emacs.git / blobdiff