1 ;;; vc-bzr.el --- VC backend for the bzr revision control system
3 ;; Copyright (C) 2006, 2007 Free Software Foundation, Inc.
5 ;; NOTE: THIS IS A MODIFIED VERSION OF Dave Love's vc-bzr.el,
6 ;; which you can find at: http://www.loveshack.ukfsn.org/emacs/vc-bzr.el
7 ;; I could not get in touch with Dave Love by email, so
8 ;; I am releasing my changes separately. -- Riccardo
10 ;; Author: Dave Love <fx@gnu.org>, Riccardo Murri <riccardo.murri@gmail.com>
13 ;; Version: 2007-05-24
14 ;; URL: http://launchpad.net/vc-bzr
16 ;; This file is free software; you can redistribute it and/or modify
17 ;; it under the terms of the GNU General Public License as published by
18 ;; the Free Software Foundation; either version 2, or (at your option)
21 ;; This file is distributed in the hope that it will be useful,
22 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 ;; GNU General Public License for more details.
26 ;; You should have received a copy of the GNU General Public License
27 ;; along with GNU Emacs; see the file COPYING. If not, write to the
28 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
29 ;; Boston, MA 02110-1301, USA.
34 ;; NOTE: THIS IS A MODIFIED VERSION OF Dave Love's vc-bzr.el,
35 ;; which you can find at: http://www.loveshack.ukfsn.org/emacs/vc-bzr.el
37 ;; See <URL:http://bazaar-vcs.org/> concerning bzr.
39 ;; Load this library to register bzr support in VC. It covers basic VC
40 ;; functionality, but was only lightly exercised with a few Emacs/bzr
41 ;; version combinations, namely those current on the authors' PCs.
42 ;; See various Fixmes below.
48 ;; When edititing a symlink and *both* the symlink and its target
49 ;; are bzr-versioned, `vc-bzr` presently runs `bzr status` on the
50 ;; symlink, thereby not detecting whether the actual contents
51 ;; (that is, the target contents) are changed.
52 ;; See https://bugs.launchpad.net/vc-bzr/+bug/116607
54 ;; For an up-to-date list of bugs, please see:
55 ;; https://bugs.launchpad.net/vc-bzr/+bugs
62 (require 'vc
)) ; for vc-exec-after
64 ;; Clear up the cache to force vc-call to check again and discover
65 ;; new functions when we reload this file.
66 (put 'BZR
'vc-functions nil
)
73 (defcustom vc-bzr-program
"bzr"
74 "Name of the bzr command (excluding any arguments)."
78 ;; Fixme: there's probably no call for this.
79 (defcustom vc-bzr-program-args nil
80 "List of global arguments to pass to `vc-bzr-program'."
82 :type
'(repeat string
))
84 (defcustom vc-bzr-diff-switches nil
85 "String/list of strings specifying extra switches for bzr diff under VC."
86 :type
'(choice (const :tag
"None" nil
)
87 (string :tag
"Argument String")
88 (repeat :tag
"Argument List" :value
("") string
))
91 ;; since v0.9, bzr supports removing the progress indicators
92 ;; by setting environment variable BZR_PROGRESS_BAR to "none".
93 (defun vc-bzr-command (bzr-command buffer okstatus file-or-list
&rest args
)
94 "Wrapper round `vc-do-command' using `vc-bzr-program' as COMMAND.
95 Invoke the bzr command adding `BZR_PROGRESS_BAR=none' to the environment."
96 (let ((process-environment
97 (list* "BZR_PROGRESS_BAR=none" ; Suppress progress output (bzr >=0.9)
98 "LC_ALL=C" ; Force English output
100 ;; bzr may attempt some kind of user interaction if its stdin/stdout
101 ;; is connected to a PTY; therefore, ask Emacs to use a pipe to
102 ;; communicate with it.
103 ;; This is redundant because vc-do-command does it already. --Stef
104 (process-connection-type nil
))
105 (apply 'vc-do-command buffer okstatus vc-bzr-program
106 file-or-list bzr-command
(append vc-bzr-program-args args
))))
110 (defconst vc-bzr-admin-dirname
".bzr") ; FIXME: "_bzr" on w32?
112 ;;;###autoload (defun vc-bzr-registered (file)
113 ;;;###autoload (if (vc-find-root file vc-bzr-admin-dirname)
114 ;;;###autoload (progn
115 ;;;###autoload (load "vc-bzr")
116 ;;;###autoload (vc-bzr-registered file))))
118 (defun vc-bzr-root-dir (file)
119 "Return the root directory in the hierarchy above FILE.
120 Return nil if there isn't one."
121 (vc-find-root file vc-bzr-admin-dirname
))
123 (defun vc-bzr-registered (file)
124 "Return non-nil if FILE is registered with bzr."
125 (if (vc-bzr-root-dir file
) ; Short cut.
126 (vc-bzr-state file
))) ; Expensive.
128 (defun vc-bzr-buffer-nonblank-p (&optional buffer
)
129 "Return non-nil if BUFFER contains any non-blank characters."
130 (or (> (buffer-size buffer
) 0)
132 (set-buffer (or buffer
(current-buffer)))
133 (goto-char (point-min))
134 (re-search-forward "[^ \t\n]" (point-max) t
))))
136 (defconst vc-bzr-state-words
137 "added\\|ignored\\|modified\\|removed\\|renamed\\|unknown"
138 "Regexp matching file status words as reported in `bzr' output.")
140 ;; FIXME: Also get this in a non-registered sub-directory.
141 (defun vc-bzr-state (file)
143 (cd (file-name-directory file
))
144 (let ((ret (vc-bzr-command "status" t
255 file
))
146 ;; the only secure status indication in `bzr status' output
147 ;; is a couple of lines following the pattern::
150 ;; if the file is up-to-date, we get no status report from `bzr',
151 ;; so if the regexp search for the above pattern fails, we consider
152 ;; the file to be up-to-date.
153 (goto-char (point-min))
156 (concat "^\\(" vc-bzr-state-words
"\\):[ \t\n]+"
157 (file-name-nondirectory file
) "[ \t\n]*$")
159 (let ((start (match-beginning 0))
164 ((not (equal ret
0)) nil
)
165 ((looking-at "added\\|renamed\\|modified\\|removed") 'edited
)
166 ((looking-at "unknown\\|ignored") nil
)))
167 ;; erase the status text that matched
168 (delete-region start end
)))
169 (when (vc-bzr-buffer-nonblank-p)
170 ;; "bzr" will output some warnings and informational messages
171 ;; to the user to stderr; due to Emacs' `vc-do-command' (and,
172 ;; it seems, `start-process' itself), we cannot catch stderr
173 ;; and stdout into different buffers. So, if there's anything
174 ;; left in the buffer after removing the above status
175 ;; keywords, let us just presume that any other message from
176 ;; "bzr" is a user warning, and display it.
177 (message "Warnings in `bzr' output: %s"
178 (buffer-substring (point-min) (point-max))))
180 (vc-file-setprop file
'vc-workfile-version
181 (vc-bzr-workfile-version file
))
182 (vc-file-setprop file
'vc-state state
))
185 (defun vc-bzr-workfile-unchanged-p (file)
186 (eq 'up-to-date
(vc-bzr-state file
)))
188 (defun vc-bzr-workfile-version (file)
189 ;; Looks like this could be obtained via counting lines in
190 ;; .bzr/branch/revision-history.
192 (vc-bzr-command "revno" t
0 file
)
193 (goto-char (point-min))
194 (buffer-substring (point) (line-end-position))))
196 (defun vc-bzr-checkout-model (file)
199 (defun vc-bzr-register (files &optional rev comment
)
200 "Register FILE under bzr.
201 Signal an error unless REV is nil.
203 (if rev
(error "Can't register explicit version with bzr"))
204 (vc-bzr-command "add" nil
0 files
))
206 ;; Could run `bzr status' in the directory and see if it succeeds, but
207 ;; that's relatively expensive.
208 (defalias 'vc-bzr-responsible-p
'vc-bzr-root-dir
209 "Return non-nil if FILE is (potentially) controlled by bzr.
210 The criterion is that there is a `.bzr' directory in the same
211 or a superior directory.")
213 (defun vc-bzr-could-register (file)
214 "Return non-nil if FILE could be registered under bzr."
215 (and (vc-bzr-responsible-p file
) ; shortcut
218 (vc-bzr-command "add" t
0 file
"--dry-run")
219 ;; The command succeeds with no output if file is
220 ;; registered (in bzr 0.8).
221 (goto-char (point-min))
222 (looking-at "added "))
225 (defun vc-bzr-unregister (file)
226 "Unregister FILE from bzr."
227 (vc-bzr-command "remove" nil
0 file
))
229 (defun vc-bzr-checkin (files rev comment
)
230 "Check FILE in to bzr with log message COMMENT.
231 REV non-nil gets an error."
232 (if rev
(error "Can't check in a specific version with bzr"))
233 (vc-bzr-command "commit" nil
0 files
"-m" comment
))
235 (defun vc-bzr-checkout (file &optional editable rev destfile
)
236 "Checkout revision REV of FILE from bzr to DESTFILE.
237 EDITABLE is ignored."
239 (setq destfile
(vc-version-backup-file-name file rev
)))
240 (let ((coding-system-for-read 'binary
)
241 (coding-system-for-write 'binary
))
242 (with-temp-file destfile
244 (vc-bzr-command "cat" t
0 file
"-r" rev
)
245 (vc-bzr-command "cat" t
0 file
)))))
247 (defun vc-bzr-revert (file &optional contents-done
)
248 (unless contents-done
249 (with-temp-buffer (vc-bzr-command "revert" t
'async file
))))
251 (defvar log-view-message-re
)
252 (defvar log-view-file-re
)
253 (defvar log-view-font-lock-keywords
)
254 (defvar log-view-current-tag-function
)
256 (define-derived-mode vc-bzr-log-view-mode log-view-mode
"Bzr-Log-View"
257 (remove-hook 'log-view-mode-hook
'vc-bzr-log-view-mode
) ;Deactivate the hack.
259 ;; Don't have file markers, so use impossible regexp.
260 (set (make-local-variable 'log-view-file-re
) "\\'\\`")
261 (set (make-local-variable 'log-view-message-re
)
262 "^ *-+\n *\\(?:revno: \\([0-9]+\\)\\|merged: .+\\)")
263 (set (make-local-variable 'log-view-font-lock-keywords
)
264 ;; log-view-font-lock-keywords is careful to use the buffer-local
265 ;; value of log-view-message-re only since Emacs-23.
266 (append `((,log-view-message-re .
'log-view-message-face
))
267 ;; log-view-font-lock-keywords
269 \\([^<(]+?\\)[ ]*[(<]\\([[:alnum:]_.+-]+@[[:alnum:]_.-]+\\)[>)]"
271 (2 'change-log-email
))
272 ("^ *timestamp: \\(.*\\)" (1 'change-log-date-face
))))))
274 (defun vc-bzr-print-log (files &optional buffer
) ; get buffer arg in Emacs 22
275 "Get bzr change log for FILES into specified BUFFER."
276 ;; Fixme: This might need the locale fixing up if things like `revno'
277 ;; got localized, but certainly it shouldn't use LC_ALL=C.
278 ;; NB. Can't be async -- see `vc-bzr-post-command-function'.
279 (vc-bzr-command "log" buffer
0 files
)
280 ;; FIXME: Until Emacs-23, VC was missing a hook to sort out the mode for
281 ;; the buffer, or at least set the regexps right.
282 (unless (fboundp 'vc-default-log-view-mode
)
283 (add-hook 'log-view-mode-hook
'vc-bzr-log-view-mode
)))
285 (defun vc-bzr-show-log-entry (version)
286 "Find entry for patch name VERSION in bzr change log buffer."
287 (goto-char (point-min))
288 (let (case-fold-search)
289 (if (re-search-forward (concat "^-+\nrevno: " version
"$") nil t
)
290 (beginning-of-line 0)
291 (goto-char (point-min)))))
293 ;; Fixem: vc-bzr-wash-log
295 (autoload 'vc-diff-switches-list
"vc" nil nil t
)
297 (defun vc-bzr-diff (files &optional rev1 rev2 buffer
)
298 "VC bzr backend for diff."
299 (let ((working (vc-workfile-version (car files
))))
300 (if (and (equal rev1 working
) (not rev2
))
302 (if (and (not rev1
) rev2
)
304 ;; NB. Can't be async -- see `vc-bzr-post-command-function'.
305 ;; bzr diff produces condition code 1 for some reason.
306 (apply #'vc-bzr-command
"diff" (or buffer
"*vc-diff*") 1 files
307 "--diff-options" (mapconcat 'identity
(vc-diff-switches-list bzr
)
311 (list "-r" (format "%s..%s" rev1 rev2
))
312 (list "-r" rev1
))))))
314 (defalias 'vc-bzr-diff-tree
'vc-bzr-diff
)
316 ;; Fixme: implement vc-bzr-dir-state, vc-bzr-dired-state-info
318 ;; Fixme: vc-{next,previous}-version need fixing in vc.el to deal with
319 ;; straight integer versions.
321 (defun vc-bzr-delete-file (file)
322 "Delete FILE and delete it in the bzr repository."
326 (vc-bzr-command "remove" nil
0 file
))
328 (defun vc-bzr-rename-file (old new
)
329 "Rename file from OLD to NEW using `bzr mv'."
330 (vc-bzr-command "mv" nil
0 new old
))
332 (defvar vc-bzr-annotation-table nil
334 (make-variable-buffer-local 'vc-bzr-annotation-table
)
336 (defun vc-bzr-annotate-command (file buffer
&optional version
)
337 "Prepare BUFFER for `vc-annotate' on FILE.
338 Each line is tagged with the revision number, which has a `help-echo'
339 property containing author and date information."
340 (apply #'vc-bzr-command
"annotate" buffer
0 file
"-l" "--all"
341 (if version
(list "-r" version
)))
342 (with-current-buffer buffer
343 ;; Store the tags for the annotated source lines in a hash table
344 ;; to allow saving space by sharing the text properties.
345 (setq vc-bzr-annotation-table
(make-hash-table :test
'equal
))
346 (goto-char (point-min))
347 (while (re-search-forward "^\\( *[0-9]+\\) \\(.+\\) +\\([0-9]\\{8\\}\\) |"
349 (let* ((rev (match-string 1))
350 (author (match-string 2))
351 (date (match-string 3))
352 (key (match-string 0))
353 (tag (gethash key vc-bzr-annotation-table
)))
356 (string-match " +\\'" author
)
357 (setq author
(substring author
0 (match-beginning 0))))
358 (setq tag
(propertize rev
'help-echo
(concat "Author: " author
360 'mouse-face
'highlight
))
361 (puthash key tag vc-bzr-annotation-table
))
363 (insert tag
" |")))))
365 ;; Definition from Emacs 22
366 (unless (fboundp 'vc-annotate-convert-time
)
367 (defun vc-annotate-convert-time (time)
368 "Convert a time value to a floating-point number of days.
369 The argument TIME is a list as returned by `current-time' or
370 `encode-time', only the first two elements of that list are considered."
371 (/ (+ (* (float (car time
)) (lsh 1 16)) (cadr time
)) 24 3600)))
373 (defun vc-bzr-annotate-time ()
374 (when (re-search-forward "^ *[0-9]+ |" nil t
)
375 (let ((prop (get-text-property (line-beginning-position) 'help-echo
)))
376 (string-match "[0-9]+\\'" prop
)
377 (vc-annotate-convert-time
379 (string-to-number (substring (match-string 0 prop
) 6 8))
380 (string-to-number (substring (match-string 0 prop
) 4 6))
381 (string-to-number (substring (match-string 0 prop
) 0 4))
384 (defun vc-bzr-annotate-extract-revision-at-line ()
385 "Return revision for current line of annoation buffer, or nil.
386 Return nil if current line isn't annotated."
389 (if (looking-at " *\\([0-9]+\\) | ")
390 (match-string-no-properties 1))))
392 ;; Not needed for Emacs 22
393 (defun vc-bzr-annotate-difference (point)
394 (let ((next-time (vc-bzr-annotate-time)))
396 (- (vc-annotate-convert-time (current-time)) next-time
))))
398 ;; FIXME: `bzr root' will return the real path to the repository root,
399 ;; that is, it can differ from the buffer's current directory name
400 ;; if there are any symbolic links.
401 (defun vc-bzr-root (dir)
402 "Return the root directory of the bzr repository containing DIR."
403 ;; Cache technique copied from vc-arch.el.
404 (or (vc-file-getprop dir
'bzr-root
)
408 (shell-command-to-string (concat vc-bzr-program
" root " dir
)) 0 -
1))))
410 ;; TODO: it would be nice to mark the conflicted files in VC Dired,
411 ;; and implement a command to run ediff and `bzr resolve' once the
412 ;; changes have been merged.
413 (defun vc-bzr-dir-state (dir &optional localp
)
414 "Find the VC state of all files in DIR.
415 Optional argument LOCALP is always ignored."
416 (let ((bzr-root-directory (vc-bzr-root dir
))
418 current-bzr-state current-vc-state
)
419 ;; Check that DIR is a bzr repository.
420 (unless (file-name-absolute-p bzr-root-directory
)
421 (error "Cannot find bzr repository for directory `%s'" dir
))
422 ;; `bzr ls --versioned' lists all versioned files;
423 ;; assume they are up-to-date, unless we are given
424 ;; evidence of the contrary.
427 (vc-bzr-command "ls" t
0 nil
"--versioned" "--non-recursive")
428 (goto-char (point-min))
430 (eq 0 (forward-line)))
432 (let ((file (expand-file-name
433 (buffer-substring-no-properties
434 (line-beginning-position) (line-end-position))
435 bzr-root-directory
)))
436 (vc-file-setprop file
'vc-state
'up-to-date
)
437 ;; XXX: is this correct? what happens if one
438 ;; mixes different SCMs in the same dir?
439 (vc-file-setprop file
'vc-backend
'BZR
))))
440 ;; `bzr status' reports on added/modified/renamed and unknown/ignored files
443 (vc-bzr-command "status" t
0 nil
)
444 (goto-char (point-min))
446 (eq 0 (forward-line)))
449 ((looking-at "^added")
450 (setq current-vc-state
'edited
)
451 (setq current-bzr-state
'added
))
452 ((looking-at "^modified")
453 (setq current-vc-state
'edited
)
454 (setq current-bzr-state
'modified
))
455 ((looking-at "^renamed")
456 (setq current-vc-state
'edited
)
457 (setq current-bzr-state
'renamed
))
458 ((looking-at "^\\(unknown\\|ignored\\)")
459 (setq current-vc-state nil
)
460 (setq current-bzr-state
'not-versioned
))
462 ;; file names are indented by two spaces
463 (when current-vc-state
464 (let ((file (expand-file-name
465 (buffer-substring-no-properties
466 (match-end 0) (line-end-position))
467 bzr-root-directory
)))
468 (vc-file-setprop file
'vc-state current-vc-state
)
469 (vc-file-setprop file
'vc-bzr-state current-bzr-state
)
470 (when (eq 'added current-bzr-state
)
471 (vc-file-setprop file
'vc-workfile-version
"0"))))
472 (when (eq 'not-versioned current-bzr-state
)
473 (let ((file (expand-file-name
474 (buffer-substring-no-properties
475 (match-end 0) (line-end-position))
476 bzr-root-directory
)))
477 (vc-file-setprop file
'vc-backend
'none
)
478 (vc-file-setprop file
'vc-state nil
))))
480 ;; skip this part of `bzr status' output
481 (setq current-vc-state nil
)
482 (setq current-bzr-state nil
)))))))
484 (defun vc-bzr-dired-state-info (file)
485 "Bzr-specific version of `vc-dired-state-info'."
486 (if (eq 'edited
(vc-state file
))
487 (let ((bzr-state (vc-file-getprop file
'vc-bzr-state
)))
489 (concat "(" (symbol-name bzr-state
) ")")
490 ;; else fall back to default vc representation
491 (vc-default-dired-state-info 'BZR file
)))))
493 ;; In case of just `(load "vc-bzr")', but that's probably the wrong
495 (add-to-list 'vc-handled-backends
'BZR
)
497 (eval-after-load "vc"
498 '(add-to-list 'vc-directory-exclusion-list
".bzr" t
))
500 (defconst vc-bzr-unload-hook
502 (setq vc-handled-backends
(delq 'BZR vc-handled-backends
))
503 (remove-hook 'vc-post-command-functions
'vc-bzr-post-command-function
)))
506 ;; arch-tag: 8101bad8-4e92-4e7d-85ae-d8e08b4e7c06
507 ;;; vc-bzr.el ends here