[Emacs-diffs] Changes to emacs/lisp/vc-bzr.el,v [EMACS_22_BASE]

[Stefan Monnier]

CVSROOT:        /sources/emacs
Module name:    emacs
Branch:         EMACS_22_BASE
Changes by:     Stefan Monnier <monnier>        07/08/09 14:57:47

Index: vc-bzr.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/vc-bzr.el,v
retrieving revision 1.11.2.6
retrieving revision 1.11.2.7
diff -u -b -r1.11.2.6 -r1.11.2.7
--- vc-bzr.el   7 Aug 2007 04:23:50 -0000       1.11.2.6
+++ vc-bzr.el   9 Aug 2007 14:57:45 -0000       1.11.2.7
@@ -145,11 +145,11 @@
            (let* ((relfile (file-relative-name file root))
                   (reldir (file-name-directory relfile)))
              (re-search-forward
-              (concat "^"
+                        (concat "^\0"
                       (if reldir (regexp-quote (directory-file-name reldir)))
-                      ""
+                                "\0"
                       (regexp-quote (file-name-nondirectory relfile))
-                      "")
+                                "\0")
                         nil t))))
                  t))
              (vc-bzr-state file)))  ; Expensive.
@@ -164,7 +164,7 @@
         (re-search-forward "[^ \t\n]" (point-max) t))))
 
 (defconst vc-bzr-state-words
-  "added\\|ignored\\|modified\\|removed\\|renamed\\|unknown"
+  "added\\|ignored\\|kind changed\\|modified\\|removed\\|renamed\\|unknown"
   "Regexp matching file status words as reported in `bzr' output.")
 
 (defun vc-bzr-file-name-relative (filename)
@@ -176,11 +176,22 @@
          (file-relative-name filename* rootdir))))
 
 ;; FIXME:  Also get this in a non-registered sub-directory.
-(defun vc-bzr-state (file)
+;; It already works for me. -- Riccardo
+(defun vc-bzr-status (file)
+  "Return FILE status according to Bzr.
+Return value is a cons (STATUS . WARNING), where WARNING is a
+string or nil, and STATUS is one of the symbols: 'added,
+'ignored, 'kindchange, 'modified, 'removed, 'renamed, 'unknown,
+which directly correspond to `bzr status' output, or 'unchanged
+for files whose copy in the working tree is identical to the one
+in the branch repository, or nil for files that are not
+registered with Bzr.
+
+If any error occurred in running `bzr status', then return nil."
   (condition-case nil
   (with-temp-buffer
         (let ((ret (vc-bzr-command "status" t 0 file))
-          (state 'up-to-date))
+              (status 'unchanged))
       ;; the only secure status indication in `bzr status' output
       ;; is a couple of lines following the pattern::
       ;;   | <status>:
@@ -193,19 +204,27 @@
           (re-search-forward
                ;; bzr prints paths relative to the repository root
            (concat "^\\(" vc-bzr-state-words "\\):[ \t\n]+"
-                       (regexp-quote (vc-bzr-file-name-relative file)) "[ 
\t\n]*$")
+                       (regexp-quote (vc-bzr-file-name-relative file)) 
+                       (if (file-directory-p file) "/?" "")
+                       "[ \t\n]*$")
            (point-max) t)
         (let ((start (match-beginning 0))
               (end (match-end 0)))
           (goto-char start)
-          (setq state
+              (setq status
                 (cond
                  ((not (equal ret 0)) nil)
-                 ((looking-at "added\\|renamed\\|modified\\|removed") 'edited)
-                 ((looking-at "unknown\\|ignored") nil)))
+                     ((looking-at "added") 'added)
+                     ((looking-at "kind changed") 'kindchange)
+                     ((looking-at "renamed") 'renamed)
+                     ((looking-at "modified") 'modified)
+                     ((looking-at "removed") 'removed)
+                     ((looking-at "ignored") 'ignored)
+                     ((looking-at "unknown") 'unknown)))
           ;; erase the status text that matched
           (delete-region start end)))
-      (when (vc-bzr-buffer-nonblank-p)
+          (if status
+              (cons status
             ;; "bzr" will output warnings and informational messages to
             ;; stderr; due to Emacs' `vc-do-command' (and, it seems,
             ;; `start-process' itself) limitations, we cannot catch stderr
@@ -213,17 +232,27 @@
         ;; 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))
-        (vc-file-setprop file 'vc-state state))
-          state))
+                    (if (vc-bzr-buffer-nonblank-p)
+                        (buffer-substring (point-min) (point-max)))))))
     (file-error nil))) ; vc-bzr-program not found
 
+(defun vc-bzr-state (file)
+  (lexical-let ((result (vc-bzr-status file)))
+    (when (consp result)
+      (if (cdr result)
+          (message "Warnings in `bzr' output: %s" (cdr result)))
+      (cdr (assq (car result)
+                 '((added . edited)
+                   (kindchange . edited)
+                   (renamed . edited)
+                   (modified . edited)
+                   (removed . edited)
+                   (ignored . nil)
+                   (unknown . nil)
+                   (unchanged . up-to-date)))))))
+
 (defun vc-bzr-workfile-unchanged-p (file)
-  (eq 'up-to-date (vc-bzr-state file)))
+  (eq 'unchanged (car (vc-bzr-status file))))
 
 (defun vc-bzr-workfile-version (file)
   (lexical-let*
@@ -318,7 +347,7 @@
 
 (defun vc-bzr-revert (file &optional contents-done)
   (unless contents-done
-    (with-temp-buffer (vc-bzr-command "revert" t 'async file))))
+    (with-temp-buffer (vc-bzr-command "revert" t 0 file))))
 
 (defvar log-view-message-re)
 (defvar log-view-file-re)
@@ -383,9 +412,8 @@
 
 (defalias 'vc-bzr-diff-tree 'vc-bzr-diff)
 
-;; Fixme: implement vc-bzr-dir-state, vc-bzr-dired-state-info
 
-;; Fixme: vc-{next,previous}-version need fixing in vc.el to deal with
+;; FIXME: vc-{next,previous}-version need fixing in vc.el to deal with
 ;; straight integer versions.
 
 (defun vc-bzr-delete-file (file)
@@ -473,7 +501,7 @@
 stream.  Standard error output is discarded."
   (with-temp-buffer
     (cons
-     (apply 'call-process command nil (list (current-buffer) nil) nil args)
+     (apply #'call-process command nil (list (current-buffer) nil) nil args)
      (buffer-substring (point-min) (point-max)))))
 
 ;; TODO: it would be nice to mark the conflicted files in  VC Dired,
@@ -518,6 +546,9 @@
          ((looking-at "^added") 
           (setq current-vc-state 'edited)
           (setq current-bzr-state 'added))
+         ((looking-at "^kind changed") 
+          (setq current-vc-state 'edited)
+          (setq current-bzr-state 'kindchange))
          ((looking-at "^modified") 
           (setq current-vc-state 'edited)
           (setq current-bzr-state 'modified))