aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/ChangeLog3
-rw-r--r--lisp/vc/vc-bzr.el87
2 files changed, 48 insertions, 42 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index fb90f095d7c..37e014751d7 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,8 @@
12012-04-11 Glenn Morris <rgm@gnu.org> 12012-04-11 Glenn Morris <rgm@gnu.org>
2 2
3 * vc/vc-bzr.el (vc-bzr-status): Handle all errors,
4 not just file-errors.
5
3 * vc/vc-bzr.el (vc-bzr-sha1-program, sha1-program): Remove. 6 * vc/vc-bzr.el (vc-bzr-sha1-program, sha1-program): Remove.
4 (vc-bzr-sha1): Use internal sha1. 7 (vc-bzr-sha1): Use internal sha1.
5 8
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index 2058c9f64ee..34d11cf359f 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -400,49 +400,52 @@ string or nil, and STATUS is one of the symbols: `added',
400`ignored', `kindchanged', `modified', `removed', `renamed', `unknown', 400`ignored', `kindchanged', `modified', `removed', `renamed', `unknown',
401which directly correspond to `bzr status' output, or 'unchanged 401which directly correspond to `bzr status' output, or 'unchanged
402for files whose copy in the working tree is identical to the one 402for files whose copy in the working tree is identical to the one
403in the branch repository, or nil for files that are not 403in the branch repository (or whose status not be determined)."
404registered with Bzr. 404;; Doc used to also say the following, but AFAICS, it has never been true.
405 405;;
406If any error occurred in running `bzr status', then return nil." 406;; ", or nil for files that are not registered with Bzr.
407;; If any error occurred in running `bzr status', then return nil."
408;;
409;; Rather than returning nil in case of an error, it returns
410;; (unchanged . WARNING). FIXME unchanged is not the best status to
411;; return in case of error.
407 (with-temp-buffer 412 (with-temp-buffer
408 (let ((ret (condition-case nil 413 (with-demoted-errors (vc-bzr-command "status" t 0 file))
409 (vc-bzr-command "status" t 0 file) 414 (let ((status 'unchanged))
410 (file-error nil))) ; vc-bzr-program not found. 415 ;; the only secure status indication in `bzr status' output
411 (status 'unchanged)) 416 ;; is a couple of lines following the pattern::
412 ;; the only secure status indication in `bzr status' output 417 ;; | <status>:
413 ;; is a couple of lines following the pattern:: 418 ;; | <file name>
414 ;; | <status>: 419 ;; if the file is up-to-date, we get no status report from `bzr',
415 ;; | <file name> 420 ;; so if the regexp search for the above pattern fails, we consider
416 ;; if the file is up-to-date, we get no status report from `bzr', 421 ;; the file to be up-to-date.
417 ;; so if the regexp search for the above pattern fails, we consider 422 (goto-char (point-min))
418 ;; the file to be up-to-date. 423 (when (re-search-forward
419 (goto-char (point-min)) 424 ;; bzr prints paths relative to the repository root.
420 (when (re-search-forward 425 (concat "^\\(" vc-bzr-state-words "\\):[ \t\n]+"
421 ;; bzr prints paths relative to the repository root. 426 (regexp-quote (vc-bzr-file-name-relative file))
422 (concat "^\\(" vc-bzr-state-words "\\):[ \t\n]+" 427 ;; Bzr appends a '/' to directory names and
423 (regexp-quote (vc-bzr-file-name-relative file)) 428 ;; '*' to executable files
424 ;; Bzr appends a '/' to directory names and 429 (if (file-directory-p file) "/?" "\\*?")
425 ;; '*' to executable files 430 "[ \t\n]*$")
426 (if (file-directory-p file) "/?" "\\*?") 431 nil t)
427 "[ \t\n]*$") 432 (lexical-let ((statusword (match-string 1)))
428 nil t) 433 ;; Erase the status text that matched.
429 (lexical-let ((statusword (match-string 1))) 434 (delete-region (match-beginning 0) (match-end 0))
430 ;; Erase the status text that matched. 435 (setq status
431 (delete-region (match-beginning 0) (match-end 0)) 436 (intern (replace-regexp-in-string " " "" statusword)))))
432 (setq status 437 (when status
433 (intern (replace-regexp-in-string " " "" statusword))))) 438 (goto-char (point-min))
434 (when status 439 (skip-chars-forward " \n\t") ;Throw away spaces.
435 (goto-char (point-min)) 440 (cons status
436 (skip-chars-forward " \n\t") ;Throw away spaces. 441 ;; "bzr" will output warnings and informational messages to
437 (cons status 442 ;; stderr; due to Emacs's `vc-do-command' (and, it seems,
438 ;; "bzr" will output warnings and informational messages to 443 ;; `start-process' itself) limitations, we cannot catch stderr
439 ;; stderr; due to Emacs's `vc-do-command' (and, it seems, 444 ;; and stdout into different buffers. So, if there's anything
440 ;; `start-process' itself) limitations, we cannot catch stderr 445 ;; left in the buffer after removing the above status
441 ;; and stdout into different buffers. So, if there's anything 446 ;; keywords, let us just presume that any other message from
442 ;; left in the buffer after removing the above status 447 ;; "bzr" is a user warning, and display it.
443 ;; keywords, let us just presume that any other message from 448 (unless (eobp) (buffer-substring (point) (point-max))))))))
444 ;; "bzr" is a user warning, and display it.
445 (unless (eobp) (buffer-substring (point) (point-max))))))))
446 449
447(defun vc-bzr-state (file) 450(defun vc-bzr-state (file)
448 (lexical-let ((result (vc-bzr-status file))) 451 (lexical-let ((result (vc-bzr-status file)))