Mercurial > emacs
comparison lisp/vc-bzr.el @ 98079:9fc5b62e3967
(vc-bzr-extra-fileinfo): New defstruct.
(vc-bzr-status-printer): New function.
(vc-bzr-after-dir-status): Deal with renamed files.
| author | Dan Nicolaescu <dann@ics.uci.edu> |
|---|---|
| date | Sun, 07 Sep 2008 17:24:57 +0000 |
| parents | 58215ab2e8e6 |
| children | 962e4709829b |
comparison
equal
deleted
inserted
replaced
| 98078:673e5f97e402 | 98079:9fc5b62e3967 |
|---|---|
| 50 | 50 |
| 51 ;;; Code: | 51 ;;; Code: |
| 52 | 52 |
| 53 (eval-when-compile | 53 (eval-when-compile |
| 54 (require 'cl) | 54 (require 'cl) |
| 55 (require 'vc)) ; for vc-exec-after | 55 (require 'vc) ;; for vc-exec-after |
| 56 (require 'vc-dir)) | |
| 56 | 57 |
| 57 ;; Clear up the cache to force vc-call to check again and discover | 58 ;; Clear up the cache to force vc-call to check again and discover |
| 58 ;; new functions when we reload this file. | 59 ;; new functions when we reload this file. |
| 59 (put 'Bzr 'vc-functions nil) | 60 (put 'Bzr 'vc-functions nil) |
| 60 | 61 |
| 574 (concat "(" (symbol-name (or (vc-file-getprop file 'vc-bzr-state) | 575 (concat "(" (symbol-name (or (vc-file-getprop file 'vc-bzr-state) |
| 575 'edited)) ")") | 576 'edited)) ")") |
| 576 ;; else fall back to default vc.el representation | 577 ;; else fall back to default vc.el representation |
| 577 (vc-default-prettify-state-info 'Bzr file))) | 578 (vc-default-prettify-state-info 'Bzr file))) |
| 578 | 579 |
| 580 (defstruct (vc-bzr-extra-fileinfo | |
| 581 (:copier nil) | |
| 582 (:constructor vc-bzr-create-extra-fileinfo (extra-name)) | |
| 583 (:conc-name vc-bzr-extra-fileinfo->)) | |
| 584 extra-name) ;; original name for rename targets, new name for | |
| 585 | |
| 586 (defun vc-bzr-status-printer (info) | |
| 587 "Pretty-printer for the vc-dir-fileinfo structure." | |
| 588 (let ((extra (vc-dir-fileinfo->extra info))) | |
| 589 (vc-default-status-printer 'Bzr info) | |
| 590 (when extra | |
| 591 (insert (propertize | |
| 592 (format " (renamed from %s)" | |
| 593 (vc-bzr-extra-fileinfo->extra-name extra)) | |
| 594 'face 'font-lock-comment-face))))) | |
| 595 | |
| 579 ;; FIXME: this needs testing, it's probably incomplete. | 596 ;; FIXME: this needs testing, it's probably incomplete. |
| 580 (defun vc-bzr-after-dir-status (update-function) | 597 (defun vc-bzr-after-dir-status (update-function) |
| 581 (let ((status-str nil) | 598 (let ((status-str nil) |
| 582 (translation '(("+N " . added) | 599 (translation '(("+N " . added) |
| 583 ("-D " . removed) | 600 ("-D " . removed) |
| 587 ;; FIXME: what about ignored files? | 604 ;; FIXME: what about ignored files? |
| 588 (" D " . missing) | 605 (" D " . missing) |
| 589 ;; For conflicts, should we list the .THIS/.BASE/.OTHER? | 606 ;; For conflicts, should we list the .THIS/.BASE/.OTHER? |
| 590 ("C " . conflict) | 607 ("C " . conflict) |
| 591 ("? " . unregistered) | 608 ("? " . unregistered) |
| 609 ("? " . unregistered) | |
| 610 ;; No such state, but we need to distinguish this case. | |
| 611 ("R " . renamed) | |
| 592 ;; Ignore "P " and "P." for pending patches. | 612 ;; Ignore "P " and "P." for pending patches. |
| 593 )) | 613 )) |
| 594 (translated nil) | 614 (translated nil) |
| 595 (result nil)) | 615 (result nil)) |
| 596 (goto-char (point-min)) | 616 (goto-char (point-min)) |
| 597 (while (not (eobp)) | 617 (while (not (eobp)) |
| 598 (setq status-str | 618 (setq status-str |
| 599 (buffer-substring-no-properties (point) (+ (point) 3))) | 619 (buffer-substring-no-properties (point) (+ (point) 3))) |
| 600 (setq translated (cdr (assoc status-str translation))) | 620 (setq translated (cdr (assoc status-str translation))) |
| 601 ;; For conflicts the file appears twice in the listing: once | 621 (cond |
| 602 ;; with the M flag and once with the C flag, so take care not | 622 ((eq translated 'conflict) |
| 603 ;; to add it twice to `result'. Ugly. | 623 ;; For conflicts the file appears twice in the listing: once |
| 604 (if (eq translated 'conflict) | 624 ;; with the M flag and once with the C flag, so take care |
| 605 (let* ((file | 625 ;; not to add it twice to `result'. Ugly. |
| 606 (buffer-substring-no-properties | 626 (let* ((file |
| 607 ;;For files with conflicts the format is: | 627 (buffer-substring-no-properties |
| 608 ;;C Text conflict in FILENAME | 628 ;;For files with conflicts the format is: |
| 609 ;; Bah. | 629 ;;C Text conflict in FILENAME |
| 610 (+ (point) 21) (line-end-position))) | 630 ;; Bah. |
| 611 (entry (assoc file result))) | 631 (+ (point) 21) (line-end-position))) |
| 612 (when entry | 632 (entry (assoc file result))) |
| 613 (setf (nth 1 entry) 'conflict))) | 633 (when entry |
| 634 (setf (nth 1 entry) 'conflict)))) | |
| 635 ((eq translated 'renamed) | |
| 636 (re-search-forward "R \\(.*\\) => \\(.*\\)$" (line-end-position) t) | |
| 637 (let ((new-name (match-string 2)) | |
| 638 (old-name (match-string 1))) | |
| 639 (push (list new-name 'edited | |
| 640 (vc-bzr-create-extra-fileinfo old-name)) result))) | |
| 641 (t | |
| 614 (push (list (buffer-substring-no-properties | 642 (push (list (buffer-substring-no-properties |
| 615 (+ (point) 4) | 643 (+ (point) 4) |
| 616 (line-end-position)) | 644 (line-end-position)) |
| 617 translated) result)) | 645 translated) result))) |
| 618 (forward-line)) | 646 (forward-line)) |
| 619 (funcall update-function result))) | 647 (funcall update-function result))) |
| 620 | 648 |
| 621 (defun vc-bzr-dir-status (dir update-function) | 649 (defun vc-bzr-dir-status (dir update-function) |
| 622 "Return a list of conses (file . state) for DIR." | 650 "Return a list of conses (file . state) for DIR." |