;;; Copyright (C) 1991 Christopher J. Love
;;;
;;; This file is for use with Epoch, a modified version of GNU Emacs.
;;; Requires Epoch 4.0 or later.
;;;
;;; This code is distributed in the hope that it will be useful,
;;; bute WITHOUT ANY WARRANTY. No author or distributor accepts
;;; responsibility to anyone for the consequences of using this code
;;; or for whether it serves any particular purpose or works at all,
;;; unless explicitly stated in a written agreement.
;;;
;;; Everyone is granted permission to copy, modify and redistribute
;;; this code, but only under the conditions described in the
;;; GNU Emacs General Public License, except the original author nor his
;;; agents are bound by the License in their use of this code.
;;; (These special rights for the author in no way restrict the rights of
;;;  others given in the License or this prologue)
;;; A copy of this license is supposed to have been given to you along
;;; with Epoch so you can know your rights and responsibilities. 
;;; It should be in a file named COPYING.  Among other things, the
;;; copyright notice and this notice must be preserved on all copies. 
;;;
;;; $Revision: 1.3 $
;;; $Source: /import/kaplan/stable/distrib/epoch-4.2/epoch-lisp/RCS/zone.el,v $
;;; $Date: 92/08/05 17:00:22 $
;;; $Author: marca $
;;;
(require 'mini-cl)
(provide 'zone)

(defun epoch::add-zone (start end style &optional data buffer)
  "Adds a zone to from START to END having STYLE and DATA in an
optional BUFFER. START and END should be markers or integers. STYLE
must be a style or nil.  DATA can be any lisp object. Returns the
zone if successful."  
  (let
    (
      (zone (epoch::move-zone (epoch::make-zone) start end buffer))
    )
    (when zone
      (epoch::set-zone-data zone data)
      (epoch::set-zone-style zone style)
    )
    zone
  )
)
(fset 'add-zone (symbol-function 'epoch::add-zone))
;;; --------------------------------------------------------------------------
;;; some utility functions
;;;
(defun add-read-only-zone (start end style &optional data buffer)
  "Adds a read-only-zone from START to END having STYLE and DATA in an
optional BUFFER.  START and END should be markers or integers.
STYLE must be a style or nil.  DATA can be any lisp object.  Returns
zone if successful" 
  (set-zone-read-only
    (add-zone start end style data buffer)
    t
  )
)

(if (functionp 'epoch::query-pixmap)
    (defun add-graphic-zone (name start end &optional offset data buffer ro)
      "Adds a graphical zone using pixmap NAME from START to END having
    DATA in an optional BUFFER.  START and END should be markers or
    integers.  OFFSET can be a percentage value (0-100) for vertical
    offset of pixmap.  DATA can be any lisp object.  Returns zone if
    successful" 
     (let
      (
	(pix (read-pixmap-file name))
	dim
	style
	font
	fname
      )
      (if pix
	(progn
	  ; get the pixmap dimensions
	  (setq dim (query-pixmap pix))
	  ; define the opaque font
	  (if offset
	    (setq fname (concat "F" (car dim) "x" (cadr dim) "+" offset))
	    (setq fname (concat "F" (car dim) "x" (cadr dim)))
	  )
	  (setq font
	    (define-opaque-font 
	      fname
	      (cadr dim)	      
	      (car dim)
	      offset
	  ))
	  ; make the style
	  (setq style (make-style))
	  (set-style-font style font)
	  (set-style-pixmap style pix)
	  ; add the zone
	  (if ro
	    (add-read-only-zone start end style data buffer)
	    (add-zone start end style data buffer)
	))
  )))
)

;;;
(defun zone-text (&optional zone)
"Returns the text contained inside the ZONE as a string."
  (and zone (not (zonep zone))
    (signal 'wrong-type-argument (list 'zonep zone))
  )
  (setq zone (or zone (zone-at)))
  (let
    (
      (buff (and zone (zone-buffer zone)))
    )
    (if (bufferp buff)
      (save-excursion
	(set-buffer buff)
	(buffer-substring (zone-start zone) (zone-end zone))
      )
      ""
    )
  )
)