Function: vc-bzr-state-heuristic

vc-bzr-state-heuristic is a byte-compiled function defined in vc-bzr.el.gz.

Signature

(vc-bzr-state-heuristic FILE)

Documentation

Like vc-bzr-state but hopefully without running Bzr.

Source Code

;; Defined in /usr/src/emacs/lisp/vc/vc-bzr.el.gz
(defun vc-bzr-state-heuristic (file)
  "Like `vc-bzr-state' but hopefully without running Bzr."
  ;; `bzr status' could be slow with large histories and pending merges,
  ;; so this tries to avoid calling it if possible.  bzr status is
  ;; faster now, so this is not as important as it was.
  ;;
  ;; This function tries first to parse Bzr internal file
  ;; `checkout/dirstate', but it may fail if Bzr internal file format
  ;; has changed.  As a safeguard, the `checkout/dirstate' file is
  ;; only parsed if it contains the string `#bazaar dirstate flat
  ;; format 3' in the first line.
  ;; If the `checkout/dirstate' file cannot be parsed, fall back to
  ;; running `vc-bzr-state'."
  ;;
  ;; The format of the dirstate file is explained in bzrlib/dirstate.py
  ;; in the bzr distribution.  Basically:
  ;; header-line giving the version of the file format in use.
  ;; a few lines of stuff
  ;; entries, one per line, with null-separated fields.  Each line:
  ;; entry_key = dirname (may be empty), basename, file-id
  ;; current = common ( = kind, fingerprint, size, executable )
  ;;           + working ( = packed_stat )
  ;; parent = common ( as above ) + history ( = rev_id )
  ;; kinds = (r)elocated, (a)bsent, (d)irectory, (f)ile, (l)ink
  (let* ((root (vc-bzr-root file))
         (dirstate (expand-file-name vc-bzr-admin-dirstate root)))
    (when root                          ; Short cut.
      (condition-case err
          (with-temp-buffer
            (insert-file-contents dirstate)
            (goto-char (point-min))
            (if (not (looking-at "#bazaar dirstate flat format 3"))
                (vc-bzr-state file)     ; Some other unknown format?
              (let* ((relfile (file-relative-name file root))
                     (reldir (file-name-directory relfile)))
                (cond
                 ((not
                   (re-search-forward
                    (concat "^\0"
                            (if reldir (regexp-quote
                                        (directory-file-name reldir)))
                            "\0"
                            (regexp-quote (file-name-nondirectory relfile))
                            "\0"
                            "[^\0]*\0"             ;id?
                            "\\([^\0]*\\)\0"       ;"a/f/d", a=removed?
                            "\\([^\0]*\\)\0"       ;sha1 (empty if conflicted)?
                            "\\([^\0]*\\)\0"       ;size?p
                            ;; y/n.  Whether or not the current copy
                            ;; was executable the last time bzr checked?
                            "[^\0]*\0"
                            "[^\0]*\0"  ;?
                            ;; Parent information.  Absent in a new repo.
                            "\\(?:\\([^\0]*\\)\0"  ;"a/f/d" a=added?
                            "\\([^\0]*\\)\0"       ;sha1 again?
                            "\\([^\0]*\\)\0"       ;size again?
                            ;; y/n.  Whether or not the repo thinks
                            ;; the file should be executable?
                            "\\([^\0]*\\)\0"
                            "[^\0]*\0\\)?" ;last revid?
                            ;; There are more fields when merges are pending.
                            )
                    nil t))
                  'unregistered)
                 ;; Apparently the second sha1 is the one we want: when
                 ;; there's a conflict, the first sha1 is absent (and the
                 ;; first size seems to correspond to the file with
                 ;; conflict markers).
                 ((eq (char-after (match-beginning 1)) ?a) 'removed)
                 ;; If there is no parent, this must be a new repo.
                 ;; If file is in dirstate, can only be added (b#8025).
                 ((or (not (match-beginning 4))
                      (eq (char-after (match-beginning 4)) ?a))
                  'added)
                 ((or (and (eql (string-to-number (match-string 3))
				(file-attribute-size (file-attributes file)))
                           (equal (match-string 5)
                                  (save-match-data (vc-bzr-sha1 file)))
                           ;; For a file, does the executable state match?
                           ;; (Bug#7544)
                           (or (not
                                (eq (char-after (match-beginning 1)) ?f))
                               (let ((exe
                                      (memq
                                       ?x
                                       (mapcar
                                        #'identity
					(file-attribute-modes
					 (file-attributes file))))))
                                 (if (eq (char-after (match-beginning 7))
                                         ?y)
                                     exe
                                   (not exe)))))
                      (and
                       ;; It looks like for lightweight
                       ;; checkouts \2 is empty and we need to
                       ;; look for size in \6.
                       (eq (match-beginning 2) (match-end 2))
                       (eql (string-to-number (match-string 6))
                            (file-attribute-size (file-attributes file)))
                       (equal (match-string 5)
                              (vc-bzr-sha1 file))))
                  'up-to-date)
                 (t 'edited)))))
        ;; The dirstate file can't be read, or some other problem.
        (error
         (message "Falling back on \"slow\" status detection (%S)" err)
         (vc-bzr-state file))))))