diff options
| author | Stefan Monnier | 2007-08-15 21:10:46 +0000 |
|---|---|---|
| committer | Stefan Monnier | 2007-08-15 21:10:46 +0000 |
| commit | fba500b6f114b319795ba5cc982ab6d8e46af56d (patch) | |
| tree | 5a91a89268b5a12f892ccbd0afbabe9f34c82ccc | |
| parent | 37e479416a2a571253ad9c4340ea9d03550b79ae (diff) | |
| download | emacs-fba500b6f114b319795ba5cc982ab6d8e46af56d.tar.gz emacs-fba500b6f114b319795ba5cc982ab6d8e46af56d.zip | |
Don't fiddle with vc-handled-backend.
(vc-bzr-registered): Don't redundantly protect against
file-error. Actually use the format-specific code.
(vc-bzr-buffer-nonblank-p): Remove.
(vc-bzr-status): Change `kindchange' -> `kindchanged'.
| -rw-r--r-- | lisp/ChangeLog | 8 | ||||
| -rw-r--r-- | lisp/vc-bzr.el | 173 |
2 files changed, 80 insertions, 101 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 40687712892..4e9a0798673 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,11 @@ | |||
| 1 | 2007-08-15 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * vc-bzr.el: Don't fiddle with vc-handled-backend. | ||
| 4 | (vc-bzr-registered): Don't redundantly protect against | ||
| 5 | file-error. Actually use the format-specific code. | ||
| 6 | (vc-bzr-buffer-nonblank-p): Remove. | ||
| 7 | (vc-bzr-status): Change `kindchange' -> `kindchanged'. | ||
| 8 | |||
| 1 | 2007-08-15 Glenn Morris <rgm@gnu.org> | 9 | 2007-08-15 Glenn Morris <rgm@gnu.org> |
| 2 | 10 | ||
| 3 | * mail/undigest.el (rmail-digest-parse-rfc1153sloppy): Be even | 11 | * mail/undigest.el (rmail-digest-parse-rfc1153sloppy): Be even |
diff --git a/lisp/vc-bzr.el b/lisp/vc-bzr.el index a11aa2e7ba8..2978e81ea50 100644 --- a/lisp/vc-bzr.el +++ b/lisp/vc-bzr.el | |||
| @@ -59,7 +59,7 @@ | |||
| 59 | 59 | ||
| 60 | (defgroup vc-bzr nil | 60 | (defgroup vc-bzr nil |
| 61 | "VC bzr backend." | 61 | "VC bzr backend." |
| 62 | ;; :version "22" | 62 | :version "22.2" |
| 63 | :group 'vc) | 63 | :group 'vc) |
| 64 | 64 | ||
| 65 | (defcustom vc-bzr-program "bzr" | 65 | (defcustom vc-bzr-program "bzr" |
| @@ -130,38 +130,27 @@ format 3' in the first line. | |||
| 130 | 130 | ||
| 131 | If the `checkout/dirstate' file cannot be parsed, fall back to | 131 | If the `checkout/dirstate' file cannot be parsed, fall back to |
| 132 | running `vc-bzr-state'." | 132 | running `vc-bzr-state'." |
| 133 | (condition-case nil | 133 | (lexical-let ((root (vc-bzr-root file))) |
| 134 | (lexical-let ((root (vc-bzr-root file))) | 134 | (when root ; Short cut. |
| 135 | (and root ; Short cut. | 135 | ;; This looks at internal files. May break if they change |
| 136 | ;; This looks at internal files. May break if they change | 136 | ;; their format. |
| 137 | ;; their format. | 137 | (lexical-let ((dirstate (expand-file-name vc-bzr-admin-dirstate root))) |
| 138 | (lexical-let | 138 | (if (not (file-readable-p dirstate)) |
| 139 | ((dirstate-file (expand-file-name vc-bzr-admin-dirstate root))) | 139 | (vc-bzr-state file) ; Expensive. |
| 140 | (if (file-exists-p dirstate-file) | 140 | (with-temp-buffer |
| 141 | (with-temp-buffer | 141 | (insert-file-contents dirstate) |
| 142 | (insert-file-contents dirstate-file) | 142 | (goto-char (point-min)) |
| 143 | (goto-char (point-min)) | 143 | (if (not (looking-at "#bazaar dirstate flat format 3")) |
| 144 | (when (looking-at "#bazaar dirstate flat format 3") | 144 | (vc-bzr-state file) ; Some other unknown format? |
| 145 | (let* ((relfile (file-relative-name file root)) | 145 | (let* ((relfile (file-relative-name file root)) |
| 146 | (reldir (file-name-directory relfile))) | 146 | (reldir (file-name-directory relfile))) |
| 147 | (re-search-forward | 147 | (re-search-forward |
| 148 | (concat "^\0" | 148 | (concat "^\0" |
| 149 | (if reldir (regexp-quote (directory-file-name reldir))) | 149 | (if reldir (regexp-quote (directory-file-name reldir))) |
| 150 | "\0" | 150 | "\0" |
| 151 | (regexp-quote (file-name-nondirectory relfile)) | 151 | (regexp-quote (file-name-nondirectory relfile)) |
| 152 | "\0") | 152 | "\0") |
| 153 | nil t)))) | 153 | nil t))))))))) |
| 154 | t)) | ||
| 155 | (vc-bzr-state file))) ; Expensive. | ||
| 156 | (file-error nil))) ; vc-bzr-program not found | ||
| 157 | |||
| 158 | (defun vc-bzr-buffer-nonblank-p (&optional buffer) | ||
| 159 | "Return non-nil if BUFFER contains any non-blank characters." | ||
| 160 | (or (> (buffer-size buffer) 0) | ||
| 161 | (save-excursion | ||
| 162 | (set-buffer (or buffer (current-buffer))) | ||
| 163 | (goto-char (point-min)) | ||
| 164 | (re-search-forward "[^ \t\n]" (point-max) t)))) | ||
| 165 | 154 | ||
| 166 | (defconst vc-bzr-state-words | 155 | (defconst vc-bzr-state-words |
| 167 | "added\\|ignored\\|kind changed\\|modified\\|removed\\|renamed\\|unknown" | 156 | "added\\|ignored\\|kind changed\\|modified\\|removed\\|renamed\\|unknown" |
| @@ -180,61 +169,53 @@ running `vc-bzr-state'." | |||
| 180 | (defun vc-bzr-status (file) | 169 | (defun vc-bzr-status (file) |
| 181 | "Return FILE status according to Bzr. | 170 | "Return FILE status according to Bzr. |
| 182 | Return value is a cons (STATUS . WARNING), where WARNING is a | 171 | Return value is a cons (STATUS . WARNING), where WARNING is a |
| 183 | string or nil, and STATUS is one of the symbols: 'added, | 172 | string or nil, and STATUS is one of the symbols: `added', |
| 184 | 'ignored, 'kindchange, 'modified, 'removed, 'renamed, 'unknown, | 173 | `ignored', `kindchanged', `modified', `removed', `renamed', `unknown', |
| 185 | which directly correspond to `bzr status' output, or 'unchanged | 174 | which directly correspond to `bzr status' output, or 'unchanged |
| 186 | for files whose copy in the working tree is identical to the one | 175 | for files whose copy in the working tree is identical to the one |
| 187 | in the branch repository, or nil for files that are not | 176 | in the branch repository, or nil for files that are not |
| 188 | registered with Bzr. | 177 | registered with Bzr. |
| 189 | 178 | ||
| 190 | If any error occurred in running `bzr status', then return nil." | 179 | If any error occurred in running `bzr status', then return nil." |
| 191 | (condition-case nil | ||
| 192 | (with-temp-buffer | 180 | (with-temp-buffer |
| 193 | (let ((ret (vc-bzr-command "status" t 0 file)) | 181 | (let ((ret (condition-case nil |
| 194 | (status 'unchanged)) | 182 | (vc-bzr-command "status" t 0 file) |
| 195 | ;; the only secure status indication in `bzr status' output | 183 | (file-error nil))) ; vc-bzr-program not found. |
| 196 | ;; is a couple of lines following the pattern:: | 184 | (status 'unchanged)) |
| 197 | ;; | <status>: | 185 | ;; the only secure status indication in `bzr status' output |
| 198 | ;; | <file name> | 186 | ;; is a couple of lines following the pattern:: |
| 199 | ;; if the file is up-to-date, we get no status report from `bzr', | 187 | ;; | <status>: |
| 200 | ;; so if the regexp search for the above pattern fails, we consider | 188 | ;; | <file name> |
| 201 | ;; the file to be up-to-date. | 189 | ;; if the file is up-to-date, we get no status report from `bzr', |
| 202 | (goto-char (point-min)) | 190 | ;; so if the regexp search for the above pattern fails, we consider |
| 203 | (when | 191 | ;; the file to be up-to-date. |
| 204 | (re-search-forward | 192 | (goto-char (point-min)) |
| 205 | ;; bzr prints paths relative to the repository root | 193 | (when (re-search-forward |
| 206 | (concat "^\\(" vc-bzr-state-words "\\):[ \t\n]+" | 194 | ;; bzr prints paths relative to the repository root. |
| 207 | (regexp-quote (vc-bzr-file-name-relative file)) | 195 | (concat "^\\(" vc-bzr-state-words "\\):[ \t\n]+" |
| 208 | (if (file-directory-p file) "/?" "") | 196 | (regexp-quote (vc-bzr-file-name-relative file)) |
| 209 | "[ \t\n]*$") | 197 | (if (file-directory-p file) "/?" "") |
| 210 | (point-max) t) | 198 | "[ \t\n]*$") |
| 211 | (let ((start (match-beginning 0)) | 199 | nil t) |
| 212 | (end (match-end 0))) | 200 | (let ((status (match-string 1))) |
| 213 | (goto-char start) | 201 | ;; Erase the status text that matched. |
| 202 | (delete-region (match-beginning 0) (match-end 0)) | ||
| 214 | (setq status | 203 | (setq status |
| 215 | (cond | 204 | (and (equal ret 0) ; Seems redundant. --Stef |
| 216 | ((not (equal ret 0)) nil) | 205 | (intern (replace-regexp-in-string " " "" |
| 217 | ((looking-at "added") 'added) | 206 | status)))))) |
| 218 | ((looking-at "kind changed") 'kindchange) | 207 | (when status |
| 219 | ((looking-at "renamed") 'renamed) | 208 | (goto-char (point-min)) |
| 220 | ((looking-at "modified") 'modified) | 209 | (skip-chars-forward " \n\t") ;Throw away spaces. |
| 221 | ((looking-at "removed") 'removed) | 210 | (cons status |
| 222 | ((looking-at "ignored") 'ignored) | 211 | ;; "bzr" will output warnings and informational messages to |
| 223 | ((looking-at "unknown") 'unknown))) | 212 | ;; stderr; due to Emacs' `vc-do-command' (and, it seems, |
| 224 | ;; erase the status text that matched | 213 | ;; `start-process' itself) limitations, we cannot catch stderr |
| 225 | (delete-region start end))) | 214 | ;; and stdout into different buffers. So, if there's anything |
| 226 | (if status | 215 | ;; left in the buffer after removing the above status |
| 227 | (cons status | 216 | ;; keywords, let us just presume that any other message from |
| 228 | ;; "bzr" will output warnings and informational messages to | 217 | ;; "bzr" is a user warning, and display it. |
| 229 | ;; stderr; due to Emacs' `vc-do-command' (and, it seems, | 218 | (unless (eobp) (buffer-substring (point) (point-max)))))))) |
| 230 | ;; `start-process' itself) limitations, we cannot catch stderr | ||
| 231 | ;; and stdout into different buffers. So, if there's anything | ||
| 232 | ;; left in the buffer after removing the above status | ||
| 233 | ;; keywords, let us just presume that any other message from | ||
| 234 | ;; "bzr" is a user warning, and display it. | ||
| 235 | (if (vc-bzr-buffer-nonblank-p) | ||
| 236 | (buffer-substring (point-min) (point-max))))))) | ||
| 237 | (file-error nil))) ; vc-bzr-program not found | ||
| 238 | 219 | ||
| 239 | (defun vc-bzr-state (file) | 220 | (defun vc-bzr-state (file) |
| 240 | (lexical-let ((result (vc-bzr-status file))) | 221 | (lexical-let ((result (vc-bzr-status file))) |
| @@ -243,7 +224,7 @@ If any error occurred in running `bzr status', then return nil." | |||
| 243 | (message "Warnings in `bzr' output: %s" (cdr result))) | 224 | (message "Warnings in `bzr' output: %s" (cdr result))) |
| 244 | (cdr (assq (car result) | 225 | (cdr (assq (car result) |
| 245 | '((added . edited) | 226 | '((added . edited) |
| 246 | (kindchange . edited) | 227 | (kindchanged . edited) |
| 247 | (renamed . edited) | 228 | (renamed . edited) |
| 248 | (modified . edited) | 229 | (modified . edited) |
| 249 | (removed . edited) | 230 | (removed . edited) |
| @@ -264,7 +245,7 @@ If any error occurred in running `bzr status', then return nil." | |||
| 264 | ;; bzr process. This looks at internal files. May break if they | 245 | ;; bzr process. This looks at internal files. May break if they |
| 265 | ;; change their format. | 246 | ;; change their format. |
| 266 | (if (file-exists-p branch-format-file) | 247 | (if (file-exists-p branch-format-file) |
| 267 | (with-temp-buffer | 248 | (with-temp-buffer |
| 268 | (insert-file-contents branch-format-file) | 249 | (insert-file-contents branch-format-file) |
| 269 | (goto-char (point-min)) | 250 | (goto-char (point-min)) |
| 270 | (cond | 251 | (cond |
| @@ -272,7 +253,7 @@ If any error occurred in running `bzr status', then return nil." | |||
| 272 | (looking-at "Bazaar-NG branch, format 0.0.4") | 253 | (looking-at "Bazaar-NG branch, format 0.0.4") |
| 273 | (looking-at "Bazaar-NG branch format 5")) | 254 | (looking-at "Bazaar-NG branch format 5")) |
| 274 | ;; count lines in .bzr/branch/revision-history | 255 | ;; count lines in .bzr/branch/revision-history |
| 275 | (insert-file-contents revhistory-file) | 256 | (insert-file-contents revhistory-file) |
| 276 | (number-to-string (count-lines (line-end-position) (point-max)))) | 257 | (number-to-string (count-lines (line-end-position) (point-max)))) |
| 277 | ((looking-at "Bazaar Branch Format 6 (bzr 0.15)") | 258 | ((looking-at "Bazaar Branch Format 6 (bzr 0.15)") |
| 278 | ;; revno is the first number in .bzr/branch/last-revision | 259 | ;; revno is the first number in .bzr/branch/last-revision |
| @@ -340,10 +321,10 @@ EDITABLE is ignored." | |||
| 340 | (setq destfile (vc-version-backup-file-name file rev))) | 321 | (setq destfile (vc-version-backup-file-name file rev))) |
| 341 | (let ((coding-system-for-read 'binary) | 322 | (let ((coding-system-for-read 'binary) |
| 342 | (coding-system-for-write 'binary)) | 323 | (coding-system-for-write 'binary)) |
| 343 | (with-temp-file destfile | 324 | (with-temp-file destfile |
| 344 | (if rev | 325 | (if rev |
| 345 | (vc-bzr-command "cat" t 0 file "-r" rev) | 326 | (vc-bzr-command "cat" t 0 file "-r" rev) |
| 346 | (vc-bzr-command "cat" t 0 file))))) | 327 | (vc-bzr-command "cat" t 0 file))))) |
| 347 | 328 | ||
| 348 | (defun vc-bzr-revert (file &optional contents-done) | 329 | (defun vc-bzr-revert (file &optional contents-done) |
| 349 | (unless contents-done | 330 | (unless contents-done |
| @@ -376,7 +357,6 @@ EDITABLE is ignored." | |||
| 376 | "Get bzr change log for FILES into specified BUFFER." | 357 | "Get bzr change log for FILES into specified BUFFER." |
| 377 | ;; Fixme: This might need the locale fixing up if things like `revno' | 358 | ;; Fixme: This might need the locale fixing up if things like `revno' |
| 378 | ;; got localized, but certainly it shouldn't use LC_ALL=C. | 359 | ;; got localized, but certainly it shouldn't use LC_ALL=C. |
| 379 | ;; NB. Can't be async -- see `vc-bzr-post-command-function'. | ||
| 380 | (vc-bzr-command "log" buffer 0 files) | 360 | (vc-bzr-command "log" buffer 0 files) |
| 381 | ;; FIXME: Until Emacs-23, VC was missing a hook to sort out the mode for | 361 | ;; FIXME: Until Emacs-23, VC was missing a hook to sort out the mode for |
| 382 | ;; the buffer, or at least set the regexps right. | 362 | ;; the buffer, or at least set the regexps right. |
| @@ -400,7 +380,6 @@ EDITABLE is ignored." | |||
| 400 | (setq rev1 nil)) | 380 | (setq rev1 nil)) |
| 401 | (if (and (not rev1) rev2) | 381 | (if (and (not rev1) rev2) |
| 402 | (setq rev1 working)) | 382 | (setq rev1 working)) |
| 403 | ;; NB. Can't be async -- see `vc-bzr-post-command-function'. | ||
| 404 | ;; bzr diff produces condition code 1 for some reason. | 383 | ;; bzr diff produces condition code 1 for some reason. |
| 405 | (apply #'vc-bzr-command "diff" (or buffer "*vc-diff*") 1 files | 384 | (apply #'vc-bzr-command "diff" (or buffer "*vc-diff*") 1 files |
| 406 | "--diff-options" (mapconcat 'identity (vc-diff-switches-list bzr) | 385 | "--diff-options" (mapconcat 'identity (vc-diff-switches-list bzr) |
| @@ -462,11 +441,11 @@ property containing author and date information." | |||
| 462 | 441 | ||
| 463 | ;; Definition from Emacs 22 | 442 | ;; Definition from Emacs 22 |
| 464 | (unless (fboundp 'vc-annotate-convert-time) | 443 | (unless (fboundp 'vc-annotate-convert-time) |
| 465 | (defun vc-annotate-convert-time (time) | 444 | (defun vc-annotate-convert-time (time) |
| 466 | "Convert a time value to a floating-point number of days. | 445 | "Convert a time value to a floating-point number of days. |
| 467 | The argument TIME is a list as returned by `current-time' or | 446 | The argument TIME is a list as returned by `current-time' or |
| 468 | `encode-time', only the first two elements of that list are considered." | 447 | `encode-time', only the first two elements of that list are considered." |
| 469 | (/ (+ (* (float (car time)) (lsh 1 16)) (cadr time)) 24 3600))) | 448 | (/ (+ (* (float (car time)) (lsh 1 16)) (cadr time)) 24 3600))) |
| 470 | 449 | ||
| 471 | (defun vc-bzr-annotate-time () | 450 | (defun vc-bzr-annotate-time () |
| 472 | (when (re-search-forward "^ *[0-9]+ |" nil t) | 451 | (when (re-search-forward "^ *[0-9]+ |" nil t) |
| @@ -548,7 +527,7 @@ Optional argument LOCALP is always ignored." | |||
| 548 | (setq current-bzr-state 'added)) | 527 | (setq current-bzr-state 'added)) |
| 549 | ((looking-at "^kind changed") | 528 | ((looking-at "^kind changed") |
| 550 | (setq current-vc-state 'edited) | 529 | (setq current-vc-state 'edited) |
| 551 | (setq current-bzr-state 'kindchange)) | 530 | (setq current-bzr-state 'kindchanged)) |
| 552 | ((looking-at "^modified") | 531 | ((looking-at "^modified") |
| 553 | (setq current-vc-state 'edited) | 532 | (setq current-vc-state 'edited) |
| 554 | (setq current-bzr-state 'modified)) | 533 | (setq current-bzr-state 'modified)) |
| @@ -590,17 +569,9 @@ Optional argument LOCALP is always ignored." | |||
| 590 | ;; else fall back to default vc representation | 569 | ;; else fall back to default vc representation |
| 591 | (vc-default-dired-state-info 'Bzr file))))) | 570 | (vc-default-dired-state-info 'Bzr file))))) |
| 592 | 571 | ||
| 593 | ;; In case of just `(load "vc-bzr")', but that's probably the wrong | ||
| 594 | ;; way to do it. | ||
| 595 | (add-to-list 'vc-handled-backends 'Bzr) | ||
| 596 | |||
| 597 | (eval-after-load "vc" | 572 | (eval-after-load "vc" |
| 598 | '(add-to-list 'vc-directory-exclusion-list vc-bzr-admin-dirname t)) | 573 | '(add-to-list 'vc-directory-exclusion-list vc-bzr-admin-dirname t)) |
| 599 | 574 | ||
| 600 | (defconst vc-bzr-unload-hook | ||
| 601 | (lambda () | ||
| 602 | (setq vc-handled-backends (delq 'Bzr vc-handled-backends)) | ||
| 603 | (remove-hook 'vc-post-command-functions 'vc-bzr-post-command-function))) | ||
| 604 | 575 | ||
| 605 | (provide 'vc-bzr) | 576 | (provide 'vc-bzr) |
| 606 | ;; arch-tag: 8101bad8-4e92-4e7d-85ae-d8e08b4e7c06 | 577 | ;; arch-tag: 8101bad8-4e92-4e7d-85ae-d8e08b4e7c06 |