comparison lisp/ediff-init.el @ 42602:633233bf2bbf

2002-01-07 Michael Kifer <[e-mail]> * viper-init.el (viper-cond-compile-for-xemacs-or-emacs): new macro that replaces viper-emacs-p and viper-xemacs-p in many cases. Used to reduce the number of warnings. * viper-cmd.el: use viper-cond-compile-for-xemacs-or-emacs. (viper-standard-value): moved here from viper.el. (viper-set-unread-command-events): moved to viper-util.el (viper-check-minibuffer-overlay): make sure viper-minibuffer-overlay is moved to cover the entire input field. * viper-util.el: use viper-cond-compile-for-xemacs-or-emacs. (viper-read-key-sequence, viper-set-unread-command-events, viper-char-symbol-sequence-p, viper-char-array-p): moved here. * viper-ex.el: use viper-cond-compile-for-xemacs-or-emacs. * viper-keym.el: use viper-cond-compile-for-xemacs-or-emacs. * viper-mous.el: use viper-cond-compile-for-xemacs-or-emacs. * viper-macs.el (viper-char-array-p, viper-char-symbol-sequence-p, viper-event-vector-p): moved to viper-util.el * viper.el (viper-standard-value): moved to viper-cmd.el. Use viper-cond-compile-for-xemacs-or-emacs. * ediff-help.el: use ediff-cond-compile-for-xemacs-or-emacs. * ediff-hook.el: use ediff-cond-compile-for-xemacs-or-emacs. * ediff-init.el (ediff-cond-compile-for-xemacs-or-emacs): new macro designed to be used in many places where ediff-emacs-p or ediff-xemacs-p was previously used. Reduces the number of warnings. Use ediff-cond-compile-for-xemacs-or-emacs in many places in lieue of ediff-xemacs-p. (ediff-make-current-diff-overlay, ediff-highlight-diff-in-one-buffer, ediff-convert-fine-diffs-to-overlays, ediff-empty-diff-region-p, ediff-whitespace-diff-region-p, ediff-get-region-contents): moved to ediff-util.el. (ediff-event-key): moved here. * ediff-merge.el: got rid of unreferenced variables. * ediff-mult.el: use ediff-cond-compile-for-xemacs-or-emacs. * ediff-util.el: use ediff-cond-compile-for-xemacs-or-emacs. (ediff-cleanup-mess): improved the way windows are set up after quitting ediff. (ediff-janitor): use ediff-dispose-of-variant-according-to-user. (ediff-dispose-of-variant-according-to-user): new function designed to be smarter and also understands indirect buffers. (ediff-highlight-diff-in-one-buffer, ediff-unhighlight-diff-in-one-buffer, ediff-unhighlight-diffs-totally-in-one-buffer, ediff-highlight-diff, ediff-highlight-diff, ediff-unhighlight-diff, ediff-unhighlight-diffs-totally, ediff-empty-diff-region-p, ediff-whitespace-diff-region-p, ediff-get-region-contents, ediff-make-current-diff-overlay): moved here. (ediff-format-bindings-of): new function by Hannu Koivisto <[e-mail]>. (ediff-setup): make sure the merge buffer is always widened and modifiable. (ediff-write-merge-buffer-and-maybe-kill): refuse to write the result of a merge into a file visited by another buffer. (ediff-arrange-autosave-in-merge-jobs): check if the merge file is visited by another buffer and ask to save/delete that buffer. (ediff-verify-file-merge-buffer): new function to do the above. * ediff-vers.el: load ediff-init.el at compile time. * ediff-wind.el: use ediff-cond-compile-for-xemacs-or-emacs. * ediff.el (ediff-windows, ediff-regions-wordwise, ediff-regions-linewise): use indirect buffers to improve robustness and make it possible to compare regions of the same buffer (even overlapping regions). (ediff-clone-buffer-for-region-comparison, ediff-clone-buffer-for-window-comparison): new functions. (ediff-files-internal): refuse to compare identical files. (ediff-regions-internal): get rid of the warning about comparing regions of the same buffer. * ediff-diff.el (ediff-convert-fine-diffs-to-overlays): moved here. Plus the following fixes courtesy of Dave Love: Doc fixes. (ediff-word-1): Use word class and move - to the front per regexp documentation. (ediff-wordify): Bind forward-word-function outside loop. (ediff-copy-to-buffer): Use insert-buffer-substring rather than consing buffer contents. (ediff-goto-word): Move syntax table setting outside loop.

42601:ddd4802ff361

;;; ediff-init.el --- Macros, variables, and defsubsts used by Ediff

;; Copyright (C) 1994, 1995, 1996, 1997, 2000 Free Software Foundation, Inc.

;; Author: Michael Kifer <[e-mail]>

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by

(defvar ediff-mouse-pixel-position)
(defvar ediff-mouse-pixel-threshold)
(defvar ediff-whitespace)
(defvar ediff-multiframe)
(defvar ediff-use-toolbar-p)

(and noninteractive
     (eval-when-compile
	 (load "ange-ftp" 'noerror)))
;; end pacifier

;; Is it XEmacs?
(defconst ediff-xemacs-p (string-match "XEmacs" emacs-version))
;; Is it Emacs?
(defconst ediff-emacs-p (not ediff-xemacs-p))

(defvar ediff-force-faces nil
  "If t, Ediff will think that it is running on a display that supports faces.
This is provided as a temporary relief for users of face-capable displays
that Ediff doesn't know about.")

;; Are we running as a window application or on a TTY?
(defsubst ediff-device-type ()
  (if ediff-emacs-p
      window-system
    (device-type (selected-device))))

;; in XEmacs: device-type is tty on tty and stream in batch.
(defun ediff-window-display-p ()
  (and (ediff-device-type) (not (memq (ediff-device-type) '(tty pc stream)))))

	(ediff-force-faces)
	((ediff-color-display-p))
	(ediff-emacs-p (memq (ediff-device-type) '(pc)))
	(ediff-xemacs-p (memq (ediff-device-type) '(tty pc)))))

(defun ediff-has-toolbar-support-p ()
  (and ediff-xemacs-p
       (featurep 'toolbar)
       (console-on-window-system-p)))

(defun ediff-use-toolbar-p ()
  (and (ediff-has-toolbar-support-p)	;Can it do it ?
       (boundp 'ediff-use-toolbar-p)
       ediff-use-toolbar-p))		;Does the user want it ?

(ediff-defvar-local ediff-buffer-C nil "")
;; 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)

to temp files when Ediff needs to find fine differences."
  :type 'symbol
  :group 'ediff)


(if ediff-xemacs-p
    (progn
      (fset 'ediff-read-event (symbol-function 'next-command-event))
      (fset 'ediff-overlayp (symbol-function 'extentp))
      (fset 'ediff-make-overlay (symbol-function 'make-extent))
      (fset 'ediff-delete-overlay (symbol-function 'delete-extent)))
  (fset 'ediff-read-event (symbol-function 'read-event))
  (fset 'ediff-overlayp (symbol-function 'overlayp))
  (fset 'ediff-make-overlay (symbol-function 'make-overlay))
  (fset 'ediff-delete-overlay (symbol-function 'delete-overlay)))

;; Check the current version against the major and minor version numbers
;; using op: cur-vers op major.minor If emacs-major-version or
;; emacs-minor-version are not defined, we assume that the current version
;; is hopelessly outdated.  We assume that emacs-major-version and

	  ((memq op '(< <=)) t))))


(defun ediff-color-display-p ()
  (condition-case nil
      (if ediff-emacs-p
	  (if (fboundp 'display-color-p)
	      (display-color-p)
	    (x-display-color-p))
	(eq (device-class (selected-device)) 'color))
    (error
     nil)))


(if (ediff-has-face-support-p)
    (if ediff-xemacs-p
	(progn
	  (fset 'ediff-valid-color-p (symbol-function 'valid-color-name-p))
	  (fset 'ediff-get-face (symbol-function 'get-face)))
      (fset 'ediff-valid-color-p (symbol-function
				  (if (fboundp 'color-defined-p)
				      'color-defined-p
				    'x-color-defined-p)))
      (fset 'ediff-get-face (symbol-function 'internal-get-face))))

(if (ediff-window-display-p)
    (if ediff-xemacs-p
	(progn
	  (fset 'ediff-display-pixel-width
		(symbol-function 'device-pixel-width))
	  (fset 'ediff-display-pixel-height
		(symbol-function 'device-pixel-height)))
      (fset 'ediff-display-pixel-width (symbol-function
					(if (fboundp 'display-pixel-width)
					    'display-pixel-width
					  'x-display-pixel-width)))
      (fset 'ediff-display-pixel-height (symbol-function
					 (if (fboundp 'display-pixel-height)
					     'display-pixel-height
					   'x-display-pixel-height)))))

;; A-list of current-diff-overlay symbols associated with buf types
(defconst ediff-current-diff-overlay-alist
  '((A . ediff-current-diff-overlay-A)
    (B . ediff-current-diff-overlay-B)

  '((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))
    ))

(defun ediff-set-overlay-face (extent face)
  (ediff-overlay-put extent 'face face)
  (ediff-overlay-put extent 'help-echo 'ediff-region-help-echo))

;; Compute priority of a current 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 ediff-shadow-overlay-priority
	   (apply 'max
		  (cons
		   1
		   (mapcar
		    (lambda (ovr)
		      (if (and ovr
			       ;; exclude ediff overlays from priority
			       ;; calculation, or else priority will keep
			       ;; increasing
			       (null (ediff-overlay-get ovr 'ediff))
			       (null (ediff-overlay-get ovr 'ediff-diff-num)))
			  ;; use the overlay priority or 0
			  (or (ediff-overlay-get ovr 'priority) 0)
			0))
		    ovr-list)
		   )
		  ))
	))))


(defvar ediff-toggle-read-only-function nil
  "*Specifies the function to be used to toggle read-only.
If nil, Ediff tries to deduce the function from the binding of C-x C-q.

(ediff-defvar-local ediff-temp-file-B nil "")
;; Temporary file used for refining difference regions in buffer C.
(ediff-defvar-local ediff-temp-file-C nil "")


;;; In-line functions

;; If file-remote-p is defined (as in XEmacs, use it. Otherwise, check
;; if find-file-name-handler is defined for 'file-local-copy
(defun ediff-file-remote-p (file-name)
  (or (and (fboundp 'file-remote-p) (file-remote-p file-name))
      (find-file-name-handler file-name 'file-local-copy)))

  (ediff-paint-background-regions-in-one-buffer
   'C unhighlight)
  (ediff-paint-background-regions-in-one-buffer
   '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
			   (ediff-highest-priority begin end-hilit buff))
	(ediff-overlay-put current-diff-overlay 'ediff-diff-num n)

	;; unhighlight the background overlay for diff n so it won't
	;; interfere with the current diff overlay
	(ediff-set-overlay-face (ediff-get-diff-overlay n buf-type) nil)
	)))


(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)

	;; rehighlight the overlay in the background of the
	;; current difference region
	(ediff-set-overlay-face
	 overlay
	 (if (and (ediff-has-face-support-p)
		  ediff-use-faces ediff-highlight-all-diffs)
	     (ediff-background-face buf-type ediff-current-difference)))
	)))

(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)
	)))


(defsubst ediff-highlight-diff (n)
  "Put face on diff N.  Invoked for X displays only."
  (ediff-highlight-diff-in-one-buffer n 'A)
  (ediff-highlight-diff-in-one-buffer n 'B)
  (ediff-highlight-diff-in-one-buffer n 'C)
  (ediff-highlight-diff-in-one-buffer n 'Ancestor)
  )


(defsubst ediff-unhighlight-diff ()
  "Remove overlays from buffers A, B, and C."
  (ediff-unhighlight-diff-in-one-buffer 'A)
  (ediff-unhighlight-diff-in-one-buffer 'B)
  (ediff-unhighlight-diff-in-one-buffer 'C)
  (ediff-unhighlight-diff-in-one-buffer 'Ancestor)
  )

;; delete highlighting overlays, restore faces to their original form
(defsubst ediff-unhighlight-diffs-totally ()
  (ediff-unhighlight-diffs-totally-in-one-buffer 'A)
  (ediff-unhighlight-diffs-totally-in-one-buffer 'B)
  (ediff-unhighlight-diffs-totally-in-one-buffer 'C)
  (ediff-unhighlight-diffs-totally-in-one-buffer 'Ancestor)
  )


;; arg is a record for a given diff in a difference vector
;; this record is itself a vector
(defsubst ediff-clear-fine-diff-vector (diff-record)
  (if diff-record

  (ediff-clear-fine-differences-in-one-buffer n 'B)
  (if ediff-3way-job
      (ediff-clear-fine-differences-in-one-buffer n 'C)))


(defsubst ediff-convert-fine-diffs-to-overlays (diff-list region-num)
  (ediff-set-fine-overlays-in-one-buffer 'A diff-list region-num)
  (ediff-set-fine-overlays-in-one-buffer 'B diff-list region-num)
  (if ediff-3way-job
      (ediff-set-fine-overlays-in-one-buffer 'C diff-list region-num)
    ))

(defsubst ediff-mouse-event-p (event)
  (if ediff-xemacs-p
      (button-event-p event)
    (string-match "mouse" (format "%S" (event-basic-type event)))
    ))


(defsubst ediff-key-press-event-p (event)
  (if ediff-xemacs-p
      (key-press-event-p event)
    (or (char-or-string-p event) (symbolp event))))

(defun ediff-event-point (event)
  (cond ((ediff-mouse-event-p event)
	 (if ediff-xemacs-p
	     (event-point event)
	   (posn-point (event-start event))))
	((ediff-key-press-event-p event)
	 (point))
	(t (error))))

(defun ediff-event-buffer (event)
  (cond ((ediff-mouse-event-p event)
	 (if ediff-xemacs-p
	     (event-buffer event)
	   (window-buffer (posn-window (event-start event)))))
	((ediff-key-press-event-p event)
	 (current-buffer))
	(t (error))))


(defsubst ediff-frame-iconified-p (frame)
  (if (and (ediff-window-display-p) (frame-live-p frame))
      (if ediff-xemacs-p
	  (frame-iconified-p frame)
	(eq (frame-visible-p frame) 'icon))))

(defsubst ediff-window-visible-p (wind)
  ;; under TTY, window-live-p also means window is visible
  (and (window-live-p wind)
       (or (not (ediff-window-display-p))
	   (frame-visible-p (window-frame wind)))))


(defsubst ediff-frame-char-width (frame)
  (if ediff-xemacs-p
      (/ (frame-pixel-width frame) (frame-width frame))
    (frame-char-width frame)))

(defun ediff-reset-mouse (&optional frame do-not-grab-mouse)
  (or frame (setq frame (selected-frame)))
  (if (ediff-window-display-p)
      (let ((frame-or-wind frame))

				  (cdr (cdr (mouse-pixel-position)))))
			  ediff-mouse-pixel-threshold))))
	    (t nil))))

(defsubst ediff-frame-char-height (frame)
  (if ediff-xemacs-p
      (glyph-height ediff-H-glyph (selected-window frame))
    (frame-char-height frame)))

;; Some overlay functions

(defsubst ediff-overlay-start (overl)
  (if (ediff-overlayp overl)
      (if ediff-emacs-p
	  (overlay-start overl)
	(extent-start-position overl))))

(defsubst ediff-overlay-end  (overl)
  (if (ediff-overlayp overl)
      (if ediff-emacs-p
	  (overlay-end overl)
	(extent-end-position overl))))

(defsubst ediff-empty-overlay-p (overl)
  (= (ediff-overlay-start overl) (ediff-overlay-end overl)))

;; like overlay-buffer in Emacs.  In XEmacs, returns nil if the extent is
;; dead.  Otherwise, works like extent-buffer
(defun ediff-overlay-buffer (overl)
  (if ediff-emacs-p
      (overlay-buffer overl)
    (and (extent-live-p overl) (extent-object overl))))

;; like overlay-get in Emacs.  In XEmacs, returns nil if the extent is
;; dead.  Otherwise, like extent-property
(defun ediff-overlay-get (overl property)
  (if ediff-emacs-p
      (overlay-get overl property)
    (and (extent-live-p overl) (extent-property overl property))))


;; These two functions are here because XEmacs refuses to
;; handle overlays whose buffers were deleted.
(defun ediff-move-overlay (overlay beg end &optional buffer)
  "Calls `move-overlay' in Emacs and `set-extent-endpoints' in Lemacs.
Checks if overlay's buffer exists before actually doing the move."
  (let ((buf (and overlay (ediff-overlay-buffer overlay))))
    (if (ediff-buffer-live-p buf)
	(if ediff-xemacs-p
	    (set-extent-endpoints overlay beg end)
	  (move-overlay overlay beg end buffer))
      ;; buffer's dead
      (if overlay
	  (ediff-delete-overlay overlay)))))

(defun ediff-overlay-put (overlay prop value)
  "Calls `overlay-put' or `set-extent-property' depending on Emacs version.
Checks if overlay's buffer exists."
  (if (ediff-buffer-live-p (ediff-overlay-buffer overlay))
      (if ediff-xemacs-p
	  (set-extent-property overlay prop value)
	(overlay-put overlay prop value))
    (ediff-delete-overlay overlay)))

;; Some diff region tests

;; t if diff region is empty.
;; In case of buffer C, t also if it is not a 3way
;; comparison job (merging jobs return t as well).
(defun ediff-empty-diff-region-p (n buf-type)
  (if (eq buf-type 'C)
      (or (not ediff-3way-comparison-job)
	  (= (ediff-get-diff-posn 'C 'beg n)
	     (ediff-get-diff-posn 'C 'end n)))
    (= (ediff-get-diff-posn buf-type 'beg n)
       (ediff-get-diff-posn buf-type 'end n))))

;; Test if diff region is white space only.
;; If 2-way job and buf-type = C, then returns t.
(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))))))

;; temporarily uses DIR to abbreviate file name
;; if DIR is nil, use default-directory
(defun ediff-abbreviate-file-name (file &optional dir)
  (cond ((stringp dir)
	 (let ((directory-abbrev-alist (list (cons dir ""))))
	   (abbreviate-file-name file)))
	(ediff-emacs-p (abbreviate-file-name file))
	(t ; XEmacs requires addl argument
	 (abbreviate-file-name file t))))

;; Takes a directory and returns the parent directory.
;; does nothing to `/'.  If the ARG is a regular file,
;; strip the file AND the last dir.
(defun ediff-strip-last-dir (dir)

	 (capitalize
	  (subst-char-in-string ?- ?\  (substring (symbol-name jobname) 6))))
	))


(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
(defsubst ediff-strip-mode-line-format ()
  (if (member (car mode-line-format) '(" A: " " B: " " C: " " Ancestor: "))
      (setq mode-line-format (nth 2 mode-line-format))))

42602:633233bf2bbf

;;; ediff-init.el --- Macros, variables, and defsubsts used by Ediff

;; Copyright (C) 1994, 95, 96, 97, 98, 99, 2000, 01, 02 Free Software Foundation, Inc.

;; Author: Michael Kifer <[e-mail]>

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by

(defvar ediff-mouse-pixel-position)
(defvar ediff-mouse-pixel-threshold)
(defvar ediff-whitespace)
(defvar ediff-multiframe)
(defvar ediff-use-toolbar-p)
(defvar mswindowsx-bitmap-file-path)

(and noninteractive
     (eval-when-compile
	 (load "ange-ftp" 'noerror)))
;; end pacifier

;; Is it XEmacs?
(defconst ediff-xemacs-p (string-match "XEmacs" emacs-version))
;; Is it Emacs?
(defconst ediff-emacs-p (not ediff-xemacs-p))

;; This is used to avoid compilation warnings. When emacs/xemacs forms can
;; generate compile time warnings, we use this macro.
;; In this case, the macro will expand into the form that is appropriate to the
;; compiler at hand.
;; Suggested by rms.
(defmacro ediff-cond-compile-for-xemacs-or-emacs (xemacs-form emacs-form)
  (if (string-match "XEmacs" emacs-version)
      xemacs-form emacs-form))

(defvar ediff-force-faces nil
  "If t, Ediff will think that it is running on a display that supports faces.
This is provided as a temporary relief for users of face-capable displays
that Ediff doesn't know about.")

;; Are we running as a window application or on a TTY?
(defsubst ediff-device-type ()
  (ediff-cond-compile-for-xemacs-or-emacs
   (device-type (selected-device)) ; xemacs form
   window-system  ; emacs form
   ))

;; in XEmacs: device-type is tty on tty and stream in batch.
(defun ediff-window-display-p ()
  (and (ediff-device-type) (not (memq (ediff-device-type) '(tty pc stream)))))

	(ediff-force-faces)
	((ediff-color-display-p))
	(ediff-emacs-p (memq (ediff-device-type) '(pc)))
	(ediff-xemacs-p (memq (ediff-device-type) '(tty pc)))))

;; toolbar support for emacs hasn't been implemented in ediff
(defun ediff-has-toolbar-support-p ()
  (ediff-cond-compile-for-xemacs-or-emacs
   (and (featurep 'toolbar) (console-on-window-system-p)) ; xemacs form
   nil ; emacs form
   ))

(defun ediff-use-toolbar-p ()
  (and (ediff-has-toolbar-support-p)	;Can it do it ?
       (boundp 'ediff-use-toolbar-p)
       ediff-use-toolbar-p))		;Does the user want it ?

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

(ediff-defvar-local ediff-temp-indirect-buffer nil
  "If t, the buffer is a temporary indirect buffer.
It needs to be killed when we quit the session.")


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

to temp files when Ediff needs to find fine differences."
  :type 'symbol
  :group 'ediff)


(ediff-cond-compile-for-xemacs-or-emacs
 (progn ; xemacs
   (fset 'ediff-read-event (symbol-function 'next-command-event))
   (fset 'ediff-overlayp (symbol-function 'extentp))
   (fset 'ediff-make-overlay (symbol-function 'make-extent))
   (fset 'ediff-delete-overlay (symbol-function 'delete-extent)))
 (progn ; emacs
   (fset 'ediff-read-event (symbol-function 'read-event))
   (fset 'ediff-overlayp (symbol-function 'overlayp))
   (fset 'ediff-make-overlay (symbol-function 'make-overlay))
   (fset 'ediff-delete-overlay (symbol-function 'delete-overlay)))
 )

;; Check the current version against the major and minor version numbers
;; using op: cur-vers op major.minor If emacs-major-version or
;; emacs-minor-version are not defined, we assume that the current version
;; is hopelessly outdated.  We assume that emacs-major-version and

	  ((memq op '(< <=)) t))))


(defun ediff-color-display-p ()
  (condition-case nil
      (ediff-cond-compile-for-xemacs-or-emacs
       (eq (device-class (selected-device)) 'color) ; xemacs form
       (if (fboundp 'display-color-p) ; emacs form
	   (display-color-p)
	 (x-display-color-p))
	)
    (error nil)))


(if (ediff-has-face-support-p)
    (ediff-cond-compile-for-xemacs-or-emacs
     (progn ; xemacs
       (defalias 'ediff-valid-color-p 'valid-color-name-p)
       (defalias 'ediff-get-face 'get-face))
     (progn ; emacs
       (defalias 'ediff-valid-color-p (if (fboundp 'color-defined-p)
					  'color-defined-p
					'x-color-defined-p))
       (defalias 'ediff-get-face 'internal-get-face))
     ))

(if (ediff-window-display-p)
    (ediff-cond-compile-for-xemacs-or-emacs
     (progn   ; xemacs
       (fset 'ediff-display-pixel-width (symbol-function 'device-pixel-width))
       (fset 'ediff-display-pixel-height
	     (symbol-function 'device-pixel-height)))
     (progn   ; emacs
       (fset 'ediff-display-pixel-width
	     (if (fboundp 'display-pixel-width)
		 (symbol-function 'display-pixel-width)
	       (symbol-function 'x-display-pixel-width)))
       (fset 'ediff-display-pixel-height
	     (if (fboundp 'display-pixel-height)
		 (symbol-function 'display-pixel-height)
	       (symbol-function 'x-display-pixel-height))))
     ))

;; A-list of current-diff-overlay symbols associated with buf types
(defconst ediff-current-diff-overlay-alist
  '((A . ediff-current-diff-overlay-A)
    (B . ediff-current-diff-overlay-B)

  '((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-set-overlay-face (extent face)
  (ediff-overlay-put extent 'face face)
  (ediff-overlay-put extent 'help-echo 'ediff-region-help-echo))

;; Compute priority of a current ediff overlay.
(defun ediff-highest-priority (start end buffer)
  (let ((pos (max 1 (1- start)))
	ovr-list)
    (ediff-cond-compile-for-xemacs-or-emacs
     (1+ ediff-shadow-overlay-priority)  ; xemacs form
     ;; emacs form
     (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 ediff-shadow-overlay-priority
	  (apply 'max
		 (cons
		  1
		  (mapcar
		   (lambda (ovr)
		     (if (and ovr
			      ;; exclude ediff overlays from priority
			      ;; calculation, or else priority will keep
			      ;; increasing
			      (null (ediff-overlay-get ovr 'ediff))
			      (null (ediff-overlay-get ovr 'ediff-diff-num)))
			 ;; use the overlay priority or 0
			 (or (ediff-overlay-get ovr 'priority) 0)
		       0))
		   ovr-list)
		  )
		 )))
     ) ; ediff-cond-compile-for-xemacs-or-emacs
    ))


(defvar ediff-toggle-read-only-function nil
  "*Specifies the function to be used to toggle read-only.
If nil, Ediff tries to deduce the function from the binding of C-x C-q.

(ediff-defvar-local ediff-temp-file-B nil "")
;; Temporary file used for refining difference regions in buffer C.
(ediff-defvar-local ediff-temp-file-C nil "")


;; If file-remote-p is defined (as in XEmacs, use it. Otherwise, check
;; if find-file-name-handler is defined for 'file-local-copy
(defun ediff-file-remote-p (file-name)
  (or (and (fboundp 'file-remote-p) (file-remote-p file-name))
      (find-file-name-handler file-name 'file-local-copy)))

  (ediff-paint-background-regions-in-one-buffer
   'C unhighlight)
  (ediff-paint-background-regions-in-one-buffer
   'Ancestor unhighlight))


;; arg is a record for a given diff in a difference vector
;; this record is itself a vector
(defsubst ediff-clear-fine-diff-vector (diff-record)
  (if diff-record

  (ediff-clear-fine-differences-in-one-buffer n 'B)
  (if ediff-3way-job
      (ediff-clear-fine-differences-in-one-buffer n 'C)))


(defsubst ediff-mouse-event-p (event)
  (ediff-cond-compile-for-xemacs-or-emacs
   (button-event-p event) ; xemacs form
   (string-match "mouse" (format "%S" (event-basic-type event))) ; emacs form
   ))


(defsubst ediff-key-press-event-p (event)
  (ediff-cond-compile-for-xemacs-or-emacs
   (key-press-event-p event) ; xemacs form
   (or (char-or-string-p event) (symbolp event)) ; emacs form
   ))

(defun ediff-event-point (event)
  (cond ((ediff-mouse-event-p event)
	 (ediff-cond-compile-for-xemacs-or-emacs
	  (event-point event)               ; xemacs form
	  (posn-point (event-start event))  ; emacs form
	  )
	 )
	((ediff-key-press-event-p event)
	 (point))
	(t (error nil))))

(defun ediff-event-buffer (event)
  (cond ((ediff-mouse-event-p event)
	 (ediff-cond-compile-for-xemacs-or-emacs
	  (event-buffer event)                              ; xemacs form
	  (window-buffer (posn-window (event-start event))) ; emacs form
	  )
	 )
	((ediff-key-press-event-p event)
	 (current-buffer))
	(t (error nil))))

(defun ediff-event-key (event-or-key)
  (ediff-cond-compile-for-xemacs-or-emacs
   (if (eventp event-or-key) (event-key event-or-key) event-or-key) ; xemacs
   event-or-key   ; emacs form
   ))


(defsubst ediff-frame-iconified-p (frame)
  (if (and (ediff-window-display-p) (frame-live-p frame))
      (ediff-cond-compile-for-xemacs-or-emacs
       (frame-iconified-p frame)          ; xemacs form
       (eq (frame-visible-p frame) 'icon) ; emacs form
       )
    ))

(defsubst ediff-window-visible-p (wind)
  ;; under TTY, window-live-p also means window is visible
  (and (window-live-p wind)
       (or (not (ediff-window-display-p))
	   (frame-visible-p (window-frame wind)))))


(defsubst ediff-frame-char-width (frame)
  (ediff-cond-compile-for-xemacs-or-emacs
   (/ (frame-pixel-width frame) (frame-width frame)) ; xemacs
   (frame-char-width frame) ; emacs
   ))

(defun ediff-reset-mouse (&optional frame do-not-grab-mouse)
  (or frame (setq frame (selected-frame)))
  (if (ediff-window-display-p)
      (let ((frame-or-wind frame))

				  (cdr (cdr (mouse-pixel-position)))))
			  ediff-mouse-pixel-threshold))))
	    (t nil))))

(defsubst ediff-frame-char-height (frame)
  (ediff-cond-compile-for-xemacs-or-emacs 
   (glyph-height ediff-H-glyph (selected-window frame)) ; xemacs cse
   (frame-char-height frame) ; emacs case
   )
  )

;; Some overlay functions

(defsubst ediff-overlay-start (overl)
  (if (ediff-overlayp overl)
      (ediff-cond-compile-for-xemacs-or-emacs
       (extent-start-position overl) ; xemacs form
       (overlay-start overl)         ; emacs form
       )
    ))

(defsubst ediff-overlay-end  (overl)
  (if (ediff-overlayp overl)
      (ediff-cond-compile-for-xemacs-or-emacs
       (extent-end-position overl) ; xemacs form
       (overlay-end overl) ; emacs form
       )
    ))

(defsubst ediff-empty-overlay-p (overl)
  (= (ediff-overlay-start overl) (ediff-overlay-end overl)))

;; like overlay-buffer in Emacs.  In XEmacs, returns nil if the extent is
;; dead.  Otherwise, works like extent-buffer
(defun ediff-overlay-buffer (overl)
  (ediff-cond-compile-for-xemacs-or-emacs
   (and (extent-live-p overl) (extent-object overl)) ; xemacs form
   (overlay-buffer overl) ; emacs form
   ))

;; like overlay-get in Emacs.  In XEmacs, returns nil if the extent is
;; dead.  Otherwise, like extent-property
(defun ediff-overlay-get (overl property)
  (ediff-cond-compile-for-xemacs-or-emacs
   (and (extent-live-p overl) (extent-property overl property)) ; xemacs form
   (overlay-get overl property) ; emacs form
   ))


;; These two functions are here because XEmacs refuses to
;; handle overlays whose buffers were deleted.
(defun ediff-move-overlay (overlay beg end &optional buffer)
  "Calls `move-overlay' in Emacs and `set-extent-endpoints' in Lemacs.
Checks if overlay's buffer exists before actually doing the move."
  (let ((buf (and overlay (ediff-overlay-buffer overlay))))
    (if (ediff-buffer-live-p buf)
	(ediff-cond-compile-for-xemacs-or-emacs
	 (set-extent-endpoints overlay beg end) ; xemacs form
	 (move-overlay overlay beg end buffer)  ; emacs form
	 )
      ;; buffer's dead
      (if overlay
	  (ediff-delete-overlay overlay)))))

(defun ediff-overlay-put (overlay prop value)
  "Calls `overlay-put' or `set-extent-property' depending on Emacs version.
Checks if overlay's buffer exists."
  (if (ediff-buffer-live-p (ediff-overlay-buffer overlay))
      (ediff-cond-compile-for-xemacs-or-emacs
       (set-extent-property overlay prop value) ; xemacs form
       (overlay-put overlay prop value) ; emacs form
       )
    (ediff-delete-overlay overlay)))

;; temporarily uses DIR to abbreviate file name
;; if DIR is nil, use default-directory
(defun ediff-abbreviate-file-name (file &optional dir)
  (cond ((stringp dir)
	 (let ((directory-abbrev-alist (list (cons dir ""))))
	   (abbreviate-file-name file)))
	(t
	 (ediff-cond-compile-for-xemacs-or-emacs
	  ;; XEmacs requires addl argument
	  (abbreviate-file-name file t) ; xemacs form
	  (abbreviate-file-name file))  ; emacs form
	 )
	))

;; Takes a directory and returns the parent directory.
;; does nothing to `/'.  If the ARG is a regular file,
;; strip the file AND the last dir.
(defun ediff-strip-last-dir (dir)

	 (capitalize
	  (subst-char-in-string ?- ?\  (substring (symbol-name jobname) 6))))
	))


;; If ediff modified mode line, strip the modification
(defsubst ediff-strip-mode-line-format ()
  (if (member (car mode-line-format) '(" A: " " B: " " C: " " Ancestor: "))
      (setq mode-line-format (nth 2 mode-line-format))))