aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2007-08-15 21:10:46 +0000
committerStefan Monnier2007-08-15 21:10:46 +0000
commitfba500b6f114b319795ba5cc982ab6d8e46af56d (patch)
tree5a91a89268b5a12f892ccbd0afbabe9f34c82ccc
parent37e479416a2a571253ad9c4340ea9d03550b79ae (diff)
downloademacs-fba500b6f114b319795ba5cc982ab6d8e46af56d.tar.gz
emacs-fba500b6f114b319795ba5cc982ab6d8e46af56d.zip
Don't fiddle with vc-handled-backend.
(vc-bzr-registered): Don't redundantly protect against file-error. Actually use the format-specific code. (vc-bzr-buffer-nonblank-p): Remove. (vc-bzr-status): Change `kindchange' -> `kindchanged'.
-rw-r--r--lisp/ChangeLog8
-rw-r--r--lisp/vc-bzr.el173
2 files changed, 80 insertions, 101 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 40687712892..4e9a0798673 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,11 @@
12007-08-15 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * vc-bzr.el: Don't fiddle with vc-handled-backend.
4 (vc-bzr-registered): Don't redundantly protect against
5 file-error. Actually use the format-specific code.
6 (vc-bzr-buffer-nonblank-p): Remove.
7 (vc-bzr-status): Change `kindchange' -> `kindchanged'.
8
12007-08-15 Glenn Morris <rgm@gnu.org> 92007-08-15 Glenn Morris <rgm@gnu.org>
2 10
3 * mail/undigest.el (rmail-digest-parse-rfc1153sloppy): Be even 11 * mail/undigest.el (rmail-digest-parse-rfc1153sloppy): Be even
diff --git a/lisp/vc-bzr.el b/lisp/vc-bzr.el
index a11aa2e7ba8..2978e81ea50 100644
--- a/lisp/vc-bzr.el
+++ b/lisp/vc-bzr.el
@@ -59,7 +59,7 @@
59 59
60(defgroup vc-bzr nil 60(defgroup vc-bzr nil
61 "VC bzr backend." 61 "VC bzr backend."
62;; :version "22" 62 :version "22.2"
63 :group 'vc) 63 :group 'vc)
64 64
65(defcustom vc-bzr-program "bzr" 65(defcustom vc-bzr-program "bzr"
@@ -130,38 +130,27 @@ format 3' in the first line.
130 130
131If the `checkout/dirstate' file cannot be parsed, fall back to 131If the `checkout/dirstate' file cannot be parsed, fall back to
132running `vc-bzr-state'." 132running `vc-bzr-state'."
133 (condition-case nil 133 (lexical-let ((root (vc-bzr-root file)))
134 (lexical-let ((root (vc-bzr-root file))) 134 (when root ; Short cut.
135 (and root ; Short cut. 135 ;; This looks at internal files. May break if they change
136 ;; This looks at internal files. May break if they change 136 ;; their format.
137 ;; their format. 137 (lexical-let ((dirstate (expand-file-name vc-bzr-admin-dirstate root)))
138 (lexical-let 138 (if (not (file-readable-p dirstate))
139 ((dirstate-file (expand-file-name vc-bzr-admin-dirstate root))) 139 (vc-bzr-state file) ; Expensive.
140 (if (file-exists-p dirstate-file) 140 (with-temp-buffer
141 (with-temp-buffer 141 (insert-file-contents dirstate)
142 (insert-file-contents dirstate-file) 142 (goto-char (point-min))
143 (goto-char (point-min)) 143 (if (not (looking-at "#bazaar dirstate flat format 3"))
144 (when (looking-at "#bazaar dirstate flat format 3") 144 (vc-bzr-state file) ; Some other unknown format?
145 (let* ((relfile (file-relative-name file root)) 145 (let* ((relfile (file-relative-name file root))
146 (reldir (file-name-directory relfile))) 146 (reldir (file-name-directory relfile)))
147 (re-search-forward 147 (re-search-forward
148 (concat "^\0" 148 (concat "^\0"
149 (if reldir (regexp-quote (directory-file-name reldir))) 149 (if reldir (regexp-quote (directory-file-name reldir)))
150 "\0" 150 "\0"
151 (regexp-quote (file-name-nondirectory relfile)) 151 (regexp-quote (file-name-nondirectory relfile))
152 "\0") 152 "\0")
153 nil t)))) 153 nil t)))))))))
154 t))
155 (vc-bzr-state file))) ; Expensive.
156 (file-error nil))) ; vc-bzr-program not found
157
158(defun vc-bzr-buffer-nonblank-p (&optional buffer)
159 "Return non-nil if BUFFER contains any non-blank characters."
160 (or (> (buffer-size buffer) 0)
161 (save-excursion
162 (set-buffer (or buffer (current-buffer)))
163 (goto-char (point-min))
164 (re-search-forward "[^ \t\n]" (point-max) t))))
165 154
166(defconst vc-bzr-state-words 155(defconst vc-bzr-state-words
167 "added\\|ignored\\|kind changed\\|modified\\|removed\\|renamed\\|unknown" 156 "added\\|ignored\\|kind changed\\|modified\\|removed\\|renamed\\|unknown"
@@ -180,61 +169,53 @@ running `vc-bzr-state'."
180(defun vc-bzr-status (file) 169(defun vc-bzr-status (file)
181 "Return FILE status according to Bzr. 170 "Return FILE status according to Bzr.
182Return value is a cons (STATUS . WARNING), where WARNING is a 171Return value is a cons (STATUS . WARNING), where WARNING is a
183string or nil, and STATUS is one of the symbols: 'added, 172string or nil, and STATUS is one of the symbols: `added',
184'ignored, 'kindchange, 'modified, 'removed, 'renamed, 'unknown, 173`ignored', `kindchanged', `modified', `removed', `renamed', `unknown',
185which directly correspond to `bzr status' output, or 'unchanged 174which directly correspond to `bzr status' output, or 'unchanged
186for files whose copy in the working tree is identical to the one 175for files whose copy in the working tree is identical to the one
187in the branch repository, or nil for files that are not 176in the branch repository, or nil for files that are not
188registered with Bzr. 177registered with Bzr.
189 178
190If any error occurred in running `bzr status', then return nil." 179If any error occurred in running `bzr status', then return nil."
191 (condition-case nil
192 (with-temp-buffer 180 (with-temp-buffer
193 (let ((ret (vc-bzr-command "status" t 0 file)) 181 (let ((ret (condition-case nil
194 (status 'unchanged)) 182 (vc-bzr-command "status" t 0 file)
195 ;; the only secure status indication in `bzr status' output 183 (file-error nil))) ; vc-bzr-program not found.
196 ;; is a couple of lines following the pattern:: 184 (status 'unchanged))
197 ;; | <status>: 185 ;; the only secure status indication in `bzr status' output
198 ;; | <file name> 186 ;; is a couple of lines following the pattern::
199 ;; if the file is up-to-date, we get no status report from `bzr', 187 ;; | <status>:
200 ;; so if the regexp search for the above pattern fails, we consider 188 ;; | <file name>
201 ;; the file to be up-to-date. 189 ;; if the file is up-to-date, we get no status report from `bzr',
202 (goto-char (point-min)) 190 ;; so if the regexp search for the above pattern fails, we consider
203 (when 191 ;; the file to be up-to-date.
204 (re-search-forward 192 (goto-char (point-min))
205 ;; bzr prints paths relative to the repository root 193 (when (re-search-forward
206 (concat "^\\(" vc-bzr-state-words "\\):[ \t\n]+" 194 ;; bzr prints paths relative to the repository root.
207 (regexp-quote (vc-bzr-file-name-relative file)) 195 (concat "^\\(" vc-bzr-state-words "\\):[ \t\n]+"
208 (if (file-directory-p file) "/?" "") 196 (regexp-quote (vc-bzr-file-name-relative file))
209 "[ \t\n]*$") 197 (if (file-directory-p file) "/?" "")
210 (point-max) t) 198 "[ \t\n]*$")
211 (let ((start (match-beginning 0)) 199 nil t)
212 (end (match-end 0))) 200 (let ((status (match-string 1)))
213 (goto-char start) 201 ;; Erase the status text that matched.
202 (delete-region (match-beginning 0) (match-end 0))
214 (setq status 203 (setq status
215 (cond 204 (and (equal ret 0) ; Seems redundant. --Stef
216 ((not (equal ret 0)) nil) 205 (intern (replace-regexp-in-string " " ""
217 ((looking-at "added") 'added) 206 status))))))
218 ((looking-at "kind changed") 'kindchange) 207 (when status
219 ((looking-at "renamed") 'renamed) 208 (goto-char (point-min))
220 ((looking-at "modified") 'modified) 209 (skip-chars-forward " \n\t") ;Throw away spaces.
221 ((looking-at "removed") 'removed) 210 (cons status
222 ((looking-at "ignored") 'ignored) 211 ;; "bzr" will output warnings and informational messages to
223 ((looking-at "unknown") 'unknown))) 212 ;; stderr; due to Emacs' `vc-do-command' (and, it seems,
224 ;; erase the status text that matched 213 ;; `start-process' itself) limitations, we cannot catch stderr
225 (delete-region start end))) 214 ;; and stdout into different buffers. So, if there's anything
226 (if status 215 ;; left in the buffer after removing the above status
227 (cons status 216 ;; keywords, let us just presume that any other message from
228 ;; "bzr" will output warnings and informational messages to 217 ;; "bzr" is a user warning, and display it.
229 ;; stderr; due to Emacs' `vc-do-command' (and, it seems, 218 (unless (eobp) (buffer-substring (point) (point-max))))))))
230 ;; `start-process' itself) limitations, we cannot catch stderr
231 ;; and stdout into different buffers. So, if there's anything
232 ;; left in the buffer after removing the above status
233 ;; keywords, let us just presume that any other message from
234 ;; "bzr" is a user warning, and display it.
235 (if (vc-bzr-buffer-nonblank-p)
236 (buffer-substring (point-min) (point-max)))))))
237 (file-error nil))) ; vc-bzr-program not found
238 219
239(defun vc-bzr-state (file) 220(defun vc-bzr-state (file)
240 (lexical-let ((result (vc-bzr-status file))) 221 (lexical-let ((result (vc-bzr-status file)))
@@ -243,7 +224,7 @@ If any error occurred in running `bzr status', then return nil."
243 (message "Warnings in `bzr' output: %s" (cdr result))) 224 (message "Warnings in `bzr' output: %s" (cdr result)))
244 (cdr (assq (car result) 225 (cdr (assq (car result)
245 '((added . edited) 226 '((added . edited)
246 (kindchange . edited) 227 (kindchanged . edited)
247 (renamed . edited) 228 (renamed . edited)
248 (modified . edited) 229 (modified . edited)
249 (removed . edited) 230 (removed . edited)
@@ -264,7 +245,7 @@ If any error occurred in running `bzr status', then return nil."
264 ;; bzr process. This looks at internal files. May break if they 245 ;; bzr process. This looks at internal files. May break if they
265 ;; change their format. 246 ;; change their format.
266 (if (file-exists-p branch-format-file) 247 (if (file-exists-p branch-format-file)
267 (with-temp-buffer 248 (with-temp-buffer
268 (insert-file-contents branch-format-file) 249 (insert-file-contents branch-format-file)
269 (goto-char (point-min)) 250 (goto-char (point-min))
270 (cond 251 (cond
@@ -272,7 +253,7 @@ If any error occurred in running `bzr status', then return nil."
272 (looking-at "Bazaar-NG branch, format 0.0.4") 253 (looking-at "Bazaar-NG branch, format 0.0.4")
273 (looking-at "Bazaar-NG branch format 5")) 254 (looking-at "Bazaar-NG branch format 5"))
274 ;; count lines in .bzr/branch/revision-history 255 ;; count lines in .bzr/branch/revision-history
275 (insert-file-contents revhistory-file) 256 (insert-file-contents revhistory-file)
276 (number-to-string (count-lines (line-end-position) (point-max)))) 257 (number-to-string (count-lines (line-end-position) (point-max))))
277 ((looking-at "Bazaar Branch Format 6 (bzr 0.15)") 258 ((looking-at "Bazaar Branch Format 6 (bzr 0.15)")
278 ;; revno is the first number in .bzr/branch/last-revision 259 ;; revno is the first number in .bzr/branch/last-revision
@@ -340,10 +321,10 @@ EDITABLE is ignored."
340 (setq destfile (vc-version-backup-file-name file rev))) 321 (setq destfile (vc-version-backup-file-name file rev)))
341 (let ((coding-system-for-read 'binary) 322 (let ((coding-system-for-read 'binary)
342 (coding-system-for-write 'binary)) 323 (coding-system-for-write 'binary))
343 (with-temp-file destfile 324 (with-temp-file destfile
344 (if rev 325 (if rev
345 (vc-bzr-command "cat" t 0 file "-r" rev) 326 (vc-bzr-command "cat" t 0 file "-r" rev)
346 (vc-bzr-command "cat" t 0 file))))) 327 (vc-bzr-command "cat" t 0 file)))))
347 328
348(defun vc-bzr-revert (file &optional contents-done) 329(defun vc-bzr-revert (file &optional contents-done)
349 (unless contents-done 330 (unless contents-done
@@ -376,7 +357,6 @@ EDITABLE is ignored."
376 "Get bzr change log for FILES into specified BUFFER." 357 "Get bzr change log for FILES into specified BUFFER."
377 ;; Fixme: This might need the locale fixing up if things like `revno' 358 ;; Fixme: This might need the locale fixing up if things like `revno'
378 ;; got localized, but certainly it shouldn't use LC_ALL=C. 359 ;; got localized, but certainly it shouldn't use LC_ALL=C.
379 ;; NB. Can't be async -- see `vc-bzr-post-command-function'.
380 (vc-bzr-command "log" buffer 0 files) 360 (vc-bzr-command "log" buffer 0 files)
381 ;; FIXME: Until Emacs-23, VC was missing a hook to sort out the mode for 361 ;; FIXME: Until Emacs-23, VC was missing a hook to sort out the mode for
382 ;; the buffer, or at least set the regexps right. 362 ;; the buffer, or at least set the regexps right.
@@ -400,7 +380,6 @@ EDITABLE is ignored."
400 (setq rev1 nil)) 380 (setq rev1 nil))
401 (if (and (not rev1) rev2) 381 (if (and (not rev1) rev2)
402 (setq rev1 working)) 382 (setq rev1 working))
403 ;; NB. Can't be async -- see `vc-bzr-post-command-function'.
404 ;; bzr diff produces condition code 1 for some reason. 383 ;; bzr diff produces condition code 1 for some reason.
405 (apply #'vc-bzr-command "diff" (or buffer "*vc-diff*") 1 files 384 (apply #'vc-bzr-command "diff" (or buffer "*vc-diff*") 1 files
406 "--diff-options" (mapconcat 'identity (vc-diff-switches-list bzr) 385 "--diff-options" (mapconcat 'identity (vc-diff-switches-list bzr)
@@ -462,11 +441,11 @@ property containing author and date information."
462 441
463;; Definition from Emacs 22 442;; Definition from Emacs 22
464(unless (fboundp 'vc-annotate-convert-time) 443(unless (fboundp 'vc-annotate-convert-time)
465(defun vc-annotate-convert-time (time) 444 (defun vc-annotate-convert-time (time)
466 "Convert a time value to a floating-point number of days. 445 "Convert a time value to a floating-point number of days.
467The argument TIME is a list as returned by `current-time' or 446The argument TIME is a list as returned by `current-time' or
468`encode-time', only the first two elements of that list are considered." 447`encode-time', only the first two elements of that list are considered."
469 (/ (+ (* (float (car time)) (lsh 1 16)) (cadr time)) 24 3600))) 448 (/ (+ (* (float (car time)) (lsh 1 16)) (cadr time)) 24 3600)))
470 449
471(defun vc-bzr-annotate-time () 450(defun vc-bzr-annotate-time ()
472 (when (re-search-forward "^ *[0-9]+ |" nil t) 451 (when (re-search-forward "^ *[0-9]+ |" nil t)
@@ -548,7 +527,7 @@ Optional argument LOCALP is always ignored."
548 (setq current-bzr-state 'added)) 527 (setq current-bzr-state 'added))
549 ((looking-at "^kind changed") 528 ((looking-at "^kind changed")
550 (setq current-vc-state 'edited) 529 (setq current-vc-state 'edited)
551 (setq current-bzr-state 'kindchange)) 530 (setq current-bzr-state 'kindchanged))
552 ((looking-at "^modified") 531 ((looking-at "^modified")
553 (setq current-vc-state 'edited) 532 (setq current-vc-state 'edited)
554 (setq current-bzr-state 'modified)) 533 (setq current-bzr-state 'modified))
@@ -590,17 +569,9 @@ Optional argument LOCALP is always ignored."
590 ;; else fall back to default vc representation 569 ;; else fall back to default vc representation
591 (vc-default-dired-state-info 'Bzr file))))) 570 (vc-default-dired-state-info 'Bzr file)))))
592 571
593;; In case of just `(load "vc-bzr")', but that's probably the wrong
594;; way to do it.
595(add-to-list 'vc-handled-backends 'Bzr)
596
597(eval-after-load "vc" 572(eval-after-load "vc"
598 '(add-to-list 'vc-directory-exclusion-list vc-bzr-admin-dirname t)) 573 '(add-to-list 'vc-directory-exclusion-list vc-bzr-admin-dirname t))
599 574
600(defconst vc-bzr-unload-hook
601 (lambda ()
602 (setq vc-handled-backends (delq 'Bzr vc-handled-backends))
603 (remove-hook 'vc-post-command-functions 'vc-bzr-post-command-function)))
604 575
605(provide 'vc-bzr) 576(provide 'vc-bzr)
606;; arch-tag: 8101bad8-4e92-4e7d-85ae-d8e08b4e7c06 577;; arch-tag: 8101bad8-4e92-4e7d-85ae-d8e08b4e7c06