comparison lisp/ediff-init.el @ 19047:f90d40b0bff5

new version

19046:689f3dc973f9

;; Ancestor buffer
(ediff-defvar-local ediff-ancestor-buffer nil "")
;; The Ediff control buffer
(ediff-defvar-local ediff-control-buffer nil "")

;;; Macros
(defmacro ediff-odd-p (arg)
  (` (eq (logand (, arg) 1) 1)))

(defmacro ediff-buffer-live-p (buf)

  (` (cond ((memq (, arg) '(?a ?A)) 'A)
	   ((memq (, arg) '(?b ?B)) 'B)
	   ((memq (, arg) '(?c ?C)) 'C)
	   )
  ))
  
(defmacro ediff-get-difference (n buf-type)
  (` (aref
      (symbol-value
       (intern (format "ediff-difference-vector-%S" (, buf-type)))) (, n))))
  
;; Tell if it has been previously determined that the region has
;; no diffs other than the white space and newlines
;; The argument, N, is the diff region number used by Ediff to index the
;; diff vector. It is 1 less than the number seen by the user.

  
(defmacro ediff-get-fine-diff-vector (n buf-type)
  (` (ediff-get-fine-diff-vector-from-diff-record
      (ediff-get-difference (, n) (, buf-type)))))
  
;; Macro to switch to BUFFER, evaluate FORMS, returns to original buffer.
;; Differs from `save-excursion' in that it doesn't save the point and mark.
;; This is essentially `emerge-eval-in-buffer' with the test for live buffers."
(defmacro ediff-eval-in-buffer (buffer &rest forms)
  (` (let ((StartBuffer (current-buffer)))
       (if (ediff-buffer-live-p (, buffer))
	   (unwind-protect
	       (progn
		 (set-buffer (, buffer))
		 (,@ forms))
	     (set-buffer StartBuffer))
	 (or (eq this-command 'ediff-quit)
	     (error ediff-KILLED-VITAL-BUFFER))
	 ))))
	 

(defsubst ediff-multiframe-setup-p ()
  (and (ediff-window-display-p) ediff-multiframe))
			 
(defmacro ediff-narrow-control-frame-p ()

;; The original values of ediff-protected-variables for buffer C
(ediff-defvar-local ediff-buffer-values-orig-C nil "")
;; The original values of ediff-protected-variables for buffer Ancestor
(ediff-defvar-local ediff-buffer-values-orig-Ancestor nil "")

;; Buffer-local variables to be saved then restored during Ediff sessions
(defconst ediff-protected-variables '(
				      ;;buffer-read-only 
				      mode-line-format))

;; different from the other two (used only in 3-way jobs.
(ediff-defvar-local ediff-difference-vector-A nil "")
(ediff-defvar-local ediff-difference-vector-B nil "")
(ediff-defvar-local ediff-difference-vector-C nil "")
(ediff-defvar-local ediff-difference-vector-Ancestor nil "")

;; [ status status status ...]
;; Each status: [state-of-merge state-of-ancestor]
;; state-of-merge is default-A, default-B, prefer-A, or prefer-B. It
;; indicates the way a diff region was created in buffer C.

      (fset 'ediff-display-pixel-width 
	    (symbol-function 'x-display-pixel-width))
      (fset 'ediff-display-pixel-height
	    (symbol-function 'x-display-pixel-height))))
      

(defun ediff-make-current-diff-overlay (type)
  (if (ediff-has-face-support-p)
      (let ((overlay (intern (format "ediff-current-diff-overlay-%S" type)))
	    (buffer (ediff-get-buffer type))
	    (face (face-name
		   (symbol-value
		    (intern (format "ediff-current-diff-face-%S" type))))))
	(set overlay
	     (ediff-make-bullet-proof-overlay (point-max) (point-max) buffer))
	(ediff-set-overlay-face (symbol-value overlay) face)
	(ediff-overlay-put (symbol-value overlay) 'ediff ediff-control-buffer))
    ))

	       'ediff-even-diff-face-C 'ediff-even-diff-face-Ancestor)
	      (ediff-set-face-pixmap 'ediff-even-diff-face-Ancestor
				     ediff-even-diff-pixmap)))
	'ediff-even-diff-face-Ancestor))
  "Face highlighting even-numbered differences in the ancestor buffer.")
  
(defvar ediff-odd-diff-face-A
  (if (ediff-has-face-support-p)
      (progn
	(make-face 'ediff-odd-diff-face-A)
	(ediff-hide-face 'ediff-odd-diff-face-A)

	      (ediff-set-face-pixmap 'ediff-odd-diff-face-Ancestor
				     ediff-odd-diff-pixmap)))
	'ediff-odd-diff-face-Ancestor))
  "Face used to highlight even-numbered differences in the ancestor buffer.")

;; Help echo
(put 'ediff-fine-diff-face-A 'ediff-help-echo
     "A `refinement' of the current difference region")
(put 'ediff-fine-diff-face-B 'ediff-help-echo
     "A `refinement' of the current difference region")

  "Overlay for the current difference region in buffer B.")
(ediff-defvar-local ediff-current-diff-overlay-C nil
  "Overlay for the current difference region in buffer C.")
(ediff-defvar-local ediff-current-diff-overlay-Ancestor nil
  "Overlay for the current difference region in the ancestor buffer.")
  
;; Compute priority of ediff overlay.
(defun ediff-highest-priority (start end buffer)
  (let ((pos (max 1 (1- start)))
	ovr-list)
    (if ediff-xemacs-p
	(1+ ediff-shadow-overlay-priority)
      (ediff-eval-in-buffer buffer
	(while (< pos (min (point-max) (1+ end)))
	  (setq ovr-list (append (overlays-at pos) ovr-list))
	  (setq pos (next-overlay-change pos)))
	(1+ (apply '+
		   (mapcar (function

      (kill-buffer (get-buffer buf))))

(defsubst ediff-background-face (buf-type dif-num)
  ;; The value of dif-num is always 1- the one that user sees.
  ;; This is why even face is used when dif-num is odd.
  (intern (format (if (ediff-odd-p dif-num)
		      "ediff-even-diff-face-%S"
		    "ediff-odd-diff-face-%S")
		  buf-type)))


;; activate faces on diff regions in buffer
(defun ediff-paint-background-regions-in-one-buffer (buf-type unhighlight)
  (let ((diff-vector 
	 (eval (intern (format "ediff-difference-vector-%S" buf-type))))
	overl diff-num)
    (mapcar (function
	     (lambda (rec)
	       (setq overl (ediff-get-diff-overlay-from-diff-record rec)
		     diff-num (ediff-overlay-get overl 'ediff-diff-num))

   'Ancestor unhighlight))

(defun ediff-highlight-diff-in-one-buffer (n buf-type)
  (if (ediff-buffer-live-p (ediff-get-buffer buf-type))
      (let* ((buff (ediff-get-buffer buf-type))
	     (last (ediff-eval-in-buffer buff (point-max)))
	     (begin (ediff-get-diff-posn buf-type 'beg n))
	     (end (ediff-get-diff-posn buf-type 'end n))
	     (xtra (if (equal begin end) 1 0))
	     (end-hilit (min last (+ end xtra)))
	     (current-diff-overlay 
	      (symbol-value
	       (intern (format "ediff-current-diff-overlay-%S" buf-type)))))
	
	(if ediff-xemacs-p
	    (ediff-move-overlay current-diff-overlay begin end-hilit)
	  (ediff-move-overlay current-diff-overlay begin end-hilit buff))
	(ediff-overlay-put current-diff-overlay 'priority  

(defun ediff-unhighlight-diff-in-one-buffer (buf-type)
  (if (ediff-buffer-live-p (ediff-get-buffer buf-type))
      (let ((current-diff-overlay 
	     (symbol-value
	      (intern (format "ediff-current-diff-overlay-%S" buf-type))))
	    (overlay
	     (ediff-get-diff-overlay ediff-current-difference buf-type))
	    )
    
	(ediff-move-overlay current-diff-overlay 1 1)

(defun ediff-unhighlight-diffs-totally-in-one-buffer (buf-type)
  (ediff-unselect-and-select-difference -1)
  (if (and (ediff-has-face-support-p) ediff-use-faces)
      (let* ((inhibit-quit t)
	     (current-diff-overlay-var
	      (intern (format "ediff-current-diff-overlay-%S" buf-type)))
	     (current-diff-overlay (symbol-value current-diff-overlay-var)))
	(ediff-paint-background-regions 'unhighlight)
	(if (ediff-overlayp current-diff-overlay)
	    (ediff-delete-overlay current-diff-overlay))
	(set current-diff-overlay-var nil)

(defun ediff-whitespace-diff-region-p (n buf-type)
  (or (and (eq buf-type 'C) (not ediff-3way-job))
      (ediff-empty-diff-region-p n buf-type)
      (let ((beg (ediff-get-diff-posn buf-type 'beg n))
	    (end (ediff-get-diff-posn buf-type 'end n)))
	(ediff-eval-in-buffer (ediff-get-buffer buf-type)
	  (save-excursion
	    (goto-char beg)
	    (skip-chars-forward ediff-whitespace)
	    (>= (point) end))))))
	    

	   str))))
  

    
(defsubst ediff-get-region-contents (n buf-type ctrl-buf &optional start end)
  (ediff-eval-in-buffer 
      (ediff-eval-in-buffer ctrl-buf (ediff-get-buffer buf-type))
    (buffer-substring
     (or start (ediff-get-diff-posn buf-type 'beg n ctrl-buf))
     (or end (ediff-get-diff-posn buf-type 'end n ctrl-buf)))))
  
;; If ediff modified mode line, strip the modification

    fname))


;;; Local Variables:
;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun)
;;; eval: (put 'ediff-eval-in-buffer 'lisp-indent-hook 1)
;;; eval: (put 'ediff-eval-in-buffer 'edebug-form-spec '(form body))
;;; End:
     
(provide 'ediff-init)

19047:f90d40b0bff5

;; Ancestor buffer
(ediff-defvar-local ediff-ancestor-buffer nil "")
;; The Ediff control buffer
(ediff-defvar-local ediff-control-buffer nil "")


;; Association between buff-type and ediff-buffer-*
(defconst ediff-buffer-alist
  '((?A . ediff-buffer-A)
    (?B . ediff-buffer-B)
    (?C . ediff-buffer-C)))

;;; Macros
(defmacro ediff-odd-p (arg)
  (` (eq (logand (, arg) 1) 1)))

(defmacro ediff-buffer-live-p (buf)

  (` (cond ((memq (, arg) '(?a ?A)) 'A)
	   ((memq (, arg) '(?b ?B)) 'B)
	   ((memq (, arg) '(?c ?C)) 'C)
	   )
  ))

;; A-list is supposed to be of the form (A . symb) (B . symb)...)
;; where the first part of any association is a buffer type and the second is
;; an appropriate symbol. Given buffer-type, this function returns the
;; symbol. This is used to avoid using `intern'
(defsubst ediff-get-symbol-from-alist (buf-type alist)
  (cdr (assoc buf-type alist)))
  
(defconst ediff-difference-vector-alist
  '((A . ediff-difference-vector-A)
    (B . ediff-difference-vector-B)
    (C . ediff-difference-vector-C)
    (Ancestor . ediff-difference-vector-Ancestor)))

(defmacro ediff-get-difference (n buf-type)
  (` (aref
      (symbol-value
       (ediff-get-symbol-from-alist
	(, buf-type) ediff-difference-vector-alist))
      (, n))))
  
;; Tell if it has been previously determined that the region has
;; no diffs other than the white space and newlines
;; The argument, N, is the diff region number used by Ediff to index the
;; diff vector. It is 1 less than the number seen by the user.

  
(defmacro ediff-get-fine-diff-vector (n buf-type)
  (` (ediff-get-fine-diff-vector-from-diff-record
      (ediff-get-difference (, n) (, buf-type)))))
  
;; Macro to switch to BUFFER, evaluate BODY, returns to original buffer.
;; Doesn't save the point and mark.
;; This is `with-current-buffer' with the added test for live buffers."
(defmacro ediff-with-current-buffer (buffer &rest body)
  (` (if (ediff-buffer-live-p (, buffer))
       (save-current-buffer
	 (set-buffer (, buffer))
	 (,@ body))
     (or (eq this-command 'ediff-quit)
	 (error ediff-KILLED-VITAL-BUFFER))
     )))
     

(defsubst ediff-multiframe-setup-p ()
  (and (ediff-window-display-p) ediff-multiframe))
			 
(defmacro ediff-narrow-control-frame-p ()

;; The original values of ediff-protected-variables for buffer C
(ediff-defvar-local ediff-buffer-values-orig-C nil "")
;; The original values of ediff-protected-variables for buffer Ancestor
(ediff-defvar-local ediff-buffer-values-orig-Ancestor nil "")

;; association between buff-type and ediff-buffer-values-orig-*
(defconst ediff-buffer-values-orig-alist
  '((A . ediff-buffer-values-orig-A)
    (B . ediff-buffer-values-orig-B)
    (C . ediff-buffer-values-orig-C)
    (Ancestor . ediff-buffer-values-orig-Ancestor)))

;; Buffer-local variables to be saved then restored during Ediff sessions
(defconst ediff-protected-variables '(
				      ;;buffer-read-only 
				      mode-line-format))

;; different from the other two (used only in 3-way jobs.
(ediff-defvar-local ediff-difference-vector-A nil "")
(ediff-defvar-local ediff-difference-vector-B nil "")
(ediff-defvar-local ediff-difference-vector-C nil "")
(ediff-defvar-local ediff-difference-vector-Ancestor nil "")
;; A-list of diff vector types associated with buffer types
(defconst ediff-difference-vector-alist
  '((A . ediff-difference-vector-A)
    (B . ediff-difference-vector-B)
    (C . ediff-difference-vector-C)
    (Ancestor . ediff-difference-vector-Ancestor)))

;; [ status status status ...]
;; Each status: [state-of-merge state-of-ancestor]
;; state-of-merge is default-A, default-B, prefer-A, or prefer-B. It
;; indicates the way a diff region was created in buffer C.

      (fset 'ediff-display-pixel-width 
	    (symbol-function 'x-display-pixel-width))
      (fset 'ediff-display-pixel-height
	    (symbol-function 'x-display-pixel-height))))
      
;; A-list of current-diff-overlay symbols asssociated with buf types
(defconst ediff-current-diff-overlay-alist
  '((A . ediff-current-diff-overlay-A)
    (B . ediff-current-diff-overlay-B)
    (C . ediff-current-diff-overlay-C)
    (Ancestor . ediff-current-diff-overlay-Ancestor)))
  
;; A-list of current-diff-face-* symbols asssociated with buf types
(defconst ediff-current-diff-face-alist
  '((A . ediff-current-diff-face-A)
    (B . ediff-current-diff-face-B)
    (C . ediff-current-diff-face-C)
    (Ancestor . ediff-current-diff-face-Ancestor)))
  

(defun ediff-make-current-diff-overlay (type)
  (if (ediff-has-face-support-p)
      (let ((overlay (ediff-get-symbol-from-alist
		      type ediff-current-diff-overlay-alist))
	    (buffer (ediff-get-buffer type))
	    (face (face-name
		   (symbol-value
		    (ediff-get-symbol-from-alist
		     type ediff-current-diff-face-alist)))))
	(set overlay
	     (ediff-make-bullet-proof-overlay (point-max) (point-max) buffer))
	(ediff-set-overlay-face (symbol-value overlay) face)
	(ediff-overlay-put (symbol-value overlay) 'ediff ediff-control-buffer))
    ))

	       'ediff-even-diff-face-C 'ediff-even-diff-face-Ancestor)
	      (ediff-set-face-pixmap 'ediff-even-diff-face-Ancestor
				     ediff-even-diff-pixmap)))
	'ediff-even-diff-face-Ancestor))
  "Face highlighting even-numbered differences in the ancestor buffer.")

;; Association between buffer types and even-diff-face symbols
(defconst ediff-even-diff-face-alist
  '((A . ediff-even-diff-face-A)
    (B . ediff-even-diff-face-B)
    (C . ediff-even-diff-face-C)
    (Ancestor . ediff-even-diff-face-Ancestor)))

(defvar ediff-odd-diff-face-A
  (if (ediff-has-face-support-p)
      (progn
	(make-face 'ediff-odd-diff-face-A)
	(ediff-hide-face 'ediff-odd-diff-face-A)

	      (ediff-set-face-pixmap 'ediff-odd-diff-face-Ancestor
				     ediff-odd-diff-pixmap)))
	'ediff-odd-diff-face-Ancestor))
  "Face used to highlight even-numbered differences in the ancestor buffer.")

;; Association between buffer types and odd-diff-face symbols
(defconst ediff-odd-diff-face-alist
  '((A . ediff-odd-diff-face-A)
    (B . ediff-odd-diff-face-B)
    (C . ediff-odd-diff-face-C)
    (Ancestor . ediff-odd-diff-face-Ancestor)))
  
;; A-list of fine-diff face symbols associated with buffer types
(defconst ediff-fine-diff-face-alist
  '((A . ediff-fine-diff-face-A)
    (B . ediff-fine-diff-face-B)
    (C . ediff-fine-diff-face-C)
    (Ancestor . ediff-fine-diff-face-Ancestor)))

;; Help echo
(put 'ediff-fine-diff-face-A 'ediff-help-echo
     "A `refinement' of the current difference region")
(put 'ediff-fine-diff-face-B 'ediff-help-echo
     "A `refinement' of the current difference region")

  "Overlay for the current difference region in buffer B.")
(ediff-defvar-local ediff-current-diff-overlay-C nil
  "Overlay for the current difference region in buffer C.")
(ediff-defvar-local ediff-current-diff-overlay-Ancestor nil
  "Overlay for the current difference region in the ancestor buffer.")

;; Compute priority of ediff overlay.
(defun ediff-highest-priority (start end buffer)
  (let ((pos (max 1 (1- start)))
	ovr-list)
    (if ediff-xemacs-p
	(1+ ediff-shadow-overlay-priority)
      (ediff-with-current-buffer buffer
	(while (< pos (min (point-max) (1+ end)))
	  (setq ovr-list (append (overlays-at pos) ovr-list))
	  (setq pos (next-overlay-change pos)))
	(1+ (apply '+
		   (mapcar (function

      (kill-buffer (get-buffer buf))))

(defsubst ediff-background-face (buf-type dif-num)
  ;; The value of dif-num is always 1- the one that user sees.
  ;; This is why even face is used when dif-num is odd.
  (ediff-get-symbol-from-alist
   buf-type (if (ediff-odd-p dif-num)
		ediff-even-diff-face-alist
	      ediff-odd-diff-face-alist)
   ))


;; activate faces on diff regions in buffer
(defun ediff-paint-background-regions-in-one-buffer (buf-type unhighlight)
  (let ((diff-vector 
	 (eval (ediff-get-symbol-from-alist
		buf-type ediff-difference-vector-alist)))
	overl diff-num)
    (mapcar (function
	     (lambda (rec)
	       (setq overl (ediff-get-diff-overlay-from-diff-record rec)
		     diff-num (ediff-overlay-get overl 'ediff-diff-num))

   'Ancestor unhighlight))

(defun ediff-highlight-diff-in-one-buffer (n buf-type)
  (if (ediff-buffer-live-p (ediff-get-buffer buf-type))
      (let* ((buff (ediff-get-buffer buf-type))
	     (last (ediff-with-current-buffer buff (point-max)))
	     (begin (ediff-get-diff-posn buf-type 'beg n))
	     (end (ediff-get-diff-posn buf-type 'end n))
	     (xtra (if (equal begin end) 1 0))
	     (end-hilit (min last (+ end xtra)))
	     (current-diff-overlay 
	      (symbol-value
	       (ediff-get-symbol-from-alist
		buf-type ediff-current-diff-overlay-alist))))
	
	(if ediff-xemacs-p
	    (ediff-move-overlay current-diff-overlay begin end-hilit)
	  (ediff-move-overlay current-diff-overlay begin end-hilit buff))
	(ediff-overlay-put current-diff-overlay 'priority  

(defun ediff-unhighlight-diff-in-one-buffer (buf-type)
  (if (ediff-buffer-live-p (ediff-get-buffer buf-type))
      (let ((current-diff-overlay 
	     (symbol-value
	      (ediff-get-symbol-from-alist
	       buf-type ediff-current-diff-overlay-alist)))
	    (overlay
	     (ediff-get-diff-overlay ediff-current-difference buf-type))
	    )
    
	(ediff-move-overlay current-diff-overlay 1 1)

(defun ediff-unhighlight-diffs-totally-in-one-buffer (buf-type)
  (ediff-unselect-and-select-difference -1)
  (if (and (ediff-has-face-support-p) ediff-use-faces)
      (let* ((inhibit-quit t)
	     (current-diff-overlay-var
	      (ediff-get-symbol-from-alist
	       buf-type ediff-current-diff-overlay-alist))
	     (current-diff-overlay (symbol-value current-diff-overlay-var)))
	(ediff-paint-background-regions 'unhighlight)
	(if (ediff-overlayp current-diff-overlay)
	    (ediff-delete-overlay current-diff-overlay))
	(set current-diff-overlay-var nil)

(defun ediff-whitespace-diff-region-p (n buf-type)
  (or (and (eq buf-type 'C) (not ediff-3way-job))
      (ediff-empty-diff-region-p n buf-type)
      (let ((beg (ediff-get-diff-posn buf-type 'beg n))
	    (end (ediff-get-diff-posn buf-type 'end n)))
	(ediff-with-current-buffer (ediff-get-buffer buf-type)
	  (save-excursion
	    (goto-char beg)
	    (skip-chars-forward ediff-whitespace)
	    (>= (point) end))))))
	    

	   str))))
  

    
(defsubst ediff-get-region-contents (n buf-type ctrl-buf &optional start end)
  (ediff-with-current-buffer 
      (ediff-with-current-buffer ctrl-buf (ediff-get-buffer buf-type))
    (buffer-substring
     (or start (ediff-get-diff-posn buf-type 'beg n ctrl-buf))
     (or end (ediff-get-diff-posn buf-type 'end n ctrl-buf)))))
  
;; If ediff modified mode line, strip the modification

    fname))


;;; Local Variables:
;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun)
;;; eval: (put 'ediff-with-current-buffer 'lisp-indent-hook 1)
;;; eval: (put 'ediff-with-current-buffer 'edebug-form-spec '(form body))
;;; End:
     
(provide 'ediff-init)