Fix typos.
[bpt/emacs.git] / lisp / vc-bzr.el
CommitLineData
b6e0e86c
SM
1;;; vc-bzr.el --- VC backend for the bzr revision control system
2
f4d0cf23 3;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc.
b6e0e86c 4
b6e0e86c
SM
5;; Author: Dave Love <fx@gnu.org>, Riccardo Murri <riccardo.murri@gmail.com>
6;; Keywords: tools
7;; Created: Sept 2006
f4d0cf23 8;; Version: 2008-01-04 (Bzr revno 25)
b6e0e86c
SM
9;; URL: http://launchpad.net/vc-bzr
10
eb3fa2cf
GM
11;; This file is part of GNU Emacs.
12
13;; GNU Emacs is free software: you can redistribute it and/or modify
b6e0e86c 14;; it under the terms of the GNU General Public License as published by
eb3fa2cf
GM
15;; the Free Software Foundation, either version 3 of the License, or
16;; (at your option) any later version.
b6e0e86c 17
eb3fa2cf 18;; GNU Emacs is distributed in the hope that it will be useful,
b6e0e86c
SM
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;; GNU General Public License for more details.
22
23;; You should have received a copy of the GNU General Public License
eb3fa2cf 24;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
b6e0e86c
SM
25
26;;; Commentary:
27
f4d0cf23
SM
28;; See <URL:http://bazaar-vcs.org/> concerning bzr. See
29;; <URL:http://launchpad.net/vc-bzr> for alternate development
30;; branches of `vc-bzr'.
b6e0e86c 31
eb3fa2cf 32;; Load this library to register bzr support in VC.
77b5d458
SM
33
34;; Known bugs
35;; ==========
36
37;; When edititing a symlink and *both* the symlink and its target
38;; are bzr-versioned, `vc-bzr` presently runs `bzr status` on the
39;; symlink, thereby not detecting whether the actual contents
eb3fa2cf 40;; (that is, the target contents) are changed.
77b5d458
SM
41;; See https://bugs.launchpad.net/vc-bzr/+bug/116607
42
43;; For an up-to-date list of bugs, please see:
44;; https://bugs.launchpad.net/vc-bzr/+bugs
b6e0e86c 45
70e2f6c7
ER
46;;; Properties of the backend
47
48(defun vc-bzr-revision-granularity () 'repository)
49(defun vc-bzr-checkout-model (files) 'implicit)
b6e0e86c
SM
50
51;;; Code:
52
53(eval-when-compile
37320a58 54 (require 'cl)
b6e0e86c
SM
55 (require 'vc)) ; for vc-exec-after
56
360cf7bc
SM
57;; Clear up the cache to force vc-call to check again and discover
58;; new functions when we reload this file.
4211679b 59(put 'Bzr 'vc-functions nil)
360cf7bc 60
b6e0e86c
SM
61(defgroup vc-bzr nil
62 "VC bzr backend."
fba500b6 63 :version "22.2"
b6e0e86c
SM
64 :group 'vc)
65
66(defcustom vc-bzr-program "bzr"
37320a58 67 "Name of the bzr command (excluding any arguments)."
b6e0e86c
SM
68 :group 'vc-bzr
69 :type 'string)
70
b6e0e86c 71(defcustom vc-bzr-diff-switches nil
37320a58 72 "String/list of strings specifying extra switches for bzr diff under VC."
b6e0e86c
SM
73 :type '(choice (const :tag "None" nil)
74 (string :tag "Argument String")
75 (repeat :tag "Argument List" :value ("") string))
76 :group 'vc-bzr)
77
f4d0cf23
SM
78(defcustom vc-bzr-log-switches nil
79 "String/list of strings specifying extra switches for `bzr log' under VC."
80 :type '(choice (const :tag "None" nil)
81 (string :tag "Argument String")
82 (repeat :tag "Argument List" :value ("") string))
83 :group 'vc-bzr)
84
37320a58
SM
85;; since v0.9, bzr supports removing the progress indicators
86;; by setting environment variable BZR_PROGRESS_BAR to "none".
8cdd17b4 87(defun vc-bzr-command (bzr-command buffer okstatus file-or-list &rest args)
37320a58 88 "Wrapper round `vc-do-command' using `vc-bzr-program' as COMMAND.
f4d0cf23
SM
89Invoke the bzr command adding `BZR_PROGRESS_BAR=none' and
90`LC_MESSAGES=C' to the environment."
37320a58
SM
91 (let ((process-environment
92 (list* "BZR_PROGRESS_BAR=none" ; Suppress progress output (bzr >=0.9)
f4d0cf23 93 "LC_MESSAGES=C" ; Force English output
a460c94c 94 process-environment)))
2888a97e 95 (apply 'vc-do-command (or buffer "*vc*") okstatus vc-bzr-program
f4d0cf23 96 file-or-list bzr-command args)))
b6e0e86c 97
37320a58
SM
98
99;;;###autoload
f4d0cf23 100(defconst vc-bzr-admin-dirname ".bzr"
b6e6e09a 101 "Name of the directory containing Bzr repository status files.")
a460c94c 102;;;###autoload
b6e6e09a
SM
103(defconst vc-bzr-admin-checkout-format-file
104 (concat vc-bzr-admin-dirname "/checkout/format"))
a460c94c 105(defconst vc-bzr-admin-dirstate
b6e6e09a
SM
106 (concat vc-bzr-admin-dirname "/checkout/dirstate"))
107(defconst vc-bzr-admin-branch-format-file
108 (concat vc-bzr-admin-dirname "/branch/format"))
a460c94c 109(defconst vc-bzr-admin-revhistory
b6e6e09a 110 (concat vc-bzr-admin-dirname "/branch/revision-history"))
12451866
RF
111(defconst vc-bzr-admin-lastrev
112 (concat vc-bzr-admin-dirname "/branch/last-revision"))
37320a58
SM
113
114;;;###autoload (defun vc-bzr-registered (file)
b6e6e09a 115;;;###autoload (if (vc-find-root file vc-bzr-admin-checkout-format-file)
37320a58
SM
116;;;###autoload (progn
117;;;###autoload (load "vc-bzr")
118;;;###autoload (vc-bzr-registered file))))
b6e0e86c 119
a460c94c
SM
120(defun vc-bzr-root (file)
121 "Return the root directory of the bzr repository containing FILE."
122 ;; Cache technique copied from vc-arch.el.
123 (or (vc-file-getprop file 'bzr-root)
b38f5e6f
DN
124 (let ((root (vc-find-root file vc-bzr-admin-checkout-format-file)))
125 (when root (vc-file-setprop file 'bzr-root root)))))
b6e0e86c 126
82eb83ff 127(require 'sha1) ;For sha1-program
a460c94c 128
82eb83ff
SM
129(defun vc-bzr-sha1 (file)
130 (with-temp-buffer
131 (set-buffer-multibyte nil)
132 (let ((prog sha1-program)
133 (args nil))
134 (when (consp prog)
135 (setq args (cdr prog))
136 (setq prog (car prog)))
07c4b87c 137 (apply 'process-file prog (file-relative-name file) t nil args)
82eb83ff
SM
138 (buffer-substring (point-min) (+ (point-min) 40)))))
139
140(defun vc-bzr-state-heuristic (file)
141 "Like `vc-bzr-state' but hopefully without running Bzr."
142 ;; `bzr status' is excrutiatingly slow with large histories and
143 ;; pending merges, so try to avoid using it until they fix their
144 ;; performance problems.
145 ;; This function tries first to parse Bzr internal file
146 ;; `checkout/dirstate', but it may fail if Bzr internal file format
147 ;; has changed. As a safeguard, the `checkout/dirstate' file is
148 ;; only parsed if it contains the string `#bazaar dirstate flat
149 ;; format 3' in the first line.
150 ;; If the `checkout/dirstate' file cannot be parsed, fall back to
151 ;; running `vc-bzr-state'."
fba500b6
SM
152 (lexical-let ((root (vc-bzr-root file)))
153 (when root ; Short cut.
154 ;; This looks at internal files. May break if they change
155 ;; their format.
156 (lexical-let ((dirstate (expand-file-name vc-bzr-admin-dirstate root)))
157 (if (not (file-readable-p dirstate))
158 (vc-bzr-state file) ; Expensive.
159 (with-temp-buffer
160 (insert-file-contents dirstate)
161 (goto-char (point-min))
162 (if (not (looking-at "#bazaar dirstate flat format 3"))
163 (vc-bzr-state file) ; Some other unknown format?
164 (let* ((relfile (file-relative-name file root))
165 (reldir (file-name-directory relfile)))
82eb83ff
SM
166 (if (re-search-forward
167 (concat "^\0"
168 (if reldir (regexp-quote
169 (directory-file-name reldir)))
170 "\0"
171 (regexp-quote (file-name-nondirectory relfile))
172 "\0"
769087ce
SM
173 "[^\0]*\0" ;id?
174 "\\([^\0]*\\)\0" ;"a/f/d", a=removed?
175 "[^\0]*\0" ;sha1 (empty if conflicted)?
176 "\\([^\0]*\\)\0" ;size?
177 "[^\0]*\0" ;"y/n", executable?
178 "[^\0]*\0" ;?
179 "\\([^\0]*\\)\0" ;"a/f/d" a=added?
180 "\\([^\0]*\\)\0" ;sha1 again?
181 "[^\0]*\0" ;size again?
182 "[^\0]*\0" ;"y/n", executable again?
183 "[^\0]*\0" ;last revid?
184 ;; There are more fields when merges are pending.
185 )
82eb83ff 186 nil t)
769087ce
SM
187 ;; Apparently the second sha1 is the one we want: when
188 ;; there's a conflict, the first sha1 is absent (and the
189 ;; first size seems to correspond to the file with
190 ;; conflict markers).
82eb83ff 191 (cond
769087ce 192 ((eq (char-after (match-beginning 1)) ?a) 'removed)
82eb83ff 193 ((eq (char-after (match-beginning 3)) ?a) 'added)
769087ce 194 ((and (eq (string-to-number (match-string 2))
82eb83ff 195 (nth 7 (file-attributes file)))
769087ce 196 (equal (match-string 4)
82eb83ff
SM
197 (vc-bzr-sha1 file)))
198 'up-to-date)
199 (t 'edited))
200 'unregistered)))))))))
201
202(defun vc-bzr-registered (file)
203 "Return non-nil if FILE is registered with bzr."
204 (let ((state (vc-bzr-state-heuristic file)))
205 (not (memq state '(nil unregistered ignored)))))
77b5d458
SM
206
207(defconst vc-bzr-state-words
33e5d7d4 208 "added\\|ignored\\|kind changed\\|modified\\|removed\\|renamed\\|unknown"
77b5d458
SM
209 "Regexp matching file status words as reported in `bzr' output.")
210
b6e6e09a
SM
211(defun vc-bzr-file-name-relative (filename)
212 "Return file name FILENAME stripped of the initial Bzr repository path."
213 (lexical-let*
214 ((filename* (expand-file-name filename))
f4d0cf23 215 (rootdir (vc-bzr-root filename*)))
def61be2 216 (when rootdir
b6e6e09a
SM
217 (file-relative-name filename* rootdir))))
218
33e5d7d4
SM
219(defun vc-bzr-status (file)
220 "Return FILE status according to Bzr.
221Return value is a cons (STATUS . WARNING), where WARNING is a
fba500b6
SM
222string or nil, and STATUS is one of the symbols: `added',
223`ignored', `kindchanged', `modified', `removed', `renamed', `unknown',
33e5d7d4
SM
224which directly correspond to `bzr status' output, or 'unchanged
225for files whose copy in the working tree is identical to the one
226in the branch repository, or nil for files that are not
227registered with Bzr.
228
229If any error occurred in running `bzr status', then return nil."
77b5d458 230 (with-temp-buffer
fba500b6
SM
231 (let ((ret (condition-case nil
232 (vc-bzr-command "status" t 0 file)
233 (file-error nil))) ; vc-bzr-program not found.
234 (status 'unchanged))
235 ;; the only secure status indication in `bzr status' output
236 ;; is a couple of lines following the pattern::
237 ;; | <status>:
238 ;; | <file name>
239 ;; if the file is up-to-date, we get no status report from `bzr',
240 ;; so if the regexp search for the above pattern fails, we consider
241 ;; the file to be up-to-date.
242 (goto-char (point-min))
243 (when (re-search-forward
244 ;; bzr prints paths relative to the repository root.
245 (concat "^\\(" vc-bzr-state-words "\\):[ \t\n]+"
246 (regexp-quote (vc-bzr-file-name-relative file))
f4d0cf23
SM
247 ;; Bzr appends a '/' to directory names and
248 ;; '*' to executable files
249 (if (file-directory-p file) "/?" "\\*?")
fba500b6
SM
250 "[ \t\n]*$")
251 nil t)
6e98ad29 252 (lexical-let ((statusword (match-string 1)))
fba500b6
SM
253 ;; Erase the status text that matched.
254 (delete-region (match-beginning 0) (match-end 0))
33e5d7d4 255 (setq status
f4d0cf23 256 (intern (replace-regexp-in-string " " "" statusword)))))
fba500b6
SM
257 (when status
258 (goto-char (point-min))
259 (skip-chars-forward " \n\t") ;Throw away spaces.
260 (cons status
261 ;; "bzr" will output warnings and informational messages to
262 ;; stderr; due to Emacs' `vc-do-command' (and, it seems,
263 ;; `start-process' itself) limitations, we cannot catch stderr
264 ;; and stdout into different buffers. So, if there's anything
265 ;; left in the buffer after removing the above status
266 ;; keywords, let us just presume that any other message from
267 ;; "bzr" is a user warning, and display it.
268 (unless (eobp) (buffer-substring (point) (point-max))))))))
a0e5e075 269
33e5d7d4
SM
270(defun vc-bzr-state (file)
271 (lexical-let ((result (vc-bzr-status file)))
272 (when (consp result)
6efbb10c
DN
273 (when (cdr result)
274 (message "Warnings in `bzr' output: %s" (cdr result)))
33e5d7d4 275 (cdr (assq (car result)
6a3f9bb7 276 '((added . added)
fba500b6 277 (kindchanged . edited)
33e5d7d4
SM
278 (renamed . edited)
279 (modified . edited)
54bf3704 280 (removed . removed)
3702367b 281 (ignored . ignored)
54bf3704 282 (unknown . unregistered)
33e5d7d4 283 (unchanged . up-to-date)))))))
b6e0e86c 284
b0a08954
SM
285(defun vc-bzr-resolve-when-done ()
286 "Call \"bzr resolve\" if the conflict markers have been removed."
287 (save-excursion
288 (goto-char (point-min))
289 (unless (re-search-forward "^<<<<<<< " nil t)
290 (vc-bzr-command "resolve" nil 0 buffer-file-name)
291 ;; Remove the hook so that it is not called multiple times.
292 (remove-hook 'after-save-hook 'vc-bzr-resolve-when-done t))))
293
294(defun vc-bzr-find-file-hook ()
295 (when (and buffer-file-name
296 ;; FIXME: We should check that "bzr status" says "conflict".
297 (file-exists-p (concat buffer-file-name ".BASE"))
298 (file-exists-p (concat buffer-file-name ".OTHER"))
299 (file-exists-p (concat buffer-file-name ".THIS"))
300 ;; If "bzr status" says there's a conflict but there are no
301 ;; conflict markers, it's not clear what we should do.
302 (save-excursion
303 (goto-char (point-min))
304 (re-search-forward "^<<<<<<< " nil t)))
305 ;; TODO: the merge algorithm used in `bzr merge' is nicely configurable,
306 ;; but the one in `bzr pull' isn't, so it would be good to provide an
307 ;; elisp function to remerge from the .BASE/OTHER/THIS files.
308 (smerge-start-session)
309 (add-hook 'after-save-hook 'vc-bzr-resolve-when-done nil t)
310 (message "There are unresolved conflicts in this file")))
311
b6e0e86c 312(defun vc-bzr-workfile-unchanged-p (file)
33e5d7d4 313 (eq 'unchanged (car (vc-bzr-status file))))
b6e0e86c 314
ac3f4c6f 315(defun vc-bzr-working-revision (file)
82eb83ff
SM
316 ;; Together with the code in vc-state-heuristic, this makes it possible
317 ;; to get the initial VC state of a Bzr file even if Bzr is not installed.
a460c94c
SM
318 (lexical-let*
319 ((rootdir (vc-bzr-root file))
6e98ad29
SM
320 (branch-format-file (expand-file-name vc-bzr-admin-branch-format-file
321 rootdir))
322 (revhistory-file (expand-file-name vc-bzr-admin-revhistory rootdir))
323 (lastrev-file (expand-file-name vc-bzr-admin-lastrev rootdir)))
324 ;; This looks at internal files to avoid forking a bzr process.
325 ;; May break if they change their format.
a460c94c 326 (if (file-exists-p branch-format-file)
fba500b6 327 (with-temp-buffer
def61be2 328 (insert-file-contents branch-format-file)
a460c94c
SM
329 (goto-char (point-min))
330 (cond
331 ((or
332 (looking-at "Bazaar-NG branch, format 0.0.4")
333 (looking-at "Bazaar-NG branch format 5"))
334 ;; count lines in .bzr/branch/revision-history
def61be2 335 (insert-file-contents revhistory-file)
a460c94c
SM
336 (number-to-string (count-lines (line-end-position) (point-max))))
337 ((looking-at "Bazaar Branch Format 6 (bzr 0.15)")
338 ;; revno is the first number in .bzr/branch/last-revision
def61be2 339 (insert-file-contents lastrev-file)
a460c94c
SM
340 (if (re-search-forward "[0-9]+" nil t)
341 (buffer-substring (match-beginning 0) (match-end 0))))))
342 ;; fallback to calling "bzr revno"
b6e6e09a 343 (lexical-let*
a460c94c 344 ((result (vc-bzr-command-discarding-stderr
07c4b87c 345 vc-bzr-program "revno" (file-relative-name file)))
b6e6e09a
SM
346 (exitcode (car result))
347 (output (cdr result)))
348 (cond
349 ((eq exitcode 0) (substring output 0 -1))
350 (t nil))))))
b6e0e86c 351
a6ea7ffc 352(defun vc-bzr-create-repo ()
4211679b 353 "Create a new Bzr repository."
a6ea7ffc
DN
354 (vc-bzr-command "init" nil 0 nil))
355
25a4ea6d 356(defun vc-bzr-init-revision (&optional file)
f4d0cf23
SM
357 "Always return nil, as Bzr cannot register explicit versions."
358 nil)
359
882e82db
SM
360(defun vc-bzr-previous-revision (file rev)
361 (if (string-match "\\`[0-9]+\\'" rev)
362 (number-to-string (1- (string-to-number rev)))
363 (concat "before:" rev)))
364
365(defun vc-bzr-next-revision (file rev)
366 (if (string-match "\\`[0-9]+\\'" rev)
367 (number-to-string (1+ (string-to-number rev)))
368 (error "Don't know how to compute the next revision of %s" rev)))
369
8cdd17b4 370(defun vc-bzr-register (files &optional rev comment)
b6e0e86c
SM
371 "Register FILE under bzr.
372Signal an error unless REV is nil.
373COMMENT is ignored."
5b5afd50 374 (if rev (error "Can't register explicit revision with bzr"))
8cdd17b4 375 (vc-bzr-command "add" nil 0 files))
b6e0e86c
SM
376
377;; Could run `bzr status' in the directory and see if it succeeds, but
378;; that's relatively expensive.
b6e6e09a 379(defalias 'vc-bzr-responsible-p 'vc-bzr-root
b6e0e86c
SM
380 "Return non-nil if FILE is (potentially) controlled by bzr.
381The criterion is that there is a `.bzr' directory in the same
37320a58 382or a superior directory.")
b6e0e86c
SM
383
384(defun vc-bzr-could-register (file)
385 "Return non-nil if FILE could be registered under bzr."
386 (and (vc-bzr-responsible-p file) ; shortcut
387 (condition-case ()
388 (with-temp-buffer
389 (vc-bzr-command "add" t 0 file "--dry-run")
390 ;; The command succeeds with no output if file is
391 ;; registered (in bzr 0.8).
360cf7bc 392 (goto-char (point-min))
b6e0e86c
SM
393 (looking-at "added "))
394 (error))))
395
396(defun vc-bzr-unregister (file)
397 "Unregister FILE from bzr."
f4d0cf23 398 (vc-bzr-command "remove" nil 0 file "--keep"))
b6e0e86c 399
8cdd17b4 400(defun vc-bzr-checkin (files rev comment)
b6e0e86c
SM
401 "Check FILE in to bzr with log message COMMENT.
402REV non-nil gets an error."
5b5afd50 403 (if rev (error "Can't check in a specific revision with bzr"))
8cdd17b4 404 (vc-bzr-command "commit" nil 0 files "-m" comment))
b6e0e86c 405
f4d0cf23
SM
406(defun vc-bzr-find-version (file rev buffer)
407 "Fetch version REV of file FILE and put it into BUFFER."
408 (with-current-buffer buffer
409 (if (and rev (stringp rev) (not (string= rev "")))
410 (vc-bzr-command "cat" t 0 file "-r" rev)
411 (vc-bzr-command "cat" t 0 file))))
412
5a3b79c4
SM
413(defun vc-bzr-checkout (file &optional editable rev)
414 (if rev (error "Operation not supported")
415 ;; Else, there's nothing to do.
416 nil))
b6e0e86c
SM
417
418(defun vc-bzr-revert (file &optional contents-done)
419 (unless contents-done
33e5d7d4 420 (with-temp-buffer (vc-bzr-command "revert" t 0 file))))
b6e0e86c 421
37320a58
SM
422(defvar log-view-message-re)
423(defvar log-view-file-re)
424(defvar log-view-font-lock-keywords)
425(defvar log-view-current-tag-function)
def61be2 426(defvar log-view-per-file-logs)
37320a58
SM
427
428(define-derived-mode vc-bzr-log-view-mode log-view-mode "Bzr-Log-View"
429 (remove-hook 'log-view-mode-hook 'vc-bzr-log-view-mode) ;Deactivate the hack.
b6e0e86c 430 (require 'add-log)
6653c6b7 431 (set (make-local-variable 'log-view-per-file-logs) nil)
ac51b151 432 (set (make-local-variable 'log-view-file-re) "^Working file:[ \t]+\\(.+\\)")
37320a58 433 (set (make-local-variable 'log-view-message-re)
f392f8b4 434 "^ *-+\n *\\(?:revno: \\([0-9.]+\\)\\|merged: .+\\)")
b6e0e86c 435 (set (make-local-variable 'log-view-font-lock-keywords)
37320a58
SM
436 ;; log-view-font-lock-keywords is careful to use the buffer-local
437 ;; value of log-view-message-re only since Emacs-23.
438 (append `((,log-view-message-re . 'log-view-message-face))
439 ;; log-view-font-lock-keywords
440 '(("^ *committer: \
5ec05779 441\\([^<(]+?\\)[ ]*[(<]\\([[:alnum:]_.+-]+@[[:alnum:]_.-]+\\)[>)]"
37320a58
SM
442 (1 'change-log-name)
443 (2 'change-log-email))
444 ("^ *timestamp: \\(.*\\)" (1 'change-log-date-face))))))
b6e0e86c 445
8cdd17b4
ER
446(defun vc-bzr-print-log (files &optional buffer) ; get buffer arg in Emacs 22
447 "Get bzr change log for FILES into specified BUFFER."
ac51b151
DN
448 ;; `vc-do-command' creates the buffer, but we need it before running
449 ;; the command.
450 (vc-setup-buffer buffer)
451 ;; If the buffer exists from a previous invocation it might be
452 ;; read-only.
5a3b79c4
SM
453 ;; FIXME: `vc-bzr-command' runs `bzr log' with `LC_MESSAGES=C', so
454 ;; the log display may not what the user wants - but I see no other
455 ;; way of getting the above regexps working.
456 (dolist (file files)
5a07b0f0
SM
457 (vc-exec-after
458 `(let ((inhibit-read-only t))
5a3b79c4
SM
459 (with-current-buffer buffer
460 ;; Insert the file name so that log-view.el can find it.
5a07b0f0
SM
461 (insert "Working file: " ',file "\n")) ;; Like RCS/CVS.
462 (apply 'vc-bzr-command "log" ',buffer 'async ',file
463 ',(if (stringp vc-bzr-log-switches)
5a3b79c4 464 (list vc-bzr-log-switches)
5a07b0f0 465 vc-bzr-log-switches))))))
b6e0e86c 466
5b5afd50
ER
467(defun vc-bzr-show-log-entry (revision)
468 "Find entry for patch name REVISION in bzr change log buffer."
b6e0e86c
SM
469 (goto-char (point-min))
470 (let (case-fold-search)
f392f8b4
DN
471 (if (re-search-forward
472 ;; "revno:" can appear either at the beginning of a line, or indented.
def61be2 473 (concat "^[ ]*-+\n[ ]*revno: "
f392f8b4
DN
474 ;; The revision can contain ".", quote it so that it
475 ;; does not interfere with regexp matching.
476 (regexp-quote revision) "$") nil t)
b6e0e86c
SM
477 (beginning-of-line 0)
478 (goto-char (point-min)))))
479
8cdd17b4 480(defun vc-bzr-diff (files &optional rev1 rev2 buffer)
b6e0e86c 481 "VC bzr backend for diff."
39f44442 482 ;; `bzr diff' exits with code 1 if diff is non-empty.
5a07b0f0 483 (apply #'vc-bzr-command "diff" (or buffer "*vc-diff*") 'async files
def61be2 484 "--diff-options" (mapconcat 'identity
39f44442 485 (vc-diff-switches-list bzr)
59ce725a 486 " ")
39f44442
SM
487 ;; This `when' is just an optimization because bzr-1.2 is *much*
488 ;; faster when the revision argument is not given.
489 (when (or rev1 rev2)
490 (list "-r" (format "%s..%s"
def61be2 491 (or rev1 "revno:-1")
39f44442 492 (or rev2 ""))))))
b6e0e86c 493
b6e0e86c 494
5b5afd50
ER
495;; FIXME: vc-{next,previous}-revision need fixing in vc.el to deal with
496;; straight integer revisions.
b6e0e86c
SM
497
498(defun vc-bzr-delete-file (file)
499 "Delete FILE and delete it in the bzr repository."
500 (condition-case ()
501 (delete-file file)
502 (file-error nil))
503 (vc-bzr-command "remove" nil 0 file))
504
505(defun vc-bzr-rename-file (old new)
506 "Rename file from OLD to NEW using `bzr mv'."
507 (vc-bzr-command "mv" nil 0 new old))
508
509(defvar vc-bzr-annotation-table nil
510 "Internal use.")
511(make-variable-buffer-local 'vc-bzr-annotation-table)
512
5b5afd50 513(defun vc-bzr-annotate-command (file buffer &optional revision)
b6e0e86c
SM
514 "Prepare BUFFER for `vc-annotate' on FILE.
515Each line is tagged with the revision number, which has a `help-echo'
516property containing author and date information."
6e98ad29 517 (apply #'vc-bzr-command "annotate" buffer 0 file "--long" "--all"
a6762235
DN
518 (if revision (list "-r" revision)))
519 (with-current-buffer buffer
520 ;; Store the tags for the annotated source lines in a hash table
521 ;; to allow saving space by sharing the text properties.
522 (setq vc-bzr-annotation-table (make-hash-table :test 'equal))
523 (goto-char (point-min))
1690cfbf 524 (while (re-search-forward "^\\( *[0-9.]+ *\\) \\([^\n ]+\\) +\\([0-9]\\{8\\}\\) |"
a6762235
DN
525 nil t)
526 (let* ((rev (match-string 1))
527 (author (match-string 2))
528 (date (match-string 3))
529 (key (match-string 0))
530 (tag (gethash key vc-bzr-annotation-table)))
531 (unless tag
532 (setq tag (propertize rev 'help-echo (concat "Author: " author
533 ", date: " date)
534 'mouse-face 'highlight))
535 (puthash key tag vc-bzr-annotation-table))
536 (replace-match "")
537 (insert tag " |")))))
b6e0e86c 538
b6e0e86c 539(defun vc-bzr-annotate-time ()
1690cfbf 540 (when (re-search-forward "^ *[0-9.]+ +|" nil t)
a6762235
DN
541 (let ((prop (get-text-property (line-beginning-position) 'help-echo)))
542 (string-match "[0-9]+\\'" prop)
f8381803 543 (let ((str (match-string-no-properties 0 prop)))
b6e0e86c
SM
544 (vc-annotate-convert-time
545 (encode-time 0 0 0
f8381803
SM
546 (string-to-number (substring str 6 8))
547 (string-to-number (substring str 4 6))
548 (string-to-number (substring str 0 4))))))))
b6e0e86c
SM
549
550(defun vc-bzr-annotate-extract-revision-at-line ()
551 "Return revision for current line of annoation buffer, or nil.
552Return nil if current line isn't annotated."
553 (save-excursion
554 (beginning-of-line)
96be1503 555 (if (looking-at " *\\([0-9.]+\\) *| ")
a6762235 556 (match-string-no-properties 1))))
b6e0e86c 557
a460c94c
SM
558(defun vc-bzr-command-discarding-stderr (command &rest args)
559 "Execute shell command COMMAND (with ARGS); return its output and exitcode.
b6e6e09a
SM
560Return value is a cons (EXITCODE . OUTPUT), where EXITCODE is
561the (numerical) exit code of the process, and OUTPUT is a string
562containing whatever the process sent to its standard output
563stream. Standard error output is discarded."
564 (with-temp-buffer
a460c94c 565 (cons
07c4b87c 566 (apply #'process-file command nil (list (current-buffer) nil) nil args)
b6e6e09a 567 (buffer-substring (point-min) (point-max)))))
b6e0e86c 568
0a299408
ER
569(defun vc-bzr-prettify-state-info (file)
570 "Bzr-specific version of `vc-prettify-state-info'."
b6e0e86c 571 (if (eq 'edited (vc-state file))
def61be2 572 (concat "(" (symbol-name (or (vc-file-getprop file 'vc-bzr-state)
f4d0cf23
SM
573 'edited)) ")")
574 ;; else fall back to default vc.el representation
0a299408 575 (vc-default-prettify-state-info 'Bzr file)))
b6e0e86c 576
def61be2 577;; XXX: this needs testing, it's probably incomplete.
c1b51374 578(defun vc-bzr-after-dir-status (update-function)
7ee8e7eb 579 (let ((status-str nil)
7ee8e7eb
DN
580 (translation '(("+N" . added)
581 ("-D" . removed)
582 (" M" . edited)
583 ;; XXX: what about ignored files?
49546869 584 (" D" . missing)
f8381803 585 ;; For conflicts, should we list the .THIS/.BASE/.OTHER?
21f7bc38 586 ("C " . conflict)
f8381803
SM
587 ("? " . unregistered)
588 ;; Ignore "P " and "P." for pending patches.
589 ))
7ee8e7eb
DN
590 (translated nil)
591 (result nil))
592 (goto-char (point-min))
593 (while (not (eobp))
594 (setq status-str
595 (buffer-substring-no-properties (point) (+ (point) 2)))
21f7bc38
DN
596 (setq translated (cdr (assoc status-str translation)))
597 ;; For conflicts the file appears twice in the listing: once
598 ;; with the M flag and once with the C flag, so take care not
599 ;; to add it twice to `result'. Ugly.
600 (if (eq translated 'conflict)
601 (let* ((file
602 (buffer-substring-no-properties
603 ;;For files with conflicts the format is:
604 ;;C Text conflict in FILENAME
605 ;; Bah.
606 (+ (point) 21) (line-end-position)))
607 (entry (assoc file result)))
608 (when entry
609 (setf (nth 1 entry) 'conflict)))
610 (push (list (buffer-substring-no-properties
611 (+ (point) 4)
def61be2 612 (line-end-position))
21f7bc38 613 translated) result))
7ee8e7eb 614 (forward-line))
c1b51374 615 (funcall update-function result)))
7ee8e7eb 616
c1b51374 617(defun vc-bzr-dir-status (dir update-function)
7ee8e7eb 618 "Return a list of conses (file . state) for DIR."
115c0061
DN
619 (vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S")
620 (vc-exec-after
c1b51374 621 `(vc-bzr-after-dir-status (quote ,update-function))))
7ee8e7eb 622
39f44442
SM
623;;; Revision completion
624
39f44442
SM
625(defun vc-bzr-revision-completion-table (files)
626 (lexical-let ((files files))
627 ;; What about using `files'?!? --Stef
628 (lambda (string pred action)
629 (cond
630 ((string-match "\\`\\(ancestor\\|branch\\|\\(revno:\\)?[-0-9]+:\\):"
631 string)
ec50e665 632 (completion-table-with-context (substring string 0 (match-end 0))
f8381803
SM
633 ;; FIXME: only allow directories.
634 ;; FIXME: don't allow envvars.
ec50e665
SM
635 'read-file-name-internal
636 (substring string (match-end 0))
637 ;; Dropping `pred'. Maybe we should
638 ;; just stash it in
639 ;; `read-file-name-predicate'?
640 nil
641 action))
39f44442 642 ((string-match "\\`\\(before\\):" string)
ec50e665
SM
643 (completion-table-with-context (substring string 0 (match-end 0))
644 (vc-bzr-revision-completion-table files)
645 (substring string (match-end 0))
646 pred
647 action))
39f44442
SM
648 ((string-match "\\`\\(tag\\):" string)
649 (let ((prefix (substring string 0 (match-end 0)))
650 (tag (substring string (match-end 0)))
651 (table nil))
652 (with-temp-buffer
653 ;; "bzr-1.2 tags" is much faster with --show-ids.
07c4b87c 654 (process-file vc-bzr-program nil '(t) nil "tags" "--show-ids")
39f44442
SM
655 ;; The output is ambiguous, unless we assume that revids do not
656 ;; contain spaces.
657 (goto-char (point-min))
658 (while (re-search-forward "^\\(.*[^ \n]\\) +[^ \n]*$" nil t)
659 (push (match-string-no-properties 1) table)))
ec50e665 660 (completion-table-with-context prefix table tag pred action)))
39f44442
SM
661
662 ((string-match "\\`\\(revid\\):" string)
663 ;; FIXME: How can I get a list of revision ids?
664 )
f8381803
SM
665 ((eq (car-safe action) 'boundaries)
666 (list* 'boundaries
8100b5a8 667 (string-match "[^:]*\\'" string)
f8381803 668 (string-match ":" (cdr action))))
39f44442 669 (t
f8381803
SM
670 ;; Could use completion-table-with-terminator, except that it
671 ;; currently doesn't work right w.r.t pcm and doesn't give
672 ;; the *Completions* output we want.
39f44442
SM
673 (complete-with-action action '("revno:" "revid:" "last:" "before:"
674 "tag:" "date:" "ancestor:" "branch:"
675 "submit:")
676 string pred))))))
677
b6e0e86c 678(eval-after-load "vc"
b6e6e09a 679 '(add-to-list 'vc-directory-exclusion-list vc-bzr-admin-dirname t))
b6e0e86c 680
b6e0e86c
SM
681(provide 'vc-bzr)
682;; arch-tag: 8101bad8-4e92-4e7d-85ae-d8e08b4e7c06
683;;; vc-bzr.el ends here