90794
|
1 ;;; vc-bzr.el --- VC backend for the bzr revision control system
|
|
2
|
|
3 ;; Copyright (C) 2006, 2007 Free Software Foundation, Inc.
|
|
4
|
|
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
|
|
9
|
|
10 ;; Author: Dave Love <fx@gnu.org>, Riccardo Murri <riccardo.murri@gmail.com>
|
|
11 ;; Keywords: tools
|
|
12 ;; Created: Sept 2006
|
|
13 ;; Version: 2007-01-17
|
|
14 ;; URL: http://launchpad.net/vc-bzr
|
|
15
|
|
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)
|
|
19 ;; any later version.
|
|
20
|
|
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.
|
|
25
|
|
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.
|
|
30
|
|
31
|
|
32 ;;; Commentary:
|
|
33
|
|
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
|
|
36
|
|
37 ;; See <URL:http://bazaar-vcs.org/> concerning bzr.
|
|
38
|
|
39 ;; Load this library to register bzr support in VC. The support is
|
|
40 ;; preliminary and incomplete, adapted from my darcs version. Lightly
|
|
41 ;; exercised with bzr 0.8 and Emacs 21, and bzr 0.11 on Emacs 22. See
|
|
42 ;; various Fixmes below.
|
|
43
|
|
44 ;; This should be suitable for direct inclusion in Emacs if someone
|
|
45 ;; can persuade rms.
|
|
46
|
|
47
|
|
48 ;;; Code:
|
|
49
|
|
50 (eval-when-compile
|
|
51 (require 'vc)) ; for vc-exec-after
|
|
52
|
|
53 (defgroup vc-bzr nil
|
|
54 "VC bzr backend."
|
|
55 ;; :version "22"
|
|
56 :group 'vc)
|
|
57
|
|
58 (defcustom vc-bzr-program "bzr"
|
|
59 "*Name of the bzr command (excluding any arguments)."
|
|
60 :group 'vc-bzr
|
|
61 :type 'string)
|
|
62
|
|
63 ;; Fixme: there's probably no call for this.
|
|
64 (defcustom vc-bzr-program-args nil
|
|
65 "*List of global arguments to pass to `vc-bzr-program'."
|
|
66 :group 'vc-bzr
|
|
67 :type '(repeat string))
|
|
68
|
|
69 (defcustom vc-bzr-diff-switches nil
|
|
70 "*String/list of strings specifying extra switches for bzr diff under VC."
|
|
71 :type '(choice (const :tag "None" nil)
|
|
72 (string :tag "Argument String")
|
|
73 (repeat :tag "Argument List" :value ("") string))
|
|
74 :group 'vc-bzr)
|
|
75
|
|
76 (defvar vc-bzr-version nil
|
|
77 "Internal use.")
|
|
78
|
|
79 ;; Could be used for compatibility checks if bzr changes.
|
|
80 (defun vc-bzr-version ()
|
|
81 "Return a three-numeric element list with components of the bzr version.
|
|
82 This is of the form (X Y Z) for revision X.Y.Z. The elements are zero
|
|
83 if running `vc-bzr-program' doesn't produce the expected output."
|
|
84 (if vc-bzr-version
|
|
85 vc-bzr-version
|
|
86 (let ((s (shell-command-to-string
|
|
87 (concat (shell-quote-argument vc-bzr-program) " --version"))))
|
|
88 (if (string-match "\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)$" s)
|
|
89 (setq vc-bzr-version (list (string-to-number (match-string 1 s))
|
|
90 (string-to-number (match-string 2 s))
|
|
91 (string-to-number (match-string 3 s))))
|
|
92 '(0 0 0)))))
|
|
93
|
|
94 (defun vc-bzr-at-least-version (vers)
|
|
95 "Return t if the bzr command reports being a least version VERS.
|
|
96 First argument VERS is a list of the form (X Y Z), as returned by `vc-bzr-version'."
|
|
97 (version-list-<= vers (vc-bzr-version)))
|
|
98
|
|
99 ;; XXX: vc-do-command is tailored for RCS and assumes that command-line
|
|
100 ;; options precede the file name (ci -something file); with bzr, we need
|
|
101 ; to pass options *after* the subcommand, e.g. bzr ls --versioned.
|
|
102 (defun vc-bzr-do-command* (buffer okstatus command &rest args)
|
|
103 "Execute bzr COMMAND, notifying user and checking for errors.
|
|
104 This is a wrapper around `vc-do-command', which see for detailed
|
|
105 explanation of arguments BUFFER, OKSTATUS and COMMAND.
|
|
106
|
|
107 If the optional list of ARGS is present, its elements are
|
|
108 appended to the command line, in the order given.
|
|
109
|
|
110 Unlike `vc-do-command', this has no way of telling which elements
|
|
111 in ARGS are file names and which are command-line options, so be
|
|
112 sure to pass absolute file names if needed. On the other hand,
|
|
113 you can mix options and file names in any order."
|
|
114 (apply 'vc-do-command buffer okstatus command nil args))
|
|
115
|
|
116 (cond
|
|
117 ((vc-bzr-at-least-version '(0 9))
|
|
118 ;; since v0.9, bzr supports removing the progress indicators
|
|
119 ;; by setting environment variable BZR_PROGRESS_BAR to "none".
|
|
120 (defun vc-bzr-command (bzr-command buffer okstatus file &rest args)
|
|
121 "Wrapper round `vc-do-command' using `vc-bzr-program' as COMMAND.
|
|
122 Invoke the bzr command adding `BZR_PROGRESS_BAR=none' to the environment."
|
|
123 (let ((process-environment (cons "BZR_PROGRESS_BAR=none" process-environment)))
|
|
124 (apply 'vc-do-command buffer okstatus vc-bzr-program
|
|
125 file bzr-command (append vc-bzr-program-args args))))
|
|
126
|
|
127 (defun vc-bzr-command* (bzr-command buffer okstatus file &rest args)
|
|
128 "Wrapper round `vc-bzr-do-command*' using `vc-bzr-program' as COMMAND.
|
|
129 Invoke the bzr command adding `BZR_PROGRESS_BAR=none' to the environment.
|
|
130 First argument BZR-COMMAND is passed as the first optional argument to
|
|
131 `vc-bzr-do-command*'."
|
|
132 (let ((process-environment (cons "BZR_PROGRESS_BAR=none" process-environment)))
|
|
133 (apply 'vc-bzr-do-command* buffer okstatus vc-bzr-program
|
|
134 bzr-command (append vc-bzr-program-args args)))))
|
|
135
|
|
136 (t
|
|
137 ;; for older versions, we fall back to washing the log buffer
|
|
138 ;; when all output has been gathered.
|
|
139 (defun vc-bzr-command (command buffer okstatus file &rest args)
|
|
140 "Wrapper round `vc-do-command' using `vc-bzr-program' as COMMAND."
|
|
141 ;; Note: The ^Ms from the progress-indicator stuff that bzr prints
|
|
142 ;; on stderr cause auto-detection of a mac coding system on the
|
|
143 ;; stream for async output. bzr ought to be fixed to be able to
|
|
144 ;; suppress this. See also `vc-bzr-post-command-function'. (We
|
|
145 ;; can't sink the stderr output in `vc-do-command'.)
|
|
146 (apply 'vc-do-command buffer okstatus vc-bzr-program
|
|
147 file command (append vc-bzr-program-args args)))
|
|
148
|
|
149 (defun vc-bzr-command* (command buffer okstatus &rest args)
|
|
150 "Wrapper round `vc-bzr-do-command*' using `vc-bzr-program' as COMMAND."
|
|
151 (apply 'vc-bzr-do-command* buffer okstatus vc-bzr-program
|
|
152 command file (append vc-bzr-program-args args)))
|
|
153
|
|
154 (defun vc-bzr-post-command-function (command file flags)
|
|
155 "`vc-post-command-functions' function to remove progress messages."
|
|
156 ;; Note that using this requires that the vc command is run
|
|
157 ;; synchronously. Otherwise, the ^Ms in the leading progress
|
|
158 ;; message on stdout cause the stream to be interpreted as having
|
|
159 ;; DOS line endings, losing the ^Ms, so the search fails. I don't
|
|
160 ;; know how this works under Windows.
|
|
161 (when (equal command vc-bzr-program)
|
|
162 (save-excursion
|
|
163 (goto-char (point-min))
|
|
164 (if (looking-at "^\\(\r.*\r\\)[^\r]+$")
|
|
165 (replace-match "" nil nil nil 1)))
|
|
166 (save-excursion
|
|
167 (goto-char (point-min))
|
|
168 ;; This is inserted by bzr 0.11 `log', at least
|
|
169 (while (looking-at "read knit.*\n")
|
|
170 (replace-match "")))))
|
|
171
|
|
172 (add-hook 'vc-post-command-functions 'vc-bzr-post-command-function)))
|
|
173
|
|
174 ;; Fixme: If we're only interested in status messages, we only need
|
|
175 ;; to set LC_MESSAGES, and we might need finer control of this. This
|
|
176 ;; is moot anyhow, since bzr doesn't appear to be localized at all
|
|
177 ;; (yet?).
|
|
178 (eval-when-compile
|
|
179 (defmacro vc-bzr-with-c-locale (&rest body)
|
|
180 "Run BODY with LC_ALL=C in the process environment.
|
|
181 This ensures that messages to be matched come out as expected."
|
|
182 `(let ((process-environment (cons "LC_ALL=C" process-environment)))
|
|
183 ,@body)))
|
|
184 (put 'vc-bzr-with-c-locale 'edebug-form-spec t)
|
|
185 (put 'vc-bzr-with-c-locale 'lisp-indent-function 0)
|
|
186
|
|
187 (defun vc-bzr-bzr-dir (file)
|
|
188 "Return the .bzr directory in the hierarchy above FILE.
|
|
189 Return nil if there isn't one."
|
|
190 (setq file (expand-file-name file))
|
|
191 (let ((dir (if (file-directory-p file)
|
|
192 file
|
|
193 (file-name-directory file)))
|
|
194 bzr)
|
|
195 (catch 'found
|
|
196 (while t
|
|
197 (setq bzr (expand-file-name ".bzr" dir)) ; fixme: "_bzr" on Doze??
|
|
198 (if (file-directory-p bzr)
|
|
199 (throw 'found (file-name-as-directory bzr)))
|
|
200 (if (equal "" (file-name-nondirectory (directory-file-name dir)))
|
|
201 (throw 'found nil)
|
|
202 (setq dir (file-name-directory (directory-file-name dir))))))))
|
|
203
|
|
204 (defun vc-bzr-registered (file)
|
|
205 "Return non-nil if FILE is registered with bzr."
|
|
206 (if (vc-bzr-bzr-dir file) ; short cut
|
|
207 (vc-bzr-state file))) ; expensive
|
|
208
|
|
209 (defun vc-bzr-state (file)
|
|
210 (let (ret state conflicts pending-merges)
|
|
211 (with-temp-buffer
|
|
212 (cd (file-name-directory file))
|
|
213 (setq ret (vc-bzr-with-c-locale (vc-bzr-command "status" t 255 file)))
|
|
214 (goto-char 1)
|
|
215 (save-excursion
|
|
216 (when (re-search-forward "^conflicts:" nil t)
|
|
217 (message "Warning -- conflicts in bzr branch")))
|
|
218 (save-excursion
|
|
219 (when (re-search-forward "^pending merges:" nil t)
|
|
220 (message "Warning -- pending merges in bzr branch")))
|
|
221 (setq state
|
|
222 (cond ((not (equal ret 0)) nil)
|
|
223 ((looking-at "added\\|renamed\\|modified\\|removed") 'edited)
|
|
224 ;; Fixme: Also get this in a non-registered sub-directory.
|
|
225 ((looking-at "^$") 'up-to-date)
|
|
226 ;; if we're seeing this as first line of text,
|
|
227 ;; then the status is up-to-date,
|
|
228 ;; but bzr output only gives the warning to users.
|
|
229 ((looking-at "conflicts\\|pending") 'up-to-date)
|
|
230 ((looking-at "unknown\\|ignored") nil)
|
|
231 (t (error "Unrecognized output from `bzr status'"))))
|
|
232 (when (or conflicts pending-merges)
|
|
233 (message
|
|
234 (concat "Warning -- "
|
|
235 (if conflicts "conflicts ")
|
|
236 (if (and conflicts pending-merges) "and ")
|
|
237 (if pending-merges "pending merges ")
|
|
238 "in bzr branch")))
|
|
239 (when state
|
|
240 (vc-file-setprop file 'vc-workfile-version
|
|
241 (vc-bzr-workfile-version file))
|
|
242 (vc-file-setprop file 'vc-state state))
|
|
243 state)))
|
|
244
|
|
245 (defun vc-bzr-workfile-unchanged-p (file)
|
|
246 (eq 'up-to-date (vc-bzr-state file)))
|
|
247
|
|
248 (defun vc-bzr-workfile-version (file)
|
|
249 (with-temp-buffer
|
|
250 (vc-bzr-command "revno" t 0 file)
|
|
251 (goto-char 1)
|
|
252 (buffer-substring 1 (line-end-position))))
|
|
253
|
|
254 (defun vc-bzr-checkout-model (file)
|
|
255 'implicit)
|
|
256
|
|
257 (defun vc-bzr-register (file &optional rev comment)
|
|
258 "Register FILE under bzr.
|
|
259 Signal an error unless REV is nil.
|
|
260 COMMENT is ignored."
|
|
261 (if rev (error "Can't register explicit version with bzr"))
|
|
262 (vc-bzr-command "add" nil 0 file))
|
|
263
|
|
264 ;; Could run `bzr status' in the directory and see if it succeeds, but
|
|
265 ;; that's relatively expensive.
|
|
266 (defun vc-bzr-responsible-p (file)
|
|
267 "Return non-nil if FILE is (potentially) controlled by bzr.
|
|
268 The criterion is that there is a `.bzr' directory in the same
|
|
269 or a superior directory."
|
|
270 (vc-bzr-bzr-dir file))
|
|
271
|
|
272 (defun vc-bzr-could-register (file)
|
|
273 "Return non-nil if FILE could be registered under bzr."
|
|
274 (and (vc-bzr-responsible-p file) ; shortcut
|
|
275 (condition-case ()
|
|
276 (with-temp-buffer
|
|
277 (vc-bzr-command "add" t 0 file "--dry-run")
|
|
278 ;; The command succeeds with no output if file is
|
|
279 ;; registered (in bzr 0.8).
|
|
280 (goto-char 1)
|
|
281 (looking-at "added "))
|
|
282 (error))))
|
|
283
|
|
284 (defun vc-bzr-unregister (file)
|
|
285 "Unregister FILE from bzr."
|
|
286 (vc-bzr-command "remove" nil 0 file))
|
|
287
|
|
288 (defun vc-bzr-checkin (file rev comment)
|
|
289 "Check FILE in to bzr with log message COMMENT.
|
|
290 REV non-nil gets an error."
|
|
291 (if rev (error "Can't check in a specific version with bzr"))
|
|
292 (vc-bzr-command "commit" nil 0 file "-m" comment))
|
|
293
|
|
294 (defun vc-bzr-checkout (file &optional editable rev destfile)
|
|
295 "Checkout revision REV of FILE from bzr to DESTFILE.
|
|
296 EDITABLE is ignored."
|
|
297 (unless destfile
|
|
298 (setq destfile (vc-version-backup-file-name file rev)))
|
|
299 (let ((coding-system-for-read 'binary)
|
|
300 (coding-system-for-write 'binary))
|
|
301 (with-temp-file destfile
|
|
302 (if rev
|
|
303 (vc-bzr-command "cat" t 0 file "-r" rev)
|
|
304 (vc-bzr-command "cat" t 0 file)))))
|
|
305
|
|
306 (defun vc-bzr-revert (file &optional contents-done)
|
|
307 (unless contents-done
|
|
308 (with-temp-buffer (vc-bzr-command "revert" t 'async file))))
|
|
309
|
|
310 (eval-when-compile
|
|
311 (defvar log-view-message-re)
|
|
312 (defvar log-view-file-re)
|
|
313 (defvar log-view-font-lock-keywords)
|
|
314 (defvar log-view-current-tag-function))
|
|
315
|
|
316 ;; Grim hack to account for lack of an extension mechanism for
|
|
317 ;; log-view. Should be fixed in VC...
|
|
318 (defun vc-bzr-view-log-function ()
|
|
319 "To be added to `log-view-mode-hook' to set variables for bzr output.
|
|
320 Removes itself after running."
|
|
321 (remove-hook 'log-view-mode-hook 'vc-bzr-view-log-function)
|
|
322 (require 'add-log)
|
|
323 ;; Don't have file markers, so use impossible regexp.
|
|
324 (set (make-local-variable 'log-view-file-re) "\\'\\`")
|
|
325 (set (make-local-variable 'log-view-message-re) "^ *-+\n *\\(revno: [0-9]+\\|merged: .+\\)")
|
|
326 (set (make-local-variable 'log-view-font-lock-keywords)
|
|
327 `(("^ *committer: \
|
|
328 \\([^<(]+?\\)[ ]*[(<]\\([A-Za-z0-9_.-]+@[A-Za-z0-9_.-]+\\)[>)]"
|
|
329 nil nil
|
|
330 (1 'change-log-name-face nil t)
|
|
331 (2 'change-log-email-face nil t)
|
|
332 (3 'change-log-email-face nil t))
|
|
333 ("^ *timestamp: \\(.*\\)" (1 'change-log-date-face))
|
|
334 (,log-view-message-re . 'log-view-message-face)
|
|
335 ;; ("^ \\(.*\\)$" (1 'log-view-message-face))
|
|
336 )))
|
|
337
|
|
338 (defun vc-bzr-print-log (file &optional buffer) ; get buffer arg in Emacs 22
|
|
339 "Get bzr change log for FILE into specified BUFFER."
|
|
340 ;; Fixme: VC needs a hook to sort out the mode for the buffer, or at
|
|
341 ;; least set the regexps right.
|
|
342 ;; Fixme: This might need the locale fixing up if things like `revno'
|
|
343 ;; got localized, but certainly it shouldn't use LC_ALL=C.
|
|
344 ;; NB. Can't be async -- see `vc-bzr-post-command-function'.
|
|
345 (vc-bzr-command "log" buffer 0 file)
|
|
346 (add-hook 'log-view-mode-hook 'vc-bzr-view-log-function))
|
|
347
|
|
348 (defun vc-bzr-show-log-entry (version)
|
|
349 "Find entry for patch name VERSION in bzr change log buffer."
|
|
350 (goto-char (point-min))
|
|
351 (let (case-fold-search)
|
|
352 (if (re-search-forward (concat "^-+\nrevno: " version "$") nil t)
|
|
353 (beginning-of-line 0)
|
|
354 (goto-char (point-min)))))
|
|
355
|
|
356 ;; Fixem: vc-bzr-wash-log
|
|
357
|
|
358 (autoload 'vc-diff-switches-list "vc" nil nil t)
|
|
359
|
|
360 (defun vc-bzr-diff (file &optional rev1 rev2 buffer)
|
|
361 "VC bzr backend for diff."
|
|
362 (let ((working (vc-workfile-version file)))
|
|
363 (if (and (equal rev1 working) (not rev2))
|
|
364 (setq rev1 nil))
|
|
365 (if (and (not rev1) rev2)
|
|
366 (setq rev1 working))
|
|
367 ;; NB. Can't be async -- see `vc-bzr-post-command-function'.
|
|
368 ;; bzr diff produces condition code 1 for some reason.
|
|
369 (apply #'vc-bzr-command "diff" (or buffer "*vc-diff*") 1 file
|
|
370 "--diff-options" (mapconcat 'identity (vc-diff-switches-list bzr)
|
|
371 " ")
|
|
372 (when rev1
|
|
373 (if rev2
|
|
374 (list "-r" (format "%s..%s" rev1 rev2))
|
|
375 (list "-r" rev1))))))
|
|
376
|
|
377 (defalias 'vc-bzr-diff-tree 'vc-bzr-diff)
|
|
378
|
|
379 ;; Fixme: implement vc-bzr-dir-state, vc-bzr-dired-state-info
|
|
380
|
|
381 ;; Fixme: vc-{next,previous}-version need fixing in vc.el to deal with
|
|
382 ;; straight integer versions.
|
|
383
|
|
384 (defun vc-bzr-delete-file (file)
|
|
385 "Delete FILE and delete it in the bzr repository."
|
|
386 (condition-case ()
|
|
387 (delete-file file)
|
|
388 (file-error nil))
|
|
389 (vc-bzr-command "remove" nil 0 file))
|
|
390
|
|
391 (defun vc-bzr-rename-file (old new)
|
|
392 "Rename file from OLD to NEW using `bzr mv'."
|
|
393 (vc-bzr-command "mv" nil 0 new old))
|
|
394
|
|
395 (defvar vc-bzr-annotation-table nil
|
|
396 "Internal use.")
|
|
397 (make-variable-buffer-local 'vc-bzr-annotation-table)
|
|
398
|
|
399 (defun vc-bzr-annotate-command (file buffer &optional version)
|
|
400 "Prepare BUFFER for `vc-annotate' on FILE.
|
|
401 Each line is tagged with the revision number, which has a `help-echo'
|
|
402 property containing author and date information."
|
|
403 (apply #'vc-bzr-command "annotate" buffer 0 file "-l" "--all"
|
|
404 (if version (list "-r" version)))
|
|
405 (with-current-buffer buffer
|
|
406 ;; Store the tags for the annotated source lines in a hash table
|
|
407 ;; to allow saving space by sharing the text properties.
|
|
408 (setq vc-bzr-annotation-table (make-hash-table :test 'equal))
|
|
409 (goto-char (point-min))
|
|
410 (while (re-search-forward "^\\( *[0-9]+\\) \\(.+\\) +\\([0-9]\\{8\\}\\) |"
|
|
411 nil t)
|
|
412 (let* ((rev (match-string 1))
|
|
413 (author (match-string 2))
|
|
414 (date (match-string 3))
|
|
415 (key (match-string 0))
|
|
416 (tag (gethash key vc-bzr-annotation-table)))
|
|
417 (unless tag
|
|
418 (save-match-data
|
|
419 (string-match " +\\'" author)
|
|
420 (setq author (substring author 0 (match-beginning 0))))
|
|
421 (setq tag (propertize rev 'help-echo (concat "Author: " author
|
|
422 ", date: " date)
|
|
423 'mouse-face 'highlight))
|
|
424 (puthash key tag vc-bzr-annotation-table))
|
|
425 (replace-match "")
|
|
426 (insert tag " |")))))
|
|
427
|
|
428 ;; Definition from Emacs 22
|
|
429 (unless (fboundp 'vc-annotate-convert-time)
|
|
430 (defun vc-annotate-convert-time (time)
|
|
431 "Convert a time value to a floating-point number of days.
|
|
432 The argument TIME is a list as returned by `current-time' or
|
|
433 `encode-time', only the first two elements of that list are considered."
|
|
434 (/ (+ (* (float (car time)) (lsh 1 16)) (cadr time)) 24 3600)))
|
|
435
|
|
436 (defun vc-bzr-annotate-time ()
|
|
437 (when (re-search-forward "^ *[0-9]+ |" nil t)
|
|
438 (let ((prop (get-text-property (line-beginning-position) 'help-echo)))
|
|
439 (string-match "[0-9]+\\'" prop)
|
|
440 (vc-annotate-convert-time
|
|
441 (encode-time 0 0 0
|
|
442 (string-to-number (substring (match-string 0 prop) 6 8))
|
|
443 (string-to-number (substring (match-string 0 prop) 4 6))
|
|
444 (string-to-number (substring (match-string 0 prop) 0 4))
|
|
445 )))))
|
|
446
|
|
447 (defun vc-bzr-annotate-extract-revision-at-line ()
|
|
448 "Return revision for current line of annoation buffer, or nil.
|
|
449 Return nil if current line isn't annotated."
|
|
450 (save-excursion
|
|
451 (beginning-of-line)
|
|
452 (if (looking-at " *\\([0-9]+\\) | ")
|
|
453 (match-string-no-properties 1))))
|
|
454
|
|
455 ;; Not needed for Emacs 22
|
|
456 (defun vc-bzr-annotate-difference (point)
|
|
457 (let ((next-time (vc-bzr-annotate-time)))
|
|
458 (if next-time
|
|
459 (- (vc-annotate-convert-time (current-time)) next-time))))
|
|
460
|
|
461 ;; FIXME: `bzr root' will return the real path to the repository root,
|
|
462 ;; that is, it can differ from the buffer's current directory name
|
|
463 ;; if there are any symbolic links.
|
|
464 (defun vc-bzr-root (dir)
|
|
465 "Return the root directory of the bzr repository containing DIR."
|
|
466 (substring
|
|
467 (shell-command-to-string (concat vc-bzr-program " root " dir)) 0 -1))
|
|
468
|
|
469 ;; TODO: it would be nice to mark the conflicted files in VC Dired,
|
|
470 ;; and implement a command to run ediff and `bzr resolve' once the
|
|
471 ;; changes have been merged.
|
|
472 (defun vc-bzr-dir-state (dir &optional localp)
|
|
473 "Find the VC state of all files in DIR.
|
|
474 Optional argument LOCALP is always ignored."
|
|
475 (let (at-start bzr-root-directory current-bzr-state current-vc-state)
|
|
476 ;; check that DIR is a bzr repository
|
|
477 (set 'bzr-root-directory (vc-bzr-root dir))
|
|
478 (unless (string-match "^/" bzr-root-directory)
|
|
479 (error "Cannot find bzr repository for directory `%s'" dir))
|
|
480 ;; `bzr ls --versioned' lists all versioned files;
|
|
481 ;; assume they are up-to-date, unless we are given
|
|
482 ;; evidence of the contrary.
|
|
483 (set 'at-start t)
|
|
484 (with-temp-buffer
|
|
485 (vc-bzr-command* "ls" t 0 "--versioned" "--non-recursive")
|
|
486 (goto-char (point-min))
|
|
487 (while (or at-start
|
|
488 (eq 0 (forward-line)))
|
|
489 (set 'at-start nil)
|
|
490 (let ((file (expand-file-name
|
|
491 (buffer-substring-no-properties
|
|
492 (line-beginning-position) (line-end-position))
|
|
493 bzr-root-directory)))
|
|
494 (vc-file-setprop file 'vc-state 'up-to-date)
|
|
495 ;; XXX: is this correct? what happens if one
|
|
496 ;; mixes different SCMs in the same dir?
|
|
497 (vc-file-setprop file 'vc-backend 'BZR))))
|
|
498 ;; `bzr status' reports on added/modified/renamed and unknown/ignored files
|
|
499 (set 'at-start t)
|
|
500 (with-temp-buffer
|
|
501 (vc-bzr-with-c-locale (vc-bzr-command "status" t 0 nil))
|
|
502 (goto-char (point-min))
|
|
503 (while (or at-start
|
|
504 (eq 0 (forward-line)))
|
|
505 (set 'at-start nil)
|
|
506 (cond
|
|
507 ((looking-at "^added")
|
|
508 (set 'current-vc-state 'edited)
|
|
509 (set 'current-bzr-state 'added))
|
|
510 ((looking-at "^modified")
|
|
511 (set 'current-vc-state 'edited)
|
|
512 (set 'current-bzr-state 'modified))
|
|
513 ((looking-at "^renamed")
|
|
514 (set 'current-vc-state 'edited)
|
|
515 (set 'current-bzr-state 'renamed))
|
|
516 ((looking-at "^\\(unknown\\|ignored\\)")
|
|
517 (set 'current-vc-state nil)
|
|
518 (set 'current-bzr-state 'not-versioned))
|
|
519 ((looking-at " ")
|
|
520 ;; file names are indented by two spaces
|
|
521 (when current-vc-state
|
|
522 (let ((file (expand-file-name
|
|
523 (buffer-substring-no-properties
|
|
524 (match-end 0) (line-end-position))
|
|
525 bzr-root-directory)))
|
|
526 (vc-file-setprop file 'vc-state current-vc-state)
|
|
527 (vc-file-setprop file 'vc-bzr-state current-bzr-state)
|
|
528 (when (eq 'added current-bzr-state)
|
|
529 (vc-file-setprop file 'vc-workfile-version "0"))))
|
|
530 (when (eq 'not-versioned current-bzr-state)
|
|
531 (let ((file (expand-file-name
|
|
532 (buffer-substring-no-properties
|
|
533 (match-end 0) (line-end-position))
|
|
534 bzr-root-directory)))
|
|
535 (vc-file-setprop file 'vc-backend 'none)
|
|
536 (vc-file-setprop file 'vc-state nil))))
|
|
537 (t
|
|
538 ;; skip this part of `bzr status' output
|
|
539 (set 'current-vc-state nil)
|
|
540 (set 'current-bzr-state nil)))))))
|
|
541
|
|
542 (defun vc-bzr-dired-state-info (file)
|
|
543 "Bzr-specific version of `vc-dired-state-info'."
|
|
544 (if (eq 'edited (vc-state file))
|
|
545 (let ((bzr-state (vc-file-getprop file 'vc-bzr-state)))
|
|
546 (if bzr-state
|
|
547 (concat "(" (symbol-name bzr-state) ")")
|
|
548 ;; else fall back to default vc representation
|
|
549 (vc-default-dired-state-info 'BZR file)))))
|
|
550
|
|
551 ;; In case of just `(load "vc-bzr")', but that's probably the wrong
|
|
552 ;; way to do it.
|
|
553 (add-to-list 'vc-handled-backends 'BZR)
|
|
554
|
|
555 (eval-after-load "vc"
|
|
556 '(add-to-list 'vc-directory-exclusion-list ".bzr" t))
|
|
557
|
|
558 (defconst vc-bzr-unload-hook
|
|
559 (lambda ()
|
|
560 (setq vc-handled-backends (delq 'BZR vc-handled-backends))
|
|
561 (remove-hook 'vc-post-command-functions 'vc-bzr-post-command-function)))
|
|
562
|
|
563 (provide 'vc-bzr)
|
|
564 ;; arch-tag: 8101bad8-4e92-4e7d-85ae-d8e08b4e7c06
|
|
565 ;;; vc-bzr.el ends here
|