From 808699f13673a881949ab94d3c0e87f5ba9cd4cf Mon Sep 17 00:00:00 2001 From: "Eric S. Raymond" Date: Mon, 1 Dec 2014 14:51:03 -0500 Subject: [PATCH] bzr-state randomly/unpredictably fails on non-bzr files. --- lisp/vc/vc-bzr.el | 109 +++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 108 insertions(+), 1 deletion(-) diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index 34a7c7be786..7f30378227f 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -178,6 +178,113 @@ in the repository root directory of FILE." (insert-file-contents-literally file) (sha1 (current-buffer)))) +(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 (eq (string-to-number (match-string 3)) + (nth 7 (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 + (nth 8 (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)) + (eq (string-to-number (match-string 6)) + (nth 7 (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)))))) + ;; This is a cheap approximation that is autoloaded. If it finds a ;; possible match it loads this file and runs the real function. ;; It requires vc-bzr-admin-checkout-format-file to be autoloaded too. @@ -189,7 +296,7 @@ in the repository root directory of FILE." (defun vc-bzr-registered (file) "Return non-nil if FILE is registered with bzr." - (let ((state (vc-bzr-state file))) + (let ((state (vc-bzr-state-heuristic file))) (not (memq state '(nil unregistered ignored))))) (defconst vc-bzr-state-words -- 2.39.5