Function: vc-bzr-after-dir-status

vc-bzr-after-dir-status is a byte-compiled function defined in vc-bzr.el.gz.

Signature

(vc-bzr-after-dir-status UPDATE-FUNCTION RELATIVE-DIR)

Source Code

;; Defined in /usr/src/emacs/lisp/vc/vc-bzr.el.gz
;; FIXME: this needs testing, it's probably incomplete.
(defun vc-bzr-after-dir-status (update-function relative-dir)
  (let ((status-str nil)
	(translation '(("+N " . added)
		       ("-D " . removed)
		       (" M " . edited) ;; file text modified
		       ("  *" . edited) ;; execute bit changed
		       (" M*" . edited) ;; text modified + execute bit changed
		       ("I  " . ignored)
		       (" D " . missing)
                       ;; For conflicts, should we list the .THIS/.BASE/.OTHER?
		       ("C  " . conflict)
		       ("?  " . unregistered)
		       ;; No such state, but we need to distinguish this case.
		       ("R  " . renamed)
		       ("RM " . renamed)
		       ;; For a non existent file FOO, the output is:
		       ;; bzr: ERROR: Path(s) do not exist: FOO
		       ("bzr" . not-found)
		       ;; If the tree is not up to date, bzr will print this warning:
		       ;; working tree is out of date, run 'bzr update'
		       ;; ignore it.
		       ;; FIXME: maybe this warning can be put in the vc-dir header...
		       ("wor" . not-found)
                       ;; Ignore "P " and "P." for pending patches.
		       ("P  " . not-found)
		       ("P. " . not-found)
                       ))
	(translated nil)
	(result nil))
      (goto-char (point-min))
      ;; Skip a warning message that can occur in some bzr installations.
      ;; vc-bzr-dir-extra-headers already reports it.
      ;; Perhaps we should just discard stderr?
      (and (looking-at "bzr: WARNING: bzrlib version doesn't match")
           (re-search-forward "^bzr is version" nil t)
           (forward-line 1))
      (while (not (eobp))
        ;; Bzr 2.3.0 added this if there are shelves.  (Bug#8170)
        (unless (looking-at "[0-9]+ shel\\(f\\|ves\\) exists?\\.")
          (setq status-str
                (buffer-substring-no-properties (point) (+ (point) 3)))
          (setq translated (cdr (assoc status-str translation)))
          (cond
           ((eq translated 'conflict)
            ;; For conflicts the file appears twice in the listing: once
            ;; with the M flag and once with the C flag, so take care
            ;; not to add it twice to `result'.  Ugly.
            (let* ((file
                    (buffer-substring-no-properties
                     ;;For files with conflicts the format is:
                     ;;C   Text conflict in FILENAME
                     ;; Bah.
                     (+ (point) 21) (line-end-position)))
                   (entry (assoc file result)))
              (when entry
                (setf (nth 1 entry) 'conflict))))
           ((eq translated 'renamed)
            (re-search-forward "R[ M]  \\(.*\\) => \\(.*\\)$" (line-end-position) t)
            (let ((new-name (file-relative-name (match-string 2) relative-dir))
                  (old-name (file-relative-name (match-string 1) relative-dir)))
              (push (list new-name 'edited
                          (vc-bzr-create-extra-fileinfo old-name)) result)))
           ;; do nothing for non existent files
           ((eq translated 'not-found))
           (t
            (push (list (file-relative-name
                         (buffer-substring-no-properties
                          (+ (point) 4)
                          (line-end-position)) relative-dir)
                        translated) result))))
        (forward-line))
      (funcall update-function result)))