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