Mercurial > emacs
comparison lisp/vc-bzr.el @ 103236:b4e12b7edf39
(vc-bzr-state-heuristic): Fallback on vc-bzr-state in case
of any kind of error (e.g. when "sha1sum" is not found).
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Sun, 17 May 2009 03:38:41 +0000 |
parents | e38631d95db3 |
children | 1bce2f053aeb |
comparison
equal
deleted
inserted
replaced
103235:304eb5ff2a17 | 103236:b4e12b7edf39 |
---|---|
141 (apply 'process-file prog (file-relative-name file) t nil args) | 141 (apply 'process-file prog (file-relative-name file) t nil args) |
142 (buffer-substring (point-min) (+ (point-min) 40))))) | 142 (buffer-substring (point-min) (+ (point-min) 40))))) |
143 | 143 |
144 (defun vc-bzr-state-heuristic (file) | 144 (defun vc-bzr-state-heuristic (file) |
145 "Like `vc-bzr-state' but hopefully without running Bzr." | 145 "Like `vc-bzr-state' but hopefully without running Bzr." |
146 ;; `bzr status' is excrutiatingly slow with large histories and | 146 ;; `bzr status' was excrutiatingly slow with large histories and |
147 ;; pending merges, so try to avoid using it until they fix their | 147 ;; pending merges, so try to avoid using it until they fix their |
148 ;; performance problems. | 148 ;; performance problems. |
149 ;; This function tries first to parse Bzr internal file | 149 ;; This function tries first to parse Bzr internal file |
150 ;; `checkout/dirstate', but it may fail if Bzr internal file format | 150 ;; `checkout/dirstate', but it may fail if Bzr internal file format |
151 ;; has changed. As a safeguard, the `checkout/dirstate' file is | 151 ;; has changed. As a safeguard, the `checkout/dirstate' file is |
156 (lexical-let ((root (vc-bzr-root file))) | 156 (lexical-let ((root (vc-bzr-root file))) |
157 (when root ; Short cut. | 157 (when root ; Short cut. |
158 ;; This looks at internal files. May break if they change | 158 ;; This looks at internal files. May break if they change |
159 ;; their format. | 159 ;; their format. |
160 (lexical-let ((dirstate (expand-file-name vc-bzr-admin-dirstate root))) | 160 (lexical-let ((dirstate (expand-file-name vc-bzr-admin-dirstate root))) |
161 (if (not (file-readable-p dirstate)) | 161 (condition-case nil |
162 (vc-bzr-state file) ; Expensive. | 162 (with-temp-buffer |
163 (with-temp-buffer | 163 (insert-file-contents dirstate) |
164 (insert-file-contents dirstate) | 164 (goto-char (point-min)) |
165 (goto-char (point-min)) | 165 (if (not (looking-at "#bazaar dirstate flat format 3")) |
166 (if (not (looking-at "#bazaar dirstate flat format 3")) | 166 (vc-bzr-state file) ; Some other unknown format? |
167 (vc-bzr-state file) ; Some other unknown format? | 167 (let* ((relfile (file-relative-name file root)) |
168 (let* ((relfile (file-relative-name file root)) | 168 (reldir (file-name-directory relfile))) |
169 (reldir (file-name-directory relfile))) | 169 (if (re-search-forward |
170 (if (re-search-forward | 170 (concat "^\0" |
171 (concat "^\0" | 171 (if reldir (regexp-quote |
172 (if reldir (regexp-quote | 172 (directory-file-name reldir))) |
173 (directory-file-name reldir))) | 173 "\0" |
174 "\0" | 174 (regexp-quote (file-name-nondirectory relfile)) |
175 (regexp-quote (file-name-nondirectory relfile)) | 175 "\0" |
176 "\0" | 176 "[^\0]*\0" ;id? |
177 "[^\0]*\0" ;id? | 177 "\\([^\0]*\\)\0" ;"a/f/d", a=removed? |
178 "\\([^\0]*\\)\0" ;"a/f/d", a=removed? | 178 "[^\0]*\0" ;sha1 (empty if conflicted)? |
179 "[^\0]*\0" ;sha1 (empty if conflicted)? | 179 "\\([^\0]*\\)\0" ;size? |
180 "\\([^\0]*\\)\0" ;size? | 180 "[^\0]*\0" ;"y/n", executable? |
181 "[^\0]*\0" ;"y/n", executable? | 181 "[^\0]*\0" ;? |
182 "[^\0]*\0" ;? | 182 "\\([^\0]*\\)\0" ;"a/f/d" a=added? |
183 "\\([^\0]*\\)\0" ;"a/f/d" a=added? | 183 "\\([^\0]*\\)\0" ;sha1 again? |
184 "\\([^\0]*\\)\0" ;sha1 again? | 184 "[^\0]*\0" ;size again? |
185 "[^\0]*\0" ;size again? | 185 "[^\0]*\0" ;"y/n", executable again? |
186 "[^\0]*\0" ;"y/n", executable again? | 186 "[^\0]*\0" ;last revid? |
187 "[^\0]*\0" ;last revid? | 187 ;; There are more fields when merges are pending. |
188 ;; There are more fields when merges are pending. | 188 ) |
189 ) | 189 nil t) |
190 nil t) | 190 ;; Apparently the second sha1 is the one we want: when |
191 ;; Apparently the second sha1 is the one we want: when | 191 ;; there's a conflict, the first sha1 is absent (and the |
192 ;; there's a conflict, the first sha1 is absent (and the | 192 ;; first size seems to correspond to the file with |
193 ;; first size seems to correspond to the file with | 193 ;; conflict markers). |
194 ;; conflict markers). | 194 (cond |
195 (cond | 195 ((eq (char-after (match-beginning 1)) ?a) 'removed) |
196 ((eq (char-after (match-beginning 1)) ?a) 'removed) | 196 ((eq (char-after (match-beginning 3)) ?a) 'added) |
197 ((eq (char-after (match-beginning 3)) ?a) 'added) | 197 ((and (eq (string-to-number (match-string 2)) |
198 ((and (eq (string-to-number (match-string 2)) | 198 (nth 7 (file-attributes file))) |
199 (nth 7 (file-attributes file))) | 199 (equal (match-string 4) |
200 (equal (match-string 4) | 200 (vc-bzr-sha1 file))) |
201 (vc-bzr-sha1 file))) | 201 'up-to-date) |
202 'up-to-date) | 202 (t 'edited)) |
203 (t 'edited)) | 203 'unregistered)))) |
204 'unregistered))))))))) | 204 ;; Either the dirstate file can't be read, or the sha1 |
205 ;; executable is missing, or ... | |
206 ;; In either case, recent versions of Bzr aren't that slow | |
207 ;; any more. | |
208 (error (vc-bzr-state file))))))) | |
209 | |
205 | 210 |
206 (defun vc-bzr-registered (file) | 211 (defun vc-bzr-registered (file) |
207 "Return non-nil if FILE is registered with bzr." | 212 "Return non-nil if FILE is registered with bzr." |
208 (let ((state (vc-bzr-state-heuristic file))) | 213 (let ((state (vc-bzr-state-heuristic file))) |
209 (not (memq state '(nil unregistered ignored))))) | 214 (not (memq state '(nil unregistered ignored))))) |