# HG changeset patch # User Stefan Monnier # Date 1182321875 0 # Node ID 92dd41bc61308888908fde7de222b8aa6a7cda08 # Parent 3dedb2297b98f082e873d61e77724b3eff540512 (vc-bzr-with-process-environment, vc-bzr-std-process-invocation): New macros. (vc-bzr-command, vc-bzr-command*): Use them. (vc-bzr-with-c-locale): Remove. (vc-bzr-dir-state): Replace its use with vc-bzr-command. (vc-bzr-buffer-nonblank-p): New function. (vc-bzr-state-words): New const. (vc-bzr-state): Look for `bzr status` keywords in output. Display everything else as a warning message to the user. Fix status report with bzr >= 0.15. diff -r 3dedb2297b98 -r 92dd41bc6130 lisp/ChangeLog --- a/lisp/ChangeLog Wed Jun 20 06:32:42 2007 +0000 +++ b/lisp/ChangeLog Wed Jun 20 06:44:35 2007 +0000 @@ -1,3 +1,16 @@ +2007-06-20 Riccardo Murri + + * vc-bzr.el (vc-bzr-with-process-environment) + (vc-bzr-std-process-invocation): New macros. + (vc-bzr-command, vc-bzr-command*): Use them. + (vc-bzr-with-c-locale): Remove. + (vc-bzr-dir-state): Replace its use with vc-bzr-command. + (vc-bzr-buffer-nonblank-p): New function. + (vc-bzr-state-words): New const. + (vc-bzr-state): Look for `bzr status` keywords in output. + Display everything else as a warning message to the user. + Fix status report with bzr >= 0.15. + 2007-06-20 Dan Nicolaescu * vc-hg.el (vc-hg-global-switches): Simplify. diff -r 3dedb2297b98 -r 92dd41bc6130 lisp/vc-bzr.el --- a/lisp/vc-bzr.el Wed Jun 20 06:32:42 2007 +0000 +++ b/lisp/vc-bzr.el Wed Jun 20 06:44:35 2007 +0000 @@ -10,7 +10,7 @@ ;; Author: Dave Love , Riccardo Murri ;; Keywords: tools ;; Created: Sept 2006 -;; Version: 2007-01-17 +;; Version: 2007-05-24 ;; URL: http://launchpad.net/vc-bzr ;; This file is free software; you can redistribute it and/or modify @@ -36,13 +36,23 @@ ;; See concerning bzr. -;; Load this library to register bzr support in VC. The support is -;; preliminary and incomplete, adapted from my darcs version. Lightly -;; exercised with bzr 0.8 and Emacs 21, and bzr 0.11 on Emacs 22. See -;; various Fixmes below. +;; Load this library to register bzr support in VC. It covers basic VC +;; functionality, but was only lightly exercised with a few Emacs/bzr +;; version combinations, namely those current on the authors' PCs. +;; See various Fixmes below. + + +;; Known bugs +;; ========== -;; This should be suitable for direct inclusion in Emacs if someone -;; can persuade rms. +;; When edititing a symlink and *both* the symlink and its target +;; are bzr-versioned, `vc-bzr` presently runs `bzr status` on the +;; symlink, thereby not detecting whether the actual contents +;; (that is, the target contents) are changed. +;; See https://bugs.launchpad.net/vc-bzr/+bug/116607 + +;; For an up-to-date list of bugs, please see: +;; https://bugs.launchpad.net/vc-bzr/+bugs ;;; Code: @@ -96,9 +106,26 @@ First argument VERS is a list of the form (X Y Z), as returned by `vc-bzr-version'." (version-list-<= vers (vc-bzr-version))) +(eval-when-compile + (defmacro vc-bzr-with-process-environment (envspec &rest body) + "Prepend the contents of ENVSPEC to `process-environment', then execute BODY." + `(let ((process-environment process-environment)) + (mapcar (lambda (var) (add-to-list 'process-environment var)) ,envspec) + ,@body)) + + (defmacro vc-bzr-std-process-invocation (&rest body) + `(vc-bzr-with-process-environment + '("BZR_PROGRESS_BAR=none" ; suppress progress output (bzr >=0.9) + "LC_ALL=C") ; force English output + ;; bzr may attempt some kind of user interaction if its stdin/stdout + ;; is connected to a PTY; therefore, ask Emacs to use a pipe to + ;; communicate with it. + (let ((process-connection-type nil)) + ,@body)))) + ;; XXX: vc-do-command is tailored for RCS and assumes that command-line -;; options precede the file name (ci -something file); with bzr, we need -; to pass options *after* the subcommand, e.g. bzr ls --versioned. +;; options precede the file name (e.g., "ci -something file"); with bzr, +;; we need to pass options *after* the subcommand, e.g. "bzr ls --versioned". (defun vc-bzr-do-command* (buffer okstatus command &rest args) "Execute bzr COMMAND, notifying user and checking for errors. This is a wrapper around `vc-do-command', which see for detailed @@ -120,16 +147,16 @@ (defun vc-bzr-command (bzr-command buffer okstatus file &rest args) "Wrapper round `vc-do-command' using `vc-bzr-program' as COMMAND. Invoke the bzr command adding `BZR_PROGRESS_BAR=none' to the environment." - (let ((process-environment (cons "BZR_PROGRESS_BAR=none" process-environment))) - (apply 'vc-do-command buffer okstatus vc-bzr-program - file bzr-command (append vc-bzr-program-args args)))) + (vc-bzr-std-process-invocation + (apply 'vc-do-command buffer okstatus vc-bzr-program + file bzr-command (append vc-bzr-program-args args)))) (defun vc-bzr-command* (bzr-command buffer okstatus file &rest args) "Wrapper round `vc-bzr-do-command*' using `vc-bzr-program' as COMMAND. Invoke the bzr command adding `BZR_PROGRESS_BAR=none' to the environment. First argument BZR-COMMAND is passed as the first optional argument to `vc-bzr-do-command*'." - (let ((process-environment (cons "BZR_PROGRESS_BAR=none" process-environment))) + (vc-bzr-std-process-invocation (apply 'vc-bzr-do-command* buffer okstatus vc-bzr-program bzr-command (append vc-bzr-program-args args))))) @@ -171,19 +198,6 @@ (add-hook 'vc-post-command-functions 'vc-bzr-post-command-function))) -;; Fixme: If we're only interested in status messages, we only need -;; to set LC_MESSAGES, and we might need finer control of this. This -;; is moot anyhow, since bzr doesn't appear to be localized at all -;; (yet?). -(eval-when-compile -(defmacro vc-bzr-with-c-locale (&rest body) - "Run BODY with LC_ALL=C in the process environment. -This ensures that messages to be matched come out as expected." - `(let ((process-environment (cons "LC_ALL=C" process-environment))) - ,@body))) -(put 'vc-bzr-with-c-locale 'edebug-form-spec t) -(put 'vc-bzr-with-c-locale 'lisp-indent-function 0) - (defun vc-bzr-bzr-dir (file) "Return the .bzr directory in the hierarchy above FILE. Return nil if there isn't one." @@ -206,36 +220,57 @@ (if (vc-bzr-bzr-dir file) ; short cut (vc-bzr-state file))) ; expensive -(defun vc-bzr-state (file) - (let (ret state conflicts pending-merges) - (with-temp-buffer - (cd (file-name-directory file)) - (setq ret (vc-bzr-with-c-locale (vc-bzr-command "status" t 255 file))) - (goto-char 1) - (save-excursion - (when (re-search-forward "^conflicts:" nil t) - (message "Warning -- conflicts in bzr branch"))) +(defun vc-bzr-buffer-nonblank-p (&optional buffer) + "Return non-nil if BUFFER contains any non-blank characters." + (or (> (buffer-size buffer) 0) (save-excursion - (when (re-search-forward "^pending merges:" nil t) - (message "Warning -- pending merges in bzr branch"))) - (setq state - (cond ((not (equal ret 0)) nil) - ((looking-at "added\\|renamed\\|modified\\|removed") 'edited) - ;; Fixme: Also get this in a non-registered sub-directory. - ((looking-at "^$") 'up-to-date) - ;; if we're seeing this as first line of text, - ;; then the status is up-to-date, - ;; but bzr output only gives the warning to users. - ((looking-at "conflicts\\|pending") 'up-to-date) - ((looking-at "unknown\\|ignored") nil) - (t (error "Unrecognized output from `bzr status'")))) - (when (or conflicts pending-merges) - (message - (concat "Warning -- " - (if conflicts "conflicts ") - (if (and conflicts pending-merges) "and ") - (if pending-merges "pending merges ") - "in bzr branch"))) + (set-buffer (or buffer (current-buffer))) + (goto-char (point-min)) + (re-search-forward "[^ \t\n]" (point-max) t)))) + +(defconst vc-bzr-state-words + "added\\|ignored\\|modified\\|removed\\|renamed\\|unknown" + "Regexp matching file status words as reported in `bzr' output.") + +;; FIXME: Also get this in a non-registered sub-directory. +(defun vc-bzr-state (file) + (with-temp-buffer + (cd (file-name-directory file)) + (let ((ret (vc-bzr-command "status" t 255 file)) + (state 'up-to-date)) + ;; the only secure status indication in `bzr status' output + ;; is a couple of lines following the pattern:: + ;; | : + ;; | + ;; if the file is up-to-date, we get no status report from `bzr', + ;; so if the regexp search for the above pattern fails, we consider + ;; the file to be up-to-date. + (goto-char (point-min)) + (when + (re-search-forward + (concat "^\\(" vc-bzr-state-words "\\):[ \t\n]+" + (file-name-nondirectory file) "[ \t\n]*$") + (point-max) t) + (let ((start (match-beginning 0)) + (end (match-end 0))) + (goto-char start) + (setq state + (cond + ((not (equal ret 0)) nil) + ((looking-at "added\\|renamed\\|modified\\|removed") 'edited) + ((looking-at "unknown\\|ignored") nil))) + ;; erase the status text that matched + (delete-region start end))) + (when (vc-bzr-buffer-nonblank-p) + ;; "bzr" will output some warnings and informational messages + ;; to the user to stderr; due to Emacs' `vc-do-command' (and, + ;; it seems, `start-process' itself), we cannot catch stderr + ;; and stdout into different buffers. So, if there's anything + ;; left in the buffer after removing the above status + ;; keywords, let us just presume that any other message from + ;; "bzr" is a user warning, and display it. + (message "Warnings in `bzr' output: %s" + (buffer-substring (point-min) (point-max)))) (when state (vc-file-setprop file 'vc-workfile-version (vc-bzr-workfile-version file)) @@ -502,7 +537,7 @@ ;; `bzr status' reports on added/modified/renamed and unknown/ignored files (set 'at-start t) (with-temp-buffer - (vc-bzr-with-c-locale (vc-bzr-command "status" t 0 nil)) + (vc-bzr-command "status" t 0 nil) (goto-char (point-min)) (while (or at-start (eq 0 (forward-line)))