;;;
;;; Emacs 18 sites specific code.
;;;
;;; ----------------------------------------------------------------------
;;; This file is part of ILOG Talk.
;;; Inquiries to ILOG S.A.
;;;              9 rue de Verdun, BP 85,
;;;              94253 Gentilly Cedex, France.
;;;
;;; Copyright (c) 1993-1996 by ILOG
;;; ----------------------------------------------------------------------
;;;


;; Methods for tm:site-make-extent
;; -------------------------------
;;

(tm:defmethod tm:site-make-extent ((site tm:site) begin end)
  "Create an extent from BEGIN to END in site's buffer. An extent is
just a pair of markers."
  (let ((buffer (get-buffer (tm:site-bufname site)))
	(begin-marker (make-marker))
	(end-marker (make-marker)))
    (set-marker begin-marker begin buffer)
    (set-marker end-marker end buffer)
    (cons begin-marker end-marker)))


;; Methods for tm:site-delete-extent
;; ---------------------------------
;;

(tm:defmethod tm:site-delete-extent ((site tm:site) extent)
  "Delete in EXTENT in BUFFER with ATTRIBUTE."
  (tm:site-dehighlight-extent site extent))


;; Methods for tm:site-highlight-extent
;; ------------------------------------
;;

(tm:defmethod tm:site-highlight-extent ((site tm:site) extent)
  (tm:put-overlay-arrow site extent))

(tm:defmethod tm:site-highlight-extent ((site tm:search-site) extent)
  (tm:put-overlay-arrow site extent))

(tm:defmethod tm:site-highlight-extent ((site tm:step-in-site) extent)
  (tm:put-overlay-arrow site extent))

(tm:defmethod tm:site-highlight-extent ((site tm:step-out-site) extent)
  (tm:put-overlay-arrow site extent))

(tm:defmethod tm:site-highlight-extent ((site tm:breakpoint-site) extent)
  (tm:put-overlay-arrow site extent))

(tm:defmethod tm:site-highlight-extent ((site tm:error-site) extent)
  (tm:put-overlay-arrow site extent))

(defun tm:put-overlay-arrow (site extent)
  "Put an overlay arrow pointing at EXTENT."
  (let ((buffer (get-buffer (tm:site-bufname site)))
	(begin (car extent)))
    (if buffer
	(save-excursion
	  (set-buffer buffer)
	  (setq overlay-arrow-position
		(save-excursion
		  (goto-char begin)
		  (beginning-of-line)
		  (point-marker)))))))


;; Methods for tm:site-dehighlight-extent
;; --------------------------------------
;;

(tm:defmethod tm:site-dehighlight-extent ((site tm:site) extent)
  "Dehighlight EXTENT."
  (let ((buffer (get-buffer (tm:site-bufname site)))
	(begin (car extent)))
    (if buffer
	(save-excursion 
	  (set-buffer buffer)
	  (if (and overlay-arrow-position
		   (= overlay-arrow-position
		      (save-excursion
			(goto-char begin)
			(beginning-of-line)
			(point))))
	      (setq overlay-arrow-position ()))))))


;; Methods for tm:site-show-extent
;; -------------------------------
;;

(tm:defmethod tm:site-show-extent ((site tm:site) extent herep gotop)
  (let ((buffer (get-buffer (tm:site-bufname site))))
    (if buffer
	(let ((point (tm:site-extent-hot-point site extent))
	      (window (tm:show-buffer buffer herep gotop)))
	  (set-window-point window point)
	  (if (not gotop)
	      (save-window-excursion
		(select-window window)
		(sit-for 1)))))))


;; Methods for tm:site-extent-showable-p
;; -------------------------------------
;;

(tm:defmethod tm:site-extent-showable-p ((site tm:site) extent)
  "Return T if the extent can be shown, and () otherwise."
  (get-buffer (tm:site-bufname site)))


;; Methods for tm:site-extent-hot-point
;; ------------------------------------
;;

(tm:defmethod tm:site-extent-hot-point ((site tm:site) extent)
  (cdr extent))

(tm:defmethod tm:site-extent-hot-point ((site tm:step-out-site) extent)
  (cdr extent))


;; Start and end positions
;; -----------------------
;;

(defun tm:extent-start-position (extent)
  "Return the start positions of EXTENT."
  (car extent))

(defun tm:extent-end-position (extent)
  "Return the end positions of EXTENT."
  (cdr extent))


(provide 'talk-sites18)
