comparison lisp/packages/emerge.el @ 189:489f57a838ef r20-3b21

Import from CVS: tag r20-3b21
author cvs
date Mon, 13 Aug 2007 09:57:07 +0200
parents 360340f9fd5f
children
comparison
equal deleted inserted replaced
188:e29a8e7498d9 189:489f57a838ef
25 ;; emerge|Dale R. Worley|drw@math.mit.edu 25 ;; emerge|Dale R. Worley|drw@math.mit.edu
26 ;; |File merge 26 ;; |File merge
27 ;; |92-12-11|version 5 gamma|~/packages/emerge.el.Z 27 ;; |92-12-11|version 5 gamma|~/packages/emerge.el.Z
28 28
29 ;;; Code 29 ;;; Code
30
31 (defmacro emerge-eval-in-buffer (buffer &rest forms)
32 "Macro to switch to BUFFER, evaluate FORMS, returns to original buffer.
33 Differs from `save-excursion' in that it doesn't save the point and mark."
34 (` (let ((StartBuffer (current-buffer)))
35 (unwind-protect
36 (progn
37 (set-buffer (, buffer))
38 (,@ forms))
39 (set-buffer StartBuffer)))))
40 30
41 (defconst emerge-xemacs-p (not (not (string-match "XEmacs" emacs-version))) 31 (defconst emerge-xemacs-p (not (not (string-match "XEmacs" emacs-version)))
42 "Non-nil if this is XEmacs. Don't alter manually, because it also 32 "Non-nil if this is XEmacs. Don't alter manually, because it also
43 turns on work-arounds for bugs.") 33 turns on work-arounds for bugs.")
44 34
594 (setq emerge-last-dir-A (file-name-directory file-A)) 584 (setq emerge-last-dir-A (file-name-directory file-A))
595 (setq emerge-last-dir-B (file-name-directory file-B)) 585 (setq emerge-last-dir-B (file-name-directory file-B))
596 (if output-file 586 (if output-file
597 (setq emerge-last-dir-output (file-name-directory output-file))) 587 (setq emerge-last-dir-output (file-name-directory output-file)))
598 ;; Make sure the entire files are seen, and they reflect what is on disk 588 ;; Make sure the entire files are seen, and they reflect what is on disk
599 (emerge-eval-in-buffer 589 (with-current-buffer buffer-A
600 buffer-A 590 (widen)
601 (widen) 591 (if (emerge-remote-file-p)
602 (if (emerge-remote-file-p) 592 (progn
603 (progn 593 ;; Store in a local file
604 ;; Store in a local file 594 (setq file-A (emerge-make-temp-file "A"))
605 (setq file-A (emerge-make-temp-file "A")) 595 (write-region (point-min) (point-max) file-A nil 'no-message)
606 (write-region (point-min) (point-max) file-A nil 'no-message) 596 (setq startup-hooks
607 (setq startup-hooks 597 (cons (` (lambda () (delete-file (, file-A))))
608 (cons (` (lambda () (delete-file (, file-A)))) 598 startup-hooks)))
609 startup-hooks))) 599 ;; Verify that the file matches the buffer
610 ;; Verify that the file matches the buffer 600 (emerge-verify-file-buffer)))
611 (emerge-verify-file-buffer))) 601 (with-current-buffer
612 (emerge-eval-in-buffer 602 buffer-B
613 buffer-B 603 (widen)
614 (widen) 604 (if (emerge-remote-file-p)
615 (if (emerge-remote-file-p) 605 (progn
616 (progn 606 ;; Store in a local file
617 ;; Store in a local file 607 (setq file-B (emerge-make-temp-file "B"))
618 (setq file-B (emerge-make-temp-file "B")) 608 (write-region (point-min) (point-max) file-B nil 'no-message)
619 (write-region (point-min) (point-max) file-B nil 'no-message) 609 (setq startup-hooks
620 (setq startup-hooks 610 (cons (` (lambda () (delete-file (, file-B))))
621 (cons (` (lambda () (delete-file (, file-B)))) 611 startup-hooks)))
622 startup-hooks))) 612 ;; Verify that the file matches the buffer
623 ;; Verify that the file matches the buffer 613 (emerge-verify-file-buffer)))
624 (emerge-verify-file-buffer)))
625 (emerge-setup buffer-A file-A buffer-B file-B startup-hooks quit-hooks 614 (emerge-setup buffer-A file-A buffer-B file-B startup-hooks quit-hooks
626 output-file))) 615 output-file)))
627 616
628 ;; Start up Emerge on two files 617 ;; Start up Emerge on two files
629 (defun emerge-setup (buffer-A file-A buffer-B file-B startup-hooks quit-hooks 618 (defun emerge-setup (buffer-A file-A buffer-B file-B startup-hooks quit-hooks
632 (setq file-B (expand-file-name file-B)) 621 (setq file-B (expand-file-name file-B))
633 (setq output-file (and output-file (expand-file-name output-file))) 622 (setq output-file (and output-file (expand-file-name output-file)))
634 (let* ((merge-buffer-name (emerge-unique-buffer-name "*merge" "*")) 623 (let* ((merge-buffer-name (emerge-unique-buffer-name "*merge" "*"))
635 ;; create the merge buffer from buffer A, so it inherits buffer A's 624 ;; create the merge buffer from buffer A, so it inherits buffer A's
636 ;; default directory, etc. 625 ;; default directory, etc.
637 (merge-buffer (emerge-eval-in-buffer 626 (merge-buffer (with-current-buffer
638 buffer-A 627 buffer-A
639 (get-buffer-create merge-buffer-name)))) 628 (get-buffer-create merge-buffer-name))))
640 (emerge-eval-in-buffer 629 (with-current-buffer
641 merge-buffer 630 merge-buffer
642 (emerge-copy-modes buffer-A) 631 (emerge-copy-modes buffer-A)
643 (setq buffer-read-only nil) 632 (setq buffer-read-only nil)
644 (auto-save-mode 1) 633 (auto-save-mode 1)
645 (setq emerge-mode t) 634 (setq emerge-mode t)
646 (setq emerge-A-buffer buffer-A) 635 (setq emerge-A-buffer buffer-A)
647 (setq emerge-B-buffer buffer-B) 636 (setq emerge-B-buffer buffer-B)
648 (setq emerge-ancestor-buffer nil) 637 (setq emerge-ancestor-buffer nil)
649 (setq emerge-merge-buffer merge-buffer) 638 (setq emerge-merge-buffer merge-buffer)
650 (setq emerge-output-description 639 (setq emerge-output-description
651 (if output-file 640 (if output-file
652 (concat "Output to file: " output-file) 641 (concat "Output to file: " output-file)
653 (concat "Output to buffer: " (buffer-name merge-buffer)))) 642 (concat "Output to buffer: " (buffer-name merge-buffer))))
654 (insert-buffer emerge-A-buffer) 643 (insert-buffer emerge-A-buffer)
655 (emerge-set-keys) 644 (emerge-set-keys)
656 (setq emerge-difference-list (emerge-make-diff-list file-A file-B)) 645 (setq emerge-difference-list (emerge-make-diff-list file-A file-B))
657 (setq emerge-number-of-differences (length emerge-difference-list)) 646 (setq emerge-number-of-differences (length emerge-difference-list))
658 (setq emerge-current-difference -1) 647 (setq emerge-current-difference -1)
659 (setq emerge-quit-hook quit-hooks) 648 (setq emerge-quit-hook quit-hooks)
660 (emerge-remember-buffer-characteristics) 649 (emerge-remember-buffer-characteristics)
661 (emerge-handle-local-variables)) 650 (emerge-handle-local-variables))
662 (emerge-setup-windows buffer-A buffer-B merge-buffer t) 651 (emerge-setup-windows buffer-A buffer-B merge-buffer t)
663 (emerge-eval-in-buffer merge-buffer 652 (with-current-buffer merge-buffer
664 (run-hooks 'startup-hooks 'emerge-startup-hook) 653 (run-hooks 'startup-hooks 'emerge-startup-hook)
665 (setq buffer-read-only t)))) 654 (setq buffer-read-only t))))
666 655
667 ;; Generate the Emerge difference list between two files 656 ;; Generate the Emerge difference list between two files
668 (defun emerge-make-diff-list (file-A file-B) 657 (defun emerge-make-diff-list (file-A file-B)
669 (let ((diff-buffer (get-buffer-create "*emerge-diff*"))) 658 (let ((diff-buffer (get-buffer-create "*emerge-diff*")))
670 (emerge-eval-in-buffer 659 (with-current-buffer
671 diff-buffer 660 diff-buffer
672 (erase-buffer) 661 (erase-buffer)
673 (shell-command 662 (shell-command
674 (format "%s %s %s %s" 663 (format "%s %s %s %s"
675 emerge-diff-program emerge-diff-options 664 emerge-diff-program emerge-diff-options
676 (emerge-protect-metachars file-A) 665 (emerge-protect-metachars file-A)
677 (emerge-protect-metachars file-B)) 666 (emerge-protect-metachars file-B))
678 t)) 667 t))
679 (emerge-prepare-error-list emerge-diff-ok-lines-regexp diff-buffer) 668 (emerge-prepare-error-list emerge-diff-ok-lines-regexp diff-buffer)
680 (emerge-convert-diffs-to-markers 669 (emerge-convert-diffs-to-markers
681 emerge-A-buffer emerge-B-buffer emerge-merge-buffer 670 emerge-A-buffer emerge-B-buffer emerge-merge-buffer
682 (emerge-extract-diffs diff-buffer)))) 671 (emerge-extract-diffs diff-buffer))))
683 672
684 (defun emerge-extract-diffs (diff-buffer) 673 (defun emerge-extract-diffs (diff-buffer)
685 (let (list) 674 (let (list)
686 (emerge-eval-in-buffer 675 (with-current-buffer
687 diff-buffer 676 diff-buffer
688 (goto-char (point-min)) 677 (goto-char (point-min))
689 (while (re-search-forward emerge-match-diff-line nil t) 678 (while (re-search-forward emerge-match-diff-line nil t)
690 (let* ((a-begin (string-to-int (buffer-substring (match-beginning 1) 679 (let* ((a-begin (string-to-int (buffer-substring (match-beginning 1)
691 (match-end 1)))) 680 (match-end 1))))
692 (a-end (let ((b (match-beginning 3)) 681 (a-end (let ((b (match-beginning 3))
693 (e (match-end 3))) 682 (e (match-end 3)))
683 (if b
684 (string-to-int (buffer-substring b e))
685 a-begin)))
686 (diff-type (buffer-substring (match-beginning 4) (match-end 4)))
687 (b-begin (string-to-int (buffer-substring (match-beginning 5)
688 (match-end 5))))
689 (b-end (let ((b (match-beginning 7))
690 (e (match-end 7)))
694 (if b 691 (if b
695 (string-to-int (buffer-substring b e)) 692 (string-to-int (buffer-substring b e))
696 a-begin))) 693 b-begin))))
697 (diff-type (buffer-substring (match-beginning 4) (match-end 4))) 694 ;; fix the beginning and end numbers, because diff is somewhat
698 (b-begin (string-to-int (buffer-substring (match-beginning 5) 695 ;; strange about how it numbers lines
699 (match-end 5)))) 696 (if (string-equal diff-type "a")
700 (b-end (let ((b (match-beginning 7)) 697 (progn
701 (e (match-end 7))) 698 (setq b-end (1+ b-end))
702 (if b 699 (setq a-begin (1+ a-begin))
703 (string-to-int (buffer-substring b e)) 700 (setq a-end a-begin))
704 b-begin)))) 701 (if (string-equal diff-type "d")
705 ;; fix the beginning and end numbers, because diff is somewhat 702 (progn
706 ;; strange about how it numbers lines 703 (setq a-end (1+ a-end))
707 (if (string-equal diff-type "a") 704 (setq b-begin (1+ b-begin))
708 (progn 705 (setq b-end b-begin))
709 (setq b-end (1+ b-end)) 706 ;; (string-equal diff-type "c")
710 (setq a-begin (1+ a-begin)) 707 (progn
711 (setq a-end a-begin)) 708 (setq a-end (1+ a-end))
712 (if (string-equal diff-type "d") 709 (setq b-end (1+ b-end)))))
713 (progn 710 (setq list (cons (vector a-begin a-end
714 (setq a-end (1+ a-end)) 711 b-begin b-end
715 (setq b-begin (1+ b-begin)) 712 'default-A)
716 (setq b-end b-begin)) 713 list)))))
717 ;; (string-equal diff-type "c")
718 (progn
719 (setq a-end (1+ a-end))
720 (setq b-end (1+ b-end)))))
721 (setq list (cons (vector a-begin a-end
722 b-begin b-end
723 'default-A)
724 list)))))
725 (nreverse list))) 714 (nreverse list)))
726 715
727 ;; Set up buffer of diff/diff3 error messages. 716 ;; Set up buffer of diff/diff3 error messages.
728 (defun emerge-prepare-error-list (ok-regexp diff-buffer) 717 (defun emerge-prepare-error-list (ok-regexp diff-buffer)
729 (setq emerge-diff-error-buffer (get-buffer-create "*emerge-diff-errors*")) 718 (setq emerge-diff-error-buffer (get-buffer-create "*emerge-diff-errors*"))
730 (emerge-eval-in-buffer 719 (with-current-buffer
731 emerge-diff-error-buffer 720 emerge-diff-error-buffer
732 (erase-buffer) 721 (erase-buffer)
733 (insert-buffer diff-buffer) 722 (insert-buffer diff-buffer)
734 (delete-matching-lines ok-regexp))) 723 (delete-matching-lines ok-regexp)))
735 724
736 ;;; Top-level and setup functions for three-file mode. 725 ;;; Top-level and setup functions for three-file mode.
737 726
738 (defun emerge-files-with-ancestor-internal (file-A file-B file-ancestor 727 (defun emerge-files-with-ancestor-internal (file-A file-B file-ancestor
739 &optional startup-hooks quit-hooks 728 &optional startup-hooks quit-hooks
752 (setq emerge-last-dir-B (file-name-directory file-B)) 741 (setq emerge-last-dir-B (file-name-directory file-B))
753 (setq emerge-last-dir-ancestor (file-name-directory file-ancestor)) 742 (setq emerge-last-dir-ancestor (file-name-directory file-ancestor))
754 (if output-file 743 (if output-file
755 (setq emerge-last-dir-output (file-name-directory output-file))) 744 (setq emerge-last-dir-output (file-name-directory output-file)))
756 ;; Make sure the entire files are seen, and they reflect what is on disk 745 ;; Make sure the entire files are seen, and they reflect what is on disk
757 (emerge-eval-in-buffer 746 (with-current-buffer
758 buffer-A 747 buffer-A
759 (widen) 748 (widen)
760 (if (emerge-remote-file-p) 749 (if (emerge-remote-file-p)
761 (progn 750 (progn
762 ;; Store in a local file 751 ;; Store in a local file
763 (setq file-A (emerge-make-temp-file "A")) 752 (setq file-A (emerge-make-temp-file "A"))
764 (write-region (point-min) (point-max) file-A nil 'no-message) 753 (write-region (point-min) (point-max) file-A nil 'no-message)
765 (setq startup-hooks 754 (setq startup-hooks
766 (cons (` (lambda () (delete-file (, file-A)))) 755 (cons (` (lambda () (delete-file (, file-A))))
767 startup-hooks))) 756 startup-hooks)))
768 ;; Verify that the file matches the buffer 757 ;; Verify that the file matches the buffer
769 (emerge-verify-file-buffer))) 758 (emerge-verify-file-buffer)))
770 (emerge-eval-in-buffer 759 (with-current-buffer
771 buffer-B 760 buffer-B
772 (widen) 761 (widen)
773 (if (emerge-remote-file-p) 762 (if (emerge-remote-file-p)
774 (progn 763 (progn
775 ;; Store in a local file 764 ;; Store in a local file
776 (setq file-B (emerge-make-temp-file "B")) 765 (setq file-B (emerge-make-temp-file "B"))
777 (write-region (point-min) (point-max) file-B nil 'no-message) 766 (write-region (point-min) (point-max) file-B nil 'no-message)
778 (setq startup-hooks 767 (setq startup-hooks
779 (cons (` (lambda () (delete-file (, file-B)))) 768 (cons (` (lambda () (delete-file (, file-B))))
780 startup-hooks))) 769 startup-hooks)))
781 ;; Verify that the file matches the buffer 770 ;; Verify that the file matches the buffer
782 (emerge-verify-file-buffer))) 771 (emerge-verify-file-buffer)))
783 (emerge-eval-in-buffer 772 (with-current-buffer
784 buffer-ancestor 773 buffer-ancestor
785 (widen) 774 (widen)
786 (if (emerge-remote-file-p) 775 (if (emerge-remote-file-p)
787 (progn 776 (progn
788 ;; Store in a local file 777 ;; Store in a local file
789 (setq file-ancestor (emerge-make-temp-file "anc")) 778 (setq file-ancestor (emerge-make-temp-file "anc"))
790 (write-region (point-min) (point-max) file-ancestor nil 'no-message) 779 (write-region (point-min) (point-max) file-ancestor nil 'no-message)
791 (setq startup-hooks 780 (setq startup-hooks
792 (cons (` (lambda () (delete-file (, file-ancestor)))) 781 (cons (` (lambda () (delete-file (, file-ancestor))))
793 startup-hooks))) 782 startup-hooks)))
794 ;; Verify that the file matches the buffer 783 ;; Verify that the file matches the buffer
795 (emerge-verify-file-buffer))) 784 (emerge-verify-file-buffer)))
796 (emerge-setup-with-ancestor buffer-A file-A buffer-B file-B 785 (emerge-setup-with-ancestor buffer-A file-A buffer-B file-B
797 buffer-ancestor file-ancestor 786 buffer-ancestor file-ancestor
798 startup-hooks quit-hooks output-file))) 787 startup-hooks quit-hooks output-file)))
799 788
800 ;; Start up Emerge on two files with an ancestor 789 ;; Start up Emerge on two files with an ancestor
807 (setq file-ancestor (expand-file-name file-ancestor)) 796 (setq file-ancestor (expand-file-name file-ancestor))
808 (setq output-file (and output-file (expand-file-name output-file))) 797 (setq output-file (and output-file (expand-file-name output-file)))
809 (let* ((merge-buffer-name (emerge-unique-buffer-name "*merge" "*")) 798 (let* ((merge-buffer-name (emerge-unique-buffer-name "*merge" "*"))
810 ;; create the merge buffer from buffer A, so it inherits buffer A's 799 ;; create the merge buffer from buffer A, so it inherits buffer A's
811 ;; default directory, etc. 800 ;; default directory, etc.
812 (merge-buffer (emerge-eval-in-buffer 801 (merge-buffer (with-current-buffer
813 buffer-A 802 buffer-A
814 (get-buffer-create merge-buffer-name)))) 803 (get-buffer-create merge-buffer-name))))
815 (emerge-eval-in-buffer 804 (with-current-buffer
816 merge-buffer 805 merge-buffer
817 (emerge-copy-modes buffer-A) 806 (emerge-copy-modes buffer-A)
818 (setq buffer-read-only nil) 807 (setq buffer-read-only nil)
819 (auto-save-mode 1) 808 (auto-save-mode 1)
820 (setq emerge-mode t) 809 (setq emerge-mode t)
821 (setq emerge-A-buffer buffer-A) 810 (setq emerge-A-buffer buffer-A)
822 (setq emerge-B-buffer buffer-B) 811 (setq emerge-B-buffer buffer-B)
823 (setq emerge-ancestor-buffer buffer-ancestor) 812 (setq emerge-ancestor-buffer buffer-ancestor)
824 (setq emerge-merge-buffer merge-buffer) 813 (setq emerge-merge-buffer merge-buffer)
825 (setq emerge-output-description 814 (setq emerge-output-description
826 (if output-file 815 (if output-file
827 (concat "Output to file: " output-file) 816 (concat "Output to file: " output-file)
828 (concat "Output to buffer: " (buffer-name merge-buffer)))) 817 (concat "Output to buffer: " (buffer-name merge-buffer))))
829 (insert-buffer emerge-A-buffer) 818 (insert-buffer emerge-A-buffer)
830 (emerge-set-keys) 819 (emerge-set-keys)
831 (setq emerge-difference-list 820 (setq emerge-difference-list
832 (emerge-make-diff3-list file-A file-B file-ancestor)) 821 (emerge-make-diff3-list file-A file-B file-ancestor))
833 (setq emerge-number-of-differences (length emerge-difference-list)) 822 (setq emerge-number-of-differences (length emerge-difference-list))
834 (setq emerge-current-difference -1) 823 (setq emerge-current-difference -1)
835 (setq emerge-quit-hook quit-hooks) 824 (setq emerge-quit-hook quit-hooks)
836 (emerge-remember-buffer-characteristics) 825 (emerge-remember-buffer-characteristics)
837 (emerge-select-prefer-Bs) 826 (emerge-select-prefer-Bs)
838 (emerge-handle-local-variables)) 827 (emerge-handle-local-variables))
839 (emerge-setup-windows buffer-A buffer-B merge-buffer t) 828 (emerge-setup-windows buffer-A buffer-B merge-buffer t)
840 (emerge-eval-in-buffer merge-buffer 829 (with-current-buffer merge-buffer
841 (run-hooks 'startup-hooks 'emerge-startup-hook) 830 (run-hooks 'startup-hooks 'emerge-startup-hook)
842 (setq buffer-read-only t)))) 831 (setq buffer-read-only t))))
843 832
844 ;; Generate the Emerge difference list between two files with an ancestor 833 ;; Generate the Emerge difference list between two files with an ancestor
845 (defun emerge-make-diff3-list (file-A file-B file-ancestor) 834 (defun emerge-make-diff3-list (file-A file-B file-ancestor)
846 (let ((diff-buffer (get-buffer-create "*emerge-diff*"))) 835 (let ((diff-buffer (get-buffer-create "*emerge-diff*")))
847 (emerge-eval-in-buffer 836 (with-current-buffer
848 diff-buffer 837 diff-buffer
849 (erase-buffer) 838 (erase-buffer)
850 (shell-command 839 (shell-command
851 (format "%s %s %s %s %s" 840 (format "%s %s %s %s %s"
852 emerge-diff3-program emerge-diff-options 841 emerge-diff3-program emerge-diff-options
853 ;; #### - fsf reverses file-ancestor and file-A, why? 842 ;; #### - fsf reverses file-ancestor and file-A, why?
854 (emerge-protect-metachars file-ancestor) 843 (emerge-protect-metachars file-ancestor)
855 (emerge-protect-metachars file-A) 844 (emerge-protect-metachars file-A)
856 (emerge-protect-metachars file-B)) 845 (emerge-protect-metachars file-B))
857 t)) 846 t))
858 (emerge-prepare-error-list emerge-diff3-ok-lines-regexp diff-buffer) 847 (emerge-prepare-error-list emerge-diff3-ok-lines-regexp diff-buffer)
859 (emerge-convert-diffs-to-markers 848 (emerge-convert-diffs-to-markers
860 emerge-A-buffer emerge-B-buffer emerge-merge-buffer 849 emerge-A-buffer emerge-B-buffer emerge-merge-buffer
861 (emerge-extract-diffs3 diff-buffer)))) 850 (emerge-extract-diffs3 diff-buffer))))
862 851
863 (defun emerge-extract-diffs3 (diff-buffer) 852 (defun emerge-extract-diffs3 (diff-buffer)
864 (let (list) 853 (let (list)
865 (emerge-eval-in-buffer 854 (with-current-buffer
866 diff-buffer 855 diff-buffer
867 (while (re-search-forward "^====\\(.?\\)$" nil t) 856 (while (re-search-forward "^====\\(.?\\)$" nil t)
868 ;; leave point after matched line 857 ;; leave point after matched line
869 (beginning-of-line 2) 858 (beginning-of-line 2)
870 (let ((agreement (buffer-substring (match-beginning 1) (match-end 1)))) 859 (let ((agreement (buffer-substring (match-beginning 1) (match-end 1))))
871 ;; if the A and B files are the same, ignore the difference 860 ;; if the A and B files are the same, ignore the difference
872 (if (not (string-equal agreement "1")) ; this goes with the file-A/ancestor reversal 861 (if (not (string-equal agreement "1")) ; this goes with the file-A/ancestor reversal
873 (setq list 862 (setq list
874 (cons 863 (cons
875 (let* ((pos (point)) 864 (let* ((pos (point))
876 (group-2 (emerge-get-diff3-group "2")) 865 (group-2 (emerge-get-diff3-group "2"))
877 (group-3 (progn (goto-char pos) 866 (group-3 (progn (goto-char pos)
878 (emerge-get-diff3-group "3")))) 867 (emerge-get-diff3-group "3"))))
879 (vector (car group-2) (car (cdr group-2)) 868 (vector (car group-2) (car (cdr group-2))
880 (car group-3) (car (cdr group-3)) 869 (car group-3) (car (cdr group-3))
881 (cond ((string-equal agreement "2") 'prefer-A) 870 (cond ((string-equal agreement "2") 'prefer-A)
882 ((string-equal agreement "3") 'prefer-B) 871 ((string-equal agreement "3") 'prefer-B)
883 (t 'default-A)))) 872 (t 'default-A))))
884 list)))))) 873 list))))))
885 (nreverse list))) 874 (nreverse list)))
886 875
887 (defun emerge-get-diff3-group (file) 876 (defun emerge-get-diff3-group (file)
888 ;; This save-excursion allows emerge-get-diff3-group to be called for the 877 ;; This save-excursion allows emerge-get-diff3-group to be called for the
889 ;; various groups of lines (1, 2, 3) in any order, and for the lines to 878 ;; various groups of lines (1, 2, 3) in any order, and for the lines to
972 (defun emerge-buffers (buffer-A buffer-B &optional startup-hooks quit-hooks) 961 (defun emerge-buffers (buffer-A buffer-B &optional startup-hooks quit-hooks)
973 "Run Emerge on two buffers." 962 "Run Emerge on two buffers."
974 (interactive "bBuffer A to merge: \nbBuffer B to merge: ") 963 (interactive "bBuffer A to merge: \nbBuffer B to merge: ")
975 (let ((emerge-file-A (emerge-make-temp-file "A")) 964 (let ((emerge-file-A (emerge-make-temp-file "A"))
976 (emerge-file-B (emerge-make-temp-file "B"))) 965 (emerge-file-B (emerge-make-temp-file "B")))
977 (emerge-eval-in-buffer 966 (with-current-buffer
978 buffer-A 967 buffer-A
979 (write-region (point-min) (point-max) emerge-file-A nil 'no-message)) 968 (write-region (point-min) (point-max) emerge-file-A nil 'no-message))
980 (emerge-eval-in-buffer 969 (with-current-buffer
981 buffer-B 970 buffer-B
982 (write-region (point-min) (point-max) emerge-file-B nil 'no-message)) 971 (write-region (point-min) (point-max) emerge-file-B nil 'no-message))
983 (emerge-setup (get-buffer buffer-A) emerge-file-A 972 (emerge-setup (get-buffer buffer-A) emerge-file-A
984 (get-buffer buffer-B) emerge-file-B 973 (get-buffer buffer-B) emerge-file-B
985 (cons (` (lambda () 974 (cons (` (lambda ()
986 (delete-file (, emerge-file-A)) 975 (delete-file (, emerge-file-A))
987 (delete-file (, emerge-file-B)))) 976 (delete-file (, emerge-file-B))))
997 (interactive 986 (interactive
998 "bBuffer A to merge: \nbBuffer B to merge: \nbAncestor buffer: ") 987 "bBuffer A to merge: \nbBuffer B to merge: \nbAncestor buffer: ")
999 (let ((emerge-file-A (emerge-make-temp-file "A")) 988 (let ((emerge-file-A (emerge-make-temp-file "A"))
1000 (emerge-file-B (emerge-make-temp-file "B")) 989 (emerge-file-B (emerge-make-temp-file "B"))
1001 (emerge-file-ancestor (emerge-make-temp-file "anc"))) 990 (emerge-file-ancestor (emerge-make-temp-file "anc")))
1002 (emerge-eval-in-buffer 991 (with-current-buffer
1003 buffer-A 992 buffer-A
1004 (write-region (point-min) (point-max) emerge-file-A nil 'no-message)) 993 (write-region (point-min) (point-max) emerge-file-A nil 'no-message))
1005 (emerge-eval-in-buffer 994 (with-current-buffer
1006 buffer-B 995 buffer-B
1007 (write-region (point-min) (point-max) emerge-file-B nil 'no-message)) 996 (write-region (point-min) (point-max) emerge-file-B nil 'no-message))
1008 (emerge-eval-in-buffer 997 (with-current-buffer
1009 buffer-ancestor 998 buffer-ancestor
1010 (write-region (point-min) (point-max) emerge-file-ancestor nil 999 (write-region (point-min) (point-max) emerge-file-ancestor nil
1011 'no-message)) 1000 'no-message))
1012 (emerge-setup-with-ancestor (get-buffer buffer-A) emerge-file-A 1001 (emerge-setup-with-ancestor (get-buffer buffer-A) emerge-file-A
1013 (get-buffer buffer-B) emerge-file-B 1002 (get-buffer buffer-B) emerge-file-B
1014 (get-buffer buffer-ancestor) 1003 (get-buffer buffer-ancestor)
1015 emerge-file-ancestor 1004 emerge-file-ancestor
1016 (cons (` (lambda () 1005 (cons (` (lambda ()
1135 (let ((buffer-A (get-buffer-create (format "%s,%s" file revision-A))) 1124 (let ((buffer-A (get-buffer-create (format "%s,%s" file revision-A)))
1136 (buffer-B (get-buffer-create (format "%s,%s" file revision-B))) 1125 (buffer-B (get-buffer-create (format "%s,%s" file revision-B)))
1137 (emerge-file-A (emerge-make-temp-file "A")) 1126 (emerge-file-A (emerge-make-temp-file "A"))
1138 (emerge-file-B (emerge-make-temp-file "B"))) 1127 (emerge-file-B (emerge-make-temp-file "B")))
1139 ;; Get the revisions into buffers 1128 ;; Get the revisions into buffers
1140 (emerge-eval-in-buffer 1129 (with-current-buffer
1141 buffer-A 1130 buffer-A
1142 (erase-buffer) 1131 (erase-buffer)
1143 (shell-command 1132 (shell-command
1144 (format "%s -q -p%s %s" emerge-rcs-co-program revision-A file) 1133 (format "%s -q -p%s %s" emerge-rcs-co-program revision-A file)
1145 t) 1134 t)
1146 (write-region (point-min) (point-max) emerge-file-A nil 'no-message) 1135 (write-region (point-min) (point-max) emerge-file-A nil 'no-message)
1147 (set-buffer-modified-p nil)) 1136 (set-buffer-modified-p nil))
1148 (emerge-eval-in-buffer 1137 (with-current-buffer
1149 buffer-B 1138 buffer-B
1150 (erase-buffer) 1139 (erase-buffer)
1151 (shell-command 1140 (shell-command
1152 (format "%s -q -p%s %s" emerge-rcs-co-program revision-B file) 1141 (format "%s -q -p%s %s" emerge-rcs-co-program revision-B file)
1153 t) 1142 t)
1154 (write-region (point-min) (point-max) emerge-file-B nil 'no-message) 1143 (write-region (point-min) (point-max) emerge-file-B nil 'no-message)
1155 (set-buffer-modified-p nil)) 1144 (set-buffer-modified-p nil))
1156 ;; Do the merge 1145 ;; Do the merge
1157 (emerge-setup buffer-A emerge-file-A 1146 (emerge-setup buffer-A emerge-file-A
1158 buffer-B emerge-file-B 1147 buffer-B emerge-file-B
1159 (cons (` (lambda () 1148 (cons (` (lambda ()
1160 (delete-file (, emerge-file-A)) 1149 (delete-file (, emerge-file-A))
1173 (buffer-ancestor (get-buffer-create (format "%s,%s" file ancestor))) 1162 (buffer-ancestor (get-buffer-create (format "%s,%s" file ancestor)))
1174 (emerge-file-A (emerge-make-temp-file "A")) 1163 (emerge-file-A (emerge-make-temp-file "A"))
1175 (emerge-file-B (emerge-make-temp-file "B")) 1164 (emerge-file-B (emerge-make-temp-file "B"))
1176 (emerge-ancestor (emerge-make-temp-file "ancestor"))) 1165 (emerge-ancestor (emerge-make-temp-file "ancestor")))
1177 ;; Get the revisions into buffers 1166 ;; Get the revisions into buffers
1178 (emerge-eval-in-buffer 1167 (with-current-buffer
1179 buffer-A 1168 buffer-A
1180 (erase-buffer) 1169 (erase-buffer)
1181 (shell-command 1170 (shell-command
1182 (format "%s -q -p%s %s" emerge-rcs-co-program 1171 (format "%s -q -p%s %s" emerge-rcs-co-program
1183 revision-A file) 1172 revision-A file)
1184 t) 1173 t)
1185 (write-region (point-min) (point-max) emerge-file-A nil 'no-message) 1174 (write-region (point-min) (point-max) emerge-file-A nil 'no-message)
1186 (set-buffer-modified-p nil)) 1175 (set-buffer-modified-p nil))
1187 (emerge-eval-in-buffer 1176 (with-current-buffer
1188 buffer-B 1177 buffer-B
1189 (erase-buffer) 1178 (erase-buffer)
1190 (shell-command 1179 (shell-command
1191 (format "%s -q -p%s %s" emerge-rcs-co-program revision-B file) 1180 (format "%s -q -p%s %s" emerge-rcs-co-program revision-B file)
1192 t) 1181 t)
1193 (write-region (point-min) (point-max) emerge-file-B nil 'no-message) 1182 (write-region (point-min) (point-max) emerge-file-B nil 'no-message)
1194 (set-buffer-modified-p nil)) 1183 (set-buffer-modified-p nil))
1195 (emerge-eval-in-buffer 1184 (with-current-buffer
1196 buffer-ancestor 1185 buffer-ancestor
1197 (erase-buffer) 1186 (erase-buffer)
1198 (shell-command 1187 (shell-command
1199 (format "%s -q -p%s %s" emerge-rcs-co-program ancestor file) 1188 (format "%s -q -p%s %s" emerge-rcs-co-program ancestor file)
1200 t) 1189 t)
1201 (write-region (point-min) (point-max) emerge-ancestor nil 'no-message) 1190 (write-region (point-min) (point-max) emerge-ancestor nil 'no-message)
1202 (set-buffer-modified-p nil)) 1191 (set-buffer-modified-p nil))
1203 ;; Do the merge 1192 ;; Do the merge
1204 (emerge-setup-with-ancestor 1193 (emerge-setup-with-ancestor
1205 buffer-A emerge-file-A buffer-B emerge-file-B 1194 buffer-A emerge-file-A buffer-B emerge-file-B
1206 buffer-ancestor emerge-ancestor 1195 buffer-ancestor emerge-ancestor
1207 (cons (` (lambda () 1196 (cons (` (lambda ()
1424 (goto-char (point-min))) 1413 (goto-char (point-min)))
1425 (other-window 1) 1414 (other-window 1)
1426 (if pos 1415 (if pos
1427 (goto-char (point-min))) 1416 (goto-char (point-min)))
1428 ;; If diff/diff3 reports errors, display them rather than the merge buffer. 1417 ;; If diff/diff3 reports errors, display them rather than the merge buffer.
1429 (if (/= 0 (emerge-eval-in-buffer emerge-diff-error-buffer (buffer-size))) 1418 (if (/= 0 (with-current-buffer emerge-diff-error-buffer (buffer-size)))
1430 (progn 1419 (progn
1431 (ding) 1420 (ding)
1432 (message "Errors found in diff/diff3 output. Merge buffer is %s." 1421 (message "Errors found in diff/diff3 output. Merge buffer is %s."
1433 (buffer-name emerge-merge-buffer)) 1422 (buffer-name emerge-merge-buffer))
1434 (switch-to-buffer emerge-diff-error-buffer)))) 1423 (switch-to-buffer emerge-diff-error-buffer))))
1481 ;; force auto-save, because we will turn off auto-saving in buffers for the 1470 ;; force auto-save, because we will turn off auto-saving in buffers for the
1482 ;; duration 1471 ;; duration
1483 (do-auto-save) 1472 (do-auto-save)
1484 ;; remember and alter buffer characteristics 1473 ;; remember and alter buffer characteristics
1485 (setq emerge-A-buffer-values 1474 (setq emerge-A-buffer-values
1486 (emerge-eval-in-buffer 1475 (with-current-buffer
1487 emerge-A-buffer 1476 emerge-A-buffer
1488 (prog1 1477 (prog1
1489 (emerge-save-variables emerge-saved-variables) 1478 (emerge-save-variables emerge-saved-variables)
1490 (emerge-restore-variables emerge-saved-variables 1479 (emerge-restore-variables emerge-saved-variables
1491 emerge-merging-values)))) 1480 emerge-merging-values))))
1492 (setq emerge-B-buffer-values 1481 (setq emerge-B-buffer-values
1493 (emerge-eval-in-buffer 1482 (with-current-buffer
1494 emerge-B-buffer 1483 emerge-B-buffer
1495 (prog1 1484 (prog1
1496 (emerge-save-variables emerge-saved-variables) 1485 (emerge-save-variables emerge-saved-variables)
1497 (emerge-restore-variables emerge-saved-variables 1486 (emerge-restore-variables emerge-saved-variables
1498 emerge-merging-values))))) 1487 emerge-merging-values)))))
1499 1488
1500 (defun emerge-restore-buffer-characteristics () 1489 (defun emerge-restore-buffer-characteristics ()
1501 "Restores characteristics saved by `emerge-remember-buffer-characteristics'." 1490 "Restores characteristics saved by `emerge-remember-buffer-characteristics'."
1502 (let ((A-values emerge-A-buffer-values) 1491 (let ((A-values emerge-A-buffer-values)
1503 (B-values emerge-B-buffer-values)) 1492 (B-values emerge-B-buffer-values))
1504 (emerge-eval-in-buffer emerge-A-buffer 1493 (with-current-buffer emerge-A-buffer
1505 (emerge-restore-variables emerge-saved-variables 1494 (emerge-restore-variables emerge-saved-variables
1506 A-values)) 1495 A-values))
1507 (emerge-eval-in-buffer emerge-B-buffer 1496 (with-current-buffer emerge-B-buffer
1508 (emerge-restore-variables emerge-saved-variables 1497 (emerge-restore-variables emerge-saved-variables
1509 B-values)))) 1498 B-values))))
1510 ;; Move to line DESIRED-LINE assuming we are at line CURRENT-LINE. 1499 ;; Move to line DESIRED-LINE assuming we are at line CURRENT-LINE.
1511 ;; Return DESIRED-LINE. 1500 ;; Return DESIRED-LINE.
1512 (defun emerge-goto-line (desired-line current-line) 1501 (defun emerge-goto-line (desired-line current-line)
1513 (forward-line (- desired-line current-line)) 1502 (forward-line (- desired-line current-line))
1514 desired-line) 1503 desired-line)
1516 (defun emerge-convert-diffs-to-markers (A-buffer 1505 (defun emerge-convert-diffs-to-markers (A-buffer
1517 B-buffer 1506 B-buffer
1518 merge-buffer 1507 merge-buffer
1519 lineno-list) 1508 lineno-list)
1520 (let* (marker-list 1509 (let* (marker-list
1521 (A-point-min (emerge-eval-in-buffer A-buffer (point-min))) 1510 (A-point-min (with-current-buffer A-buffer (point-min)))
1522 (offset (1- A-point-min)) 1511 (offset (1- A-point-min))
1523 (B-point-min (emerge-eval-in-buffer B-buffer (point-min))) 1512 (B-point-min (with-current-buffer B-buffer (point-min)))
1524 ;; Record current line number in each buffer 1513 ;; Record current line number in each buffer
1525 ;; so we don't have to count from the beginning. 1514 ;; so we don't have to count from the beginning.
1526 (a-line 1) 1515 (a-line 1)
1527 (b-line 1)) 1516 (b-line 1))
1528 (emerge-eval-in-buffer A-buffer (goto-char (point-min))) 1517 (with-current-buffer A-buffer (goto-char (point-min)))
1529 (emerge-eval-in-buffer B-buffer (goto-char (point-min))) 1518 (with-current-buffer B-buffer (goto-char (point-min)))
1530 (while lineno-list 1519 (while lineno-list
1531 (let* ((list-element (car lineno-list)) 1520 (let* ((list-element (car lineno-list))
1532 a-begin-marker 1521 a-begin-marker
1533 a-end-marker 1522 a-end-marker
1534 b-begin-marker 1523 b-begin-marker
1539 (a-end (aref list-element 1)) 1528 (a-end (aref list-element 1))
1540 (b-begin (aref list-element 2)) 1529 (b-begin (aref list-element 2))
1541 (b-end (aref list-element 3)) 1530 (b-end (aref list-element 3))
1542 (state (aref list-element 4))) 1531 (state (aref list-element 4)))
1543 ;; place markers at the appropriate places in the buffers 1532 ;; place markers at the appropriate places in the buffers
1544 (emerge-eval-in-buffer 1533 (with-current-buffer
1545 A-buffer 1534 A-buffer
1546 (setq a-line (emerge-goto-line a-begin a-line)) 1535 (setq a-line (emerge-goto-line a-begin a-line))
1547 (setq a-begin-marker (point-marker)) 1536 (setq a-begin-marker (point-marker))
1548 (setq a-line (emerge-goto-line a-end a-line)) 1537 (setq a-line (emerge-goto-line a-end a-line))
1549 (setq a-end-marker (point-marker))) 1538 (setq a-end-marker (point-marker)))
1550 (emerge-eval-in-buffer 1539 (with-current-buffer
1551 B-buffer 1540 B-buffer
1552 (setq b-line (emerge-goto-line b-begin b-line)) 1541 (setq b-line (emerge-goto-line b-begin b-line))
1553 (setq b-begin-marker (point-marker)) 1542 (setq b-begin-marker (point-marker))
1554 (setq b-line (emerge-goto-line b-end b-line)) 1543 (setq b-line (emerge-goto-line b-end b-line))
1555 (setq b-end-marker (point-marker))) 1544 (setq b-end-marker (point-marker)))
1556 (setq merge-begin-marker (set-marker 1545 (setq merge-begin-marker (set-marker
1557 (make-marker) 1546 (make-marker)
1558 (- (marker-position a-begin-marker) 1547 (- (marker-position a-begin-marker)
1559 offset) 1548 offset)
1560 merge-buffer)) 1549 merge-buffer))
1976 (emerge-next-difference)))))) 1965 (emerge-next-difference))))))
1977 (emerge-select-version force operate-no-change operate operate))) 1966 (emerge-select-version force operate-no-change operate operate)))
1978 1967
1979 ;; Actually select the A variant 1968 ;; Actually select the A variant
1980 (defun emerge-select-A-edit (merge-begin merge-end A-begin A-end) 1969 (defun emerge-select-A-edit (merge-begin merge-end A-begin A-end)
1981 (emerge-eval-in-buffer 1970 (with-current-buffer
1982 emerge-merge-buffer 1971 emerge-merge-buffer
1983 (delete-region merge-begin merge-end) 1972 (delete-region merge-begin merge-end)
1984 (goto-char merge-begin) 1973 (goto-char merge-begin)
1985 (insert-buffer-substring emerge-A-buffer A-begin A-end) 1974 (insert-buffer-substring emerge-A-buffer A-begin A-end)
1986 (goto-char merge-begin) 1975 (goto-char merge-begin)
1987 (aset diff-vector 6 'A) 1976 (aset diff-vector 6 'A)
1988 (emerge-refresh-mode-line))) 1977 (emerge-refresh-mode-line)))
1989 1978
1990 (defun emerge-select-B (&optional force) 1979 (defun emerge-select-B (&optional force)
1991 "Select the B variant of this difference. 1980 "Select the B variant of this difference.
1992 Refuses to function if this difference has been edited, i.e., if it 1981 Refuses to function if this difference has been edited, i.e., if it
1993 is neither the A nor the B variant. 1982 is neither the A nor the B variant.
2005 (emerge-next-difference)))))) 1994 (emerge-next-difference))))))
2006 (emerge-select-version force operate operate-no-change operate))) 1995 (emerge-select-version force operate operate-no-change operate)))
2007 1996
2008 ;; Actually select the B variant 1997 ;; Actually select the B variant
2009 (defun emerge-select-B-edit (merge-begin merge-end B-begin B-end) 1998 (defun emerge-select-B-edit (merge-begin merge-end B-begin B-end)
2010 (emerge-eval-in-buffer 1999 (with-current-buffer
2011 emerge-merge-buffer 2000 emerge-merge-buffer
2012 (delete-region merge-begin merge-end) 2001 (delete-region merge-begin merge-end)
2013 (goto-char merge-begin) 2002 (goto-char merge-begin)
2014 (insert-buffer-substring emerge-B-buffer B-begin B-end) 2003 (insert-buffer-substring emerge-B-buffer B-begin B-end)
2015 (goto-char merge-begin) 2004 (goto-char merge-begin)
2016 (aset diff-vector 6 'B) 2005 (aset diff-vector 6 'B)
2017 (emerge-refresh-mode-line))) 2006 (emerge-refresh-mode-line)))
2018 2007
2019 (defun emerge-default-A (force) 2008 (defun emerge-default-A (force)
2020 "Make the A variant the default from here down. 2009 "Make the A variant the default from here down.
2021 This selects the A variant for all differences from here down in the buffer 2010 This selects the A variant for all differences from here down in the buffer
2022 which are still defaulted, i.e., which the user has not selected and for 2011 which are still defaulted, i.e., which the user has not selected and for
2217 ;; window. 2206 ;; window.
2218 ;; (split-window-vertically) 2207 ;; (split-window-vertically)
2219 (switch-to-buffer buf) 2208 (switch-to-buffer buf)
2220 (other-window 1))))) 2209 (other-window 1)))))
2221 (with-output-to-temp-buffer "*Help*" 2210 (with-output-to-temp-buffer "*Help*"
2222 (emerge-eval-in-buffer emerge-A-buffer 2211 (with-current-buffer emerge-A-buffer
2223 (if buffer-file-name 2212 (if buffer-file-name
2224 (progn 2213 (progn
2225 (princ "File A is: ") 2214 (princ "File A is: ")
2226 (princ buffer-file-name)) 2215 (princ buffer-file-name))
2227 (progn 2216 (progn
2228 (princ "Buffer A is: ") 2217 (princ "Buffer A is: ")
2229 (princ (buffer-name)))) 2218 (princ (buffer-name))))
2230 (princ "\n")) 2219 (princ "\n"))
2231 (emerge-eval-in-buffer emerge-B-buffer 2220 (with-current-buffer emerge-B-buffer
2232 (if buffer-file-name 2221 (if buffer-file-name
2233 (progn 2222 (progn
2234 (princ "File B is: ") 2223 (princ "File B is: ")
2235 (princ buffer-file-name)) 2224 (princ buffer-file-name))
2236 (progn 2225 (progn
2237 (princ "Buffer B is: ") 2226 (princ "Buffer B is: ")
2238 (princ (buffer-name)))) 2227 (princ (buffer-name))))
2239 (princ "\n")) 2228 (princ "\n"))
2240 (if emerge-ancestor-buffer 2229 (if emerge-ancestor-buffer
2241 (emerge-eval-in-buffer emerge-ancestor-buffer 2230 (with-current-buffer emerge-ancestor-buffer
2242 (if buffer-file-name 2231 (if buffer-file-name
2243 (progn 2232 (progn
2244 (princ "Ancestor file is: ") 2233 (princ "Ancestor file is: ")
2245 (princ buffer-file-name)) 2234 (princ buffer-file-name))
2246 (progn 2235 (progn
2247 (princ "Ancestor buffer is: ") 2236 (princ "Ancestor buffer is: ")
2248 (princ (buffer-name)))) 2237 (princ (buffer-name))))
2249 (princ "\n"))) 2238 (princ "\n")))
2250 (princ emerge-output-description) 2239 (princ emerge-output-description)
2251 (save-excursion 2240 (save-excursion
2252 (set-buffer standard-output) 2241 (set-buffer standard-output)
2253 (help-mode))))) 2242 (help-mode)))))
2254 2243
2308 (interactive) 2297 (interactive)
2309 (let ((n emerge-current-difference)) 2298 (let ((n emerge-current-difference))
2310 ;; check that this is a valid difference 2299 ;; check that this is a valid difference
2311 (emerge-validate-difference) 2300 (emerge-validate-difference)
2312 ;; get the point values and old difference 2301 ;; get the point values and old difference
2313 (let ((A-point (emerge-eval-in-buffer emerge-A-buffer 2302 (let ((A-point (with-current-buffer emerge-A-buffer
2314 (point-marker))) 2303 (point-marker)))
2315 (B-point (emerge-eval-in-buffer emerge-B-buffer 2304 (B-point (with-current-buffer emerge-B-buffer
2316 (point-marker))) 2305 (point-marker)))
2317 (merge-point (point-marker)) 2306 (merge-point (point-marker))
2318 (old-diff (aref emerge-difference-list n))) 2307 (old-diff (aref emerge-difference-list n)))
2319 ;; check location of the points, give error if they aren't in the 2308 ;; check location of the points, give error if they aren't in the
2320 ;; differences 2309 ;; differences
2321 (if (or (< A-point (aref old-diff 0)) 2310 (if (or (< A-point (aref old-diff 0))
2392 (while (> size 0) 2381 (while (> size 0)
2393 (setq success t) 2382 (setq success t)
2394 (while success 2383 (while success
2395 (setq size (min size (- bottom-a top-a) (- bottom-b top-b) 2384 (setq size (min size (- bottom-a top-a) (- bottom-b top-b)
2396 (- bottom-m top-m))) 2385 (- bottom-m top-m)))
2397 (setq sa (emerge-eval-in-buffer emerge-A-buffer 2386 (setq sa (with-current-buffer emerge-A-buffer
2398 (buffer-substring top-a 2387 (buffer-substring top-a
2399 (+ size top-a)))) 2388 (+ size top-a))))
2400 (setq sb (emerge-eval-in-buffer emerge-B-buffer 2389 (setq sb (with-current-buffer emerge-B-buffer
2401 (buffer-substring top-b 2390 (buffer-substring top-b
2402 (+ size top-b)))) 2391 (+ size top-b))))
2403 (setq sm (buffer-substring top-m (+ size top-m))) 2392 (setq sm (buffer-substring top-m (+ size top-m)))
2404 (setq success (and (> size 0) (equal sa sb) (equal sb sm))) 2393 (setq success (and (> size 0) (equal sa sb) (equal sb sm)))
2405 (if success 2394 (if success
2406 (setq top-a (+ top-a size) 2395 (setq top-a (+ top-a size)
2407 top-b (+ top-b size) 2396 top-b (+ top-b size)
2414 (while (> size 0) 2403 (while (> size 0)
2415 (setq success t) 2404 (setq success t)
2416 (while success 2405 (while success
2417 (setq size (min size (- bottom-a top-a) (- bottom-b top-b) 2406 (setq size (min size (- bottom-a top-a) (- bottom-b top-b)
2418 (- bottom-m top-m))) 2407 (- bottom-m top-m)))
2419 (setq sa (emerge-eval-in-buffer emerge-A-buffer 2408 (setq sa (with-current-buffer emerge-A-buffer
2420 (buffer-substring (- bottom-a size) 2409 (buffer-substring (- bottom-a size)
2421 bottom-a))) 2410 bottom-a)))
2422 (setq sb (emerge-eval-in-buffer emerge-B-buffer 2411 (setq sb (with-current-buffer emerge-B-buffer
2423 (buffer-substring (- bottom-b size) 2412 (buffer-substring (- bottom-b size)
2424 bottom-b))) 2413 bottom-b)))
2425 (setq sm (buffer-substring (- bottom-m size) bottom-m)) 2414 (setq sm (buffer-substring (- bottom-m size) bottom-m))
2426 (setq success (and (> size 0) (equal sa sb) (equal sb sm))) 2415 (setq success (and (> size 0) (equal sa sb) (equal sb sm)))
2427 (if success 2416 (if success
2428 (setq bottom-a (- bottom-a size) 2417 (setq bottom-a (- bottom-a size)
2429 bottom-b (- bottom-b size) 2418 bottom-b (- bottom-b size)
2430 bottom-m (- bottom-m size)))) 2419 bottom-m (- bottom-m size))))
2431 (setq size (/ size 2))) 2420 (setq size (/ size 2)))
2432 ;; {top,bottom}-{a,b,m} are now set at the new beginnings and ends 2421 ;; {top,bottom}-{a,b,m} are now set at the new beginnings and ends
2433 ;; of the difference regions. Move them to the beginning of lines, as 2422 ;; of the difference regions. Move them to the beginning of lines, as
2434 ;; appropriate. 2423 ;; appropriate.
2435 (emerge-eval-in-buffer emerge-A-buffer 2424 (with-current-buffer emerge-A-buffer
2436 (goto-char top-a) 2425 (goto-char top-a)
2437 (beginning-of-line) 2426 (beginning-of-line)
2438 (aset diff 0 (point-marker)) 2427 (aset diff 0 (point-marker))
2439 (goto-char bottom-a) 2428 (goto-char bottom-a)
2440 (beginning-of-line 2) 2429 (beginning-of-line 2)
2441 (aset diff 1 (point-marker))) 2430 (aset diff 1 (point-marker)))
2442 (emerge-eval-in-buffer emerge-B-buffer 2431 (with-current-buffer emerge-B-buffer
2443 (goto-char top-b) 2432 (goto-char top-b)
2444 (beginning-of-line) 2433 (beginning-of-line)
2445 (aset diff 2 (point-marker)) 2434 (aset diff 2 (point-marker))
2446 (goto-char bottom-b) 2435 (goto-char bottom-b)
2447 (beginning-of-line 2) 2436 (beginning-of-line 2)
2448 (aset diff 3 (point-marker))) 2437 (aset diff 3 (point-marker)))
2449 (goto-char top-m) 2438 (goto-char top-m)
2450 (beginning-of-line) 2439 (beginning-of-line)
2451 (aset diff 4 (point-marker)) 2440 (aset diff 4 (point-marker))
2452 (goto-char bottom-m) 2441 (goto-char bottom-m)
2453 (beginning-of-line 2) 2442 (beginning-of-line 2)
2488 the nearest previous difference." 2477 the nearest previous difference."
2489 (interactive "P") 2478 (interactive "P")
2490 ;; search for the point in the A buffer, using the markers 2479 ;; search for the point in the A buffer, using the markers
2491 ;; for the beginning and end of the differences in the A buffer 2480 ;; for the beginning and end of the differences in the A buffer
2492 (emerge-find-difference1 arg 2481 (emerge-find-difference1 arg
2493 (emerge-eval-in-buffer emerge-A-buffer (point)) 2482 (with-current-buffer emerge-A-buffer (point))
2494 0 1)) 2483 0 1))
2495 2484
2496 (defun emerge-find-difference-B (arg) 2485 (defun emerge-find-difference-B (arg)
2497 "Find the difference containing point, in the B buffer. 2486 "Find the difference containing point, in the B buffer.
2498 This command must be executed in the merge buffer. 2487 This command must be executed in the merge buffer.
2501 the nearest previous difference." 2490 the nearest previous difference."
2502 (interactive "P") 2491 (interactive "P")
2503 ;; search for the point in the B buffer, using the markers 2492 ;; search for the point in the B buffer, using the markers
2504 ;; for the beginning and end of the differences in the B buffer 2493 ;; for the beginning and end of the differences in the B buffer
2505 (emerge-find-difference1 arg 2494 (emerge-find-difference1 arg
2506 (emerge-eval-in-buffer emerge-B-buffer (point)) 2495 (with-current-buffer emerge-B-buffer (point))
2507 2 3)) 2496 2 3))
2508 2497
2509 (defun emerge-find-difference1 (arg location begin end) 2498 (defun emerge-find-difference1 (arg location begin end)
2510 (let* ((index 2499 (let* ((index
2511 ;; find first difference containing or after the current position 2500 ;; find first difference containing or after the current position
2552 (and (>= emerge-current-difference 0) 2541 (and (>= emerge-current-difference 0)
2553 (< emerge-current-difference emerge-number-of-differences))) 2542 (< emerge-current-difference emerge-number-of-differences)))
2554 (diff (and valid-diff 2543 (diff (and valid-diff
2555 (aref emerge-difference-list emerge-current-difference))) 2544 (aref emerge-difference-list emerge-current-difference)))
2556 (merge-line (emerge-line-number-in-buf 4 5)) 2545 (merge-line (emerge-line-number-in-buf 4 5))
2557 (A-line (emerge-eval-in-buffer emerge-A-buffer 2546 (A-line (with-current-buffer emerge-A-buffer
2558 (emerge-line-number-in-buf 0 1))) 2547 (emerge-line-number-in-buf 0 1)))
2559 (B-line (emerge-eval-in-buffer emerge-B-buffer 2548 (B-line (with-current-buffer emerge-B-buffer
2560 (emerge-line-number-in-buf 2 3)))) 2549 (emerge-line-number-in-buf 2 3))))
2561 (message "At lines: merge = %d, A = %d, B = %d" 2550 (message "At lines: merge = %d, A = %d, B = %d"
2562 merge-line A-line B-line))) 2551 merge-line A-line B-line)))
2563 2552
2564 (defun emerge-line-number-in-buf (begin-marker end-marker) 2553 (defun emerge-line-number-in-buf (begin-marker end-marker)
2565 (let (temp) 2554 (let (temp)
2636 (emerge-select-version force operate operate operate))) 2625 (emerge-select-version force operate operate operate)))
2637 2626
2638 (defun emerge-combine-versions-edit (merge-begin merge-end 2627 (defun emerge-combine-versions-edit (merge-begin merge-end
2639 A-begin A-end B-begin B-end 2628 A-begin A-end B-begin B-end
2640 template) 2629 template)
2641 (emerge-eval-in-buffer 2630 (with-current-buffer
2642 emerge-merge-buffer 2631 emerge-merge-buffer
2643 (delete-region merge-begin merge-end) 2632 (delete-region merge-begin merge-end)
2644 (goto-char merge-begin) 2633 (goto-char merge-begin)
2645 (let ((i 0)) 2634 (let ((i 0))
2646 (while (< i (length template)) 2635 (while (< i (length template))
2647 (let ((c (aref template i))) 2636 (let ((c (aref template i)))
2648 (if (= c ?%) 2637 (if (= c ?%)
2649 (progn 2638 (progn
2650 (setq i (1+ i)) 2639 (setq i (1+ i))
2651 (setq c 2640 (setq c
2652 (condition-case nil 2641 (condition-case nil
2653 (aref template i) 2642 (aref template i)
2654 (error ?%))) 2643 (error ?%)))
2655 (cond ((= c ?a) 2644 (cond ((= c ?a)
2656 (insert-buffer-substring emerge-A-buffer A-begin A-end)) 2645 (insert-buffer-substring emerge-A-buffer A-begin A-end))
2657 ((= c ?b) 2646 ((= c ?b)
2658 (insert-buffer-substring emerge-B-buffer B-begin B-end)) 2647 (insert-buffer-substring emerge-B-buffer B-begin B-end))
2659 ((= c ?%) 2648 ((= c ?%)
2660 (insert ?%)) 2649 (insert ?%))
2661 (t 2650 (t
2662 (insert c)))) 2651 (insert c))))
2663 (insert c))) 2652 (insert c)))
2664 (setq i (1+ i)))) 2653 (setq i (1+ i))))
2665 (goto-char merge-begin) 2654 (goto-char merge-begin)
2666 (aset diff-vector 6 'combined) 2655 (aset diff-vector 6 'combined)
2667 (emerge-refresh-mode-line))) 2656 (emerge-refresh-mode-line)))
2668 2657
2669 (defun emerge-set-merge-mode (mode) 2658 (defun emerge-set-merge-mode (mode)
2670 "Set the major mode in a merge buffer. 2659 "Set the major mode in a merge buffer.
2671 Overrides any change that the mode might make to the mode line or local 2660 Overrides any change that the mode might make to the mode line or local
2672 keymap. Leaves merge in fast mode." 2661 keymap. Leaves merge in fast mode."
2697 (run-hooks 'emerge-select-hook)) 2686 (run-hooks 'emerge-select-hook))
2698 2687
2699 (defun emerge-place-flags-in-buffer (buffer difference before-index 2688 (defun emerge-place-flags-in-buffer (buffer difference before-index
2700 after-index) 2689 after-index)
2701 (if buffer 2690 (if buffer
2702 (emerge-eval-in-buffer 2691 (with-current-buffer
2703 buffer 2692 buffer
2704 (emerge-place-flags-in-buffer1 difference before-index after-index)) 2693 (emerge-place-flags-in-buffer1 difference before-index after-index))
2705 (emerge-place-flags-in-buffer1 difference before-index after-index))) 2694 (emerge-place-flags-in-buffer1 difference before-index after-index)))
2706 2695
2707 (defun emerge-place-flags-in-buffer1 (difference before-index after-index) 2696 (defun emerge-place-flags-in-buffer1 (difference before-index after-index)
2708 (if (and emerge-xemacs-p (not emerge-mark-with-text)) 2697 (if (and emerge-xemacs-p (not emerge-mark-with-text))
2709 ;; XEmacs highlights the difference 2698 ;; XEmacs highlights the difference
2790 (defun emerge-remove-flags-in-buffer (buffer before after) 2779 (defun emerge-remove-flags-in-buffer (buffer before after)
2791 (if (and emerge-xemacs-p (not emerge-mark-with-text)) 2780 (if (and emerge-xemacs-p (not emerge-mark-with-text))
2792 ;; XEmacs -- remove highlighting 2781 ;; XEmacs -- remove highlighting
2793 (emerge-remove-flags-in-buffer-xemacs buffer before after) 2782 (emerge-remove-flags-in-buffer-xemacs buffer before after)
2794 ;; Else remove character flags 2783 ;; Else remove character flags
2795 (emerge-eval-in-buffer 2784 (with-current-buffer
2796 buffer 2785 buffer
2797 (let ((buffer-read-only nil)) 2786 (let ((buffer-read-only nil))
2798 ;; remove the flags, if they're there 2787 ;; remove the flags, if they're there
2799 (goto-char (- before (1- emerge-before-flag-length))) 2788 (goto-char (- before (1- emerge-before-flag-length)))
2800 (if (looking-at emerge-before-flag-match) 2789 (if (looking-at emerge-before-flag-match)
2801 (delete-char emerge-before-flag-length) 2790 (delete-char emerge-before-flag-length)
2802 ;; the flag isn't there 2791 ;; the flag isn't there
2803 (ding) 2792 (ding)
2804 (message "Trouble removing flag")) 2793 (message "Trouble removing flag"))
2805 (goto-char (1- after)) 2794 (goto-char (1- after))
2806 (if (looking-at emerge-after-flag-match) 2795 (if (looking-at emerge-after-flag-match)
2807 (delete-char emerge-after-flag-length) 2796 (delete-char emerge-after-flag-length)
2808 ;; the flag isn't there 2797 ;; the flag isn't there
2809 (ding) 2798 (ding)
2810 (message "Trouble removing flag")))))) 2799 (message "Trouble removing flag"))))))
2811 2800
2812 (defun emerge-remove-flags-in-buffer-xemacs (buffer before after) 2801 (defun emerge-remove-flags-in-buffer-xemacs (buffer before after)
2813 (map-extents (function (lambda (x y) 2802 (map-extents (function (lambda (x y)
2814 (if (extent-property x 'emerge) 2803 (if (extent-property x 'emerge)
2815 (delete-extent x)))) 2804 (delete-extent x))))
2947 nil 2936 nil
2948 (catch 'exit 2937 (catch 'exit
2949 (while (< x-begin x-end) 2938 (while (< x-begin x-end)
2950 ;; bite off and compare no more than 1000 characters at a time 2939 ;; bite off and compare no more than 1000 characters at a time
2951 (let* ((compare-length (min (- x-end x-begin) 1000)) 2940 (let* ((compare-length (min (- x-end x-begin) 1000))
2952 (x-string (emerge-eval-in-buffer 2941 (x-string (with-current-buffer
2953 buffer-x 2942 buffer-x
2954 (buffer-substring x-begin 2943 (buffer-substring x-begin
2955 (+ x-begin compare-length)))) 2944 (+ x-begin compare-length))))
2956 (y-string (emerge-eval-in-buffer 2945 (y-string (with-current-buffer
2957 buffer-y 2946 buffer-y
2958 (buffer-substring y-begin 2947 (buffer-substring y-begin
2959 (+ y-begin compare-length))))) 2948 (+ y-begin compare-length)))))
2960 (if (not (string-equal x-string y-string)) 2949 (if (not (string-equal x-string y-string))
2961 (throw 'exit nil) 2950 (throw 'exit nil)
2962 (setq x-begin (+ x-begin compare-length)) 2951 (setq x-begin (+ x-begin compare-length))
2963 (setq y-begin (+ y-begin compare-length))))) 2952 (setq y-begin (+ y-begin compare-length)))))
2964 t))) 2953 t)))
3089 3078
3090 ;; Set up the mode in the current buffer to duplicate the mode in another 3079 ;; Set up the mode in the current buffer to duplicate the mode in another
3091 ;; buffer. 3080 ;; buffer.
3092 (defun emerge-copy-modes (buffer) 3081 (defun emerge-copy-modes (buffer)
3093 ;; Set the major mode 3082 ;; Set the major mode
3094 (funcall (emerge-eval-in-buffer buffer major-mode))) 3083 (funcall (with-current-buffer buffer major-mode)))
3095 3084
3096 ;; Define a key, even if a prefix of it is defined 3085 ;; Define a key, even if a prefix of it is defined
3097 (defun emerge-force-define-key (keymap key definition) 3086 (defun emerge-force-define-key (keymap key definition)
3098 "Like `define-key', but forcibly creates prefix characters as needed. 3087 "Like `define-key', but forcibly creates prefix characters as needed.
3099 If some prefix of KEY has a non-prefix definition, it is redefined." 3088 If some prefix of KEY has a non-prefix definition, it is redefined."