;;;
;;; Emacs 19 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)
  (let ((buffer (get-buffer (tm:site-bufname site))))
    (make-extent begin end buffer)))

(defun tm:locate-file (file)
  "Search FILE in the load-path."
  (let ((paths load-path)
	(result ()))
    (while (and paths (null result))
      (let ((file (concat (car paths) "/" file)))
	(if (file-exists-p file)
	    (setq result file)
	  (setq paths (cdr paths)))))
    result))
		       
(defconst tm:breakpoint-pixmap
  (let ((file (tm:locate-file "icons/breakpoint.xbm")))
    (if (null file)
	(error "Cannot locate the icons directory in the load-path."))
    (make-pixmap file))
  "The breakpoint bitmap.")

(tm:defmethod tm:site-make-extent ((site tm:breakpoint-site) begin end)
  (let* ((buffer (get-buffer (tm:site-bufname site)))
	 (extent (make-extent begin end buffer)))
    (set-extent-begin-glyph extent tm:breakpoint-pixmap)
    extent))


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

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


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

(tm:defmethod tm:site-highlight-extent ((site tm:site) extent)
  ())

(tm:defmethod tm:site-highlight-extent ((site tm:search-site) extent)
  (tm:highlight-with-face extent tm:search-face))

(tm:defmethod tm:site-highlight-extent ((site tm:step-in-site) extent)
  (tm:highlight-with-face extent tm:step-in-face))

(tm:defmethod tm:site-highlight-extent ((site tm:step-out-site) extent)
  (tm:highlight-with-face extent tm:step-out-face))

(tm:defmethod tm:site-highlight-extent ((site tm:error-site) extent)
  (tm:highlight-with-face extent tm:error-face))

(tm:defmethod tm:site-highlight-extent ((site tm:breakpoint-site) extent)
  ())

(defun tm:highlight-with-face (extent face)
  (if (tm:extent-live-p extent)
      (set-extent-face extent face)))


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

(tm:defmethod tm:site-dehighlight-extent ((site tm:site) extent)
  (if (tm:extent-live-p extent)
      (set-extent-face extent 'default)))


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

(tm:defmethod tm:site-show-extent ((site tm:site) extent herep gotop)
  (if (tm:extent-live-p extent)
      (let* ((buffer (get-buffer (tm:site-bufname site)))
	     (point (tm:site-extent-hot-point site extent)))
	(set-window-point (tm:show-buffer buffer herep gotop) point))))

;; 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."
  (tm:extent-live-p extent))

(defun tm:extent-live-p (extent)
  "Return T if the extent can be shown, and () otherwise."
  (let ((props (extent-properties extent)))
    (and 
      (not (memq 'destroyed props))
      (not (memq 'detached props))
      (buffer-name (extent-buffer extent))
      (>= (extent-start-position extent) 0))))


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

(tm:defmethod tm:site-extent-hot-point ((site tm:site) extent)
  (extent-start-position extent))

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


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

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

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


;; Volatile sites mode
;; -------------------
;;

(add-hook (if gnu-emacs-p
	      'activate-mark-hook
	    'zmacs-activate-region-hook)
	  'tm:zmacs-activate-region-hook)

(defun tm:zmacs-activate-region-hook ()
  (if tml:highlighted-site
      (tm:site-dehighlight tml:highlighted-site)))

(setq before-change-function 'tm:before-change-function)

(defun tm:before-change-function (start end)
  (if tml:highlighted-site
      (tm:site-dehighlight tml:highlighted-site)))


(provide 'talk-sites19)
